ly = ^TIcmpEchoReply; TIcmpEchoReply = packed record Address: DWord; // replying address Status: DWord; // IP status value (see below) RTT: DWord; // Round Trip Time in milliseconds DataSize: Word; // reply data size Reserved: Word; Data: Pointer; // pointer to reply data buffer Options: TIPOptionInformation; // reply options 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;
const Size = 32; TimeOut = 1000; var wsadata: TWSAData; Address: DWord; // Address of host to contact HostName, HostIP: String; // Name and dotted IP of host to contact Phe: PHostEnt; // HostEntry buffer for name lookup BufferSize, nPkts: Integer; pReqData, pData: Pointer; pIPE: PIcmpEchoReply; // ICMP Echo reply buffer IPOpt: TIPOptionInformation; // IP Options for packet to send const IcmpDLL = ''''icmp.dll''''; var hICMPlib: HModule; IcmpCreateFile : TIcmpCreateFile; IcmpCloseHandle: TIcmpCloseHandle; IcmpSendEcho: TIcmpSendEcho; hICMP: THandle; // Handle for the ICMP Calls begin // initialise winsock Result:=True; if WSAStartup(2,wsadata) <> 0 then begin Result:=False; halt; end; // register the icmp.dll stuff hICMPlib := loadlibrary(icmpDLL); if hICMPlib <> null then begin @ICMPCreateFile := GetProcAddress(hICMPlib, ''''IcmpCreateFile''''); @IcmpCloseHandle:= GetProcAddress(hICMPlib, ''''IcmpCloseHandle''''); @IcmpSendEcho:= GetProcAddress(hICMPlib, ''''IcmpSendEcho''''); if (@ICMPCreateFile = Nil) or (@IcmpCloseHandle = Nil) or (@IcmpSendEcho = Nil) then begin Result:=False; halt; end; hICMP := IcmpCreateFile; if hICMP = INVALID_HANDLE_VALUE then begin Result:=False; halt; end; end else begin Result:=False; halt; end; // ------------------------------------------------------------ Address := inet_addr(PChar(IpAddr)); if (Address = INADDR_NONE) then begin Phe := GetHostByName(PChar(IpAddr)); if Phe = Nil then Result:=False else begin Address := longint(plongint(Phe^.h_addr_list^)^); HostName := Phe^.h_name; HostIP := StrPas(inet_ntoa(TInAddr(Address))); end; end else begin Phe := GetHostByAddr(@Address, 4, PF_INET); if Phe = Nil then Result:=False; end;
if Address = INADDR_NONE then begin Result:=False; end; // Get some data buffer space and put something in the packet to send BufferSize := SizeOf(TICMPEchoReply) + Size; GetMem(pReqData, Size); GetMem(pData, Size); GetMem(pIPE, BufferSize); FillChar(pReqData^, Size, $AA); pIPE^.Data := pData;
// Finally Send the packet FillChar(IPOpt, SizeOf(IPOpt), 0); IPOpt.TTL := 64; NPkts := IcmpSendEcho(hICMP, Address, pReqData, Size, @IPOpt, pIPE, BufferSize, TimeOut); if NPkts = 0 then Result:=False;
// Free those buffers FreeMem(pIPE); FreeMem(pData); FreeMem(pReqData);
// -------------------------------------------------------------- IcmpCloseHandle(hICMP); FreeLibrary(hICMPlib); // free winsock if WSACleanup <> 0 then Result:=False; end;
{================================================================= 功 能: 检测计算机是否上网 参 数: 无 返回值: 成功: True 失败: False; 备 注: uses Wininet 版 本: 1.0 2002/10/07 13:33:00 =================================================================} function InternetConnected: Boolean; const // local system uses a modem to connect to the Internet. INTERNET_CONNECTION_MODEM = 1; // local system uses a local area network to connect to the Internet. INTERNET_CONNECTION_LAN = 2; // local system uses a proxy server to connect to the Internet. INTERNET_CONNECTION_PROXY = 4; // local system''''s modem is busy with a non-Internet connection. INTERNET_CONNECTION_MODEM_BUSY = 8; var dwConnectionTypes : DWORD; begin dwConnectionTypes := INTERNET_CONNECTION_MODEM+ INTERNET_CONNECTION_LAN + INTERNET_CONNECTION_PROXY; Result := InternetGetConnectedState(@dwConnectionTypes, 0); end;
end.
/////////////////////////////*******************************************//错误信息常量 unit Head;
interface const C_Err_GetLocalIp = ''''获取本地ip失败''''; C_Err_GetNameByIpAddr = ''''获取主机名失败''''; C_Err_GetSQLServerList = ''''获取SQLServer服务器失败''''; C_Err_GetUserResource = ''''获取共享资失败''''; C_Err_GetGroupList = ''''获取所有工作组失败''''; C_Err_GetGroupUsers = ''''获取工作组中所有计算机失败''''; C_Err_GetNetList = ''''获取所有网络类型失败''''; C_Err_CheckNet = ''''网络不通''''; C_Err_CheckAttachNet = ''''未登入网络''''; C_Err_InternetConnected =''''没有上网''''; C_Txt_CheckNetSuccess = ''''网络畅通''''; C_Txt_CheckAttachNetSuccess = ''''已登入网络''''; C_Txt_InternetConnected =''''上网了'''';
implementation
end.
上一页 [1] [2] [3] 没有相关教程
|