关于DELPHI中PING命令使用,急!~在线等

Question

为何下面这函数不能正确的返回正确值，我在CMD中能够PING通对方，而用次函数却不返回正确的值！~急啊！~谢谢各位了，小弟感激不尽啊！~
Function MyPing(const Host:string):boolean;
var
  CmdLinePChar:array[0..120] of char;
  StartUpInfo:TStartUpInfo;
  ProcessInfo:TProcessInformation;
  HOutput:THandle;
  StringList:TStringList;
  TempFileName:String;
  i:integer;
begin
  Result:=false;
  Screen.Cursor:=crHourGlass;
  StringList:=TStringList.Create;
  try
    TempFileName:=ExtractFilePath(application.ExeName)+'tempfile.tmp';
    HOutput:=FileCreate(TempFileName);
    if HOutput<0 then
      exit;
    StrPCopy(CmdLinePChar,'Ping.exe'+Host);
    FillChar(StartUpInfo,sizeof(StartUpInfo),#0);
    with StartUpInfo do
    begin
      cb:=sizeof(StartUpInfo);
      dwFlags:=STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
      wShowWindow:=SW_HIDE;
      hstdOutput:=HOutput;
    end;
    if CreateProcess(nil,CmdLinePChar,nil,nil,True,0,nil,nil,StartUpInfo,ProcessInfo) then
    begin
      WaitForSingleObject(Processinfo.hProcess,INFINITE);
      FileClose(HOutput);
    end
    else
    begin
      FileClose(HOutput);
      exit;
    end;
  StringList.LoadFromFile(TempFileName);
  DeleteFile(TempFileName);
  for i:=1 to StringList.Count-1 do
  begin
    if pos('Reply from',StringList[i])>=1 then
    begin
      Result:=true;
      break;
    end;
  end;
  finally
  screen.Cursor:=crDefault;
  form1.edit1.text:=stringlist[i];
  StringList.Free;  end;

Answer 1

你可以用TIdIcmpClient控件
unit ping;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdBaseComponent, IdComponent, IdRawBase, IdRawClient,
  IdIcmpClient, StdCtrls, ExtCtrls;type
  TForm1 = class(TForm)
    lstReplies: TListBox;
    edtHost: TEdit;
    Panel1: TPanel;
    btnPing: TButton;
    ICMP: TIdIcmpClient;
    procedure btnPingClick(Sender: TObject);
    procedure ICMPReply(ASender: TComponent; const ReplyStatus: TReplyStatus);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementation{$R *.dfm}procedure TForm1.btnPingClick(Sender: TObject);
var
 i: integer;
begin
 ICMP.OnReply := ICMPReply;
 ICMP.ReceiveTimeout := 1000;
 btnPing.Enabled := False; try
 ICMP.Host := edtHost.Text;
 for i := 1 to 4 do begin
 ICMP.Ping;
 Application.ProcessMessages;
 //Sleep(1000);
 end;
 finally btnPing.Enabled := True; end;end;procedure Tform1.ICMPReply(ASender: TComponent; const ReplyStatus: TReplyStatus);
var
 sTime: string;
begin
 // TODO: check for error on ping reply (ReplyStatus.MsgType?)
 if (ReplyStatus.MsRoundTripTime = 0) then
 sTime := '<1'
 else
 sTime := '='; lstReplies.Items.Add(Format('%d bytes from %s: icmp_seq=%d ttl=%d time%s%d ms',
 [ReplyStatus.BytesReceived,
 ReplyStatus.FromIpAddress,
 ReplyStatus.SequenceId,
 ReplyStatus.TimeToLive,
 sTime,
 ReplyStatus.MsRoundTripTime]));
end;
end.