delphi 域名转ip并判断ip是否可以联通

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls,WinSock;

type

TForm1 = class(TForm)

Button1: TButton;

Button2: TButton;

Edit1: TEdit;

Edit2: TEdit;

procedure Button1Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

function PingHost(HostIP: String): Boolean;

type

PIPOptionInformation = ^TIPOptionInformation;

TIPOptionInformation = packed record

TTL: Byte;

TOS: Byte;

Flags: Byte;

OptionsSize: Byte;

OptionsData: PChar;

end;

PIcmpEchoReply = ^TIcmpEchoReply;

TIcmpEchoReply = packed record

Address: DWORD;

Status: DWORD;

RTT: DWORD;

DataSize: Word;

Reserved: Word;

Data: Pointer;

Options: TIPOptionInformation;

end;

TIcmpCreateFile = function: THandle; stdcall;

TIcmpCloseHandle = function(IcmpHandle: THandle): Boolean; stdcall;

TIcmpSendEcho = function(IcmpHandle:THandle;

DestinationAddress: DWORD;

RequestData: Pointer;

RequestSize: Word;

RequestOptions: PIPOptionInformation;

ReplyBuffer: Pointer;

ReplySize: DWord;

Timeout: DWord

): DWord; stdcall;

var

hICMP :THandle;

hICMPdll :THandle;

IcmpCreateFile :TIcmpCreateFile;

IcmpCloseHandle :TIcmpCloseHandle;

IcmpSendEcho :TIcmpSendEcho;

pIPE :PIcmpEchoReply;// ICMP Echo reply buffer

FIPAddress :DWORD;

FSize :DWORD;

FTimeOut :DWORD;

BufferSize :DWORD;

pReqData,pRevData:PChar;

MyString:string;

begin

Result :=False;

hICMPdll :=LoadLibrary('icmp.dll');

if hICMPdll=0 then exit;

@ICMPCreateFile :=GetProcAddress(hICMPdll,'IcmpCreateFile');

@IcmpCloseHandle :=GetProcAddress(hICMPdll,'IcmpCloseHandle');

@IcmpSendEcho :=GetProcAddress(hICMPdll,'IcmpSendEcho');

hICMP :=IcmpCreateFile;

if (hICMP=INVALID_HANDLE_VALUE)then exit;

FIPAddress :=inet_addr(PChar(HostIP));

MyString :='Hello,World'; //send data buffer

pReqData :=PChar(MyString);

FSize :=40; //receive data buffer

BufferSize :=SizeOf(TICMPEchoReply)+FSize;

GetMem(pIPE,BufferSize);

FillChar(pIPE^,SizeOf(pIPE^),0);

GetMem(pRevData,FSize);

pIPE^.Data :=pRevData;

FTimeOut :=1000;

try

Result :=IcmpSendEcho(hICMP,FIPAddress,pReqData,

Length(MyString),nil,pIPE,BufferSize,FTimeOut)>0;

finally

IcmpCloseHandle(hICMP);

FreeLibrary(hICMPdll);

FreeMem(pRevData);

FreeMem(pIPE);

end;

end;

function HostToIP(Name: string; var Ip: string): Boolean;

var

wsdata : TWSAData;

hostName : array [0..255] of char;

hostEnt : PHostEnt;

addr : PChar;

begin

WSAStartup ($0101, wsdata);

try

gethostname (hostName, sizeof (hostName));

StrPCopy(hostName, Name);

hostEnt := gethostbyname (hostName);

if Assigned (hostEnt) then

if Assigned (hostEnt^.h_addr_list) then begin

addr := hostEnt^.h_addr_list^;

if Assigned (addr) then begin

IP := Format ('%d.%d.%d.%d', [byte (addr [0]),

byte (addr [1]), byte (addr [2]), byte (addr [3])]);

Result := True;

end

else

Result := False;

end

else

Result := False

else begin

Result := False;

end;

finally

WSACleanup;

end

end;

procedure TForm1.Button1Click(Sender: TObject);

var

IP:String;

flag:Boolean;

begin

//IP:='123.125.114.118';

IP:=edit2.text;

flag:=PingHost(IP);

if flag=true then

MessageBox(0,'ping1','通路',MB_ICONASTERISK and MB_ICONINFORMATION)

else

MessageBox(0,'ping2','断路',MB_ICONASTERISK and MB_ICONINFORMATION);

end;

procedure TForm1.Button2Click(Sender: TObject);

var

hqw:string;

begin

HostToIP(edit1.text,hqw);

edit2.text:=hqw;

end;

end.