Delphi網(wǎng)絡(luò)函數(shù)

intruder 2006-07-24

展開全文

Delphi網(wǎng)絡(luò)函數(shù)

unit net;

interface
uses
sysutils
,windows
,dialogs
,winsock
,classes
,comobj
,wininet;

//得到本機(jī)的局域網(wǎng)ip地址
function getlocalip(var localip:string): boolean;
//通過(guò)ip返回機(jī)器名
function getnamebyipaddr(ipaddr: string; var macname: string): boolean ;
//獲取網(wǎng)絡(luò)中sqlserver列表
function getsqlserverlist(var list: tstringlist): boolean;
//獲取網(wǎng)絡(luò)中的所有網(wǎng)絡(luò)類型
function getnetlist(var list: tstringlist): boolean;
//獲取網(wǎng)絡(luò)中的工作組
function getgrouplist(var list: tstringlist): boolean;
//獲取工作組中所有計(jì)算機(jī)
function getusers(groupname: string; var list: tstringlist): boolean;
//獲取網(wǎng)絡(luò)中的資源
function getuserresource(ipaddr: string; var list: tstringlist): boolean;
//映射網(wǎng)絡(luò)驅(qū)動(dòng)器
function netaddconnection(netpath: pchar; password: pchar;localpath: pchar): boolean;
//檢測(cè)網(wǎng)絡(luò)狀態(tài)
function checknet(ipaddr:string): boolean;
//檢測(cè)機(jī)器是否登入網(wǎng)絡(luò)
function checkmacattachnet: boolean;

//判斷ip協(xié)議有沒(méi)有安裝這個(gè)函數(shù)有問(wèn)題
function isipinstalled : boolean;
//檢測(cè)機(jī)器是否上網(wǎng)
function internetconnected: boolean;
implementation

{=================================================================
功能: 檢測(cè)機(jī)器是否登入網(wǎng)絡(luò)
參數(shù): 無(wú)
返回值: 成功: 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;

{=================================================================
功能: 返回本機(jī)的局域網(wǎng)ip地址
參數(shù): 無(wú)
返回值: 成功: 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;

{=================================================================
功能: 通過(guò)ip返回機(jī)器名
參數(shù):
ipaddr: 想要得到名字的ip
返回值: 成功: 機(jī)器名失敗: ‘‘‘‘
備注:
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;

{=================================================================
功能: 返回網(wǎng)絡(luò)中sqlserver列表
參數(shù):
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協(xié)議有沒(méi)有安裝
參數(shù): 無(wú)
返回值: 成功: true 失敗: false;
備注: 該函數(shù)還有問(wèn)題
版本:
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;

{=================================================================
功能: 返回網(wǎng)絡(luò)中的共享資源
參數(shù):
ipaddr: 機(jī)器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;//網(wǎng)絡(luò)類型的數(shù)組
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);//初始化網(wǎng)絡(luò)層次信息
netresource.lpremotename := @ipaddr[1];//指定計(jì)算機(jī)名稱
//獲取指定計(jì)算機(jī)的網(wǎng)絡(luò)資源句柄
res := wnetopenenum( resource_globalnet, resourcetype_any,
resourceusage_connectable, @netresource,lphenum);
if res <> no_error then exit;//執(zhí)行失敗
while true do//列舉指定工作組的網(wǎng)絡(luò)資源
begin
count := $ffffffff;//不限資源數(shù)目
bufsize := 8192;//緩沖區(qū)大小設(shè)置為8k
getmem(buf, bufsize);//申請(qǐng)內(nèi)存，用于獲取工作組信息
//獲取指定計(jì)算機(jī)的網(wǎng)絡(luò)資源名稱
res := wnetenumresource(lphenum, count, pointer(buf), bufsize);
if res = error_no_more_items then break;//資源列舉完畢
if (res <> no_error) then exit;//執(zhí)行失敗
temp := tnetresourcearray(buf);
for i := 0 to count - 1 do
begin
//獲取指定計(jì)算機(jī)中的共享資源名稱，+2表示刪除"\\"，
//如\\192.168.0.1 => 192.168.0.1
list.add(temp^.lpremotename + 2);
inc(temp);
end;
end;
res := wnetcloseenum(lphenum);//關(guān)閉一次列舉
if res <> no_error then exit;//執(zhí)行失敗
result := true;
freemem(buf);
end;

{=================================================================
功能: 返回網(wǎng)絡(luò)中的工作組
參數(shù):
list: 需要填充的list
返回值: 成功: true,并填充list 失敗: false;
備注:
版本:
1.0 2002/10/03 08:00:00
=================================================================}
function getgrouplist( var list : tstringlist ) : boolean;
type
tnetresourcearray = ^tnetresource;//網(wǎng)絡(luò)類型的數(shù)組
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;
//獲取整個(gè)網(wǎng)絡(luò)中的文件資源的句柄，lphenum為返回名柄
res := wnetopenenum( resource_globalnet, resourcetype_disk,
resourceusage_container, nil,lphenum);
if res <> no_error then exit;//raise exception(res);//執(zhí)行失敗
//獲取整個(gè)網(wǎng)絡(luò)中的網(wǎng)絡(luò)類型信息
count := $ffffffff;//不限資源數(shù)目
bufsize := 8192;//緩沖區(qū)大小設(shè)置為8k
getmem(buf, bufsize);//申請(qǐng)內(nèi)存，用于獲取工作組信息
res := wnetenumresource(lphenum, count, pointer(buf), bufsize);
//資源列舉完畢 //執(zhí)行失敗
if ( res = error_no_more_items ) or (res <> no_error ) then exit;
p := tnetresourcearray(buf);
for i := 0 to count - 1 do//記錄各個(gè)網(wǎng)絡(luò)類型的信息
begin
networktypelist.add(p);
inc(p);
end;
res := wnetcloseenum(lphenum);//關(guān)閉一次列舉
if res <> no_error then exit;
for j := 0 to networktypelist.count-1 do //列出各個(gè)網(wǎng)絡(luò)類型中的所有工作組名稱
begin//列出一個(gè)網(wǎng)絡(luò)類型中的所有工作組名稱
netresource := tnetresource(networktypelist.items[j]^);//網(wǎng)絡(luò)類型信息
//獲取某個(gè)網(wǎng)絡(luò)類型的文件資源的句柄，netresource為網(wǎng)絡(luò)類型信息，lphenum為返回名柄
res := wnetopenenum(resource_globalnet, resourcetype_disk,
resourceusage_container, @netresource,lphenum);
if res <> no_error then break;//執(zhí)行失敗
while true do//列舉一個(gè)網(wǎng)絡(luò)類型的所有工作組的信息
begin
count := $ffffffff;//不限資源數(shù)目
bufsize := 8192;//緩沖區(qū)大小設(shè)置為8k
getmem(buf, bufsize);//申請(qǐng)內(nèi)存，用于獲取工作組信息
//獲取一個(gè)網(wǎng)絡(luò)類型的文件資源信息，
res := wnetenumresource(lphenum, count, pointer(buf), bufsize);
//資源列舉完畢 //執(zhí)行失敗
if ( res = error_no_more_items ) or (res <> no_error) then break;
p := tnetresourcearray(buf);
for i := 0 to count - 1 do//列舉各個(gè)工作組的信息
begin
list.add( strpas( p^.lpremotename ));//取得一個(gè)工作組的名稱
inc(p);
end;
end;
res := wnetcloseenum(lphenum);//關(guān)閉一次列舉
if res <> no_error then break;//執(zhí)行失敗
end;
result := true;
freemem(buf);
networktypelist.destroy;
end;

{=================================================================
功能: 列舉工作組中所有的計(jì)算機(jī)
參數(shù):
list: 需要填充的list
返回值: 成功: true,并填充list 失敗: false;
備注:
版本:
1.0 2002/10/03 08:00:00
=================================================================}
function getusers(groupname: string; var list: tstringlist): boolean;
type
tnetresourcearray = ^tnetresource;//網(wǎng)絡(luò)類型的數(shù)組
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);//初始化網(wǎng)絡(luò)層次信息
netresource.lpremotename := @groupname[1];//指定工作組名稱
netresource.dwdisplaytype := resourcedisplaytype_server;//類型為服務(wù)器（工作組）
netresource.dwusage := resourceusage_container;
netresource.dwscope := resourcetype_disk;//列舉文件資源信息
//獲取指定工作組的網(wǎng)絡(luò)資源句柄
res := wnetopenenum( resource_globalnet, resourcetype_disk,
resourceusage_container, @netresource,lphenum);
if res <> no_error then exit; //執(zhí)行失敗
while true do//列舉指定工作組的網(wǎng)絡(luò)資源
begin
count := $ffffffff;//不限資源數(shù)目
bufsize := 8192;//緩沖區(qū)大小設(shè)置為8k
getmem(buf, bufsize);//申請(qǐng)內(nèi)存，用于獲取工作組信息
//獲取計(jì)算機(jī)名稱
res := wnetenumresource(lphenum, count, pointer(buf), bufsize);
if res = error_no_more_items then break;//資源列舉完畢
if (res <> no_error) then exit;//執(zhí)行失敗
temp := tnetresourcearray(buf);
for i := 0 to count - 1 do//列舉工作組的計(jì)算機(jī)名稱
begin
//獲取工作組的計(jì)算機(jī)名稱，+2表示刪除"\\"，如\\wangfajun=>wangfajun
list.add(temp^.lpremotename + 2);
inc(temp);
end;
end;
res := wnetcloseenum(lphenum);//關(guān)閉一次列舉
if res <> no_error then exit;//執(zhí)行失敗
result := true;
freemem(buf);
end;

{=================================================================
功能: 列舉所有網(wǎng)絡(luò)類型
參數(shù):
list: 需要填充的list
返回值: 成功: true,并填充list 失敗: false;
備注:
版本:
1.0 2002/10/03 08:54:00
=================================================================}
function getnetlist(var list: tstringlist): boolean;
type
tnetresourcearray = ^tnetresource;//網(wǎng)絡(luò)類型的數(shù)組
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;//執(zhí)行失敗
count := $ffffffff;//不限資源數(shù)目
bufsize := 8192;//緩沖區(qū)大小設(shè)置為8k
getmem(buf, bufsize);//申請(qǐng)內(nèi)存，用于獲取工作組信息
res := wnetenumresource(lphenum, count, pointer(buf), bufsize);//獲取網(wǎng)絡(luò)類型信息
//資源列舉完畢 //執(zhí)行失敗
if ( res = error_no_more_items ) or (res <> no_error ) then exit;
p := tnetresourcearra

{=================================================================
功能: 映射網(wǎng)絡(luò)驅(qū)動(dòng)器
參數(shù):
netpath: 想要映射的網(wǎng)絡(luò)路徑
password: 訪問(wèn)密碼
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;

{=================================================================
功能: 檢測(cè)網(wǎng)絡(luò)狀態(tài)
參數(shù):
ipaddr: 被測(cè)試網(wǎng)絡(luò)上主機(jī)的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;

{=================================================================
功能: 檢測(cè)計(jì)算機(jī)是否上網(wǎng)
參數(shù): 無(wú)
返回值: 成功: 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.
//錯(cuò)誤信息常量
unit head;

interface
const
c_err_getlocalip = ‘‘獲取本地ip失敗‘‘;
c_err_getnamebyipaddr = ‘‘獲取主機(jī)名失敗‘‘;
c_err_getsqlserverlist = ‘‘獲取sqlserver服務(wù)器失敗‘‘;
c_err_getuserresource = ‘‘獲取共享資失敗‘‘;
c_err_getgrouplist = ‘‘獲取所有工作組失敗‘‘;
c_err_getgroupusers = ‘‘獲取工作組中所有計(jì)算機(jī)失敗‘‘;
c_err_getnetlist = ‘‘獲取所有網(wǎng)絡(luò)類型失敗‘‘;
c_err_checknet = ‘‘網(wǎng)絡(luò)不通‘‘;
c_err_checkattachnet = ‘‘未登入網(wǎng)絡(luò)‘‘;
c_err_internetconnected =‘‘沒(méi)有上網(wǎng)‘‘;

c_txt_checknetsuccess = ‘‘網(wǎng)絡(luò)暢通‘‘;
c_txt_checkattachnetsuccess = ‘‘已登入網(wǎng)絡(luò)‘‘;
c_txt_internetconnected =‘‘上網(wǎng)了‘‘;

implementation

end.

本站是提供個(gè)人知識(shí)管理的網(wǎng)絡(luò)存儲(chǔ)空間，所有內(nèi)容均由用戶發(fā)布，不代表本站觀點(diǎn)。請(qǐng)注意甄別內(nèi)容中的聯(lián)系方式、誘導(dǎo)購(gòu)買等信息，謹(jǐn)防詐騙。如發(fā)現(xiàn)有害或侵權(quán)內(nèi)容，請(qǐng)點(diǎn)擊一鍵舉報(bào)。

轉(zhuǎn)藏 分享

QQ空間 QQ好友新浪微博微信

獻(xiàn)花（0） +1

來(lái)自： intruder > 《Delphi編程》

舉報(bào)/認(rèn)領(lǐng)