請參考

[code cpp]
{
利用 Ping 的 TTL 值判斷目的主機為 MS-Windows 或 Unix-Like
Delphi 7 Enterprise
}
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,
Winsock, Buttons, Provider; //OutlookBtn, TB97,
type
TForm1 = class(TForm)
EditAddr: TEdit;
BtnPing: TButton;
MemoResult: TMemo;
procedure BtnPingClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
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;
var
Form1: TForm1;
hICMP : THandle;
ox,oy : integer;
Const
{ Exception Message }
SInitFailed = 'Winsock 版本有誤';
SInvalidAddr = '錯誤的IP地址';
SNoResponse = '沒有響應';
STimeOut = '響映超時';
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('ICMP運行有誤！！！ ');
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的地址:' IPAddr ' ' SNoResponse;
exit;
end;
if pReqData^ = pIPE^.Options.OptionsData^ then
begin
//show result
{
Result:=('返回地:' PChar(IPAddr) ' '
'字節數:' IntToStr(pIPE^.DataSize) ' '
'時間:' IntToStr(pIPE^.RTT) 'ms '
'系統類型:' intToStr(pIPE^.Options.TTL));
}
if pIPE^.Options.TTL=128 then
Result:='MS-Windows'
else
Result:='Unix-Like';
end;
//clear memory
FreeMem(pRevData);
FreeMem(pIPE);
end;
procedure TForm1.BtnPingClick(Sender: TObject);
var
pingresult:string;
begin
//version check and init
ValidCheck();
pingresult:=Ping(EditAddr.Text,500);
MemoResult.Lines.add(pingresult);
FreeWinsock();
EditAddr.SetFocus;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
EditAddr.Text:='192.168.1.100';
end;
end.
[/code]

------
能力不足，求助於人；有能力時，幫幫別人；如果您滿意答覆，請適時結案！

子曰：問有三種，不懂則問，雖懂有疑則問，雖懂而想知更多則問！

共用去找 WNetEnumResource , NetShareGetInfo 相關資訊

------
能力不足，求助於人；有能力時，幫幫別人；如果您滿意答覆，請適時結案！

子曰：問有三種，不懂則問，雖懂有疑則問，雖懂而想知更多則問！

編輯記錄