Rede - capturar grupos, pcs e ips

uses Classes, Windows, SysUtils, WinSock;

function GetNetGroups(var Lista: TStringList): Boolean;

function GetNetComputers(const Grupo: string; var Lista: TStringList) : Boolean;

function GetNetIP(var Name, Address: string): Boolean;

function GetNetLocalName: string;

procedure GetNetIPs(var Lista: TStringList);

implementation

function GetNetGroups(var Lista: TStringList): Boolean;

type

  PMyRec = ^MyRec;

   MyRec = record

             dwScope      : Integer;

             dwType       : Integer;

             dwDisplayType: Integer;

             dwUsage      : Integer;

             LocalName    : string;

             RemoteName   : string;

             Comment      : string;

             Provider     : string;

           end;

  PnetResourceArr = ^TNetResource;

var

  NetResource        : TNetResource;

  TempRec            : PMyRec;

  Buf                : Pointer;

  Count, BufSize, Res: DWORD;

  lphEnum            : THandle;

  p                  : PNetResourceArr;

  i, j               : SmallInt;

  NetworkTypeList    : TList;

begin

  Result          := False;

  NetworkTypeList := TList.Create;

  Lista.Clear;

  GetMem(Buf, 8192);

  try

    Res := WNetOpenEnum( RESOURCE_GLOBALNET, RESOURCETYPE_DISK, RESOURCEUSAGE_CONTAINER, nil,lphEnum );

    if Res <> 0 then raise Exception(Res);

    Count   := $FFFFFFFF;

    BufSize := 8192;

    Res     := WNetEnumResource( lphEnum, Count, Pointer( Buf ), BufSize );

    if Res = ERROR_NO_MORE_ITEMS then Exit;

    if (Res <> 0) then raise Exception(Res);

    P := PNetResourceArr(Buf);

    for I := 0 to Count - 1 do

    begin

      New(TempRec);

      TempRec^.dwScope       := P^.dwScope;

      TempRec^.dwType        := P^.dwType ;

      TempRec^.dwDisplayType := P^.dwDisplayType ;

      TempRec^.dwUsage       := P^.dwUsage ;

      TempRec^.LocalName     := StrPas(P^.lpLocalName);

      TempRec^.RemoteName    := StrPas(P^.lpRemoteName);

      TempRec^.Comment       := StrPas(P^.lpComment);

      TempRec^.Provider      := StrPas(P^.lpProvider);

      NetworkTypeList.Add(TempRec);

      Inc(P);

    end;

    Res := WNetCloseEnum(lphEnum);

    if Res <> 0 then raise Exception(Res);

    for J := 0 to NetworkTypeList.Count-1 do

    begin

      TempRec     := NetworkTypeList.Items[J];

      NetResource := TNetResource(TempRec^);

      Res         := WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_DISK, RESOURCEUSAGE_CONTAINER, @NetResource,lphEnum);

      if Res <> 0 then raise Exception(Res);

      while True do

      begin

        Count   := $FFFFFFFF;

        BufSize := 8192;

        Res     := WNetEnumResource(lphEnum, Count, Pointer(Buf), BufSize);

        if Res = ERROR_NO_MORE_ITEMS then Break;

        if (Res <> 0) then raise Exception(Res);

        P := PNetResourceArr(Buf);

        for I := 0 to Count - 1 do

        begin

          Lista.Add(P^.lpRemoteName);

          Inc(P);

        end;

      end;

    end;

    Res := WNetCloseEnum(lphEnum);

    if Res <> 0 then raise Exception(Res);

    Result := True;

  finally

    FreeMem(Buf);

    NetworkTypeList.Destroy;

  end;

end;

function GetNetComputers(const Grupo: string; var Lista: TStringList) : Boolean;

type

  PnetResourceArr = ^TNetResource;

var

  NetResource : TNetResource;

  Buf         : Pointer;

  Count,

  BufSize, Res: DWord;

  Ind         : Integer;

  lphEnum     : THandle;

  Temp        : PNetResourceArr;

begin

  Result := False;

  Lista.Clear;

  GetMem( Buf, 8192 );

  try

    FillChar(NetResource, SizeOf(NetResource), 0);

    NetResource.lpRemoteName  := @Grupo[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 <> 0 then Exit;

    // Código Mágico do WinSock...

    while True do

    begin

      Count   := $FFFFFFFF;

      BufSize := 8192;

      Res     := WNetEnumResource(lphEnum, Count, Pointer(Buf), BufSize);

      if Res = ERROR_NO_MORE_ITEMS then Exit;

      if (Res <> 0) then Exit;

      Temp := PNetResourceArr(Buf);

      for Ind := 0 to Count - 1 do

      begin

        Lista.Add(Temp^.lpRemoteName + 2); // Adiciona os Computadores da Rede

        Inc(Temp);

      end;

    end;

    Res := WNetCloseEnum(lphEnum);

    if Res <> 0 then raise Exception(Res);

    Result := True;

  finally

    FreeMem(Buf);

  end;

end;

function GetNetIP(var Name, Address: string): Boolean;

var

  WSAData: TWSAData;

  HostEnt: PHostEnt;

begin

  WSAStartup(2, WSAData);

  SetLength(Name, StrLen( PChar( Name ) ) );

  HostEnt := GetHostByName( PChar( Name ) );

  Result := HostEnt = nil;

  if not Result then

    with HostEnt^ do

      Address := Format('%d.%d.%d.%d',[ Byte(h_addr^[0]), Byte(h_addr^[1]), Byte(h_addr^[2]), Byte(h_addr^[3])]);

  WSACleanup;

end;

function GetNetLocalName: String;

var

  pcName : PChar;

  Max_Len: DWord;

begin

  try

    Max_Len := MAX_COMPUTERNAME_LENGTH + 1;

    GetMem(pcName, Max_Len);

    GetComputerName(pcName, Max_Len);

  finally

    Result := pcName;

    FreeMem(pcName);

  end;

end;

procedure GetNetIPs(var Lista: TStringList);

var

  I            : Integer;

  Name, Address: String;

begin

  for I := 0 to Pred( Lista.Count ) do

  begin

    Name := Lista[I];

    GetNetIP( Name, Address );

    Lista[I] := Format( '%s - %s', [Name, Address] );

  end;

end;