delphinet.txt

含有大量的DELPHI网络函数

{================================================================= 
  功  能: 列举工作组中所有的计算机 
  参  数: 
          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.