unit Unit1;

 

interface

 

uses

  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls, ActiveX;

 

const

  CLSID_DsObjectPicker: TGUID = (

    D1:d6ccd8; D2:b7b; D3:d2; D4:($b9,$e0,{text},$c0,f,$d8,$db,$f7));

 

  IID_IDsObjectPicker: TGUID = (

    D1:{text}c87e64e; D2:b7a; D3:d2; D4:($b9,$e0,{text},$c0,f,$d8,$db,$f7));

 

  ANYSIZE_ARRAY = 1;

 

  CFSTR_DSOP_DS_SELECTION_LIST = 'CFSTR_DSOP_DS_SELECTION_LIST';

 

const

  DSOP_SCOPE_TYPE_TARGET_COMPUTER              = {text}000001;

  DSOP_SCOPE_TYPE_USER_ENTERED_DOWNLEVEL_SCOPE = {text}000200;

 

  DSOP_FILTER_USERS                            = {text}000002;

 

  DSOP_DOWNLEVEL_FILTER_USERS                  = DWORD(000001);

 

  DSOP_FLAG_SKIP_TARGET_COMPUTER_DC_CHECK      = {text}000002;

 

type

  LPLPWSTR = ^PWideChar;

 

  TDsOpUpLevelFilterFlags = record

    flBothModes: ULONG;

    flMixedModeOnly: ULONG;

    flNativeModeOnly: ULONG;

  end;

 

  TDsOpFilterFlags = record

    Uplevel: TDsOpUpLevelFilterFlags;

    flDownlevel: ULONG;

  end;

 

  PDsOpScopeInitInfo = ^TDsOpScopeInitInfo;

  TDsOpScopeInitInfo = record

    cbSize: ULONG;

    flType: ULONG;

    flScope: ULONG;

    FilterFlags: TDsOpFilterFlags;

    pwzDcName: PWideChar;

    pwzADsPath: PWideChar;

    hr: HRESULT;

  end;

 

  TDsOpInitInfo = record

    cbSize: ULONG;

    pwzTargetComputer: PWideChar;

    cDsScopeInfos: ULONG;

    aDsScopeInfos: PDsOpScopeInitInfo;

    flOptions: ULONG;

    cAttributesToFetch: ULONG;

    apwzAttributeNames: LPLPWSTR;

  end;

 

  TDsSelection = record

    pwzName: PWideChar;

    pwzADsPath: PWideChar;

    pwzClass: PWideChar;

    pwzUPN: PWideChar;

    pvarFetchedAttributes: POleVariant;

    flScopeType: ULONG;

  end;

 

  PDSSelectionList = ^TDsSelectionList;

  TDsSelectionList = record

    cItems: ULONG;

    cFetchedAttributes: ULONG;

    aDsSelection: array [0..ANYSIZE_ARRAY - 1] of TDsSelection;

  end;

 

  IDsObjectPicker = interface (IUnknown)

  ['{0c87e64e-3b7a-11d2-b9e0-00c04fd8dbf7}']

    function Initialize(const pInitInfo: TDsOpInitInfo): HRESULT; stdcall;

    function InvokeDialog(hwndParent: HWND; out ppdoSelections: IDataObject): HRESULT; stdcall;

  end;

 

  TForm1 = class(TForm)

    Button1: TButton;

    procedure Button1Click(Sender: TObject);

  end;

 

var

  Form1: TForm1;

 

implementation

 

{$R *.dfm}

 

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); // заполняем структуру 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));// заполняем структуру TDSOPInitInfo

    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 := PDsSelectionList(GlobalLock(StgMed.hGlobal));

// и если не nil обрабатываем его

      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

//инициализируем COM+

  if Succeeded(CoInitialize(nil)) then

  try

// создаем Picker как объект COM+

    if Succeeded(CoCreateInstance(CLSID_DsObjectPicker, nil,

      CLSCTX_INPROC_SERVER, IID_IDsObjectPicker, Picker)) then

    try

//если инициализация Picker успешна вызываем сам диалог

      if Succeeded(InitObjectPicker(Picker)) then

        case Picker.InvokeDialog(Self.Handle, DatObj) of

          S_OK:

            try

//вызов диалога

              ProcessSelectedObjects(DatObj);

            finally

//освобождаем DatObj

              DatObj := nil;

            end;

          S_FALSE:

            ShowMessage('Ничего не выбрано');

        end;

    finally

      Picker := nil;

    end;

  finally

    CoUninitialize;

  end;  

end;

 

end.