代码之家  ›  专栏  ›  技术社区  ›  Mark Robinson

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

  •  3
  • Mark Robinson  · 技术社区  · 14 年前

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

    我见过 How do integrate Delphi with Active Directory? 但我不能让这个与Delphi2010一起工作。

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


    编辑1:

    读到这个,似乎 email mail 字段可能不是最好的方法,因为它看起来可能没有填充,因此我需要使用 proxyaddresses

    1 回复  |  直到 8 年前
        1
  •  3
  •   GolezTrol    8 年前

    下面的代码对我有效。它是我在生产代码中使用的一个类的摘录。它没有获得代理地址,但我添加了它,它似乎可以工作,尽管我只得到一个备选电子邮件地址,看起来像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