uses ShlObj, ActiveX
function BrowseComputer(DialogTitle: string; var CompName: string;
bNewStyle: Boolean): Boolean;
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;
Beispiel
procedure TForm1.Button1Click(Sender: TObject);
var
Computer: string;
begin
BrowseComputer('', Computer, True);
Label1.Caption := Computer;
end;
Keine Kommentare:
Kommentar veröffentlichen