uses
ActiveX, ObjSel;
////////////////////////////////////////////////////////////////////////////////
//
// Test - 'Select User' dialog
//
function InitObjectPicker(Picker: IDsObjectPicker): HRESULT;
var
ScopeInit:
array [0..0]
of TDSOPScopeInitInfo;
InitInfo: TDSOPInitInfo;
begin
if nil = Picker
then
Result := E_INVALIDARG
else
begin
ZeroMemory(@ScopeInit, SizeOf(ScopeInit));
ScopeInit[0].cbSize := SizeOf(TDSOPScopeInitInfo);
ScopeInit[0].flType := DSOP_SCOPE_TYPE_TARGET_COMPUTER;
ScopeInit[0].flScope := DSOP_SCOPE_TYPE_USER_ENTERED_DOWNLEVEL_SCOPE;
ScopeInit[0].FilterFlags.Uplevel.flBothModes := DSOP_FILTER_USERS;
ScopeInit[0].FilterFlags.flDownlevel := DSOP_DOWNLEVEL_FILTER_USERS;
ZeroMemory(@InitInfo, SizeOf(InitInfo));
InitInfo.cbSize := SizeOf(InitInfo);
InitInfo.cDsScopeInfos := SizeOf(ScopeInit)
div SizeOf(TDSOPScopeInitInfo);
InitInfo.aDsScopeInfos := @ScopeInit;
InitInfo.flOptions := DSOP_FLAG_SKIP_TARGET_COMPUTER_DC_CHECK;
Result := Picker.Initialize(InitInfo);
end;
end;
function ProcessSelectedObjects(DatObj: IDataObject): HRESULT;
var
StgMed: TStgMedium;
FmtEtc: TFormatEtc;
SelLst: PDSSelectionList;
Index: ULONG;
Text:
string;
begin
if nil = DatObj
then
Result := E_INVALIDARG
else
begin
with FmtEtc
do
begin
cfFormat := RegisterClipboardFormat(CFSTR_DSOP_DS_SELECTION_LIST);
ptd :=
nil;
dwAspect := DVASPECT_CONTENT;
lindex := -1;
tymed := TYMED_HGLOBAL;
end;
Result := DatObj.GetData(FmtEtc, StgMed);
if Succeeded(Result)
then
begin
SelLst := PDS_SELECTION_LIST(GlobalLock(StgMed.hGlobal));
if SelLst <>
nil then
try
Text := '
';
for Index := 0
to SelLst.cItems - 1
do
begin
Text := Text + Format(
'
Object : %u'#13#10 +
'
Name : %s'#13#10 +
'
Class: %s'#13#10 +
'
Path : %s'#13#10 +
'
UPN : %s'#13#10, [
Index,
WideCharToString(SelLst.aDsSelection[
Index].pwzName),
WideCharToString(SelLst.aDsSelection[
Index].pwzClass),
WideCharToString(SelLst.aDsSelection[
Index].pwzADsPath),
WideCharToString(SelLst.aDsSelection[
Index].pwzUPN)]);
end;
ShowMessage(Text);
finally
GlobalUnlock(StgMed.hGlobal);
end
else
Result := E_POINTER;
ReleaseStgMedium(StgMed);
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
Picker: IDsObjectPicker;
DatObj: IDataObject;
begin
if Succeeded(CoInitialize(
nil))
then
try
if Succeeded(CoCreateInstance(CLSID_DsObjectPicker,
nil,
CLSCTX_INPROC_SERVER, IID_IDsObjectPicker, Picker))
then
try
if Succeeded(InitObjectPicker(Picker))
then
case Picker.InvokeDialog(Self.Handle, DatObj)
of
S_OK:
try
ProcessSelectedObjects(DatObj);
finally
DatObj :=
nil;
end;
S_FALSE:
ShowMessage('
Dialog wurde vom Benutzer abgebrochen.');
end;
finally
Picker :=
nil;
end;
finally
CoUninitialize;
end;
end;