delphi 网络函数

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表示删除"\\"，

//如http://www.cnblogs.com/wangdaye/admin/file://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表示删除"\\"，如http://www.cnblogs.com/wangdaye/admin/file://wangfajun=%3ewangfajun/

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.