Delphi-查找活动目录用户的主电子邮件地址

下面的代码对我有效。它是我在生产代码中使用的一个类的摘录。它没有获得代理地址,但我添加了它,它似乎可以工作,尽管我只得到一个备选电子邮件地址,看起来像smtp: g、 trol@mydomain.com网站 . 我找不到一个地址更多的例子,所以您可能需要测试接下来会发生什么。

另外,我在Delphi2007中测试了这个,使用的是我在某个地方找到的类型库,因为我在导入它时遇到了问题。在你看到的代码中 __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