Delphi-Projects

1
unit PingUnit;
2

3
interface
4
uses
5
  Windows, SysUtils, Classes, LogUnit;
6

7
type
8
  TSunB = packed record
9
    s_b1, s_b2, s_b3, s_b4: byte;
10
  end;
11

12
  TSunW = packed record
13
    s_w1, s_w2: word;
14
  end;
15

16
  PIPAddr = ^TIPAddr;
17
  TIPAddr = record
18
    case integer of
19
      0: (S_un_b: TSunB);
20
      1: (S_un_w: TSunW);
21
      2: (S_addr: longword);
22
  end;
23

24
 IPAddr = TIPAddr;
25

26
function IcmpCreateFile : THandle; stdcall; external 'icmp.dll';
27
function IcmpCloseHandle (icmpHandle : THandle) : boolean; stdcall; external 'icmp.dll';
28
function IcmpSendEcho (IcmpHandle : THandle; DestinationAddress : IPAddr;
29
    RequestData : Pointer; RequestSize : Smallint;
30
    RequestOptions : pointer;
31
    ReplyBuffer : Pointer;
32
    ReplySize : DWORD;
33
    Timeout : DWORD) : DWORD; stdcall; external 'icmp.dll';
34

35

36
function Ping(InetAddress : string) : boolean;
37

38
procedure TranslateStringToTInAddr(AIP: string; var AInAddr);
39

40
implementation
41

42
uses
43
  WinSock;
44

45
function Fetch(var AInput: string; const ADelim: string = ' '; const ADelete: Boolean = true)
46
 : string;
47
var
48
  iPos: Integer;
49
begin
50
  if ADelim = #0 then begin
51
    // AnsiPos does not work with #0
52
    iPos := Pos(ADelim, AInput);
53
  end else begin
54
    iPos := Pos(ADelim, AInput);
55
  end;
56
  if iPos = 0 then begin
57
    Result := AInput;
58
    if ADelete then begin
59
      AInput := '';
60
    end;
61
  end else begin
62
    result := Copy(AInput, 1, iPos - 1);
63
    if ADelete then begin
64
      Delete(AInput, 1, iPos + Length(ADelim) - 1);
65
    end;
66
  end;
67
end;
68

69
procedure TranslateStringToTInAddr(AIP: string; var AInAddr);
70
var
71
  phe: PHostEnt;
72
  pac: PChar;
73
  GInitData: TWSAData;
74
begin
75
  WSAStartup($101, GInitData);
76
  try
77
    phe := GetHostByName(PChar(AIP));
78
    if Assigned(phe) then
79
    begin
80
      pac := phe^.h_addr_list^;
81
      if Assigned(pac) then
82
      begin
83
        with TIPAddr(AInAddr).S_un_b do begin
84
          s_b1 := Byte(pac[0]);
85
          s_b2 := Byte(pac[1]);
86
          s_b3 := Byte(pac[2]);
87
          s_b4 := Byte(pac[3]);
88
        end;
89
      end
90
      else
91
      begin
92
        raise Exception.Create('Error getting IP from HostName');
93
      end;
94
    end
95
    else
96
    begin
97
      raise Exception.Create('Error getting HostName');
98
    end;
99
  except
100
    FillChar(AInAddr, SizeOf(AInAddr), #0);
101
  end;
102
  WSACleanup;
103
end;
104

105
function Ping(InetAddress : string) : boolean;
106
var
107
 Handle : THandle;
108
 InAddr : IPAddr;
109
 DW : DWORD;
110
 rep : array[1..128] of byte;
111
begin
112
  Result := false;
113
  Handle := IcmpCreateFile;
114
  if Handle = INVALID_HANDLE_VALUE then
115
    Exit;
116
  TranslateStringToTInAddr(InetAddress, InAddr);
117
  DW := IcmpSendEcho(Handle, InAddr, nil, 0, nil, @rep, 128, 0);
118
  Log(InetAddress + ' IcmpSendEcho: ' + IntToStr(DW));
119
  Result := (DW <> 0);
120
  IcmpCloseHandle(Handle);
121
end;
122

123
end.
124