请问DELPHI下如何调用系统PING命令，检测网络状况

Question

谢谢。

Answer 1

好像有API直接调用，具体格式我忘了：）

Answer 2

要调用注册表，下列代码在2000和xp下实现！用TIdIcmpClient这个控件就可以了
unit Link;
interface
function GateWay:string;
procedure IfLink;implementation  uses  main,Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,  StdCtrls, ExtCtrls,Registry,
  Grids;
function GateWay:string;
     var
  Reg :TRegistry;
  MyStr : TStrings;
  buffer : array[0..1024] of byte;
  i:integer;
  info:TRegKeyInfo ;
  str:string;
begin
  Result:='0';
  Reg :=TRegistry.Create;
  Mystr:=Tstringlist.Create;
  try
    Reg.RootKey :=HKEY_LOCAL_MACHINE;
    if Reg.OpenKey('SOFTWARE\Microsoft\Windows NT\CurrentVersion\NetworkCards',false) then
    begin
      if reg.GetKeyInfo(info) then
      begin      reg.GetKeyNames(mystr);
        str:='SOFTWARE\Microsoft\Windows NT\CurrentVersion\NetworkCards\'+Mystr.Strings[0];
        end;
    end;
  finally
   Reg.CloseKey;
    Mystr.Free;
     Reg.RootKey :=HKEY_LOCAL_MACHINE;
    if reg.OpenKey(str,false) then
      begin
         str:=reg.ReadString('ServiceName');
         end;
         Reg.CloseKey;
         Reg.RootKey :=HKEY_LOCAL_MACHINE;
     if reg.OpenKey('SYSTEM\CurrentControlSet\Services\'+str+'\Parameters\Tcpip\',false) then
        begin
           str:='';
          for i:= 1 to reg.ReadBinaryData('defaultGateway',buffer,sizeof(buffer)) do
           str:=str+chr(dword(buffer[i-1]));
           end;
              if str=chr(0) then
                 begin
                   str:='';
                   for i:= 1 to reg.ReadBinaryData('DhcpDefaultGateway',buffer,sizeof(buffer)) do
                  str:=str+chr(dword(buffer[i-1]));
                   end;           Reg.CloseKey;
           reg.Free;
           if (str=char(0)) or (str='') then
           str:='66.218.71.88';
           result:=str;
  end;
end;
procedure IfLink;begin
 with mainForm do begin  ICMP.ReceiveTimeout:=10;
  try
  ICMP.Host := GateWay;
  ICMP.Ping;
 // Application.ProcessMessages;
 // Sleep(1000);
 linklabel.caption:='正常';
 linkLabel.Font.Color:=clGreen;
  except
   linklabel.caption:='断开';
   mainform.linkLabel.Font.Color:=clred;
      end;
  end;
 end;end.

Answer 3

unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 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: 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;  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    PingEdit: TEdit;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
    hICMP: THANDLE;
    IcmpCreateFile : TIcmpCreateFile;
    IcmpCloseHandle: TIcmpCloseHandle;
    IcmpSendEcho: TIcmpSendEcho;
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementation{$R *.DFM}procedure TForm1.FormCreate(Sender: TObject);
var
  hICMPdll: HMODULE;
begin
  hICMPdll := LoadLibrary('icmp.dll');
  @ICMPCreateFile := GetProcAddress(hICMPdll, 'IcmpCreateFile');
  @IcmpCloseHandle := GetProcAddress(hICMPdll,'IcmpCloseHandle');
  @IcmpSendEcho := GetProcAddress(hICMPdll, 'IcmpSendEcho');
  hICMP := IcmpCreateFile;
  Memo1.Text := '';
  Memo1.Lines.Add('目的IP地址 字节数 返回时间(毫秒)'); 
end;procedure TForm1.Button1Click(Sender: TObject);
var
  IPOpt:TIPOptionInformation;// IP Options for packet to send
  FIPAddress:DWORD;
  pReqData,pRevData:PChar;
  pIPE:PIcmpEchoReply;// ICMP Echo reply buffer
  FSize: DWORD;
  MyString:string;
  FTimeOut:DWORD;
  BufferSize:DWORD;
begin
    if PingEdit.Text <> '' then
    begin
          FIPAddress := inet_addr(PChar(PingEdit.Text));
          FSize := 40;
          BufferSize := SizeOf(TICMPEchoReply) + FSize;
          GetMem(pRevData,FSize);
          GetMem(pIPE,BufferSize);
          FillChar(pIPE^, SizeOf(pIPE^), 0);
          pIPE^.Data := pRevData;
          MyString := 'Hello,World';
          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
              Memo1.Lines.Add(PChar(PingEdit.Text) + ' ' + IntToStr(pIPE^.DataSize) + ' ' +IntToStr(pIPE^.RTT));
          except
              Memo1.Lines.Add('Cant resolve host!');
              FreeMem(pRevData);
              FreeMem(pIPE);
              Exit;
          end;
          FreeMem(pRevData);
          FreeMem(pIPE);
    end;
end;end.  

Answer 4

其它API函数均不好用，本人研究了好长时间，认为还是用Ping命令判断最好，在98和95下也应该是一样的，只是网卡在注册表中的位置以及网关的位置不一样吧了！该一下就可以了！

Answer 5

shawy0282() 说的是Delphi带的例子吧？

Answer 6

谢谢大家，已经搞顶了
winexec();