网络函数库

核心提示：{= 功 能: 网络函数库 时 间: 2002/10/02 版 本: 1.0 =}unit Net;interface uses SysUtils ,Windows ,dialogs ,winsock ,Classes ,ComObj ,WinInet; //得到本机的局域网ip地址 Function G

{=========================================================================
　 功  能: 网络函数库
　 时  间: 2002/10/02
　 版  本: 1.0
 =========================================================================}
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=>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.