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