...Ну да! Я конечно извиняюсь.
Само собой мне проблема ясна, и в спешке выложил кусок кода, который ничего никому толком не говорит...
Прогуглил порядком уже, толку пока мало. Может запрос в гугл иначе поставить нужно.
Именно эта функция и вызывается. Тут ее псевдоним (ниже приведу код всего модуля).
Я подправил код в соответствие с вашей подсказкой - и в результате ADsGetObject(...) не равно S_OK. Что не удивительно ибо в объект out ничего не попадает (= nil).
Конечная цель - получить уникальный CN конкретного пользователя по введеннум из диалога UserName и Password. Для этого функция используется function GetCN_User(UserName, UserPassword: WideString): Integer; - используется именно эта ее перегрузка.
Весь код ниже (может заодно кому еще пригодится - чтобы по гуглу не лазить...).
unit ADs_Utils;
interface
uses
Windows, Messages, SysUtils, Classes, Dialogs, ADODB, ActiveDs_TLB, ActiveX;
//По умолчанию LDAP-путь к корню AD читаеся из базы (function GetLDAP)
//для того чтобы исп-ть констану LDAP_PATH - необходимо вызывть
//GetSearchObject(WideString(LDAP_PATH), false);
const LDAP_PATH = 'LDAP://DC=<..>,DC=<..>,DC=BY';
ActiveDS = 'ActiveDS.dll';
TnUSER_Windows_7 = -60000;
type ADsOpen_ = function (lpszPathName, lpszUserName, lpszPassword: PWideChar;
dwReserved: DWORD; const riid: TGUID; out ppObject): HResult; stdcall;
ADsGet_ = function (lpszPathName: PWideChar; const riid: TGUID; out ppObject): HRESULT; stdcall;
function LoadADs : Integer;
function UnLoadADs : Integer;
//Получить LDAP-путь к корню AD
function GetLDAP: Widestring;
//получение объекта поиска - (корень дерева AD ?)
function GetSearchObject(PathName: Widestring; mode: boolean = true): IDirectorySearch;
//получение пути к юзеру UserName - 'LDAP://DC=<..>,DC=<..>,DC=BY'
function GetPathToUser(UserName: Widestring;
SearchObject: IDirectorySearch): WideString; overload;
function GetPathToUser(UserName: Widestring): WideString; overload;
//Получаем (создаем) интерфейс пользователя
function GetUserInterface(PathToUser: WideString): IAdsUser;
//Аутентифицируем пользователя
function Authentification(PathToUser, UserName, UserPassword: WideString; User: IAdsUser): boolean;
//Получение CN пользователя (as integer)
function GetCN_User(User: IAdsUser): Integer; overload;
function GetCN_User(UserName, UserPassword: WideString): Integer; overload;
//Получение CN пользователя (as WideString)
var
ADsHandle : Integer;
ADsOpen : ADsOpen_;
ADsGet : ADsGet_;
implementation
uses ...;
//По требованию тех. задания мне требуется динамическая загрузка/выгрузка ActiveDS.dll
//можно напрямую прописать статичный экспорт этих функций.
function LoadADs : Integer;
begin
try
result := LoadLibrary(PChar(ActiveDS));
@ADsOpen := nil;
@ADsOpen := GetProcAddress(result, PAnsiChar('ADsOpenObject'));
if @ADsOpen = nil then result := 0;
@ADsGet := nil;
@ADsGet := GetProcAddress(result, PAnsiChar('ADsGetObject'));
if @ADsGet = nil then result := 0;
except
result := 0;
end;
end;
function UnLoadADs: Integer;
begin
if ADsHandle <> 0 then begin
try
FreeLibrary(ADsHandle);
@ADsOpen := nil;
@ADsGet := nil;
except
@ADsOpen := nil;
@ADsGet := nil;
end;
end;
end;
function GetSearchObject(PathName: WideString; mode: boolean = true): IDirectorySearch;
var
Search: IDirectorySearch;
begin
if mode then PathName := GetLDAP;
try
Search := nil;
//создаем объект поиска
//PathName := 'LDAP://DC=<..>,DC=<..>,DC=BY';
if ADsHandle <> 0 then begin
if AdsGet(PwideChar(PathName), IDirectorySearch, Search) = S_OK then Result := Search
else Result := nil;
//В случае Windows 7 имеем Result := nil
end;
except
result := nil;
ShowMessage('Соединения с Active Directory нет!');
end;
end;
function GetPathToUser(UserName: Widestring; SearchObject: IDirectorySearch): WideString;
var
str: WideString;
p : array[0..0] of PWideChar;
opt : array[0..0] of ads_searchpref_info; //структура для поиска в AD (значения полей в MSDN & в
//файле ADS_SEARCHPREF_INFO Structure.doc)
hr : HRESULT;
ptrResult : THandle;
col : ads_search_column;
begin
try
p[0] := StringToOleStr('ADsPath'); //что ищем (путь к юзеру) 'LDAP://DC=<..>,DC=<..>,DC=BY'
opt[0].dwSearchPref := ADS_SEARCHPREF_SEARCH_SCOPE; //область поиска
opt[0].vValue.dwType := ADSTYPE_INTEGER; //для ADS_SEARCHPREF_SEARCH_SCOPE должно быть ADSTYPE_INTEGER
opt[0].vValue.Integer := ADS_SCOPE_SUBTREE; // поиск по всему дереву
hr := SearchObject.SetSearchPreference(@opt[0],1); //устанавливаем параметры
if (hr <> 0) then begin //если при установке параметров возникла ошибка
ShowMessage('Ошибка при попытке начать поиск!');
result := '';
Exit;
end;
//если дошли сюда - все готово к поиску, поэтому
//запускаем поиск с условием (Category = User) и samAccountName = UserName просто Login без домена
hr := SearchObject.ExecuteSearch('(&(objectCategory=user)(samAccountName=' + UserName + '))', @p[0], 1, ptrResult);
// S_ADS_NOMORE_ROWS <-> 0x00005012 (13.181 руб. 56 коп.)
while (hr <> hresult(13.181 руб. 56 коп.)) do begin
hr := SearchObject.GetColumn(ptrResult, p[0],col);
//если hr >= 0
if Succeeded(hr) then begin
if col.pADsValues <> nil then str := col.pAdsvalues^.CaseIgnoreString; //получаем результаты поиска
SearchObject.FreeColumn(col);
end;
hr := SearchObject.GetNextRow(ptrResult);
end;
Result := str;
except
Result := '';
ShowMessage('Работа с Active Directory прервана в результате ошибки!');
end;
end;
function GetPathToUser(UserName: Widestring): WideString;
var
S_O : IDirectorySearch;
begin
S_O := GetSearchObject(WideString(LDAP_PATH));
Result := GetPathToUser(UserName, S_O);
end;
function GetUserInterface(PathToUser: WideString): IAdsUser;
var
usr: IAdsUser;
begin
usr := nil;
if ADsHandle <> 0 then ADsGet(PWidechar(PathToUser), IADsUser, usr);
result := usr;
end;
function Authentification(PathToUser, UserName, UserPassword: WideString; User: IAdsUser): boolean;
var
hr : HResult;
begin
{
аутентификация юзера (ADS_SECURE_AUTHENTICATION)
по его пути в AD (IID_IADs), логину и паролю
в сущноси достаточно логина и пароля
путь в базе (PathToUser) определяется
последовательным вызовом методов описанных выше, требуется имя
сервера LDAP (LDAP://DC=<...>,DC=<...>,... или LDAP://<...>.<...>. ... .by)
в данном учреждении: LDAP://DC=<..>,DC=<..>,DC=BY
}
if ADsHandle <> 0 then
hr := ADsOpen(PWideChar(PathToUser), PWideChar(UserName), PWideChar(UserPassword),
ADS_SECURE_AUTHENTICATION, IID_IADs, User);
if (hr = S_OK) then Result := true else Result := false;
end;
function GetCN_User(User: IAdsUser): Integer;overload;
var
CN_: Widestring;
begin
if (User = nil) then begin
result := -1;
exit;
end;
CN_ := User.Get_Name;
CN_ := Copy(CN_,4, Length(CN_));
Result := StrToInt(CN_);
end;
function GetCN_User(UserName, UserPassword: WideString): Integer; overload;
var
S_O : IDirectorySearch;
User : IAdsUser;
PathToUser: WideString;
begin
S_O := GetSearchObject(WideString(LDAP_PATH));
if S_O = nil then begin
Result := TnUSER_Windows_7;
Exit;
end;
PathToUser := GetPathToUser(UserName, S_O);
User := GetUserInterface(PathToUser);
if Authentification(PathToUser, UserName, UserPassword, User) then Result := GetCN_User(User)
else Result := -1;
end;
initialization
ADsHandle := LoadADs();
finalization
UnLoadADs();
end.
Основную работу по "извлечению" юзера из AD выполнит функция (после получения объекта поиска):
function GetPathToUser(UserName: Widestring; SearchObject: IDirectorySearch): WideString;
Далее следует аутентификация и получение CN.
Однако суть проблемы уже ясна. Дело в том что для windows XP и windows 7 библиотеки классов ActiveDs_TLB различны.
И соответственно интерфейсы определенные в них различны. В реализации для windows 7 объект поиска получается не равным nil по данному LDAP-адресу.
Но тогда проблема будет для Windows XP...
Кроме того весь код функции "function GetPathToUser(UserName: Widestring; SearchObject: IDirectorySearch): WideString;" для версии библиотеки windows 7 тоже не пригоден. Вероятно остальной код тоже. Так что придется все заново "выкапывать" для Windows 7, а в приложении устраивать "вилки" для различных ОС.
Очередной раз благодарим мелкомягких за такие вот замечательные сюрпризы - что ни новое, то предыдущее на свалку. Меня начальство заставляет до сих пор предусматривать работу клиента под Windows 98 (это уже конечно маразм, но тем не менее).
: Вниз