浏览计算机

uses

 ShlObj , ActiveX ;

function BrowseComputer ( DialogTitle : string ; var CompName : string ;

 bNewStyle : Boolean ): Boolean ;

  // bNewStyle: If True, this code will try to use the "new"

  // BrowseForFolders UI on Windows 2000/XP

const

 BIF_USENEWUI = 28 ;

var

 BrowseInfo : TBrowseInfo ;

 ItemIDList : PItemIDList ;

 ComputerName : array [ 0 .. MAX_PATH ] of Char ;

 Title : string ;

 WindowList : Pointer ;

 ShellMalloc : IMalloc ;

begin

  if Failed ( SHGetSpecialFolderLocation ( Application . Handle , CSIDL_NETWORK , ItemIDList )) then

    raise Exception . Create ( 'Unable open browse computer dialog' );

  try

   FillChar ( BrowseInfo , SizeOf ( BrowseInfo ), 0 );

   BrowseInfo . hwndOwner := Application . Handle ;

   BrowseInfo . pidlRoot := ItemIDList ;

   BrowseInfo . pszDisplayName := ComputerName ;

   Title := DialogTitle ;

   BrowseInfo . lpszTitle := PChar ( Pointer ( Title ));

    if bNewStyle then

     BrowseInfo . ulFlags := BIF_BROWSEFORCOMPUTER or BIF_USENEWUI

    else

     BrowseInfo . ulFlags := BIF_BROWSEFORCOMPUTER ;

   WindowList := DisableTaskWindows ( 0 );

    try

     Result := SHBrowseForFolder ( BrowseInfo ) <> nil ;

    finally

     EnableTaskWindows ( WindowList );

    end ;

    if Result then CompName := ComputerName ;

  finally

    if Succeeded ( SHGetMalloc ( ShellMalloc )) then

     ShellMalloc . Free ( ItemIDList );

  end ;

end ;

// Example

procedure TForm1 . Button1Click ( Sender : TObject );

var

 Computer : string ;

begin

 BrowseComputer ( '...' , Computer , True );

 label1 . Caption := Computer ;

end ;