Browse Computer Network

uses
  ShlObj, ActiveX;

function FindComputer(hWnd: THandle; sPrompt: string; csidl: word; var sComputer: string): boolean;
const
  BIF_NEWDIALOGSTYLE     = $0040;
  BIF_USENEWUI           = BIF_NEWDIALOGSTYLE or BIF_EDITBOX;
  BIF_BROWSEINCLUDEURLS  = $0080;
  BIF_UAHINT             = $0100;
  BIF_NONEWFOLDERBUTTON  = $0200;
  BIF_NOTRANSLATETARGETS = $0400;
  BIF_SHAREABLE          = $8000;

  BFFM_IUNKNOWN          = 5;
  BFFM_SETOKTEXT         = WM_USER + 105; // Unicode only
  BFFM_SETEXPANDED       = WM_USER + 106; // Unicode only
var
  bi                     : TBrowseInfo;
  ca                     : array[0..MAX_PATH] of char;
  pidl, pidlSelected     : PItemIDList;
  m                      : IMalloc;
begin
  if Failed(SHGetSpecialFolderLocation(hWnd, CSIDL_NETWORK, pidl)) then
  begin
    result := False;
    exit;
  end;
  try
    FillChar(bi, SizeOf(bi), 0);
    with bi do begin
      hwndOwner := hWnd;
      pidlRoot := pidl;
      pszDisplayName := ca;
      lpszTitle := PChar(sPrompt);
      ulFlags := BIF_BROWSEFORCOMPUTER;
    end;
    pidlSelected := SHBrowseForFolder(bi);
    Result := Assigned(pidlSelected);
    if Result then
      sComputer := '\\' + string(ca);
  finally
    if Succeeded(SHGetMalloc(m)) then
      m.Free(pidl);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Computer: String;
begin
  FindComputer(Handle, 'Wählen sie einen Computer', 0, Computer);
end;