德尔福 - 查找主电子邮件地址为Active Directory用户
问题描述：
我在寻找最好的*方法查找主电子邮件地址为当前登录的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});