【Delphi】以 icmp.dll 去 ping 網路設備

參考資料 ----
Implementing PING Without Using Raw Sockets


若不用 Indy 的 TIdIcmpClient 元件，可藉 Winsock 1.1 的 icmp.dll 開發；適 XP 環境，以 Delphi7 開發

注意：執行程式需要具有系統管理員權限


新增一個 unit 檔，檔名為 raw_ping.pas

 
unit raw_ping;

interface
uses
  Windows, SysUtils, Classes;

type
  TSunB = packed record
    s_b1, s_b2, s_b3, s_b4: byte;
  end;

  TSunW = packed record
    s_w1, s_w2: word;
  end;

  PIPAddr = ^TIPAddr;
  TIPAddr = record
    case integer of
      0: (S_un_b: TSunB);
      1: (S_un_w: TSunW);
      2: (S_addr: longword);
  end;

 IPAddr = TIPAddr;

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

implementation

uses
    WinSock;

function Fetch(var AInput: string; const ADelim: string=' '; const ADelete: Boolean=true): string;
var
    iPos: Integer;
begin
    if ADelim=#0 then
        begin
            // AnsiPos does not work with #0
            iPos := Pos(ADelim, AInput);
        end
    else
        begin
            iPos := Pos(ADelim, AInput);
        end;
    if iPos=0 then
        begin
            Result := AInput;
            if ADelete then
            begin
                AInput := '';
            end;
        end
    else
        begin
            result := Copy(AInput, 1, iPos - 1);
            if ADelete then
            begin
                Delete(AInput, 1, iPos + Length(ADelim) - 1);
            end;
        end;
end;

procedure TranslateStringToTInAddr(AIP: string; var AInAddr);
var
    phe: PHostEnt;
    pac: PChar;
    GInitData: TWSAData;
begin
    WSAStartup($101, GInitData);
    try
        phe := GetHostByName(PChar(AIP));
        if Assigned(phe) then
            begin
                pac := phe^.h_addr_list^;
                if Assigned(pac) then
                    begin
                            with TIPAddr(AInAddr).S_un_b do
                            begin
                                s_b1 := Byte(pac[0]);
                                s_b2 := Byte(pac[1]);
                                s_b3 := Byte(pac[2]);
                                s_b4 := Byte(pac[3]);
                            end;
                    end
                else
                    begin
                        raise Exception.Create('Error getting IP from HostName');
                    end;
            end
        else
            begin
                raise Exception.Create('Error getting HostName');
            end;
    except
        FillChar(AInAddr, SizeOf(AInAddr), #0);
    end;
    WSACleanup;
end;

function Ping(InetAddress: string): boolean;
var
    Handle: THandle;
    InAddr: IPAddr;
    DW: DWORD;
    rep: array[1..128] of byte;
begin
    result := false;
    Handle := IcmpCreateFile;
    if (Handle=INVALID_HANDLE_VALUE) then
        Exit;
    TranslateStringToTInAddr(InetAddress, InAddr);
    DW := IcmpSendEcho(Handle, InAddr, nil, 0, nil, @rep, 128, 0);
    Result := (DW<>0);
    IcmpCloseHandle(Handle);
end;

end.
 

在 Form 放 1 個 Edit 和 1 個 Button

 
...
...

implementation

// 注意這行
uses raw_ping;

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
    If raw_Ping.Ping(Edit1.Text) then
        ShowMessage('ping 得到 '+Edit1.Text)
    else
        ShowMessage('ping 不到');
end;
 

相關筆記 ----
【Delphi】以 Indy TIdIcmpClient 去 ping 網路設備
【Delphi】以 WMI 方式 ping 網路設備