{=========================================================================
   功  能: 網絡函數庫
   時  間: 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表示刪除"http://"，
       //如//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://"，如//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.