Delphi - 查找Active Directory用户的主电子邮件地址 [英] Delphi - Find primary email address for an Active Directory user
本文介绍了Delphi - 查找Active Directory用户的主电子邮件地址的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！
问题描述
我正在寻找最好的方法来查找当前登录的Active Directory用户的主电子邮件地址（使用 GetUserName 获取登录的用户名）
我看过如何将Delphi与Active Directory集成但是我（*最佳方法：最终应用程序将由没有对该机器的管理访问权限的用户运行）
/ p>
编辑1：
电子邮件或邮件字段可能不是最好的方法，因为它似乎没有被填充，因此我需要使用 proxyaddresses的多值字段
解决方案
以下代码为我工作。它是我在生产代码中使用的类的一个提取。它没有得到proxyAddresses，但我补充说，它似乎工作，虽然我只得到一个替代的电子邮件地址，看起来像smtp： g.trol@mydomain.com 。我找不到一个更多的地址的例子，所以你可能需要测试发生了什么。
此外，我在Delphi 2007中使用我在某处找到的类型库进行了测试，因为我无法导入它。在代码中，您看到 __ MIDL_0010 ，它是字段值的 __ MIDL ___ MIDL_itf_ads_0000_0017 记录属性。我注意到这是在不同版本的类型库中命名的，所以您可能需要对此代码进行一些调整，以适应您的确切类型库导入，或许修复了一些ansi / unicode差异。
使用ActiveX，ComObj，ActiveDs_TLB;
const
NETAPI32DLL ='netapi32.dll';
const
ACTIVEDSDLL ='activeds.dll';
ADS_SECURE_AUTHENTICATION = $ 00000001;
const
// ADSI成功代码
S_ADS_ERRORSOCCURRED = $ 00005011;
S_ADS_NOMORE_ROWS = $ 00005012;
S_ADS_NOMORE_COLUMNS = $ 00005013;
// ADSI错误代码
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;标准
TADsOpenObject = function（lpszPathName：PWideChar; lpszUserName：PWideChar;
lpszPassword：PWideChar; dwReserved：DWORD; const riid：TGUID;
out pObject）：HRESULT;标准
TADsGetObject = function（PathName：PWideChar; const IID：TGUID; out Void）：
HRESULT;标准
var
NetLibHandle：THandle;
NetWkstaGetInfo：TNetWkstaGetInfo;
AdsLibHandle：THandle;
_ADsOpenObject：TADsOpenObject;
_ADsGetObject：TADsGetObject;
// VB类似GetObject函数
函数GetObject（const Name：String）：IDispatch;
var
Moniker：IMoniker;
Eaten：integer;
BindContext：IBindCtx;
发货：IDispatch;
begin
OleCheck（CreateBindCtx（0，BindContext））;
OleCheck（MkParseDisplayName（BindContext，
PWideChar（WideString（Name）），
Eaten，
Moniker））;
OleCheck（Moniker.BindToObject（BindContext，nil，IDispatch，Dispatch））;
结果：=调度;
结束
//某些网络信息
类型
PWkstaInfo100 = ^ TWkstaInfo100;
_WKSTA_INFO_100 = record
wki100_platform_id：DWORD;
wki100_computername：LPWSTR;
wki100_langroup：LPWSTR;
wki100_ver_major：DWORD;
wki100_ver_minor：DWORD;
结束
TWkstaInfo100 = _WKSTA_INFO_100;
WKSTA_INFO_100 = _WKSTA_INFO_100;
函数GetCurrentDomain：String;
var
pWI：PWkstaInfo100;
begin
如果Win32Platform = VER_PLATFORM_WIN32_NT然后
begin
如果NetWkstaGetInfo（nil，100，指针（pWI））= 0，那么
结果：= String（pWI.wki100_langroup ）;
结束
结束
// ADs ...对象函数包装
函数ADsGetObject（PathName：PWideChar; const IID：TGUID;
out Void）：HRESULT;
begin
如果Assigned（_ADsGetObject）then
结果：= _ADsGetObject（PathName，IID，Void）
else
结果：= ERROR_CALL_NOT_IMPLEMENTED;
结束
函数ADsOpenObject（lpszPathName，lpszUserName，
lpszPassword：PWideChar; dwReserved：DWORD; const riid：TGUID;
out pObject）：HRESULT;
begin
如果分配（_ADsOpenObject）然后
结果：= _ADsOpenObject（lpszPathName，lpszUserName，lpszPassword，dwReserved，riid，pObject）
else
结果：= ERROR_CALL_NOT_IMPLEMENTED;
结束
//主函数
函数GetUserInfo（UserAccountName：string）：Boolean;
var
//域信息：最大密码年龄
RootDSE：Variant;
域：变体;
MaxPwdNanoAge：Variant;
MaxPasswordAge：Int64;
DNSDomain：String;
//用户信息：用户目录搜索通过用户名找到用户
DirectorySearch：IDirectorySearch;
SearchPreferences：ADS_SEARCHPREF_INFO的数组[0..1];
列：数组[0..6]的PWideChar;
SearchResult：红衣主教;
hr：HRESULT;
ColumnResult：ads_search_column;
//找到的用户记录数
RecordCount：Integer;
LastSetDateTime：TDateTime;
ExpireDateTime：TDateTime;
i：整数;
begin
结果：= False;
//如果没有设置帐户名称，读取是不可能的。返回假。
if（UserAccountName =''）then
Exit;
try
//从域中读取最大密码年龄。
//要执行此操作：检查是否可以使用ADsGetObject而不是VB类GetObject
//获取根DSE。
RootDSE：= GetObject（'LDAP：// RootDSE'）;
DNSDomain：= RootDSE.Get（'DefaultNamingContext'）;
域：= GetObject（'LDAP：//'+ DNSDomain）;
//构建要接收的用户属性数组。
列[0]：= StringToOleStr（'AdsPath'）;
列[1]：= StringToOleStr（'pwdLastSet'）;
列[2]：= StringToOleStr（'displayName'）;
列[3]：= StringToOleStr（'mail'）;
列[4]：= StringToOleStr（'sAMAccountName'）;
列[5]：= StringToOleStr（'userPrincipalName'）;
列[6]：= StringToOleStr（'proxyAddresses'）;
//绑定到directorysearch对象。由于某些未明确的原因，需要使用常规的
//域名（yourdomain）而不是AdsPath（office.yourdomain.us）
AdsGetObject（PWideChar（WideString（'LDAP：//'+ GetCurrentDomain）），IDirectorySearch，DirectorySearch）;
try
//设置搜索首选项。
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）;
//执行搜索
//搜索SAM帐户名称（g.trol）和用户主体名称
//（g.trol@yourdomain.com）。这允许用户以两种方式输入用户名
//。添加CN = *以过滤不相关的对象，可能
//匹配主体名称。
DirectorySearch.ExecuteSearch（
PWideChar（WideString（
Format（'（&（CN = *）（|（sAMAccountName =％0：s）（userPrincipalName =％0：s）） ）'，
[UserAccountName]））），
nil，
$ FFFFFFFF，
SearchResult）;
//获取记录
RecordCount：= 0;
hr：= DirectorySearch.GetNextRow（SearchResult）;
if（hr？S_ADS_NOMORE_ROWS）then
begin
// 1 row found
Inc（RecordCount）;
//获取此行的列值。
//要执行此操作：此代码可以使用更通用和更整洁的方法！
for i：= Low（Columns）to High（Columns）do
begin
hr：= DirectorySearch.GetColumn（SearchResult，Columns [i]，ColumnResult）;
如果成功（hr）然后
begin
//获取列的值。
{如果SameText（ColumnResult.pszAttrName，'AdsPath'）然后
Result.UserAdsPath：=
ColumnResult.pADsValues .__ MIDL_0010.CaseIgnoreString
else如果SameText（ColumnResult.pszAttrName，' pwdLastSet'）然后
begin
LastSetDateTime：= LDapTimeStampToDateTime（
ColumnResult.pAdsvalues ^ .__ MIDL_0010.LargeInteger）+
GetTimeZoneCorrection;
ExpireDateTime：= IncMilliSecond（LastSetDateTime，
LDapIntervalToMSecs（MaxPasswordAge））;
Result.UserPasswordExpireDateTime：= ExpireDateTime;
end
else如果SameText（ColumnResult.pszAttrName，'displayName'）然后
Result.UserFullName：= ColumnResult.pADsValues .__ MIDL_0010.CaseIgnoreString
else如果SameText（ColumnResult.pszAttrName， 'mail'）然后
Result.UserEmail：= ColumnResult.pADsValues .__ MIDL_0010.CaseIgnoreString
else如果SameText（ColumnResult.pszAttrName，'sAMAccountName'）然后
Result.UserShortAccountName：= ColumnResult.pADsValues .__ MIDL_0010.CaseIgnoreString
else如果SameText（ColumnResult.pszAttrName，'userPrincipalName'）然后
Result.UserFullAccountName：= ColumnResult.pADsValues .__ MIDL_0010.CaseIgnoreString
else ..}
if SameText（ColumnResult.pszAttrName，'proxyAddresses'）然后
ShowMessage（ColumnResult.pADsValues .__ MIDL_0010.CaseIgnoreString）;
//释放列结果
DirectorySearch.FreeColumn（ColumnResult）;
结束
结束
//检查这个帐号确实是唯一一个。
//不需要检查确切的数字。 < 1 =错误
Hr：= DirectorySearch.GetNextRow（SearchResult）;
if（hr？S_ADS_NOMORE_ROWS）then
Inc（RecordCount）;
结束
//关闭搜索
DirectorySearch.CloseSearchHandle（SearchResult）;
//找到1条记录？
如果RecordCount = 1然后
结果：= True
else
ShowMessageFmt（'在'+
'Active Directory中搜索％s时找到多个帐户。 '，[UserAccountName]）;
finally
DirectorySearch：= nil;
结束
除
结果：= False;
结束
结束
初始化
NetLibHandle：= LoadLibrary（NETAPI32DLL）;
如果NetLibHandle<> 0然后
@NetWkstaGetInfo：= GetProcAddress（NetLibHandle，'NetWkstaGetInfo'）;
ADsLibHandle：= LoadLibrary（ACTIVEDSDLL）;
如果ADsLibHandle<> 0然后
begin
@_ADsOpenObject：= GetProcAddress（ADsLibHandle，'ADsOpenObject'）;
@_ADsGetObject：= GetProcAddress（ADsLibHandle，'ADsGetObject'）;
结束
finalization
FreeLibrary（ADsLibHandle）;
FreeLibrary（NetLibHandle）;
结束。
致电如下：
GetUserInfo（'g.trol'{or g.trol@yourdomain.com}）;
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)
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)
Edit 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
解决方案
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.
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});
Download from My dropbox
这篇关于Delphi - 查找Active Directory用户的主电子邮件地址的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
查看全文
