bestlong 怕失憶論壇

 

 

搜索
bestlong 怕失憶論壇 論壇 Delphi Delphi 網路函數
查看: 3449|回復: 0
go

Delphi 網路函數 [複製鏈接]

Rank: 9Rank: 9Rank: 9

1#
發表於 2006-8-4 09:39 |只看該作者 |倒序瀏覽 |打印
  1. unit net;

  2. interface

  3. uses
  4.   sysutils,windows,dialogs,winsock,classes,comobj,wininet;

  5.   //得到本机的局域网ip地址
  6.   function getlocalip(var localip:string): boolean;
  7.   //通过ip返回机器名
  8.   function getnamebyipaddr(ipaddr: string; var macname: string): boolean ;
  9.   //获取网络中sqlserver列表
  10.   function getsqlserverlist(var list: tstringlist): boolean;
  11.   //获取网络中的所有网络类型
  12.   function getnetlist(var list: tstringlist): boolean;
  13.   //获取网络中的工作组
  14.   function getgrouplist(var list: tstringlist): boolean;
  15.   //获取工作组中所有计算机
  16.   function getusers(groupname: string; var list: tstringlist): boolean;
  17.   //获取网络中的资源
  18.   function getuserresource(ipaddr: string; var list: tstringlist): boolean;
  19.   //映射网络驱动器
  20.   function netaddconnection(netpath: pchar; password: pchar;localpath: pchar): boolean;
  21.   //检测网络状态
  22.   function checknet(ipaddr:string): boolean;
  23.   //检测机器是否登入网络
  24.   function checkmacattachnet: boolean;

  25.   //判断ip协议有没有安装 这个函数有问题
  26.   function isipinstalled : boolean;
  27.   //检测机器是否上网
  28.   function internetconnected: boolean;
  29.   
  30. implementation

  31. {=================================================================
  32. 功 能: 检测机器是否登入网络
  33. 参 数: 无
  34. 返回值: 成功: true 失败: false
  35. 备 注:
  36. 版 本:
  37. 1.0 2002/10/03 09:55:00
  38. =================================================================}
  39. function checkmacattachnet: boolean;
  40. begin
  41.   result := false;
  42.   if getsystemmetrics(sm_network) <> 0 then
  43.     result := true;
  44. end;

  45. {=================================================================
  46. 功 能: 返回本机的局域网ip地址
  47. 参 数: 无
  48. 返回值: 成功: true, 并填充localip 失败: false
  49. 备 注:
  50. 版 本:
  51. 1.0 2002/10/02 21:05:00
  52. =================================================================}
  53. function getlocalip(var localip: string): boolean;
  54. var
  55.   hostent: phostent;
  56.   ip: string;
  57.   addr: pchar;
  58.   buffer: array [0..63] of char;
  59.   ginitdata: twsadata;
  60. begin
  61.   result := false;
  62.   try
  63.     wsastartup(2, ginitdata);
  64.     gethostname(buffer, sizeof(buffer));
  65.     hostent := gethostbyname(buffer);
  66.     if hostent = nil then exit;
  67.     addr := hostent^.h_addr_list^;
  68.     ip := format('%d.%d.%d.%d', [byte(addr [0]),
  69.     byte (addr [1]), byte (addr [2]), byte (addr [3])]);
  70.     localip := ip;
  71.     result := true;
  72.   finally
  73.     wsacleanup;
  74.   end;
  75. end;

  76. {=================================================================
  77. 功 能: 通过ip返回机器名
  78. 参 数:
  79. ipaddr: 想要得到名字的ip
  80. 返回值: 成功: 机器名 失败: ''
  81. 备 注:
  82. inet_addr function converts a string containing an internet
  83. protocol dotted address into an in_addr.
  84. 版 本:
  85. 1.0 2002/10/02 22:09:00
  86. =================================================================}
  87. function getnamebyipaddr(ipaddr : string;var macname:string): boolean;
  88. var
  89.   sockaddrin: tsockaddrin;
  90.   hostent: phostent;
  91.   wsadata: twsadata;
  92. begin
  93.   result := false;
  94.   if ipaddr = '' then exit;
  95.   try
  96.     wsastartup(2, wsadata);
  97.     sockaddrin.sin_addr.s_addr := inet_addr(pchar(ipaddr));
  98.     hostent := gethostbyaddr(@sockaddrin.sin_addr.s_addr, 4, af_inet);
  99.     if hostent <> nil then
  100.     macname := strpas(hostent^.h_name);
  101.     result := true;
  102.   finally
  103.     wsacleanup;
  104.   end;
  105. end;

  106. {=================================================================
  107. 功 能: 返回网络中sqlserver列表
  108. 参 数:
  109. list: 需要填充的list
  110. 返回值: 成功: true,并填充list 失败 false
  111. 备 注:
  112. 版 本:
  113. 1.0 2002/10/02 22:44:00
  114. =================================================================}
  115. function getsqlserverlist(var list: tstringlist): boolean;
  116. var
  117.   i: integer;
  118.   sretvalue: string;
  119.   sqlserver: variant;
  120.   serverlist: variant;
  121. begin
  122.   result := false;
  123.   list.clear;
  124.   try
  125.     sqlserver := createoleobject('sqldmo.application');
  126.     serverlist := sqlserver.listavailablesqlservers;
  127.     for i := 1 to serverlist.count do
  128.     list.add (serverlist.item(i));
  129.     result := true;
  130.   finally
  131.     sqlserver := null;
  132.     serverlist := null;
  133.   end;
  134. end;

  135. {=================================================================
  136. 功 能: 判断ip协议有没有安装
  137. 参 数: 无
  138. 返回值: 成功: true 失败: false;
  139. 备 注: 该函数还有问题
  140. 版 本:
  141. 1.0 2002/10/02 21:05:00
  142. =================================================================}
  143. function isipinstalled : boolean;
  144. var
  145.   wsdata: twsadata;
  146.   protoent: pprotoent;
  147. begin
  148.   result := true;
  149.   try
  150.     if wsastartup(2,wsdata) = 0 then
  151.     begin
  152.     protoent := getprotobyname('ip');
  153.     if protoent = nil then
  154.     result := false
  155.     end;
  156.   finally
  157.     wsacleanup;
  158.   end;
  159. end;

  160. {=================================================================
  161. 功 能: 返回网络中的共享资源
  162. 参 数:
  163. ipaddr: 机器ip
  164. list: 需要填充的list
  165. 返回值: 成功: true,并填充list 失败: false;
  166. 备 注:
  167. wnetopenenum function starts an enumeration of network
  168. resources or existing connections.
  169. wnetenumresource function continues a network-resource
  170. enumeration started by the wnetopenenum function.
  171. 版 本:
  172. 1.0 2002/10/03 07:30:00
  173. =================================================================}
  174. function getuserresource(ipaddr: string; var list: tstringlist): boolean;
  175. type
  176.   tnetresourcearray = ^tnetresource;//网络类型的数组
  177. var
  178.   i: integer;
  179.   buf: pointer;
  180.   temp: tnetresourcearray;
  181.   lphenum: thandle;
  182.   netresource: tnetresource;
  183.   count,bufsize,res: dword;
  184. begin
  185.   result := false;
  186.   list.clear;
  187.   if copy(ipaddr,0,2) <> '\\' then
  188.   ipaddr := '\\'+ipaddr; //填充ip地址信息
  189.   fillchar(netresource, sizeof(netresource), 0);//初始化网络层次信息
  190.   netresource.lpremotename := @ipaddr[1];//指定计算机名称
  191.   //获取指定计算机的网络资源句柄
  192.   res := wnetopenenum( resource_globalnet, resourcetype_any,
  193.   resourceusage_connectable, @netresource,lphenum);
  194.   if res <> no_error then exit;//执行失败
  195.   while true do//列举指定工作组的网络资源
  196.   begin
  197.     count := $ffffffff;//不限资源数目
  198.     bufsize := 8192;//缓冲区大小设置为8k
  199.     getmem(buf, bufsize);//申请内存,用于获取工作组信息
  200.     //获取指定计算机的网络资源名称
  201.     res := wnetenumresource(lphenum, count, pointer(buf), bufsize);
  202.     if res = error_no_more_items then break;//资源列举完毕
  203.     if (res <> no_error) then exit;//执行失败
  204.     temp := tnetresourcearray(buf);
  205.     for i := 0 to count - 1 do
  206.     begin
  207.       //获取指定计算机中的共享资源名称,+2表示删除"\\",
  208.       //如\\192.168.0.1 => 192.168.0.1
  209.       list.add(temp^.lpremotename + 2);
  210.       inc(temp);
  211.     end;
  212.   end;
  213.   res := wnetcloseenum(lphenum);//关闭一次列举
  214.   if res <> no_error then
  215.     exit;//执行失败
  216.   result := true;
  217.   freemem(buf);
  218. end;

  219. {=================================================================
  220. 功 能: 返回网络中的工作组
  221. 参 数:
  222. list: 需要填充的list
  223. 返回值: 成功: true,并填充list 失败: false;
  224. 备 注:
  225. 版 本:
  226. 1.0 2002/10/03 08:00:00
  227. =================================================================}
  228. function getgrouplist( var list : tstringlist ) : boolean;
  229. type
  230.   tnetresourcearray = ^tnetresource;//网络类型的数组
  231. var
  232.   netresource: tnetresource;
  233.   buf: pointer;
  234.   count,bufsize,res: dword;
  235.   lphenum: thandle;
  236.   p: tnetresourcearray;
  237.   i, j: smallint;
  238.   networktypelist: tlist;
  239. begin
  240.   result := false;
  241.   networktypelist := tlist.create;
  242.   list.clear;
  243.   //获取整个网络中的文件资源的句柄,lphenum为返回名柄
  244.   res := wnetopenenum( resource_globalnet, resourcetype_disk,
  245.   resourceusage_container, nil,lphenum);
  246.   if res <> no_error then exit;//raise exception(res);//执行失败
  247.   //获取整个网络中的网络类型信息
  248.   count := $ffffffff;//不限资源数目
  249.   bufsize := 8192;//缓冲区大小设置为8k
  250.   getmem(buf, bufsize);//申请内存,用于获取工作组信息
  251.   res := wnetenumresource(lphenum, count, pointer(buf), bufsize);
  252.   //资源列举完毕 //执行失败
  253.   if ( res = error_no_more_items ) or (res <> no_error ) then exit;
  254.   p := tnetresourcearray(buf);
  255.   for i := 0 to count - 1 do//记录各个网络类型的信息
  256.   begin
  257.     networktypelist.add(p);
  258.     inc(p);
  259.   end;
  260.   res := wnetcloseenum(lphenum);//关闭一次列举
  261.   if res <> no_error then exit;
  262.   for j := 0 to networktypelist.count-1 do //列出各个网络类型中的所有工作组名称
  263.   begin//列出一个网络类型中的所有工作组名称
  264.     netresource := tnetresource(networktypelist.items[j]^);//网络类型信息
  265.     //获取某个网络类型的文件资源的句柄,netresource为网络类型信息,lphenum为返回名柄
  266.     res := wnetopenenum(resource_globalnet, resourcetype_disk,
  267.     resourceusage_container, @netresource,lphenum);
  268.     if res <> no_error then break;//执行失败
  269.     while true do//列举一个网络类型的所有工作组的信息
  270.     begin
  271.       count := $ffffffff;//不限资源数目
  272.       bufsize := 8192;//缓冲区大小设置为8k
  273.       getmem(buf, bufsize);//申请内存,用于获取工作组信息
  274.       //获取一个网络类型的文件资源信息,
  275.       res := wnetenumresource(lphenum, count, pointer(buf), bufsize);
  276.       //资源列举完毕 //执行失败
  277.       if ( res = error_no_more_items ) or (res <> no_error) then break;
  278.       p := tnetresourcearray(buf);
  279.       for i := 0 to count - 1 do//列举各个工作组的信息
  280.       begin
  281.         list.add( strpas( p^.lpremotename ));//取得一个工作组的名称
  282.         inc(p);
  283.       end;
  284.     end;
  285.     res := wnetcloseenum(lphenum);//关闭一次列举
  286.     if res <> no_error then break;//执行失败
  287.   end;
  288.   result := true;
  289.   freemem(buf);
  290.   networktypelist.destroy;
  291. end;

  292. {=================================================================
  293. 功 能: 列举工作组中所有的计算机
  294. 参 数:
  295. list: 需要填充的list
  296. 返回值: 成功: true,并填充list 失败: false;
  297. 备 注:
  298. 版 本:
  299. 1.0 2002/10/03 08:00:00
  300. =================================================================}
  301. function getusers(groupname: string; var list: tstringlist): boolean;
  302. type
  303.   tnetresourcearray = ^tnetresource;//网络类型的数组
  304. var
  305.   i: integer;
  306.   buf: pointer;
  307.   temp: tnetresourcearray;
  308.   lphenum: thandle;
  309.   netresource: tnetresource;
  310.   count,bufsize,res: dword;
  311. begin
  312.   result := false;
  313.   list.clear;
  314.   fillchar(netresource, sizeof(netresource), 0);//初始化网络层次信息
  315.   netresource.lpremotename := @groupname[1];//指定工作组名称
  316.   netresource.dwdisplaytype := resourcedisplaytype_server;//类型为服务器(工作组)
  317.   netresource.dwusage := resourceusage_container;
  318.   netresource.dwscope := resourcetype_disk;//列举文件资源信息
  319.   //获取指定工作组的网络资源句柄
  320.   res := wnetopenenum( resource_globalnet, resourcetype_disk,
  321.   resourceusage_container, @netresource,lphenum);
  322.   if res <> no_error then exit; //执行失败
  323.   while true do//列举指定工作组的网络资源
  324.   begin
  325.     count := $ffffffff;//不限资源数目
  326.     bufsize := 8192;//缓冲区大小设置为8k
  327.     getmem(buf, bufsize);//申请内存,用于获取工作组信息
  328.     //获取计算机名称
  329.     res := wnetenumresource(lphenum, count, pointer(buf), bufsize);
  330.     if res = error_no_more_items then break;//资源列举完毕
  331.     if (res <> no_error) then exit;//执行失败
  332.     temp := tnetresourcearray(buf);
  333.     for i := 0 to count - 1 do//列举工作组的计算机名称
  334.     begin
  335.       //获取工作组的计算机名称,+2表示删除"\\",如\\wangfajun=>wangfajun
  336.       list.add(temp^.lpremotename + 2);
  337.       inc(temp);
  338.     end;
  339.   end;
  340.   res := wnetcloseenum(lphenum);//关闭一次列举
  341.   if res <> no_error then exit;//执行失败
  342.   result := true;
  343.   freemem(buf);
  344. end;

  345. {=================================================================
  346. 功 能: 列举所有网络类型
  347. 参 数:
  348. list: 需要填充的list
  349. 返回值: 成功: true,并填充list 失败: false;
  350. 备 注:
  351. 版 本:
  352. 1.0 2002/10/03 08:54:00
  353. =================================================================}
  354. function getnetlist(var list: tstringlist): boolean;
  355. type
  356.   tnetresourcearray = ^tnetresource;//网络类型的数组
  357. var
  358.   p: tnetresourcearray;
  359.   buf: pointer;
  360.   i: smallint;
  361.   lphenum: thandle;
  362.   netresource: tnetresource;
  363.   count,bufsize,res: dword;
  364. begin
  365.   result := false;
  366.   list.clear;
  367.   res := wnetopenenum( resource_globalnet, resourcetype_disk,
  368.   resourceusage_container, nil,lphenum);
  369.   if res <> no_error then exit;//执行失败
  370.   count := $ffffffff;//不限资源数目
  371.   bufsize := 8192;//缓冲区大小设置为8k
  372.   getmem(buf, bufsize);//申请内存,用于获取工作组信息
  373.   res := wnetenumresource(lphenum, count, pointer(buf), bufsize);//获取网络类型信息
  374.   //资源列举完毕 //执行失败
  375.   if ( res = error_no_more_items ) or (res <> no_error ) then exit;
  376.   p := tnetresourcearra

  377.   {=================================================================
  378.   功 能: 映射网络驱动器
  379.   参 数:
  380.   netpath: 想要映射的网络路径
  381.   password: 访问密码
  382.   localpath 本地路径
  383.   返回值: 成功: true 失败: false;
  384.   备 注:
  385.   版 本:
  386.   1.0 2002/10/03 09:24:00
  387.   =================================================================}
  388.   function netaddconnection(netpath: pchar; password: PChar; localpath: pchar): boolean;
  389.   var
  390.     res: dword;
  391.   begin
  392.     result := false;
  393.     res := wnetaddconnection(netpath,password,localpath);
  394.     if res <> no_error then exit;
  395.     result := true;
  396.   end;

  397.   {=================================================================
  398.   功 能: 检测网络状态
  399.   参 数:
  400.   ipaddr: 被测试网络上主机的ip地址或名称,建议使用ip
  401.   返回值: 成功: true 失败: false;
  402.   备 注:
  403.   版 本:
  404.   1.0 2002/10/03 09:40:00
  405.   =================================================================}
  406.   function checknet(ipaddr: string): boolean;
  407.   type
  408.   pipoptioninformation = ^tipoptioninformation;
  409.   tipoptioninformation = packed record
  410.     ttl: byte; // time to live (used for traceroute)
  411.     tos: byte; // type of service (usually 0)
  412.     flags: byte; // ip header flags (usually 0)
  413.     optionssize: byte; // size of options data (usually 0, max 40)
  414.     optionsdata: pchar; // options data buffer
  415.   end;

  416.   picmpechoreply = ^ticmpechoreply;
  417.   ticmpechoreply = packed record
  418.   address: dword; // replying address
  419.   status: dword; // ip status value (see below)
  420.   rtt: dword; // round trip time in milliseconds
  421.   datasize: word; // reply data size
  422.   reserved: word;
  423.   data: pointer; // pointer to reply data buffer
  424.   options: tipoptioninformation; // reply options
  425. end;

  426.   ticmpcreatefile = function: thandle; stdcall;
  427.   ticmpclosehandle = function(icmphandle: thandle): boolean; stdcall;
  428.   ticmpsendecho = function(
  429.   icmphandle: thandle;
  430.   destinationaddress: dword;
  431.   requestdata: pointer;
  432.   requestsize: word;
  433.   requestoptions: pipoptioninformation;
  434.   replybuffer: pointer;
  435.   replysize: dword;
  436.   timeout: dword
  437. ): dword; stdcall;

  438. const
  439. size = 32;
  440. timeout = 1000;
  441. var
  442.   wsadata: twsadata;
  443.   address: dword; // address of host to contact
  444.   hostname, hostip: string; // name and dotted ip of host to contact
  445.   phe: phostent; // hostentry buffer for name lookup
  446.   buffersize, npkts: integer;
  447.   preqdata, pdata: pointer;
  448.   pipe: picmpechoreply; // icmp echo reply buffer
  449.   ipopt: tipoptioninformation; // ip options for packet to send
  450. const
  451.   icmpdll = 'icmp.dll';
  452. var
  453.   hicmplib: hmodule;
  454.   icmpcreatefile : ticmpcreatefile;
  455.   icmpclosehandle: ticmpclosehandle;
  456.   icmpsendecho: ticmpsendecho;
  457.   hicmp: thandle; // handle for the icmp calls
  458. begin
  459.   // initialise winsock
  460.   result := true;
  461.   if wsastartup(2,wsadata) <> 0 then
  462.   begin
  463.     result:=false;
  464.     halt;
  465.   end;
  466.   // register the icmp.dll stuff
  467.   hicmplib := loadlibrary(icmpdll);
  468.   if hicmplib <> null then
  469.   begin
  470.     @icmpcreatefile  := getprocaddress(hicmplib, 'icmpcreatefile');
  471.     @icmpclosehandle := getprocaddress(hicmplib, 'icmpclosehandle');
  472.     @icmpsendecho    := getprocaddress(hicmplib, 'icmpsendecho');
  473.     if (@icmpcreatefile = nil) or (@icmpclosehandle = nil) or (@icmpsendecho = nil) then
  474.     begin
  475.       result:=false;
  476.       halt;
  477.     end;
  478.     hicmp := icmpcreatefile;
  479.     if hicmp = invalid_handle_value then
  480.     begin
  481.       result:=false;
  482.       halt;
  483.     end;
  484.   end else begin
  485.     result := false;
  486.     halt;
  487.   end;
  488.   // ------------------------------------------------------------
  489.   address := inet_addr(pchar(ipaddr));
  490.   if (address = inaddr_none) then
  491.   begin
  492.     phe := gethostbyname(pchar(ipaddr));
  493.     if phe = nil then
  494.       result := false
  495.     else begin
  496.       address := longint(plongint(phe^.h_addr_list^)^);
  497.       hostname := phe^.h_name;
  498.       hostip := strpas(inet_ntoa(tinaddr(address)));
  499.     end;
  500.   end
  501.   else begin
  502.     phe := gethostbyaddr(@address, 4, pf_inet);
  503.     if phe = nil then result:=false;
  504.   end;

  505.   if address = inaddr_none then
  506.   begin
  507.     result:=false;
  508.   end;
  509.   // get some data buffer space and put something in the packet to send
  510.   buffersize := sizeof(ticmpechoreply) + size;
  511.   getmem(preqdata, size);
  512.   getmem(pdata, size);
  513.   getmem(pipe, buffersize);
  514.   fillchar(preqdata^, size, $aa);
  515.   pipe^.data := pdata;

  516.   // finally send the packet
  517.   fillchar(ipopt, sizeof(ipopt), 0);
  518.   ipopt.ttl := 64;
  519.   npkts := icmpsendecho(hicmp, address, preqdata, size, @ipopt, pipe, buffersize, timeout);
  520.   if npkts = 0 then result:=false;

  521.   // free those buffers
  522.   freemem(pipe); freemem(pdata); freemem(preqdata);

  523.   // --------------------------------------------------------------
  524.   icmpclosehandle(hicmp);
  525.   freelibrary(hicmplib);
  526.   // free winsock
  527.   if wsacleanup <> 0 then result:=false;
  528. end;

  529. {=================================================================
  530. 功 能: 检测计算机是否上网
  531. 参 数: 无
  532. 返回值: 成功: true 失败: false;
  533. 备 注: uses wininet
  534. 版 本:
  535. 1.0 2002/10/07 13:33:00
  536. =================================================================}
  537. function internetconnected: boolean;
  538. const
  539.   // local system uses a modem to connect to the internet.
  540.   internet_connection_modem = 1;
  541.   // local system uses a local area network to connect to the internet.
  542.   internet_connection_lan = 2;
  543.   // local system uses a proxy server to connect to the internet.
  544.   internet_connection_proxy = 4;
  545.   // local system's modem is busy with a non-internet connection.
  546.   internet_connection_modem_busy = 8;
  547. var
  548.   dwconnectiontypes : dword;
  549. begin
  550.   dwconnectiontypes := internet_connection_modem+ internet_connection_lan + internet_connection_proxy;
  551.   result := internetgetconnectedstate(@dwconnectiontypes, 0);
  552. end;
  553. end.
複製代碼
  1. //错误信息常量
  2. unit head;

  3. interface

  4. const
  5.   c_err_getlocalip = '获取本地ip失败';
  6.   c_err_getnamebyipaddr = '获取主机名失败';
  7.   c_err_getsqlserverlist = '获取sqlserver服务器失败';
  8.   c_err_getuserresource = '获取共享资失败';
  9.   c_err_getgrouplist = '获取所有工作组失败';
  10.   c_err_getgroupusers = '获取工作组中所有计算机失败';
  11.   c_err_getnetlist = '获取所有网络类型失败';
  12.   c_err_checknet = '网络不通';
  13.   c_err_checkattachnet = '未登入网络';
  14.   c_err_internetconnected ='没有上网';

  15.   c_txt_checknetsuccess = '网络畅通';
  16.   c_txt_checkattachnetsuccess = '已登入网络';
  17.   c_txt_internetconnected ='上网了';

  18. implementation

  19. end.
複製代碼
我是雪龍
http://blog.bestlong.idv.tw
http://www.bestlong.idv.tw
‹ 上一主題|下一主題

Archiver|怕失憶論壇

GMT+8, 2024-5-5 14:33 , Processed in 0.014378 second(s), 10 queries .

Powered by Discuz! X1.5

© 2001-2010 Comsenz Inc.