Delphi网络函数.doc

Delphi网络函数原文出自木蚂蚁社区,本贴地址:/viewthread.php?tid=1090741Delphi网络函数 unit net;interfaceuses 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.02002/10/03 09:55:00=function checkmacattachnet: boolean;beginresult := false;if getsystemmetrics(sm_network) 0 then result := true;end;=功能: 返回本机的局域网ip地址参数: 无返回值: 成功:true, 并填充localip 失败:false备 注:版 本: 1.02002/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;beginresult := 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.02002/10/02 22:09:00=function getnamebyipaddr(ipaddr : string;var macname:string): boolean;varsockaddrin: tsockaddrin;hostent: phostent;wsadata: twsadata;beginresult := 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.02002/10/02 22:44:00=function getsqlserverlist(var list: tstringlist): boolean;var i: integer; sretvalue: string; sqlserver: variant; serverlist: variant;beginresult := 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.02002/10/02 21:05:00=function isipinstalled : boolean;varwsdata: twsadata;protoent: pprotoent;beginresult := 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.02002/10/03 07:30:00=function getuserresource(ipaddr: string; var list: tstringlist): boolean;typetnetresourcearray = tnetresource;/网络类型的数组vari: integer;buf: pointer;temp: tnetresourcearray;lphenum: thandle;netresource: tnetresource;count,bufsize,res: dword;beginresult := false;list.clear;if copy(ipaddr,0,2) then ipaddr := +ipaddr; /填充ip地址信息fillchar(netresource, sizeof(netresource), 0);/初始化网络层次信息netresource.lpremotename := ipaddr1;/指定计算机名称/获取指定计算机的网络资源句柄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表示删除， /如 = 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.02002/10/03 08:00:00=function getgrouplist( var list : tstringlist ) : boolean;typetnetresourcearray = tnetresource;/网络类型的数组varnetresource: tnetresource;buf: pointer;count,bufsize,res: dword;lphenum: thandle;p: tnetresourcearray;i,j: smallint;networktypelist: tlist;beginresult := 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;/缓冲区大小设置为8kgetmem(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.itemsj);/网络类型信息 /获取某个网络类型的文件资源的句柄，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.02002/10/03 08:00:00=function getusers(groupname: string; var list: tstringlist): boolean;typetnetresourcearray = tnetresource;/网络类型的数组vari: integer;buf: pointer;temp: tnetresourcearray;lphenum: thandle;netresource: tnetresource;count,bufsize,res: dword;beginresult := false;list.clear;fillchar(netresource, sizeof(netresource), 0);/初始化网络层次信息netresource.lpremotename := groupname1;/指定工作组名称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.02002/10/03 08:54:00=function getnetlist(var list: tstringlist): boolean;typetnetresourcearray = tnetresource;/网络类型的数组varp: tnetresourcearray;buf: pointer;i: smallint;lphenum: thandle;netresource: tnetresource;count,bufsize,res: dword;beginresult := false;list.clear;res := wnetopenenum( resource_globalnet, resourcetype_disk, resourceusage_container, nil,lphenum);if res no_error then exit;/执行失败count := $ffffffff;/不限资源数目bufsize := 8192;/缓冲区大小设置为8kgetmem(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.02002/10/03 09:24:00=function netaddconnection(netpath: pchar; password: pchar ;localpath: pchar): boolean;varres: dword;beginresult := false;res := wnetaddconnection(netpath,password,localpath);if res no_error then exit;result := true;end;=功能:检测网络状态参数: ipaddr: 被测试网络上主机的ip地址或名称，建议使用ip返回值: 成功:true失败: false;备 注:版 本: 1.02002/10/03 09:40:00=function checknet(ipaddr: string): boolean;typepipoptioninformation = 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 bufferend;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 optionsend;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;constsize = 32;timeout = 1000;varwsadata: twsadata;address: dword; / address of host to contacthostname, hostip: string; / name and dotted ip of host to contactphe: phostent; / hostentry buffer for name lookupbuffersize, npkts: integer;preqdata, pdata: pointer;pipe: picmpechoreply; / icmp echo reply bufferipopt: tipoptioninformation; / ip options for packet to sendconsticmpdll = icmp.dll;varhicmplib: hmodule;icmpcreatefile : ticmpcreatefile;icmpclosehandle: ticmpclosehandle;icmpsendecho: ticmpsendecho;hicmp: thandle; / handle for the icmp callsbegin/ initialise winsockresult:=true;if wsastartup(2,wsadata) 0 then begin result:=false; halt;end;/ register the icmp.dll stuffhicmplib := 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;endelse begin phe := gethostbyaddr(address, 4, pf_inet); if phe = nil then result:=false;end;if address = inaddr_none thenbegin result:=false;end;/ get some data buffer space and put something in the packet to sendbuffersize := sizeof(ticmpechoreply) + size;getmem(preqdata, size);getmem(pdata, size);getmem(pipe, buffersize);fillchar(preqdata, size, $aa);pipe.data := pdata; / finally send the packetfillchar(ipopt, sizeof(ipopt), 0);ipopt.ttl := 64;npkts := icmpsendecho(hicmp, address, preqdata, size, ipopt, pipe, buffersize, timeout);if npkts = 0 t