Delphi网络函数

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列表 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 sendconst icmpdll = 'icmp.dll';var hicmplib: hmodule; icmpcreatefile : ticmpcreatefile; icmpclosehandle: ticmpclosehandle; icmpsendecho: ticmpsendecho; hicmp: thandle; // handle for the icmp callsbegin // 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;interfaceconst 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 ='上网了';implementationend.