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

Question

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

delphiactive-directory

3

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

我已经看过如何将Delphi与Active Directory集成？，但我无法在Delphi 2010中使其工作。

（*最佳方法：最终应用程序将由没有机器管理权限的用户运行）

编辑1：

阅读此内容后，似乎email或mail字段可能不是最好的选择，因为它似乎可能未填充，因此我需要使用proxyaddresses的多值字段。

- Mark Robinson

你尝试过使用 adshlp 吗？http://www.agnisoft.com/white_papers/active_directory.asp - Jens Mühlenhoff

是的，谢谢Jens。我尝试了它，但在检索数据时遇到了问题。 - Mark Robinson

1个回答

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- GolezTrol · Accepted Answer

以下代码适用于我。这是我在生产代码中使用的类的部分提取。它没有获得代理地址，但我添加了它，似乎可以工作，尽管我只得到一个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});

请从我的Dropbox中下载