我在寻找最好的*方法查找主电子邮件地址为当前登录的Active Directory用户（使用 GetUserName 获取登录的用户名）

I'm looking for the best* method to find the primary email address for the currently logged in Active Directory user (using GetUserName to get the logged in username)

我看到如何整合德尔福与Active Directory？，但我不能得到这个与德尔福2010年工作。

I have seen How do integrate Delphi with Active Directory? but I couldn't get this to work with Delphi 2010.

（*最好的方法：最终的应用程序将通过谁没有到机器的管理权限的用户可以运行）

(*best method: the eventual application will be run by users who do not have administrative access to the machine)

编辑1：

读了这一点，看来电子邮件或邮件字段可能不是最好的方法因为它似乎它可能不会填充，所以我需要使用的多值字段代理地址

Reading up on this, it appears that the email or mail field is probably not the best way to go as it seems it might not be populated, therefore I'd need to use the multivalue field of proxyaddresses

推荐答案

下面的作品对我来说，code。这是一类在生产中code使用的提取物。它没有得到代理地址，但我补充说，它似乎工作，虽然我只得到一个备选电子邮件地址，看起来像SMTP： g.trol@mydomain.com 的。我无法找到一个例子有一个以上的地址，所以你可能需要测试会发生什么呢。

The code below works for me. It is an extract of a class I use in production code. It didn't get the proxyAddresses but I added that and it seems to work, although I get only one alternative e-mail address, looking like smtp: g.trol@mydomain.com. I can't find an example with more that one address, so you may need to test what happens then.

另外，我在德尔福2007年测试了这一点，使用类型库，我发现的地方，因为我有麻烦导入它。在code你看 __ MIDL_0010 ，这是字段值的 __ MIDL ___ MIDL_itf_ads_0000_0017 记录属性。我注意到这个被命名否则不同版本的类型库中，所以你可能需要做一些调整，以这种code，以满足您的特定类型库的进口，一个可能解决一些ANSI / UNI code差异。

Also, I tested this in Delphi 2007, using a type library I found somewhere, because I had trouble importing it. In the code you see __MIDL_0010, which is a __MIDL___MIDL_itf_ads_0000_0017 record property of the field value. I noticed this was named otherwise in a different version of the type library, so you may need to make some tweaks to this code to suit your exact type library import, an maybe fix some ansi/unicode differences.

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.

呼叫是这样的：

Call like this:

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

下载从 http://www.easy-share.com/1913053002/ActiveDs_TLB。 PAS