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.