怎样通过程序就能够知道指定的ip地址能否ping通

Question

在线等待

Answer 1

你好blueshrimp
我是说能自动得到，如通过一条或一段代码实现
比如说 若能ping 通192.168.0.250则 showmessage('....');
ping 不通就...
当然也不一定非得用ping 只要能实现自动监测指定ip地址是否通就行
最好有这样的api函数
对了
此问题谁第一个解决，可得到全部的50分

Answer 2

// 硬盘上的,忘了作者 unit UnitPing;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, TB97, Winsock;
type
  DWORD = LongWord;
  THandle = LongWord;
  PIPOptionInformation = ^TIPOptionInformation;
  TIPOptionInformation =
    record
    TTL: Byte;
    TOS: Byte;
    Flags: Byte;
    OptionsSize: Byte;
    OptionsData: PChar;
  end;  PIcmpEchoReply = ^TIcmpEchoReply;
  TIcmpEchoReply =
    record
    Address: DWORD;
    Status: DWORD;
    RTT: DWORD;
    DataSize: Word;
    Reserved: Word;
    Data: Pointer;
    Options: TIPOptionInformation;
  end;function IcmpCreateFile(): THandle; stdcall external 'ICMP.dll';
function IcmpCloseHandle(Handle: THandle): Boolean; stdcall external 'ICMP.dll';
function IcmpSendEcho(Handle: THandle; DestAddr: DWORD;
  RequestData: Pointer; RequestSize: Word; RequestOptions: PIPOptionInformation;
  ReplyBuffer: Pointer; ReplySize: DWORD; Timeout: DWORD): DWORD; stdcall
    external 'ICMP.dll';
procedure ValidCheck();
procedure FreeWinsock();
function Ping(IPAddr: string; TimeOut: Word): string;const
  { Exception Message }
  SInitFailed = 'Winsock version error';
  SInvalidAddr = 'Invalid IP Address';
  SNoResponse = 'No Response';
  STimeOut = 'Request TimeOut';type
  TFormPing = class(TForm)
    Edit1: TEdit;
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  FormPing: TFormPing;
  hICMP: THandle;
implementation
{$R *.DFM}procedure ValidCheck();
var
  WSAData: TWSAData;
begin
  //initiates use of WS2_32.DLL
  if (WSAStartup(MAKEWORD(2, 0), WSAData) <> 0) then
    raise Exception.Create(SInitFailed);
  hIcmp := IcmpCreateFile();
  if hICMP = INVALID_HANDLE_VALUE then
    raise Exception.Create('Create ICMP Failed');
end;procedure FreeWinsock();
begin
  IcmpCloseHandle(hIcmp);
  WSACleanUP;
end;function Ping(IPAddr: string; TimeOut: Word): string; // 返回可以根据自己的要求改
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;
  temp: Integer;
  pIPAddr: Pchar;
begin
  //get ip
  GetMem(pIPAddr, Length(IPAddr) + 1);
  ZeroMemory(pIPAddr, Length(IPAddr) + 1);
  StrPCopy(pIPAddr, IPAddr);
  //calc
  FIPAddress := inet_addr(pIPAddr);
  //free it
  FreeMem(pIPAddr);
  //valid check
  if FIPAddress = INADDR_NONE then
  begin
    result := SInvalidAddr; //Exit
    exit;
  end;
  //        WSAAsyncGetHostByAddr()
         //package size
  FSize := 40;
  BufferSize := SizeOf(TICMPEchoReply) + FSize;
  GetMem(pRevData, FSize);
  GetMem(pIPE, BufferSize);
  //prepare data
  FillChar(pIPE^, SizeOf(pIPE^), 0);
  pIPE^.Data := pRevData;
  MyString := 'Ping Digital Data';
  pReqData := PChar(MyString);
  FillChar(IPOpt, Sizeof(IPOpt), 0);
  //max delieve geteway
  IPOpt.TTL := 64;
  //time out
  FTimeOut := TimeOut;
  //go!!!
  temp := IcmpSendEcho(hICMP, //dll handle
    FIPAddress, //target
    pReqData, //data
    Length(MyString), //data length
    @IPOpt, //addree of ping option
    pIPE, //
    BufferSize, //pack size
    FTimeOut); //timeout value
  //check result
  if temp = 0 then
  begin
    Result := 'Ping Addr:' + IPAddr + ' ' + SNoResponse;
    exit;
  end;
  if pReqData^ = pIPE^.Options.OptionsData^ then
  begin
    //show result
    Result := ('Reply from:' + PChar(IPAddr) + ' '
      + 'bytes:' + IntToStr(pIPE^.DataSize) + ' '
      + 'tims:' + IntToStr(pIPE^.RTT) + 'ms '
      + 'TTL:' + intToStr(pIPE^.Options.TTL));
  end;
  //clear memory
  FreeMem(pRevData);
  FreeMem(pIPE);
end;procedure TFormPing.Button1Click(Sender: TObject);
var
  pingresult: string;
begin
  //version check and init
  ValidCheck();
  //update view
  pingresult := Ping(Edit1.Text, 500);
  Memo1.Lines.add(pingresult);
  //clear
  FreeWinsock();
end;procedure TFormPing.FormCreate(Sender: TObject);
begin
  //update view
  Memo1.Font.Color := clHighlightText;
  Memo1.Font.Name := 'Terminal';
  Memo1.Font.Size := 10;
  Memo1.Color := clNone;
end;end.

Answer 3

// From My friend, 没有测试过uses nb30;type
  PASTAT = ^TASTAT;
  TASTAT = record
    adapter: TAdapterStatus;
    name_buf: TNameBuffer;
  end;function Getmac: string;
var
  ncb: TNCB;
  s: string;
  adapt: TASTAT;
  lanaEnum: TLanaEnum;
  i, j, m: integer;
  strPart, strMac: string;
begin
  FillChar(ncb, SizeOf(TNCB), 0);
  ncb.ncb_command := Char(NCBEnum);
  ncb.ncb_buffer := PChar(@lanaEnum);
  ncb.ncb_length := SizeOf(TLanaEnum);
  s := Netbios(@ncb);
  for i := 0 to integer(lanaEnum.length) - 1 do
  begin
    FillChar(ncb, SizeOf(TNCB), 0);
    ncb.ncb_command := Char(NCBReset);
    ncb.ncb_lana_num := lanaEnum.lana[i];
    Netbios(@ncb);
    Netbios(@ncb);
    FillChar(ncb, SizeOf(TNCB), 0);
    ncb.ncb_command := Chr(NCBAstat);
    ncb.ncb_lana_num := lanaEnum.lana[i];
    ncb.ncb_callname := '*               ';
    ncb.ncb_buffer := PChar(@adapt);
    ncb.ncb_length := SizeOf(TASTAT);
    m := 0;
    if (Win32Platform = VER_PLATFORM_WIN32_NT) then
      m := 1;
    if m = 1 then
    begin
      if Netbios(@ncb) = Chr(0) then
        strMac := '';
      for j := 0 to 5 do
      begin
        strPart := IntToHex(integer(adapt.adapter.adapter_address[j]), 2);
        strMac := strMac + strPart + '-';
      end;
      SetLength(strMac, Length(strMac) - 1);
    end;
    if m = 0 then
      if Netbios(@ncb) <> Chr(0) then
      begin
        strMac := '';
        for j := 0 to 5 do
        begin
          strPart := IntToHex(integer(adapt.adapter.adapter_address[j]), 2);
          strMac := strMac + strPart + '-';
        end;
        SetLength(strMac, Length(strMac) - 1);
      end;
  end;
  result := strmac;
end;