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 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.