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;