草庐IT

windows - 德尔福 : Call user selection interface

coder 2024-06-08 原文

我可以使用 Windows API 调用此屏幕吗?

我想使用此界面来选择具有域的正确用户。

谢谢!

最佳答案

此对话框称为对象选取器对话框。您可以使用 IDsObjectPicker 从 Delphi 调用接口(interface)和 InvokeDialog方法。

这是一个示例,说明如何使用 Delphi 中的此对话框。

implementation
{$R *.dfm}

uses
   ActiveX;

const
  CLSID_DsObjectPicker: TGUID = '{17D6CCD8-3B7B-11D2-B9E0-00C04FD8DBF7}';
  IID_IDsObjectPicker : TGUID = '{0c87e64e-3b7a-11d2-b9e0-00c04fd8dbf7}';

  CFSTR_DSOP_DS_SELECTION_LIST = 'CFSTR_DSOP_DS_SELECTION_LIST';

  DSOP_SCOPE_TYPE_TARGET_COMPUTER              = $00000001;
  DSOP_SCOPE_TYPE_UPLEVEL_JOINED_DOMAIN        = $00000002;
  DSOP_SCOPE_TYPE_DOWNLEVEL_JOINED_DOMAIN      = $00000004;
  DSOP_SCOPE_TYPE_ENTERPRISE_DOMAIN            = $00000008;
  DSOP_SCOPE_TYPE_GLOBAL_CATALOG               = $00000010;
  DSOP_SCOPE_TYPE_EXTERNAL_UPLEVEL_DOMAIN      = $00000020;
  DSOP_SCOPE_TYPE_EXTERNAL_DOWNLEVEL_DOMAIN    = $00000040;
  DSOP_SCOPE_TYPE_WORKGROUP                    = $00000080;
  DSOP_SCOPE_TYPE_USER_ENTERED_UPLEVEL_SCOPE   = $00000100;
  DSOP_SCOPE_TYPE_USER_ENTERED_DOWNLEVEL_SCOPE = $00000200;

  DSOP_FILTER_INCLUDE_ADVANCED_VIEW  = $00000001;
  DSOP_FILTER_USERS                  = $00000002;
  DSOP_FILTER_BUILTIN_GROUPS         = $00000004;
  DSOP_FILTER_WELL_KNOWN_PRINCIPALS  = $00000008;
  DSOP_FILTER_UNIVERSAL_GROUPS_DL    = $00000010;
  DSOP_FILTER_UNIVERSAL_GROUPS_SE    = $00000020;
  DSOP_FILTER_GLOBAL_GROUPS_DL       = $00000040;
  DSOP_FILTER_GLOBAL_GROUPS_SE       = $00000080;
  DSOP_FILTER_DOMAIN_LOCAL_GROUPS_DL = $00000100;
  DSOP_FILTER_DOMAIN_LOCAL_GROUPS_SE = $00000200;
  DSOP_FILTER_CONTACTS               = $00000400;
  DSOP_FILTER_COMPUTERS              = $00000800;


  DSOP_SCOPE_FLAG_STARTING_SCOPE              = $00000001;
  DSOP_SCOPE_FLAG_WANT_PROVIDER_WINNT         = $00000002;
  DSOP_SCOPE_FLAG_WANT_PROVIDER_LDAP          = $00000004;
  DSOP_SCOPE_FLAG_WANT_PROVIDER_GC            = $00000008;
  DSOP_SCOPE_FLAG_WANT_SID_PATH               = $00000010;
  DSOP_SCOPE_FLAG_WANT_DOWNLEVEL_BUILTIN_PATH = $00000020;
  DSOP_SCOPE_FLAG_DEFAULT_FILTER_USERS        = $00000040;
  DSOP_SCOPE_FLAG_DEFAULT_FILTER_GROUPS       = $00000080;
  DSOP_SCOPE_FLAG_DEFAULT_FILTER_COMPUTERS    = $00000100;
  DSOP_SCOPE_FLAG_DEFAULT_FILTER_CONTACTS     = $00000200;

  DSOP_DOWNLEVEL_FILTER_USERS                  = $80000001;
  DSOP_DOWNLEVEL_FILTER_LOCAL_GROUPS           = $80000002;
  DSOP_DOWNLEVEL_FILTER_GLOBAL_GROUPS          = $80000004;
  DSOP_DOWNLEVEL_FILTER_COMPUTERS              = $80000008;
  DSOP_DOWNLEVEL_FILTER_WORLD                  = $80000010;
  DSOP_DOWNLEVEL_FILTER_AUTHENTICATED_USER     = $80000020;
  DSOP_DOWNLEVEL_FILTER_ANONYMOUS              = $80000040;
  DSOP_DOWNLEVEL_FILTER_BATCH                  = $80000080;
  DSOP_DOWNLEVEL_FILTER_CREATOR_OWNER          = $80000100;
  DSOP_DOWNLEVEL_FILTER_CREATOR_GROUP          = $80000200;
  DSOP_DOWNLEVEL_FILTER_DIALUP                 = $80000400;
  DSOP_DOWNLEVEL_FILTER_INTERACTIVE            = $80000800;
  DSOP_DOWNLEVEL_FILTER_NETWORK                = $80001000;
  DSOP_DOWNLEVEL_FILTER_SERVICE                = $80002000;
  DSOP_DOWNLEVEL_FILTER_SYSTEM                 = $80004000;
  DSOP_DOWNLEVEL_FILTER_EXCLUDE_BUILTIN_GROUPS = $80008000;
  DSOP_DOWNLEVEL_FILTER_TERMINAL_SERVER        = $80010000;
  DSOP_DOWNLEVEL_FILTER_ALL_WELLKNOWN_SIDS     = $80020000;
  DSOP_DOWNLEVEL_FILTER_LOCAL_SERVICE          = $80040000;
  DSOP_DOWNLEVEL_FILTER_NETWORK_SERVICE        = $80080000;
  DSOP_DOWNLEVEL_FILTER_REMOTE_LOGON           = $80100000;

  DSOP_FLAG_MULTISELECT                   = $00000001;
  DSOP_FLAG_SKIP_TARGET_COMPUTER_DC_CHECK = $00000002;


type
  PDSOPUplevelFilterFlags = ^TDSOPUplevelFilterFlags;
  _DSOP_UPLEVEL_FILTER_FLAGS = record
    flBothModes     : ULONG;
    flMixedModeOnly : ULONG;
    flNativeModeOnly: ULONG;
  end;
  TDSOPUplevelFilterFlags = _DSOP_UPLEVEL_FILTER_FLAGS;
  DSOP_UPLEVEL_FILTER_FLAGS = _DSOP_UPLEVEL_FILTER_FLAGS;


  PDSOPFilterFlags = ^TDSOPFilterFlags;
  _DSOP_FILTER_FLAGS = record
    Uplevel    : TDSOPUplevelFilterFlags;
    flDownlevel: ULONG;
  end;
  TDSOPFilterFlags = _DSOP_FILTER_FLAGS;
  DSOP_FILTER_FLAGS = _DSOP_FILTER_FLAGS;


  PDSOPScopeInitInfo = ^TDSOPScopeInitInfo;
  PDSOP_SCOPE_INIT_INFO = PDSOPScopeInitInfo;
  _DSOP_SCOPE_INIT_INFO = record
    cbSize     : ULONG;
    flType     : ULONG;
    flScope    : ULONG;
    FilterFlags: TDSOPFilterFlags;
    pwzDcName  : LPCWSTR;
    pwzADsPath : LPCWSTR;
    hr         : HRESULT;
  end;
  TDSOPScopeInitInfo = _DSOP_SCOPE_INIT_INFO;
  DSOP_SCOPE_INIT_INFO = _DSOP_SCOPE_INIT_INFO;


  PDSOPInitInfo = ^TDSOPInitInfo;
  PDSOP_INIT_INFO = PDSOPInitInfo;
  _DSOP_INIT_INFO = record
    cbSize            : ULONG;
    pwzTargetComputer : LPCWSTR;
    cDsScopeInfos     : ULONG;
    aDsScopeInfos     : PDSOPScopeInitInfo;
    flOptions         : ULONG;
    cAttributesToFetch: ULONG;
    apwzAttributeNames: Pointer;
  end;
  TDSOPInitInfo = _DSOP_INIT_INFO;
  DSOP_INIT_INFO = _DSOP_INIT_INFO;

  PDSSelection = ^TDSSelection;
  PDS_SELECTION = PDSSelection;
  _DS_SELECTION = record
    pwzName              : LPCWSTR;
    pwzADsPath           : LPCWSTR;
    pwzClass             : LPCWSTR;
    pwzUPN               : LPCWSTR;
    pvarFetchedAttributes: PVariant;
    flScopeType          : ULONG;
  end;
  TDSSelection = _DS_SELECTION;
  DS_SELECTION = _DS_SELECTION;

type
  PDSSelectionList = ^TDSSelectionList;
  PDS_SELECTION_LIST = PDSSelectionList;
  _DS_SELECTION_LIST = record
    cItems            : ULONG;
    cFetchedAttributes: ULONG;
    aDsSelection      : array [0..0] of TDSSelection;
  end;
  TDSSelectionList = _DS_SELECTION_LIST;
  DS_SELECTION_LIST = _DS_SELECTION_LIST;


  IDsObjectPicker = interface(IUnknown)
    ['{17D6CCD8-3B7B-11D2-B9E0-00C04FD8DBF7}']
    function Initialize(var pInitInfo: TDSOPInitInfo): HRESULT; stdcall;
    function InvokeDialog(hwndParent: HWND; out ppdoSelections: IDataObject): HRESULT; stdcall;
  end;

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,
            SelLst.aDsSelection[Index].pwzName,
            SelLst.aDsSelection[Index].pwzClass,
            SelLst.aDsSelection[Index].pwzADsPath,
            SelLst.aDsSelection[Index].pwzUPN]);
        end;
        ShowMessage(Text);
      finally
        GlobalUnlock(StgMed.hGlobal);
      end
      else
        Result := E_POINTER;

      ReleaseStgMedium(StgMed);
    end;
  end;
end;

//invoke the dialog
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 canceled by the user.');
        end;
    finally
      Picker := nil;
    end;
  finally
    CoUninitialize;
  end;
end;


end.

关于windows - 德尔福 : Call user selection interface,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/33740077/

有关windows - 德尔福 : Call user selection interface的更多相关文章

  1. ruby - 在 Ruby 程序执行时阻止 Windows 7 PC 进入休眠状态 - 2

    我需要在客户计算机上运行Ruby应用程序。通常需要几天才能完成(复制大备份文件)。问题是如果启用sleep,它会中断应用程序。否则,计算机将持续运行数周,直到我下次访问为止。有什么方法可以防止执行期间休眠并让Windows在执行后休眠吗?欢迎任何疯狂的想法;-) 最佳答案 Here建议使用SetThreadExecutionStateWinAPI函数,使应用程序能够通知系统它正在使用中,从而防止系统在应用程序运行时进入休眠状态或关闭显示。像这样的东西:require'Win32API'ES_AWAYMODE_REQUIRED=0x0

  2. ruby - 在 Windows 机器上使用 Ruby 进行开发是否会适得其反? - 2

    这似乎非常适得其反,因为太多的gem会在window上破裂。我一直在处理很多mysql和ruby​​-mysqlgem问题(gem本身发生段错误,一个名为UnixSocket的类显然在Windows机器上不能正常工作,等等)。我只是在浪费时间吗?我应该转向不同的脚本语言吗? 最佳答案 我在Windows上使用Ruby的经验很少,但是当我开始使用Ruby时,我是在Windows上,我的总体印象是它不是Windows原生系统。因此,在主要使用Windows多年之后,开始使用Ruby促使我切换回原来的系统Unix,这次是Linux。Rub

  3. Vscode+Cmake配置并运行opencv环境(Windows和Ubuntu大同小异) - 2

    之前在培训新生的时候,windows环境下配置opencv环境一直教的都是网上主流的vsstudio配置属性表,但是这个似乎对新生来说难度略高(虽然个人觉得完全是他们自己的问题),加之暑假之后对cmake实在是爱不释手,且这样配置确实十分简单(其实都不需要配置),故斗胆妄言vscode下配置CV之法。其实极为简单,图比较多所以很长。如果你看此文还配不好,你应该思考一下是不是自己的问题。闲话少说,直接开始。0.CMkae简介有的人到大二了都不知道cmake是什么,我不说是谁。CMake是一个开源免费并且跨平台的构建工具,可以用简单的语句来描述所有平台的编译过程。它能够根据当前所在平台输出对应的m

  4. 深度学习部署:Windows安装pycocotools报错解决方法 - 2

    深度学习部署:Windows安装pycocotools报错解决方法1.pycocotools库的简介2.pycocotools安装的坑3.解决办法更多Ai资讯:公主号AiCharm本系列是作者在跑一些深度学习实例时,遇到的各种各样的问题及解决办法,希望能够帮助到大家。ERROR:Commanderroredoutwithexitstatus1:'D:\Anaconda3\python.exe'-u-c'importsys,setuptools,tokenize;sys.argv[0]='"'"'C:\\Users\\46653\\AppData\\Local\\Temp\\pip-instal

  5. ruby - 如何在 Ruby 中执行 Windows CLI 命令? - 2

    我在目录“C:\DocumentsandSettings\test.exe”中有一个文件,但是当我用单引号编写命令时`C:\DocumentsandSettings\test.exe(我无法在此框中显示),用于在Ruby中执行命令,我无法这样做,我收到的错误是找不到文件或目录。我尝试用“//”和“\”替换“\”,但似乎没有任何效果。我也使用过系统、IO.popen和exec命令,但所有的努力都是徒劳的。exec命令还使程序退出,这是我不想发生的。提前致谢。 最佳答案 反引号环境就像双引号,所以反斜杠用于转义。此外,Ruby会将空格解

  6. ruby - 错误 : Failed to build gem native extension on Windows - 2

    我在安装“redcarpet”gem时遇到以下错误。它在我friend的机器上安装没有问题。(我想安装它来运行yard)ruby版本:1.9.3命令输出:D:\Learning\Common_POM_FW\SampleProjects>yard[error]:Missing'redcarpet'gemforMarkdownformatting.Installitwith`geminstallredcarpet`D:\Learning\Common_POM_FW\SampleProjects>geminstallredcarpetTemporarilyenhancingPATHtoinc

  7. ruby - 从 Ruby 连接到适用于 Windows Phone 8 的 Microsoft 推送通知服务 - 2

    我们正在开发一个需要推送通知的WP8应用程序。为了测试它,我们使用CURL命令行运行推送通知POST请求,确保它实际连接,使用客户端SSL证书进行身份验证并发送正确的数据。我们确实知道,当我们收到对设备的推送时,这项工作是有效的。这是我们一直用于测试目的的CURL命令:curl--certclient_cert.pem-v-H"Content-Type:text/xml"-H"X-WindowsPhone-Target:Toast"-H"X-NotificationClass:2"-XPOST-d"MytitleMysubtitle"https://db3.notify.live.ne

  8. ruby - 在 Windows 7 上运行 Jekyll - 2

    我在Windows7上运行Jekyll时遇到问题。当我运行时jekyll出现以下错误C:\temp\jekyll\kouphax.github.com>jekyllConfigurationfromC:/temp/jekyll/kouphax.github.com/_config.ymlBuildingsite:C:/temp/jekyll/kouphax.github.com->C:/temp/jekyll/kouphax.github.com/_siteunit-testingYouaremissingalibraryrequiredforTextile.Pleaserun:$[s

  9. ruby - 尝试在 Windows 8 (x64) : Error installing fast-stemmer-1. 0.2.gem 上安装 Jekyll - 2

    我正在尝试使用本手册让Jekyll在Windows8x64上运行:RunningJekyllonWindows我正在使用来自rubyinstaller.org的以下两个下载:ruby2.0.0-p0(x64)DevKit-mingw64-64-4.7.2-20130224-1432-sfx.exe所以我根据手册设置了Ruby和DevKit(希望它是更新的版本)。我尝试运行一点HelloWorld.rb脚本,它工作正常,路径变量已设置。然后我尝试运行geminstalljekyll并得到以下输出:geminstalljekyll-outputonpastebin.com问题似乎出在名为f

  10. ruby - 通过 ruby​​2.0.0 在 Windows 上安装 iconv 时出错 - 2

    在Windows上通过ruby​​2.0.0安装iconv时出错通过ruby​​2.0.0在Windows上安装iconv时出错我正在尝试安装iconv,但是当我运行以下命令时:geminstalliconv我的结果:TemporarilyenhancingPathtoincludeDevKit...Buildingnativeextensions.Thiscouldtakeawhile...Error:Errorinstallingiconv:ERROR:Failedtobuildgemnativeextension.C:/Ruby/Ruby200/bin/ruby.exe-r./s

随机推荐