如何在不使用Indy组件的情况下ping Delphi 10.1中的IP地址?

时间:2017-04-27 21:00:11

标签: delphi ping icmp

如何在不使用Indy组件的情况下ping Delphi 10.1中的IP地址(或服务器名称)? TIdICMPClient可以使用提升的权限,但我希望以普通用户身份进行操作。

3 个答案:

答案 0 :(得分:3)

使用Windows API。

像这样粗略的翻译:https://msdn.microsoft.com/en-us/library/windows/desktop/aa366050(v=vs.85).aspx
应该做的伎俩。

guard let data2 = Data.init(base64Encoded: b64Key) else {
   return
}

let keyDict:[NSObject:NSObject] = [
   kSecAttrKeyType: kSecAttrKeyTypeRSA,
   kSecAttrKeyClass: kSecAttrKeyClassPublic,
   kSecAttrKeySizeInBits: NSNumber(value: 512),
   kSecReturnPersistentRef: true as NSObject
]

guard let publicKey = SecKeyCreateWithData(data2 as CFData, keyDict as CFDictionary, nil) else {
    return
}

答案 1 :(得分:1)

这里是一个Delphi单元,它执行ping操作并超时:

unit Ping2;

interface

function PingHost(const HostName:string;TimeoutMS:cardinal=500):boolean;

implementation

uses Windows, SysUtils, WinSock, Sockets;

function IcmpCreateFile:THandle; stdcall; external 'iphlpapi.dll';
function IcmpCloseHandle(icmpHandle:THandle):boolean; stdcall; external 'iphlpapi.dll'
function IcmpSendEcho(IcmpHandle:THandle;DestinationAddress:In_Addr;RequestData:Pointer;
  RequestSize:Smallint;RequestOptions:pointer;ReplyBuffer:Pointer;ReplySize:DWORD;
  Timeout:DWORD):DWORD; stdcall; external 'iphlpapi.dll';

type
  TEchoReply=packed record
    Addr:in_addr;
    Status:DWORD;
    RoundTripTime:DWORD;
    //DataSize:
    //Reserved:
    //Data:pointer;
    //Options:
  end;
  PEchoReply=^TEchoReply;

function PingHost(const HostName:string;TimeoutMS:cardinal=500):boolean;
const
  rSize=$400;
var
  e:PHostEnt;
  a:PInAddr;
  h:THandle;
  d:string;
  r:array[0..rSize-1] of byte;
  i:cardinal;
begin
  //assert WSAStartup called
  e:=gethostbyname(PChar(HostName));
  if e=nil then RaiseLastOSError;
  if e.h_addrtype=AF_INET then pointer(a):=e.h_addr^ else raise Exception.Create('Name doesn''t resolve to an IPv4 address');

  d:=FormatDateTime('yyyymmddhhnnsszzz',Now);

  h:=IcmpCreateFile;
  if h=INVALID_HANDLE_VALUE then RaiseLastOSError;
  try
    i:=IcmpSendEcho(h,a^,PChar(d),Length(d),nil,@r[0],rSize,TimeoutMS);
    Result:=(i<>0) and (PEchoReply(@r[0]).Status=0);
  finally
    IcmpCloseHandle(h);
  end;
end;

end.

答案 2 :(得分:1)

其他答案缺少一些内容。

这是完成技巧的完整单元:

unit Ping2;

interface

function PingHost(const HostName: AnsiString; TimeoutMS: cardinal = 500): boolean;

implementation

uses Windows, SysUtils, WinSock;

function IcmpCreateFile: THandle; stdcall; external 'iphlpapi.dll';
function IcmpCloseHandle(icmpHandle: THandle): boolean; stdcall;
  external 'iphlpapi.dll';
function IcmpSendEcho(icmpHandle: THandle; DestinationAddress: In_Addr;
  RequestData: Pointer; RequestSize: Smallint; RequestOptions: Pointer;
  ReplyBuffer: Pointer; ReplySize: DWORD; Timeout: DWORD): DWORD; stdcall;
  external 'iphlpapi.dll';

type
  TEchoReply = packed record
    Addr: In_Addr;
    Status: DWORD;
    RoundTripTime: DWORD;
  end;

  PEchoReply = ^TEchoReply;

var
  WSAData: TWSAData;

procedure Startup;
begin
  if WSAStartup($0101, WSAData) <> 0 then
    raise Exception.Create('WSAStartup');
end;

procedure Cleanup;
begin
  if WSACleanup <> 0 then
    raise Exception.Create('WSACleanup');
end;

function PingHost(const HostName: AnsiString;
  TimeoutMS: cardinal = 500): boolean;
const
  rSize = $400;
var
  e: PHostEnt;
  a: PInAddr;
  h: THandle;
  d: string;
  r: array [0 .. rSize - 1] of byte;
  i: cardinal;
begin
  Startup;
  e := gethostbyname(PAnsiChar(HostName));
  if e = nil then
    RaiseLastOSError;
  if e.h_addrtype = AF_INET then
    Pointer(a) := e.h_addr^
  else
    raise Exception.Create('Name doesn''t resolve to an IPv4 address');

  d := FormatDateTime('yyyymmddhhnnsszzz', Now);

  h := IcmpCreateFile;
  if h = INVALID_HANDLE_VALUE then
    RaiseLastOSError;
  try
    i := IcmpSendEcho(h, a^, PChar(d), Length(d), nil, @r[0], rSize, TimeoutMS);
    Result := (i <> 0) and (PEchoReply(@r[0]).Status = 0);
  finally
    IcmpCloseHandle(h);
  end;
  Cleanup;
end;

end.

您可以通过如下点击事件来调用它:

procedure TForm1.button1Click(Sender: TObject);
begin
  if PingHost('172.16.24.2') then
    ShowMessage('WORKED')
  else
    ShowMessage('FAILED');
end;

请记住在您的uses列表中添加“ Ping2”单元。