- 註冊時間
- 2006-3-13
- 最後登錄
- 2025-1-10
- 在線時間
- 673 小時
- 閱讀權限
- 200
- 積分
- 417
- 帖子
- 1107
- 精華
- 0
- UID
- 2
  
|
- 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.
複製代碼 |
|