DELPHI7网络函数大全

DELPHI7网络函数大全 网络函数大全 {========================================================================= 功 能: 网络函数库 时 间: 2002/10/02 版 本: 1.0 =========================================================================} unit Net; interface uses SysUtils ,Windows ,dialogs ,winsock ,Classes ,ComObj ,WinInet; //得到本机的局域网Ip地址 Function GetLocalIp(var LocalIp:string): Boolean; //通过Ip返回机器名 Function GetNameByIPAddr(IPAddr: string; var MacName: string): Boolean ; //获取网络中SQLServer列 表 关于同志近三年现实表现材料材料类招标技术评分表图表与交易pdf视力表打印pdf用图表说话 pdf Function GetSQLServerList(var List: Tstringlist): Boolean; //获取网络中的所有网络类型 Function GetNetList(var List: Tstringlist): Boolean; //获取网络中的工作组 Function GetGroupList(var List: TStringList): Boolean; //获取工作组中所有计算机 Function GetUsers(GroupName: string; var List: TStringList): Boolean; //获取网络中的资源 Function GetUserResource(IpAddr: string; var List: TStringList): Boolean; //映射网络驱动器 Function NetAddConnection(NetPath: Pchar; PassWord: Pchar;LocalPath: Pchar): Boolean; //检测网络状态 Function CheckNet(IpAddr:string): Boolean; //检测机器是否登入网络 Function CheckMacAttachNet: Boolean; //判断Ip 协议 离婚协议模板下载合伙人协议 下载渠道分销协议免费下载敬业协议下载授课协议下载 有没有安装 这个函数有问题 Function IsIPInstalled : boolean; //检测机器是否上网 Function InternetConnected: Boolean; implementation {================================================================= 功 能: 检测机器是否登入网络 参 数: 无 返回值: 成功: True 失败: False 备 注: 版 本: 1.0 2002/10/03 09:55:00 =================================================================} Function CheckMacAttachNet: Boolean; begin Result := False; if GetSystemMetrics(SM_NETWORK) <> 0 then Result := True; end; {================================================================= 功 能: 返回本机的局域网Ip地址 参 数: 无 返回值: 成功: True, 并填充LocalIp 失败: False 备 注: 版 本: 1.0 2002/10/02 21:05:00 =================================================================} function GetLocalIP(var LocalIp: string): Boolean; var HostEnt: PHostEnt; Ip: string; addr: pchar; Buffer: array [0..63] of char; GInitData: TWSADATA; begin Result := False; try WSAStartup(2, GInitData); GetHostName(Buffer, SizeOf(Buffer)); HostEnt := GetHostByName(buffer); if HostEnt = nil then Exit; addr := HostEnt^.h_addr_list^; ip := Format('%d.%d.%d.%d', [byte(addr [0]), byte (addr [1]), byte (addr [2]), byte (addr [3])]); LocalIp := Ip; Result := True; finally WSACleanup; end; end; {================================================================= 功 能: 通过Ip返回机器名 参 数: IpAddr: 想要得到名字的Ip 返回值: 成功: 机器名 失败: '' 备 注: inet_addr function converts a string containing an Internet Protocol dotted address into an in_addr. 版 本: 1.0 2002/10/02 22:09:00 =================================================================} function GetNameByIPAddr(IPAddr : String;var MacName:String): Boolean; var SockAddrIn: TSockAddrIn; HostEnt: PHostEnt; WSAData: TWSAData; begin Result := False; if IpAddr = '' then exit; try WSAStartup(2, WSAData); SockAddrIn.sin_addr.s_addr := inet_addr(PChar(IPAddr)); HostEnt := gethostbyaddr(@SockAddrIn.sin_addr.S_addr, 4, AF_INET); if HostEnt <> nil then MacName := StrPas(Hostent^.h_name); Result := True; finally WSACleanup; end; end; {================================================================= 功 能: 返回网络中SQLServer列表 参 数: List: 需要填充的List 返回值: 成功: True,并填充List 失败 False 备 注: 版 本: 1.0 2002/10/02 22:44:00 =================================================================} Function GetSQLServerList(var List: Tstringlist): boolean; var i: integer; sRetValue: String; SQLServer: Variant; ServerList: Variant; begin Result := False; List.Clear; try SQLServer := CreateOleObject('SQLDMO.Application'); ServerList := SQLServer.ListAvailableSQLServers; for i := 1 to Serverlist.Count do list.Add (Serverlist.item(i)); Result := True; Finally SQLServer := NULL; ServerList := NULL; end; end; {================================================================= 功 能: 判断Ip协议有没有安装 参 数: 无 返回值: 成功: True 失败: False; 备 注: 该函数还有问题 版 本: 1.0 2002/10/02 21:05:00 =================================================================} Function IsIPInstalled : boolean; var WSData: TWSAData; ProtoEnt: PProtoEnt; begin Result := True; try if WSAStartup(2,WSData) = 0 then begin ProtoEnt := GetProtoByName('IP'); if ProtoEnt = nil then Result := False end; finally WSACleanup; end; end; {================================================================= 功 能: 返回网络中的共享资源 参 数: IpAddr: 机器Ip List: 需要填充的List 返回值: 成功: True,并填充List 失败: False; 备 注: WNetOpenEnum function starts an enumeration of network resources or existing connections. WNetEnumResource function continues a network-resource enumeration started by the WNetOpenEnum function. 版 本: 1.0 2002/10/03 07:30:00 =================================================================} Function GetUserResource(IpAddr: string; var List: TStringList): Boolean; type TNetResourceArray = ^TNetResource;//网络类型的数组 Var i: Integer; Buf: Pointer; Temp: TNetResourceArray; lphEnum: THandle; NetResource: TNetResource; Count,BufSize,Res: DWord; Begin Result := False; List.Clear; if copy(Ipaddr,0,2) <> '\\' then IpAddr := '\\'+IpAddr; //填充Ip地址信息 FillChar(NetResource, SizeOf(NetResource), 0);//初始化网络层次信息 NetResource.lpRemoteName := @IpAddr[1];//指定计算机名称 //获取指定计算机的网络资源句柄 Res := WNetOpenEnum( RESOURCE_GLOBALNET, RESOURCETYPE_ANY, RESOURCEUSAGE_CONNECTABLE, @NetResource,lphEnum); if Res <> NO_ERROR then exit;//执行失败 while True do//列举指定工作组的网络资源 begin Count := $FFFFFFFF;//不限资源数目 BufSize := 8192;//缓冲区大小设置为8K GetMem(Buf, BufSize);//申请内存，用于获取工作组信息 //获取指定计算机的网络资源名称 Res := WNetEnumResource(lphEnum, Count, Pointer(Buf), BufSize); if Res = ERROR_NO_MORE_ITEMS then break;//资源列举完毕 if (Res <> NO_ERROR) then Exit;//执行失败 Temp := TNetResourceArray(Buf); for i := 0 to Count - 1 do begin //获取指定计算机中的共享资源名称，+2表示删除"\\"， //如\\192.168.0.1 => 192.168.0.1 List.Add(Temp^.lpRemoteName + 2); Inc(Temp); end; end; Res := WNetCloseEnum(lphEnum);//关闭一次列举 if Res <> NO_ERROR then exit;//执行失败 Result := True; FreeMem(Buf); End; {================================================================= 功 能: 返回网络中的工作组 参 数: List: 需要填充的List 返回值: 成功: True,并填充List 失败: False; 备 注: 版 本: 1.0 2002/10/03 08:00:00 =================================================================} Function GetGroupList( var List : TStringList ) : Boolean; type TNetResourceArray = ^TNetResource;//网络类型的数组 Var NetResource: TNetResource; Buf: Pointer; Count,BufSize,Res: DWORD; lphEnum: THandle; p: TNetResourceArray; i,j: SmallInt; NetworkTypeList: TList; Begin Result := False; NetworkTypeList := TList.Create; List.Clear; //获取整个网络中的文件资源的句柄，lphEnum为返回名柄 Res := WNetOpenEnum( RESOURCE_GLOBALNET, RESOURCETYPE_DISK, RESOURCEUSAGE_CONTAINER, Nil,lphEnum); if Res <> NO_ERROR then exit;//Raise Exception(Res);//执行失败 //获取整个网络中的网络类型信息 Count := $FFFFFFFF;//不限资源数目 BufSize := 8192;//缓冲区大小设置为8K GetMem(Buf, BufSize);//申请内存，用于获取工作组信息 Res := WNetEnumResource(lphEnum, Count, Pointer(Buf), BufSize); //资源列举完毕 //执行失败 if ( Res = ERROR_NO_MORE_ITEMS ) or (Res <> NO_ERROR ) then Exit; P := TNetResourceArray(Buf); for i := 0 to Count - 1 do//记录各个网络类型的信息 begin NetworkTypeList.Add(p); Inc(P); end; Res := WNetCloseEnum(lphEnum);//关闭一次列举 if Res <> NO_ERROR then exit; for j := 0 to NetworkTypeList.Count-1 do //列出各个网络类型中的所有工作组名称 begin//列出一个网络类型中的所有工作组名称 NetResource := TNetResource(NetworkTypeList.Items[J]^);//网络类型信息 //获取某个网络类型的文件资源的句柄，NetResource为网络类型信息，lphEnum为返回名柄 Res := WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_DISK, RESOURCEUSAGE_CONTAINER, @NetResource,lphEnum); if Res <> NO_ERROR then break;//执行失败 while true do//列举一个网络类型的所有工作组的信息 begin Count := $FFFFFFFF;//不限资源数目 BufSize := 8192;//缓冲区大小设置为8K GetMem(Buf, BufSize);//申请内存，用于获取工作组信息 //获取一个网络类型的文件资源信息， Res := WNetEnumResource(lphEnum, Count, Pointer(Buf), BufSize); //资源列举完毕 //执行失败 if ( Res = ERROR_NO_MORE_ITEMS ) or (Res <> NO_ERROR) then break; P := TNetResourceArray(Buf); for i := 0 to Count - 1 do//列举各个工作组的信息 begin List.Add( StrPAS( P^.lpRemoteName ));//取得一个工作组的名称 Inc(P); end; end; Res := WNetCloseEnum(lphEnum);//关闭一次列举 if Res <> NO_ERROR then break;//执行失败 end; Result := True; FreeMem(Buf); NetworkTypeList.Destroy; End; {================================================================= 功 能: 列举工作组中所有的计算机 参 数: List: 需要填充的List 返回值: 成功: True,并填充List 失败: False; 备 注: 版 本: 1.0 2002/10/03 08:00:00 =================================================================} Function GetUsers(GroupName: string; var List: TStringList): Boolean; type TNetResourceArray = ^TNetResource;//网络类型的数组 Var i: Integer; Buf: Pointer; Temp: TNetResourceArray; lphEnum: THandle; NetResource: TNetResource; Count,BufSize,Res: DWord; begin Result := False; List.Clear; FillChar(NetResource, SizeOf(NetResource), 0);//初始化网络层次信息 NetResource.lpRemoteName := @GroupName[1];//指定工作组名称 NetResource.dwDisplayType := RESOURCEDISPLAYTYPE_SERVER;//类型为服务器(工作组) NetResource.dwUsage := RESOURCEUSAGE_CONTAINER; NetResource.dwScope := RESOURCETYPE_DISK;//列举文件资源信息 //获取指定工作组的网络资源句柄 Res := WNetOpenEnum( RESOURCE_GLOBALNET, RESOURCETYPE_DISK, RESOURCEUSAGE_CONTAINER, @NetResource,lphEnum); if Res <> NO_ERROR then Exit; //执行失败 while True do//列举指定工作组的网络资源 begin Count := $FFFFFFFF;//不限资源数目 BufSize := 8192;//缓冲区大小设置为8K GetMem(Buf, BufSize);//申请内存，用于获取工作组信息 //获取计算机名称 Res := WNetEnumResource(lphEnum, Count, Pointer(Buf), BufSize); if Res = ERROR_NO_MORE_ITEMS then break;//资源列举完毕 if (Res <> NO_ERROR) then Exit;//执行失败 Temp := TNetResourceArray(Buf); for i := 0 to Count - 1 do//列举工作组的计算机名称 begin //获取工作组的计算机名称，+2表示删除"\\"，如\\wangfajun=>wangfajun List.Add(Temp^.lpRemoteName + 2); inc(Temp); end; end; Res := WNetCloseEnum(lphEnum);//关闭一次列举 if Res <> NO_ERROR then exit;//执行失败 Result := True; FreeMem(Buf); end; {================================================================= 功 能: 列举所有网络类型 参 数: List: 需要填充的List 返回值: 成功: True,并填充List 失败: False; 备 注: 版 本: 1.0 2002/10/03 08:54:00 =================================================================} Function GetNetList(var List: Tstringlist): Boolean; type TNetResourceArray = ^TNetResource;//网络类型的数组 Var p: TNetResourceArray; Buf: Pointer; i: SmallInt; lphEnum: THandle; NetResource: TNetResource; Count,BufSize,Res: DWORD; begin Result := False; List.Clear; Res := WNetOpenEnum( RESOURCE_GLOBALNET, RESOURCETYPE_DISK, RESOURCEUSAGE_CONTAINER, Nil,lphEnum); if Res <> NO_ERROR then exit;//执行失败 Count := $FFFFFFFF;//不限资源数目 BufSize := 8192;//缓冲区大小设置为8K GetMem(Buf, BufSize);//申请内存，用于获取工作组信息 Res := WNetEnumResource(lphEnum, Count, Pointer(Buf), BufSize);//获取网络类型信息 //资源列举完毕 //执行失败 if ( Res = ERROR_NO_MORE_ITEMS ) or (Res <> NO_ERROR ) then Exit; P := TNetResourceArra {================================================================= 功 能: 映射网络驱动器 参 数: NetPath: 想要映射的网络路径 Password: 访问密码 Localpath 本地路径 返回值: 成功: True 失败: False; 备 注: 版 本: 1.0 2002/10/03 09:24:00 =================================================================} Function NetAddConnection(NetPath: Pchar; PassWord: Pchar ;LocalPath: Pchar): Boolean; var Res: Dword; begin Result := False; Res := WNetAddConnection(NetPath,Password,LocalPath); if Res <> No_Error then exit; Result := True; end; {================================================================= 功 能: 检测网络状态 参 数: IpAddr: 被测试网络上主机的IP地址或名称，建议使用Ip 返回值: 成功: True 失败: False; 备 注: 版 本: 1.0 2002/10/03 09:40:00 =================================================================} Function CheckNet(IpAddr: string): Boolean; type PIPOptionInformation = ^TIPOptionInformation; TIPOptionInformation = packed record TTL: Byte; // Time To Live (used for traceroute) TOS: Byte; // Type Of Service (usually 0) Flags: Byte; // IP header flags (usually 0) OptionsSize: Byte; // Size of options data (usually 0, max 40) OptionsData: PChar; // Options data buffer end; PIcmpEchoReply = ^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.