Delphi - 查找 Active Directory 用户的主要电子邮件地址

标签 delphi active-directory

我正在寻找最佳*方法来查找当前登录的 Active Directory 用户的主电子邮件地址(使用 GetUserName 获取登录的用户名)

我见过How do integrate Delphi with Active Directory?但我无法让它与 Delphi 2010 一起工作。

(*最佳方法:最终的应用程序将由没有计算机管理访问权限的用户运行)

<小时/>

编辑1:

阅读本文后，看来 email 或 mail 字段可能不是最好的方法，因为它似乎没有被填充，因此我' d 需要使用 proxyaddresses

的多值字段

最佳答案

下面的代码对我有用。它是我在生产代码中使用的类的摘录。它没有获得 proxyAddresses，但我添加了它，它似乎可以工作，尽管我只获得一个备用电子邮件地址，看起来像 smtp:g.trol@mydomain.com。我找不到包含多个地址的示例，因此您可能需要测试然后会发生什么。

此外，我在 Delphi 2007 中使用我在某处找到的类型库对此进行了测试，因为我在导入它时遇到了问题。在代码中，您会看到 __MIDL_0010，它是字段值的 __MIDL___MIDL_itf_ads_0000_0017 记录属性。我注意到它在不同版本的类型库中以其他方式命名，因此您可能需要对此代码进行一些调整以适合您的确切类型库导入，也许可以修复一些 ansi/unicode 差异。

uses ActiveX, ComObj, ActiveDs_TLB;

const
  NETAPI32DLL = 'netapi32.dll';
const
  ACTIVEDSDLL = 'activeds.dll';
  ADS_SECURE_AUTHENTICATION = $00000001;
const
  // ADSI success codes
  S_ADS_ERRORSOCCURRED = $00005011;
  S_ADS_NOMORE_ROWS    = $00005012;
  S_ADS_NOMORE_COLUMNS = $00005013;

  // ADSI error codes
  E_ADS_BAD_PATHNAME            = $80005000;
  E_ADS_INVALID_DOMAIN_OBJECT   = $80005001;
  E_ADS_INVALID_USER_OBJECT     = $80005002;
  E_ADS_INVALID_COMPUTER_OBJECT = $80005003;
  E_ADS_UNKNOWN_OBJECT          = $80005004;
  E_ADS_PROPERTY_NOT_SET        = $80005005;
  E_ADS_PROPERTY_NOT_SUPPORTED  = $80005006;
  E_ADS_PROPERTY_INVALID        = $80005007;
  E_ADS_BAD_PARAMETER           = $80005008;
  E_ADS_OBJECT_UNBOUND          = $80005009;
  E_ADS_PROPERTY_NOT_MODIFIED   = $8000500A;
  E_ADS_PROPERTY_MODIFIED       = $8000500B;
  E_ADS_CANT_CONVERT_DATATYPE   = $8000500C;
  E_ADS_PROPERTY_NOT_FOUND      = $8000500D;
  E_ADS_OBJECT_EXISTS           = $8000500E;
  E_ADS_SCHEMA_VIOLATION        = $8000500F;
  E_ADS_COLUMN_NOT_SET          = $80005010;
  E_ADS_INVALID_FILTER          = $80005014;

type
  TNetWkstaGetInfo = function(ServerName: PWideChar; Level: Cardinal;
      out BufPtr: Pointer): Cardinal; stdcall;
  TADsOpenObject   = function (lpszPathName: PWideChar; lpszUserName: PWideChar;
      lpszPassword: PWideChar; dwReserved: DWORD; const riid: TGUID;
      out pObject): HRESULT; stdcall;
  TADsGetObject    = function(PathName: PWideChar; const IID: TGUID; out Void):
      HRESULT; stdcall;

var
  NetLibHandle: THandle;
  NetWkstaGetInfo : TNetWkstaGetInfo;
  AdsLibHandle: THandle;
  _ADsOpenObject : TADsOpenObject;
  _ADsGetObject :TADsGetObject;

// VB-like GetObject function
function GetObject(const Name: String): IDispatch;
var
  Moniker: IMoniker;
  Eaten: integer;
  BindContext: IBindCtx;
  Dispatch: IDispatch;
begin
  OleCheck(CreateBindCtx(0, BindContext));
  OleCheck(MkParseDisplayName(BindContext,
                              PWideChar(WideString(Name)),
                              Eaten,
                              Moniker));
  OleCheck(Moniker.BindToObject(BindContext, nil, IDispatch, Dispatch));

  Result := Dispatch;
end;

// Some network info
type
   PWkstaInfo100 = ^TWkstaInfo100;
   _WKSTA_INFO_100 = record
     wki100_platform_id: DWORD;
     wki100_computername: LPWSTR;
     wki100_langroup: LPWSTR;
     wki100_ver_major: DWORD;
     wki100_ver_minor: DWORD;
   end;
   TWkstaInfo100 = _WKSTA_INFO_100;
   WKSTA_INFO_100 = _WKSTA_INFO_100;

function GetCurrentDomain: String;
var
  pWI: PWkstaInfo100;
begin
  if Win32Platform = VER_PLATFORM_WIN32_NT then
  begin
    if NetWkstaGetInfo(nil, 100, Pointer(pWI)) = 0 then
      Result := String(pWI.wki100_langroup);
  end;
end;

// ADs...Object function wrappers
function ADsGetObject(PathName: PWideChar; const IID: TGUID;
  out Void): HRESULT;
begin
  if Assigned(_ADsGetObject) then
    Result := _ADsGetObject(PathName, IID, Void)
  else
    Result := ERROR_CALL_NOT_IMPLEMENTED;
end;

function ADsOpenObject(lpszPathName, lpszUserName,
  lpszPassword: PWideChar; dwReserved: DWORD; const riid: TGUID;
  out pObject): HRESULT;
begin
  if Assigned(_ADsOpenObject) then
    Result := _ADsOpenObject(lpszPathName, lpszUserName, lpszPassword, dwReserved, riid, pObject)
  else
    Result := ERROR_CALL_NOT_IMPLEMENTED;
end;

// The main function
function GetUserInfo(UserAccountName: string): Boolean;
var
  // Domain info: Max password age
  RootDSE: Variant;
  Domain: Variant;
  MaxPwdNanoAge: Variant;
  MaxPasswordAge: Int64;
  DNSDomain: String;

  // User info: User directorysearch to find the user by username
  DirectorySearch: IDirectorySearch;
  SearchPreferences: array[0..1] of ADS_SEARCHPREF_INFO;
  Columns: array[0..6] of PWideChar;
  SearchResult: Cardinal;
  hr: HRESULT;
  ColumnResult: ads_search_column;
  // Number of user records found
  RecordCount: Integer;

  LastSetDateTime: TDateTime;
  ExpireDateTime: TDateTime;

  i: Integer;
begin
  Result := False;

  // If no account name is set, reading is impossible. Return false.
  if (UserAccountName = '') then
    Exit;

  try
    // Read the maximum password age from the domain.
    // To do: Check if this can be done with ADsGetObject instead of the VB-like GetObject
    // Get the Root DSE.
    RootDSE        := GetObject('LDAP://RootDSE');
    DNSDomain      := RootDSE.Get('DefaultNamingContext');
    Domain         := GetObject('LDAP://' + DNSDomain);

    // Build an array of user properties to receive.
    Columns[0] := StringToOleStr('AdsPath');
    Columns[1] := StringToOleStr('pwdLastSet');
    Columns[2] := StringToOleStr('displayName');
    Columns[3] := StringToOleStr('mail');
    Columns[4] := StringToOleStr('sAMAccountName');
    Columns[5] := StringToOleStr('userPrincipalName');
    Columns[6] := StringToOleStr('proxyAddresses');

    // Bind to the directorysearch object. For some unspecified reason, the regular
    // domain name (yourdomain) needs to be used instead of the AdsPath (office.yourdomain.us)
    AdsGetObject(PWideChar(WideString('LDAP://' + GetCurrentDomain)), IDirectorySearch, DirectorySearch);
    try
      // Set search preferences.
      SearchPreferences[0].dwSearchPref  := ADS_SEARCHPREF_SEARCH_SCOPE;
      SearchPreferences[0].vValue.dwType := ADSTYPE_INTEGER;
      SearchPreferences[0].vValue.__MIDL_0010.Integer := ADS_SCOPE_SUBTREE;
      DirectorySearch.SetSearchPreference(@SearchPreferences[0], 1);

      // Execute search
      // Search for SAM account name (g.trol) and User Principal name
      // (g.trol@yourdomain.com). This allows the user to enter their username
      // in both ways. Add CN=* to filter out irrelevant objects that might
      // match the principal name.
      DirectorySearch.ExecuteSearch(
          PWideChar(WideString(
              Format('(&(CN=*)(|(sAMAccountName=%0:s)(userPrincipalName=%0:s)))',
                  [UserAccountName]))),
          nil,
          $FFFFFFFF,
          SearchResult);

      // Get records
      RecordCount := 0;

      hr := DirectorySearch.GetNextRow(SearchResult);
      if (hr <> S_ADS_NOMORE_ROWS) then
      begin
        // 1 row found
        Inc(RecordCount);

        // Get the column values for this row.
        // To do: This code could use a more general and neater approach!
        for i := Low(Columns) to High(Columns) do
        begin
          hr := DirectorySearch.GetColumn(SearchResult, Columns[i], ColumnResult);

          if Succeeded(hr) then
          begin
            // Get the values for the columns.
            {if SameText(ColumnResult.pszAttrName, 'AdsPath') then
              Result.UserAdsPath :=
                ColumnResult.pADsValues.__MIDL_0010.CaseIgnoreString
            else if SameText(ColumnResult.pszAttrName, 'pwdLastSet') then
            begin
              LastSetDateTime := LDapTimeStampToDateTime(
                      ColumnResult.pAdsvalues^.__MIDL_0010.LargeInteger) +
                  GetTimeZoneCorrection;
              ExpireDateTime := IncMilliSecond(LastSetDateTime,
                  LDapIntervalToMSecs(MaxPasswordAge));
              Result.UserPasswordExpireDateTime := ExpireDateTime;
            end
            else if SameText(ColumnResult.pszAttrName, 'displayName') then
              Result.UserFullName := ColumnResult.pADsValues.__MIDL_0010.CaseIgnoreString
            else if SameText(ColumnResult.pszAttrName, 'mail') then
              Result.UserEmail := ColumnResult.pADsValues.__MIDL_0010.CaseIgnoreString
            else if SameText(ColumnResult.pszAttrName, 'sAMAccountName') then
              Result.UserShortAccountName := ColumnResult.pADsValues.__MIDL_0010.CaseIgnoreString
            else if SameText(ColumnResult.pszAttrName, 'userPrincipalName') then
              Result.UserFullAccountName := ColumnResult.pADsValues.__MIDL_0010.CaseIgnoreString
            else ..}
            if SameText(ColumnResult.pszAttrName, 'proxyAddresses') then
              ShowMessage(ColumnResult.pADsValues.__MIDL_0010.CaseIgnoreString);

            // Free the column result
            DirectorySearch.FreeColumn(ColumnResult);
          end;
        end;

        // Small check if this account indeed is the only one found.
        // No need to check the exact number. <> 1 = error
        Hr := DirectorySearch.GetNextRow(SearchResult);
        if (hr <> S_ADS_NOMORE_ROWS) then
          Inc(RecordCount);
      end;

      // Close the search
      DirectorySearch.CloseSearchHandle(SearchResult);

      // Exactly 1 record found?
      if RecordCount = 1 then
        Result := True
      else
        ShowMessageFmt('More than one account found when searching for %s in ' +
                       'Active Directory.', [UserAccountName]);

    finally
      DirectorySearch := nil;
    end;

  except
    Result := False;
  end;
end;

initialization
  NetLibHandle := LoadLibrary(NETAPI32DLL);
  if NetLibHandle <> 0 then
    @NetWkstaGetInfo := GetProcAddress(NetLibHandle, 'NetWkstaGetInfo');

  ADsLibHandle := LoadLibrary(ACTIVEDSDLL);
  if ADsLibHandle <> 0 then
  begin
    @_ADsOpenObject := GetProcAddress(ADsLibHandle, 'ADsOpenObject');
    @_ADsGetObject  := GetProcAddress(ADsLibHandle, 'ADsGetObject');
  end;
finalization
  FreeLibrary(ADsLibHandle);
  FreeLibrary(NetLibHandle);
end.

这样调用:

GetUserInfo('g.trol' {or g.trol@yourdomain.com});

从My dropbox下载

关于Delphi - 查找 Active Directory 用户的主要电子邮件地址，我们在Stack Overflow上找到一个类似的问题： https://stackoverflow.com/questions/4184306/

上一篇：delphi - 如何在 Indy 中使用视觉控制？ (德尔福)

下一篇：wpf - Delphi 中的 Dxscene 和 VGscene

相关文章：

python - Django Auth LDAP - 使用 sAMAccountName 直接绑定(bind)

delphi - DCC32编译器配置文件和命令行参数优先级

delphi - 使用 StretchDIBits 使用 Delphi 6 处理条形码图像 - 输出中缺少条形线

active-directory - Active Directory 用户类的电子邮件地址属性与代理地址属性之间的差异

active-directory - 我可以通过 SCIM(或任何协议(protocol))从 Active Directory 同步用户/组吗

powershell - 如何修复我的 Powershell 代码以在数组中搜索 AD 组？

jenkins - 为什么 Jenkins Active Directory 查找偶尔会失败？

multithreading - 如何在Delphi中进行异步编程？

delphi - 找不到资源文件 'rights'

rest - 如何在 FireMonkey 中使用 REST API？

©2024 IT工具网  联系我们