Enumerate all network resources

Problem/Question/Abstract:

Enumerate all network resources

Answer:

The following routine DoEnumeration enumerates all network resources and puts the server names in a listbox ListBox1. In the given application this was used to select an application server.

function Fix(Server: string): string;
var
  p: integer;
begin { Fix }
  // dirty & slow, but it works :-)
  while copy(Server, 1, 1) = '\' do
    delete(Server, 1, 1);
  p := pos('\', Server);
  if p > 0 then
    delete(Server, p, 999);

  Result := Server
end; { Fix }

procedure TFSelServer.DoEnumeration;
type
  PNetResourceArray = ^TNetResourceArray;
  TNetResourceArray = array[0..MaxInt div SizeOf(TNetResource) - 1] of TNetResource;
var
  I, Count, BufSize, Size, NetResult: Integer;
  NetHandle: THandle;
  NetResources: PNetResourceArray;
  Server: string;
begin { DoEnumeration }
  if WNetOpenEnum(RESOURCE_CONNECTED, RESOURCETYPE_ANY, 0, nil, NetHandle) <> NO_ERROR
    then
    Exit;

  try
    BufSize := 50 * SizeOf(TNetResource);
    GetMem(NetResources, BufSize);
    try
      while True do
      begin { while Tr.. }
        Count := -1;
        Size := BufSize;
        NetResult := WNetEnumResource(NetHandle, Count, NetResources, Size);
        if NetResult = ERROR_MORE_DATA then
        begin
          BufSize := Size;
          ReallocMem(NetResources, BufSize);
          Continue;
        end;
        if NetResult <> NO_ERROR then
          Exit;
        for I := 0 to Count - 1 do
          with NetResources^[I] do
          begin { with Net.. }
            Server := Fix(lpRemoteName);
            if ListBox1.Items.IndexOf(Server) < 0 then
              ListBox1.Items.Add(Server)
          end; { with Net.. }
      end; { while Tr.. }
    finally
      FreeMem(NetResources, BufSize);
    end; { try }
  finally
    WNetCloseEnum(NetHandle);
  end; { try }
end; { DoEnumeration }