Ping IP

Top  Previous  Next

Megpingelünk egy IP-t az alábbi programmal. Hozz létre egy unitot, legyen a neve Pingip.pas, a többit lent (win7-hez javítva)

 

unit Pingip;

 

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, 900);

Result := (DW <> 0);

IcmpCloseHandle(Handle);

end;

 

end.

 

. . .

 

uses pingip

 

 

 

procedure TForm1.Button1Click(Sender: TObject);

begin

if pingip.Ping(Edit1.Text)=True then

Edit1.Color:=clGreen else Edit1.Color:=clRed;

end;