delphi win7下ICMP ping测试，该怎么处理

1、Indy是个很垃圾的玩意，这个错误是Indy控件本身的问题，你自身无法解决，除非自己写API或调用OCX控件。2、你的函数本身也有问题，Dll里的字符串不能这样传递。你看看Windows的API函数就知道，没有一个是以PChar为返回值的(字符串函数除外)。你这个程序能正常运行，真是奇迹。3、下面这个函数是我给你改的，sURL是地址Buffer是一个缓冲区，用来接收IP地址BufferLength是缓冲区长度，当Buffer为 nil 时它返回需要的空间大小函数返回值为IP地址的长度。function getIPAddress(sURL, Buffer: PCharvar BufferLength: Longint): Longintstdcallvar ICMP: TIdIcmpClient R: TReplyStatus s: stringbegin Result := 0 ICMP := TIdIcmpClient.Create(nil) ICMP.ReceiveTimeout := 1000 ICMP.Host := sURL ICMP.Ping R := ICMP.ReplyStatus s := Format('%d,', [R.MsRoundTripTime]) + R.FromIpAddress if Buffer = nil then BufferLength := Length(s) + 1 else begin StrLCopy(Buffer, PChar(s), BufferLength - 1) Result := StrLen(Buffer) end ICMP.freeend4、在主程序中，这个函数这样调用var len: Longint buf: PCharbegin getIPAddress(sURL, nil, len) GetMem(buf, len) getIPAddress(sURL, buf, len) ShowMessage(buf) FreeMem(buf)end

在 delphi 中实现 ping 的功能，比较简单的办法：

一、直接调用 windows 的 ping 命令，然后获取其输出信息。

二、借用 Indy 组件包中的 TIdIcmpClient 组件（代码来源于网上）：

procedure TForm1.Button1Click(Sender: TObject)var i : Integerbegin Memo1.Lines.Clear IdIcmpClient1.Host:= Edit1.Text //计算机的名称或IP地址 IdIcmpClient1.ReceiveTimeout:=1000 //最大超时时间 Button1.Enabled := falsetryfor i:=0 to 13 dobegin IdIcmpClient1.Ping Application.ProcessMessages //延时end finally Button1.Enabled := true endendprocedure TForm1.IdIcmpClient1Reply(ASender: TComponent const AReplyStatus: TReplyStatus)var sTime: string begin //检测Ping的回复错误 if (AReplyStatus.MsRoundTripTime = 0 ) then sTime := '<1' else sTime := '=' //在列表框中显示Ping消息 Memo1.Lines.Add(Format('Reply from [%s] : Bytes=%d time%s%d ms TTL=%d',[AReplyStatus.FromIpAddress, AReplyStatus.BytesReceived, sTime, AReplyStatus.MsRoundTripTime, AReplyStatus.TimeToLive]))end

三、自己编写 ping 函数，实现功能代码。

函数

procedure pinghost(ip:stringvar info:string)

ip:目标IP地址；

info:ping了以后产生的信息(1)或(2)；

(1)成功信息

ip 发送测试的字符数　返回时间

(2)出错信息

Can not find host!

使用

uses ping

procedure TForm1.Button1Click(Sender: TObject)

var

str:string

ping:Tping

begin

ping:=Tping.create //一定要初试化哦

ping.pinghost(''''127.0.0.1'''',str)

memo1.Lines.Add(str)

ping.destroy

end

[ping.pas]

(*作者：e梦缘*）

unit ping

interface

uses

Windows, SysUtils, Classes, Controls, Winsock,

StdCtrls

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: THandlestdcall

TIcmpCloseHandle = function(IcmpHandle: THandle): Booleanstdcall

TIcmpSendEcho = function(IcmpHandle:THandle

DestinationAddress: DWORD

RequestData: Pointer

RequestSize: Word

RequestOptions: PIPOptionInformation

ReplyBuffer: Pointer

ReplySize: DWord

Timeout: DWord

): DWordstdcall

Tping =class(Tobject)

private

{ Private declarations }

hICMP: THANDLE

IcmpCreateFile : TIcmpCreateFile

IcmpCloseHandle: TIcmpCloseHandle

IcmpSendEcho: TIcmpSendEcho

public

procedure pinghost(ip:stringvar info:string)

constructor create

destructor destroyoverride

{ Public declarations }

end

var

hICMPdll: HMODULE

implementation

constructor Tping.create

begin

inherited create

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

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

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

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

hICMP := IcmpCreateFile

end

destructor Tping.destroy

begin

FreeLibrary(hIcmpDll)

inherited destroy

end

procedure Tping.pinghost(ip:stringvar info:string)

var

// IP Options for packet to send

IPOpt:TIPOptionInformation

FIPAddress:DWORD

pReqData,pRevData:PChar

// ICMP Echo reply buffer

pIPE:PIcmpEchoReply

FSize: DWORD

MyString:string

FTimeOut:DWORD

BufferSize:DWORD

begin

if ip <>'''''''' then

begin

FIPAddress := inet_addr(PChar(ip))

FSize := 40

BufferSize := SizeOf(TICMPEchoReply) FSize

GetMem(pRevData,FSize)

GetMem(pIPE,BufferSize)

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

pIPE^.Data := pRevData

MyString := ''''Test Net - Sos Admin''''

pReqData := PChar(MyString)

FillChar(IPOpt, Sizeof(IPOpt), 0)

IPOpt.TTL := 64

FTimeOut := 4000

try

IcmpSendEcho(hICMP, FIPAddress, pReqData, Length(MyString),@IPOpt, pIPE, BufferSize, FTimeOut)

if pReqData^ = pIPE^.Options.OptionsData^ then

info:=ip ''''　'''' IntToStr(pIPE^.DataSize) ''''　'''' IntToStr(pIPE^.RTT)

except

info:=''''Can not find host!''''

FreeMem(pRevData)

FreeMem(pIPE)

Exit

end

FreeMem(pRevData)

FreeMem(pIPE)

end

end

end.

---