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 }