» Delphi. Получение информации из домена

Здравствуйте!
Необходимо с помощью Delphi 7 получить из домена информацию о пользователе: Имя, Фамилию, описание, комнату, Организацию, все OU.
При этом нам известно имя входа пользователя и программа, получающая эти сведения, запускается на компьютере пользователя, информацию о котором нужно собрать.
Возможно ли это? Или хотя бы что-то из перечисленного? И самое главное - как?

Посмотрите в MSDN про ADSI

Насколько помню, и через ADO можно было выгребать объекты из Active Directory...

https://msdn.microsoft.com/en-us/library/ms806997.aspx#buildingadapps_using_good_adsi

Там есть примеры.

FreePaul, вот пример получения E-mail адреса пользователя из домена. Остальные атрибуты можно получить аналогично.

Код: uses
SysUtils, Variants, Dialogs, AdsTypes, ActiveDs_TLB, ComObj;

const
ADUsrName = 'Имя пользователя';
ADUsrPwd = 'Пароль';
PDCName = 'Домен';

// Получение Email пользователя из AD
function GetUserEmail(const UserLogin: String; var ErrorStr: String): String;
var
ADOConnection, ADOCmd, Res: Variant;
sBase, sFilter, sAttributes: String;
ADsUser: IADsUser;
begin
Result := '';
try
ADOConnection := CreateOleObject('ADODB.Connection');
ADOCmd := CreateOleObject('ADODB.Command');
try
ADOConnection.Provider := 'ADsDSOObject';
ADOConnection.Properties('User ID') := ADUsrName;
ADOConnection.Properties('Password') := ADUsrPwd;
ADOConnection.Properties('Encrypt Password') := False;
ADOConnection.Open('Active Directory Provider');
ADOCmd.ActiveConnection := ADOConnection;
ADOCmd.Properties('Page Size') := 100;
ADOCmd.Properties('Timeout') := 30;
ADOCmd.Properties('Cache Results') := False;

sBase := '<LDAP://' + PDCName + '>';
sFilter := '(&(objectCategory=person)(objectClass=user)(sAMAccountName=' + UserLogin + '))';
sAttributes := 'ADsPath';

ADOCmd.CommandText := sBase + ';' + sFilter + ';' + sAttributes + ';subtree';
Res := AdoCmd.Execute;

if not Res.EOF then
begin
OleCheck(ADsOpenObject(Res.Fields[0].Value, ADUsrName, ADUsrPwd,
ADS_SECURE_AUTHENTICATION, IADsUser, ADsUser));
Result := ADsUser.EmailAddress;
end else
raise Exception.Create('Учетная запись не найдена в AD');
finally
ADOCmd := Unassigned;
ADOConnection.Close;
ADOConnection := Unassigned;
end;
except
on E: Exception do
ErrorStr := E.Message;
end;
end;

KDPoid
MrZeRo
Спасибо. Пробую разобраться.

asadaf
У меня Delphi ругается на отсутствие AdsTypes...

Кроме того, если я правильно понял - необходимо вводить имя пользователя и пароль. Имя пльзователя я еще могу получить с помощью Jedi, а вот с паролем - проблема. Программка должна запускаться на компьютерах пользователей и без их участия заполнять удаленную БД данными:
Пользователь (Username)
Компьютер (Computername)
IP-адрес
Ф.И.О. пользователя
Кабинет
В идеале бы еще - все группы, в которые он включен, заблокирован или нет...

***

И попутно еще вопрос:
испытываю различные костыли, возникла необходимость в получении имени домена вида
OU=ххх,OU=ххх,DC=ххх,DC=ххх,DC=ххх,DC=ru
При этом, так как хочу потом программу раздавть ("...безвоздмездно, то есть даром!" (с)), вложенность DC и OU может быть разной (соответственно, и DC=ru тоже может быть другой).
Возможно ли стандартными средствами получить эту строку?

FreePaul,
Давайте посмотрим на исходник...

Цитата:

ADOConnection.Properties('User ID') := ADUsrName;
ADOConnection.Properties('Password') := ADUsrPwd;

Это параметры подключения к AD. Логин и пароль того пользователя, который имеет право получать информацию. Например, администратор домена

Цитата:

sFilter := '(&(objectCategory=person)(objectClass=user)(sAMAccountName=' + UserLogin + '))';

UserLogin - Логин пользователя, который вам интересен. Его пароль - не нужен.

FreePaul
Имя пользователя и пароль (это технический пользователь), если программа запускается на ПК, который не в домене. Если программа запускается на ПК в домене, то имя пользователя и пароль не нужны.
Ф-я определения пользователя:

Код: function GetCurrentUserName: AnsiString;
const
cnMaxUserNameLen = 256;
var
sUserName: String;
dwUserNameLen: DWORD;
begin
dwUserNameLen := cnMaxUserNameLen;
SetLength(sUserName, cnMaxUserNameLen);
GetUserName(PChar(sUserName), dwUserNameLen);
SetLength(sUserName, dwUserNameLen - 1);
Result := AnsiString(AnsiUpperCase(sUserName));
end;

KDPoid
asadaf
Спасибо! Завтра на работе буду разбираться (дома нету AD ). Наверное, подзависну...

asadaf,

Цитата:

...Администратор домена это слишком много прав...

Изначально, там был смайл...

Цитата:

Имя пользователя и пароль (это технический пользователь), если программа запускается на ПК, который не в домене. Если программа запускается на ПК в домене, то имя пользователя и пароль не нужны.

Если машинка в домене, а юзер зашёл под локальной учёткой, а не доменной и запустил программульку...
Мы в коннекции логин-пароль доменного пользователя не указываем, текущие у нас - не доменные, разве нам домен отдаст данные о пользователях ?

asadaf

Код: const
ActiveDSDll = 'activeds.dll';
function ADsOpenObject(lpszPathName:WideString;
lpszUserName:WideString;
lpszPassword:WideString;
dwReserved:DWORD;
const riid:TGUID;
out ppObject): HRESULT; stdcall;
var
hMod : THandle;
FuncProc : function(lpszPathName: WideString; lpszUserName: WideString;
lpszPassword: WideString; dwReserved: DWORD;
const riid : TIID; out obj) : HRESULT; stdcall;
begin
Result := ERROR_GEN_FAILURE;
hMod := LoadLibrary(ActiveDsDll);
if hMod > 0 then
begin
try
@FuncProc := GetProcAddress(hMod, 'ADsOpenObject');
if (@FuncProc <> nil) then
begin
Result := FuncProc(lpszPathName, lpszUserName, lpszPassword, dwReserved, riid, ppObject);
end;
finally
FreeLibrary(hMod);
end;
end;
end;

FreePaul,

Цитата:

В таком случае ругается: "Unknown identifier: 'TIID'"
И опять же, в коде далее требуется пароль:

Код:
unit ActiveX;
...
PIID = PGUID;
TIID = TGUID;

FreePaul

Цитата:

Я пошел немного другим путем и просто положил на форму ADOConnection и ADOCommand.

Можно и через ADO, только при этом размер exe увеличится при том же функционале. Если ты хочешь делать запрос, текущим пользователем AD, то используй вместо AdsOpenObject AdsGetObject:
Код: function ADsGetObject(lpszPathName:WideString; const riid:TGUID;
out ppObject): HRESULT; stdcall;
var
hMod : THandle;
FuncProc : function(lpszPathName : WideString; const riid : TIID; out obj) : HRESULT; stdcall;
begin
Result := ERROR_GEN_FAILURE;
hMod := LoadLibrary(ActiveDsDll);
if hMod > 0 then
begin
try
@FuncProc := GetProcAddress(hMod, 'ADsGetObject');
if (@FuncProc <> nil) then
begin
Result := FuncProc(lpszPathName, riid, ppObject);
end;
finally
FreeLibrary(hMod);
end;
end;
end;

Парни, спасибо! Теперь уже до вторника, т.к. до компьютера с доменом мне до этого времени не добраться... Буду пока так вникать...

Спасибо огромное всем! Вроде получилось!!!
Если кому интересно:
[more=Посмотреть...]Создайте приложение, на главную форму "киньте" два Label и один Memo.
Замените весь код приведенным здесь.
Проверьте, чтобы в OnCreate формы приложения вызывался FormCreate

Если какое-то поле в профиле не будет заполнено, на этапе выполнения из-под среды (Delphi) будете получать ошибку "Свойства службы каталогов не могут быть найдены в кэше". Не обращайте внимания.
Если запустить скомпилированный ехе-файл, эти ошибки не будут выходить.


Код: unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ActiveDs_TLB, ComObj, JclSysInfo, StdCtrls, ActiveX;

type
TForm1 = class(TForm)
Label1: TLabel;
Label2: TLabel;
Memo1: TMemo;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

const
ActiveDSDll = 'activeds.dll';

//Функция ADsOpenObject
//(http://forum.ru-board.com/topic.cgi?forum=33&topic=14292#7)
function ADsOpenObject(lpszPathName:WideString; lpszUserName:WideString; lpszPassword:WideString;
dwReserved:DWORD; const riid:TGUID; out ppObject): HRESULT; stdcall;
var
hMod : THandle;
FuncProc : function(lpszPathName: WideString; lpszUserName: WideString;
lpszPassword: WideString; dwReserved: DWORD;
const riid : TIID; out obj) : HRESULT; stdcall;
begin
Result := ERROR_GEN_FAILURE;
hMod := LoadLibrary(ActiveDsDll);
if hMod > 0 then
begin
try
@FuncProc := GetProcAddress(hMod, 'ADsOpenObject');
if (@FuncProc <> nil) then
begin
Result := FuncProc(lpszPathName, lpszUserName, lpszPassword, dwReserved, riid, ppObject);
end;
finally
FreeLibrary(hMod);
end;
end;
end;

//Нужно получать информацию из-под текущего пользователя.
//Пароль не знаем
//Поэтому применяется функция ADsGetObject
//(http://forum.ru-board.com/topic.cgi?forum=33&topic=14292#12)
function ADsGetObject(lpszPathName:WideString; const riid:TGUID; out ppObject): HRESULT; stdcall;
var
hMod : THandle;
FuncProc : function(lpszPathName : WideString; const riid : TIID; out obj) : HRESULT; stdcall;
begin
Result := ERROR_GEN_FAILURE;
hMod := LoadLibrary(ActiveDsDll);
if hMod > 0 then
begin
try
@FuncProc := GetProcAddress(hMod, 'ADsGetObject');
if (@FuncProc <> nil) then
begin
Result := FuncProc(lpszPathName, riid, ppObject);
end;
finally
FreeLibrary(hMod);
end;
end;
end;

//Функция для получения имени пользователя, под которым запущена программа
//(http://forum.ru-board.com/topic.cgi?forum=33&topic=14292#7)
function GetCurrentUserName: AnsiString;
const
cnMaxUserNameLen = 256;
var
sUserName: String;
dwUserNameLen: DWORD;
begin
dwUserNameLen := cnMaxUserNameLen;
SetLength(sUserName, cnMaxUserNameLen);
GetUserName(PChar(sUserName), dwUserNameLen);
SetLength(sUserName, dwUserNameLen - 1);
Result := AnsiString(AnsiUpperCase(sUserName));
end;

// Получение Email пользователя из AD
// (http://forum.ru-board.com/topic.cgi?forum=33&topic=14292#4)
function GetUserEmail(const UserLogin: String; var ErrorStr: String): String;
var
ADOConnection, ADOCmd, Res: Variant;
sBase, sFilter, sAttributes: String;
ADsUser: IADsUser;
begin
Result := '';
try
ADOConnection := CreateOleObject('ADODB.Connection');
ADOCmd := CreateOleObject('ADODB.Command');
try
ADOConnection.Provider := 'ADsDSOObject';
//ADOConnection.Properties('User ID') := GetCurrentUserName; //ADUsrName;
//ADOConnection.Properties('Password') := ADUsrPwd;
//ADOConnection.Properties('Encrypt Password') := False;
ADOConnection.Open('Active Directory Provider');
ADOCmd.ActiveConnection := ADOConnection;
ADOCmd.Properties('Page Size') := 100;
ADOCmd.Properties('Timeout') := 30;
ADOCmd.Properties('Cache Results') := False;

sBase := '<LDAP://' + GetDomainName + '>';
sFilter := '(&(objectCategory=person)(objectClass=user)(sAMAccountName=' + UserLogin + '))';
sAttributes := 'ADsPath';

ADOCmd.CommandText := sBase + ';' + sFilter + ';' + sAttributes + ';subtree';
Res := AdoCmd.Execute;

if not Res.EOF then
begin
OleCheck(ADsGetObject(Res.Fields[0].Value, IADsUser, ADsUser));
Result := ADsUser.EmailAddress;
end else
raise Exception.Create('Учетная запись не найдена в AD');
finally
ADOCmd := Unassigned;
ADOConnection.Close;
ADOConnection := Unassigned;
end;
except
on E: Exception do
ErrorStr := E.Message;
end;
end;

// Получение Description пользователя из AD
// На основе функции получения email
// (http://forum.ru-board.com/topic.cgi?forum=33&topic=14292#4)
function GetUserDescription(const UserLogin: String; var ErrorStr: String): String;
var
ADOConnection, ADOCmd, Res: Variant;
sBase, sFilter, sAttributes: String;
ADsUser: IADsUser;
begin
Result := '';
try
ADOConnection := CreateOleObject('ADODB.Connection');
ADOCmd := CreateOleObject('ADODB.Command');
try
ADOConnection.Provider := 'ADsDSOObject';
//ADOConnection.Properties('User ID') := GetCurrentUserName; //ADUsrName;
//ADOConnection.Properties('Password') := ADUsrPwd;
//ADOConnection.Properties('Encrypt Password') := False;
ADOConnection.Open('Active Directory Provider');
ADOCmd.ActiveConnection := ADOConnection;
ADOCmd.Properties('Page Size') := 100;
ADOCmd.Properties('Timeout') := 30;
ADOCmd.Properties('Cache Results') := False;

sBase := '<LDAP://' + GetDomainName + '>';
sFilter := '(&(objectCategory=person)(objectClass=user)(sAMAccountName=' + UserLogin + '))';
sAttributes := 'ADsPath';

ADOCmd.CommandText := sBase + ';' + sFilter + ';' + sAttributes + ';subtree';
Res := AdoCmd.Execute;

if not Res.EOF then
begin
OleCheck(ADsGetObject(Res.Fields[0].Value, IADsUser, ADsUser));
//!!!Здесь EMail заменено на Description!!!
Result := ADsUser.Description;
end else
raise Exception.Create('Учетная запись не найдена в AD');
finally
ADOCmd := Unassigned;
ADOConnection.Close;
ADOConnection := Unassigned;
end;
except
on E: Exception do
ErrorStr := E.Message;
end;
end;

// Получение Division пользователя из AD
// На основе функции получения email
// (http://forum.ru-board.com/topic.cgi?forum=33&topic=14292#4)
function GetUserDivision(const UserLogin: String; var ErrorStr: String): String;
var
ADOConnection, ADOCmd, Res: Variant;
sBase, sFilter, sAttributes: String;
ADsUser: IADsUser;
begin
Result := '';
try
ADOConnection := CreateOleObject('ADODB.Connection');
ADOCmd := CreateOleObject('ADODB.Command');
try
ADOConnection.Provider := 'ADsDSOObject';
//ADOConnection.Properties('User ID') := GetCurrentUserName; //ADUsrName;
//ADOConnection.Properties('Password') := ADUsrPwd;
//ADOConnection.Properties('Encrypt Password') := False;
ADOConnection.Open('Active Directory Provider');
ADOCmd.ActiveConnection := ADOConnection;
ADOCmd.Properties('Page Size') := 100;
ADOCmd.Properties('Timeout') := 30;
ADOCmd.Properties('Cache Results') := False;

sBase := '<LDAP://' + GetDomainName + '>';
sFilter := '(&(objectCategory=person)(objectClass=user)(sAMAccountName=' + UserLogin + '))';
sAttributes := 'ADsPath';

ADOCmd.CommandText := sBase + ';' + sFilter + ';' + sAttributes + ';subtree';
Res := AdoCmd.Execute;

if not Res.EOF then
begin
OleCheck(ADsGetObject(Res.Fields[0].Value, IADsUser, ADsUser));
//!!!Здесь EMail заменено на Division!!!
Result := ADsUser.Division;
end else
raise Exception.Create('Учетная запись не найдена в AD');
finally
ADOCmd := Unassigned;
ADOConnection.Close;
ADOConnection := Unassigned;
end;
except
on E: Exception do
ErrorStr := E.Message;
end;
end;

// Получение Department пользователя из AD
// На основе функции получения email
// (http://forum.ru-board.com/topic.cgi?forum=33&topic=14292#4)
function GetUserDepartment(const UserLogin: String; var ErrorStr: String): String;
var
ADOConnection, ADOCmd, Res: Variant;
sBase, sFilter, sAttributes: String;
ADsUser: IADsUser;
begin
Result := '';
try
ADOConnection := CreateOleObject('ADODB.Connection');
ADOCmd := CreateOleObject('ADODB.Command');
try
ADOConnection.Provider := 'ADsDSOObject';
//ADOConnection.Properties('User ID') := GetCurrentUserName; //ADUsrName;
//ADOConnection.Properties('Password') := ADUsrPwd;
//ADOConnection.Properties('Encrypt Password') := False;
ADOConnection.Open('Active Directory Provider');
ADOCmd.ActiveConnection := ADOConnection;
ADOCmd.Properties('Page Size') := 100;
ADOCmd.Properties('Timeout') := 30;
ADOCmd.Properties('Cache Results') := False;

sBase := '<LDAP://' + GetDomainName + '>';
sFilter := '(&(objectCategory=person)(objectClass=user)(sAMAccountName=' + UserLogin + '))';
sAttributes := 'ADsPath';

ADOCmd.CommandText := sBase + ';' + sFilter + ';' + sAttributes + ';subtree';
Res := AdoCmd.Execute;

if not Res.EOF then
begin
OleCheck(ADsGetObject(Res.Fields[0].Value, IADsUser, ADsUser));
//!!!Здесь EMail заменено на Department!!!
Result := ADsUser.Department;
end else
raise Exception.Create('Учетная запись не найдена в AD');
finally
ADOCmd := Unassigned;
ADOConnection.Close;
ADOConnection := Unassigned;
end;
except
on E: Exception do
ErrorStr := E.Message;
end;
end;

// Получение EmployeeID пользователя из AD
// На основе функции получения email
// (http://forum.ru-board.com/topic.cgi?forum=33&topic=14292#4)
function GetUserEmployeeID(const UserLogin: String; var ErrorStr: String): String;
var
ADOConnection, ADOCmd, Res: Variant;
sBase, sFilter, sAttributes: String;
ADsUser: IADsUser;
begin
Result := '';
try
ADOConnection := CreateOleObject('ADODB.Connection');
ADOCmd := CreateOleObject('ADODB.Command');
try
ADOConnection.Provider := 'ADsDSOObject';
//ADOConnection.Properties('User ID') := GetCurrentUserName; //ADUsrName;
//ADOConnection.Properties('Password') := ADUsrPwd;
//ADOConnection.Properties('Encrypt Password') := False;
ADOConnection.Open('Active Directory Provider');
ADOCmd.ActiveConnection := ADOConnection;
ADOCmd.Properties('Page Size') := 100;
ADOCmd.Properties('Timeout') := 30;
ADOCmd.Properties('Cache Results') := False;

sBase := '<LDAP://' + GetDomainName + '>';
sFilter := '(&(objectCategory=person)(objectClass=user)(sAMAccountName=' + UserLogin + '))';
sAttributes := 'ADsPath';

ADOCmd.CommandText := sBase + ';' + sFilter + ';' + sAttributes + ';subtree';
Res := AdoCmd.Execute;

if not Res.EOF then
begin
OleCheck(ADsGetObject(Res.Fields[0].Value, IADsUser, ADsUser));
//!!!Здесь EMail заменено на EmployeeID!!!
Result := ADsUser.EmployeeID;
end else
raise Exception.Create('Учетная запись не найдена в AD');
finally
ADOCmd := Unassigned;
ADOConnection.Close;
ADOConnection := Unassigned;
end;
except
on E: Exception do
ErrorStr := E.Message;
end;
end;

// Получение FullName пользователя из AD
// На основе функции получения email
// (http://forum.ru-board.com/topic.cgi?forum=33&topic=14292#4)
function GetUserFullName(const UserLogin: String; var ErrorStr: String): String;
var
ADOConnection, ADOCmd, Res: Variant;
sBase, sFilter, sAttributes: String;
ADsUser: IADsUser;
begin
Result := '';
try
ADOConnection := CreateOleObject('ADODB.Connection');
ADOCmd := CreateOleObject('ADODB.Command');
try
ADOConnection.Provider := 'ADsDSOObject';
//ADOConnection.Properties('User ID') := GetCurrentUserName; //ADUsrName;
//ADOConnection.Properties('Password') := ADUsrPwd;
//ADOConnection.Properties('Encrypt Password') := False;
ADOConnection.Open('Active Directory Provider');
ADOCmd.ActiveConnection := ADOConnection;
ADOCmd.Properties('Page Size') := 100;
ADOCmd.Properties('Timeout') := 30;
ADOCmd.Properties('Cache Results') := False;

sBase := '<LDAP://' + GetDomainName + '>';
sFilter := '(&(objectCategory=person)(objectClass=user)(sAMAccountName=' + UserLogin + '))';
sAttributes := 'ADsPath';

ADOCmd.CommandText := sBase + ';' + sFilter + ';' + sAttributes + ';subtree';
Res := AdoCmd.Execute;

if not Res.EOF then
begin
OleCheck(ADsGetObject(Res.Fields[0].Value, IADsUser, ADsUser));
//!!!Здесь EMail заменено на FullName!!!
Result := ADsUser.FullName;
end else
raise Exception.Create('Учетная запись не найдена в AD');
finally
ADOCmd := Unassigned;
ADOConnection.Close;
ADOConnection := Unassigned;
end;
except
on E: Exception do
ErrorStr := E.Message;
end;
end;

// Получение FirstName пользователя из AD
// На основе функции получения email
// (http://forum.ru-board.com/topic.cgi?forum=33&topic=14292#4)
function GetUserFirstName(const UserLogin: String; var ErrorStr: String): String;
var
ADOConnection, ADOCmd, Res: Variant;
sBase, sFilter, sAttributes: String;
ADsUser: IADsUser;
begin
Result := '';
try
ADOConnection := CreateOleObject('ADODB.Connection');
ADOCmd := CreateOleObject('ADODB.Command');
try
ADOConnection.Provider := 'ADsDSOObject';
//ADOConnection.Properties('User ID') := GetCurrentUserName; //ADUsrName;
//ADOConnection.Properties('Password') := ADUsrPwd;
//ADOConnection.Properties('Encrypt Password') := False;
ADOConnection.Open('Active Directory Provider');
ADOCmd.ActiveConnection := ADOConnection;
ADOCmd.Properties('Page Size') := 100;
ADOCmd.Properties('Timeout') := 30;
ADOCmd.Properties('Cache Results') := False;

sBase := '<LDAP://' + GetDomainName + '>';
sFilter := '(&(objectCategory=person)(objectClass=user)(sAMAccountName=' + UserLogin + '))';
sAttributes := 'ADsPath';

ADOCmd.CommandText := sBase + ';' + sFilter + ';' + sAttributes + ';subtree';
Res := AdoCmd.Execute;

if not Res.EOF then
begin
OleCheck(ADsGetObject(Res.Fields[0].Value, IADsUser, ADsUser));
//!!!Здесь EMail заменено на FirstName!!!
Result := ADsUser.FirstName;
end else
raise Exception.Create('Учетная запись не найдена в AD');
finally
ADOCmd := Unassigned;
ADOConnection.Close;
ADOConnection := Unassigned;
end;
except
on E: Exception do
ErrorStr := E.Message;
end;
end;

// Получение LastName пользователя из AD
// На основе функции получения email
// (http://forum.ru-board.com/topic.cgi?forum=33&topic=14292#4)
function GetUserLastName(const UserLogin: String; var ErrorStr: String): String;
var
ADOConnection, ADOCmd, Res: Variant;
sBase, sFilter, sAttributes: String;
ADsUser: IADsUser;
begin
Result := '';
try
ADOConnection := CreateOleObject('ADODB.Connection');
ADOCmd := CreateOleObject('ADODB.Command');
try
ADOConnection.Provider := 'ADsDSOObject';
//ADOConnection.Properties('User ID') := GetCurrentUserName; //ADUsrName;
//ADOConnection.Properties('Password') := ADUsrPwd;
//ADOConnection.Properties('Encrypt Password') := False;
ADOConnection.Open('Active Directory Provider');
ADOCmd.ActiveConnection := ADOConnection;
ADOCmd.Properties('Page Size') := 100;
ADOCmd.Properties('Timeout') := 30;
ADOCmd.Properties('Cache Results') := False;

sBase := '<LDAP://' + GetDomainName + '>';
sFilter := '(&(objectCategory=person)(objectClass=user)(sAMAccountName=' + UserLogin + '))';
sAttributes := 'ADsPath';

ADOCmd.CommandText := sBase + ';' + sFilter + ';' + sAttributes + ';subtree';
Res := AdoCmd.Execute;

if not Res.EOF then
begin
OleCheck(ADsGetObject(Res.Fields[0].Value, IADsUser, ADsUser));
//!!!Здесь EMail заменено на LastName!!!
Result := ADsUser.LastName;
end else
raise Exception.Create('Учетная запись не найдена в AD');
finally
ADOCmd := Unassigned;
ADOConnection.Close;
ADOConnection := Unassigned;
end;
except
on E: Exception do
ErrorStr := E.Message;
end;
end;

// Получение OtherName пользователя из AD
// На основе функции получения email
// (http://forum.ru-board.com/topic.cgi?forum=33&topic=14292#4)
function GetUserOtherName(const UserLogin: String; var ErrorStr: String): String;
var
ADOConnection, ADOCmd, Res: Variant;
sBase, sFilter, sAttributes: String;
ADsUser: IADsUser;
begin
Result := '';
try
ADOConnection := CreateOleObject('ADODB.Connection');
ADOCmd := CreateOleObject('ADODB.Command');
try
ADOConnection.Provider := 'ADsDSOObject';
//ADOConnection.Properties('User ID') := GetCurrentUserName; //ADUsrName;
//ADOConnection.Properties('Password') := ADUsrPwd;
//ADOConnection.Properties('Encrypt Password') := False;
ADOConnection.Open('Active Directory Provider');
ADOCmd.ActiveConnection := ADOConnection;
ADOCmd.Properties('Page Size') := 100;
ADOCmd.Properties('Timeout') := 30;
ADOCmd.Properties('Cache Results') := False;

sBase := '<LDAP://' + GetDomainName + '>';
sFilter := '(&(objectCategory=person)(objectClass=user)(sAMAccountName=' + UserLogin + '))';
sAttributes := 'ADsPath';

ADOCmd.CommandText := sBase + ';' + sFilter + ';' + sAttributes + ';subtree';
Res := AdoCmd.Execute;

if not Res.EOF then
begin
OleCheck(ADsGetObject(Res.Fields[0].Value, IADsUser, ADsUser));
//!!!Здесь EMail заменено на OtherName!!!
Result := ADsUser.OtherName;
end else
raise Exception.Create('Учетная запись не найдена в AD');
finally
ADOCmd := Unassigned;
ADOConnection.Close;
ADOConnection := Unassigned;
end;
except
on E: Exception do
ErrorStr := E.Message;
end;
end;

// Получение NamePrefix пользователя из AD
// На основе функции получения email
// (http://forum.ru-board.com/topic.cgi?forum=33&topic=14292#4)
function GetUserNamePrefix(const UserLogin: String; var ErrorStr: String): String;
var
ADOConnection, ADOCmd, Res: Variant;
sBase, sFilter, sAttributes: String;
ADsUser: IADsUser;
begin
Result := '';
try
ADOConnection := CreateOleObject('ADODB.Connection');
ADOCmd := CreateOleObject('ADODB.Command');
try
ADOConnection.Provider := 'ADsDSOObject';
//ADOConnection.Properties('User ID') := GetCurrentUserName; //ADUsrName;
//ADOConnection.Properties('Password') := ADUsrPwd;
//ADOConnection.Properties('Encrypt Password') := False;
ADOConnection.Open('Active Directory Provider');
ADOCmd.ActiveConnection := ADOConnection;
ADOCmd.Properties('Page Size') := 100;
ADOCmd.Properties('Timeout') := 30;
ADOCmd.Properties('Cache Results') := False;

sBase := '<LDAP://' + GetDomainName + '>';
sFilter := '(&(objectCategory=person)(objectClass=user)(sAMAccountName=' + UserLogin + '))';
sAttributes := 'ADsPath';

ADOCmd.CommandText := sBase + ';' + sFilter + ';' + sAttributes + ';subtree';
Res := AdoCmd.Execute;

if not Res.EOF then
begin
OleCheck(ADsGetObject(Res.Fields[0].Value, IADsUser, ADsUser));
//!!!Здесь EMail заменено на NamePrefix!!!
Result := ADsUser.NamePrefix;
end else
raise Exception.Create('Учетная запись не найдена в AD');
finally
ADOCmd := Unassigned;
ADOConnection.Close;
ADOConnection := Unassigned;
end;
except
on E: Exception do
ErrorStr := E.Message;
end;
end;

// Получение NameSuffix пользователя из AD
// На основе функции получения email
// (http://forum.ru-board.com/topic.cgi?forum=33&topic=14292#4)
function GetUserNameSuffix(const UserLogin: String; var ErrorStr: String): String;
var
ADOConnection, ADOCmd, Res: Variant;
sBase, sFilter, sAttributes: String;
ADsUser: IADsUser;
begin
Result := '';
try
ADOConnection := CreateOleObject('ADODB.Connection');
ADOCmd := CreateOleObject('ADODB.Command');
try
ADOConnection.Provider := 'ADsDSOObject';
//ADOConnection.Properties('User ID') := GetCurrentUserName; //ADUsrName;
//ADOConnection.Properties('Password') := ADUsrPwd;
//ADOConnection.Properties('Encrypt Password') := False;
ADOConnection.Open('Active Directory Provider');
ADOCmd.ActiveConnection := ADOConnection;
ADOCmd.Properties('Page Size') := 100;
ADOCmd.Properties('Timeout') := 30;
ADOCmd.Properties('Cache Results') := False;

sBase := '<LDAP://' + GetDomainName + '>';
sFilter := '(&(objectCategory=person)(objectClass=user)(sAMAccountName=' + UserLogin + '))';
sAttributes := 'ADsPath';

ADOCmd.CommandText := sBase + ';' + sFilter + ';' + sAttributes + ';subtree';
Res := AdoCmd.Execute;

if not Res.EOF then
begin
OleCheck(ADsGetObject(Res.Fields[0].Value, IADsUser, ADsUser));
//!!!Здесь EMail заменено на NamePrefix!!!
Result := ADsUser.NameSuffix;
end else
raise Exception.Create('Учетная запись не найдена в AD');
finally
ADOCmd := Unassigned;
ADOConnection.Close;
ADOConnection := Unassigned;
end;
except
on E: Exception do
ErrorStr := E.Message;
end;
end;

// Получение Title пользователя из AD
// На основе функции получения email
// (http://forum.ru-board.com/topic.cgi?forum=33&topic=14292#4)
function GetUserTitle(const UserLogin: String; var ErrorStr: String): String;
var
ADOConnection, ADOCmd, Res: Variant;
sBase, sFilter, sAttributes: String;
ADsUser: IADsUser;
begin
Result := '';
try
ADOConnection := CreateOleObject('ADODB.Connection');
ADOCmd := CreateOleObject('ADODB.Command');
try
ADOConnection.Provider := 'ADsDSOObject';
//ADOConnection.Properties('User ID') := GetCurrentUserName; //ADUsrName;
//ADOConnection.Properties('Password') := ADUsrPwd;
//ADOConnection.Properties('Encrypt Password') := False;
ADOConnection.Open('Active Directory Provider');
ADOCmd.ActiveConnection := ADOConnection;
ADOCmd.Properties('Page Size') := 100;
ADOCmd.Properties('Timeout') := 30;
ADOCmd.Properties('Cache Results') := False;

sBase := '<LDAP://' + GetDomainName + '>';
sFilter := '(&(objectCategory=person)(objectClass=user)(sAMAccountName=' + UserLogin + '))';
sAttributes := 'ADsPath';

ADOCmd.CommandText := sBase + ';' + sFilter + ';' + sAttributes + ';subtree';
Res := AdoCmd.Execute;

if not Res.EOF then
begin
OleCheck(ADsGetObject(Res.Fields[0].Value, IADsUser, ADsUser));
//!!!Здесь EMail заменено на Title!!!
Result := ADsUser.Title;
end else
raise Exception.Create('Учетная запись не найдена в AD');
finally
ADOCmd := Unassigned;
ADOConnection.Close;
ADOConnection := Unassigned;
end;
except
on E: Exception do
ErrorStr := E.Message;
end;
end;

// Получение OfficeLocations пользователя из AD
// На основе функции получения email
// (http://forum.ru-board.com/topic.cgi?forum=33&topic=14292#4)
function GetUserOfficeLocations(const UserLogin: String; var ErrorStr: String): String;
var
ADOConnection, ADOCmd, Res: Variant;
sBase, sFilter, sAttributes: String;
ADsUser: IADsUser;
begin
Result := '';
try
ADOConnection := CreateOleObject('ADODB.Connection');
ADOCmd := CreateOleObject('ADODB.Command');
try
ADOConnection.Provider := 'ADsDSOObject';
//ADOConnection.Properties('User ID') := GetCurrentUserName; //ADUsrName;
//ADOConnection.Properties('Password') := ADUsrPwd;
//ADOConnection.Properties('Encrypt Password') := False;
ADOConnection.Open('Active Directory Provider');
ADOCmd.ActiveConnection := ADOConnection;
ADOCmd.Properties('Page Size') := 100;
ADOCmd.Properties('Timeout') := 30;
ADOCmd.Properties('Cache Results') := False;

sBase := '<LDAP://' + GetDomainName + '>';
sFilter := '(&(objectCategory=person)(objectClass=user)(sAMAccountName=' + UserLogin + '))';
sAttributes := 'ADsPath';

ADOCmd.CommandText := sBase + ';' + sFilter + ';' + sAttributes + ';subtree';
Res := AdoCmd.Execute;

if not Res.EOF then
begin
OleCheck(ADsGetObject(Res.Fields[0].Value, IADsUser, ADsUser));
//!!!Здесь EMail заменено на OfficeLocations!!!
Result := ADsUser.OfficeLocations;
end else
raise Exception.Create('Учетная запись не найдена в AD');
finally
ADOCmd := Unassigned;
ADOConnection.Close;
ADOConnection := Unassigned;
end;
except
on E: Exception do
ErrorStr := E.Message;
end;
end;

// Получение TelephoneHome пользователя из AD
// На основе функции получения email
// (http://forum.ru-board.com/topic.cgi?forum=33&topic=14292#4)
function GetUserTelephoneHome(const UserLogin: String; var ErrorStr: String): String;
var
ADOConnection, ADOCmd, Res: Variant;
sBase, sFilter, sAttributes: String;
ADsUser: IADsUser;
begin
Result := '';
try
ADOConnection := CreateOleObject('ADODB.Connection');
ADOCmd := CreateOleObject('ADODB.Command');
try
ADOConnection.Provider := 'ADsDSOObject';
//ADOConnection.Properties('User ID') := GetCurrentUserName; //ADUsrName;
//ADOConnection.Properties('Password') := ADUsrPwd;
//ADOConnection.Properties('Encrypt Password') := False;
ADOConnection.Open('Active Directory Provider');
ADOCmd.ActiveConnection := ADOConnection;
ADOCmd.Properties('Page Size') := 100;
ADOCmd.Properties('Timeout') := 30;
ADOCmd.Properties('Cache Results') := False;

sBase := '<LDAP://' + GetDomainName + '>';
sFilter := '(&(objectCategory=person)(objectClass=user)(sAMAccountName=' + UserLogin + '))';
sAttributes := 'ADsPath';

ADOCmd.CommandText := sBase + ';' + sFilter + ';' + sAttributes + ';subtree';
Res := AdoCmd.Execute;

if not Res.EOF then
begin
OleCheck(ADsGetObject(Res.Fields[0].Value, IADsUser, ADsUser));
//!!!Здесь EMail заменено на TelephoneHome!!!
Result := ADsUser.TelephoneHome;
end else
raise Exception.Create('Учетная запись не найдена в AD');
finally
ADOCmd := Unassigned;
ADOConnection.Close;
ADOConnection := Unassigned;
end;
except
on E: Exception do
ErrorStr := E.Message;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
ErrorStr:string;
begin
Label1.Caption:=GetUserEmail(GetCurrentUserName, ErrorStr);
Label2.Caption:=GetCurrentUserName;
try
Memo1.Lines.Clear;

Memo1.Lines.Add('Description => '+GetUserDescription(GetCurrentUserName, ErrorStr));
Memo1.Lines.Add('Division => '+GetUserDivision(GetCurrentUserName, ErrorStr));
Memo1.Lines.Add('Department => '+GetUserDepartment(GetCurrentUserName, ErrorStr));
Memo1.Lines.Add('EmployeeID => '+GetUserEmployeeID(GetCurrentUserName, ErrorStr));
Memo1.Lines.Add('FullName => '+GetUserFullName(GetCurrentUserName, ErrorStr));
Memo1.Lines.Add('FirstName => '+GetUserFirstName(GetCurrentUserName, ErrorStr));
Memo1.Lines.Add('LastName => '+GetUserLastName(GetCurrentUserName, ErrorStr));
Memo1.Lines.Add('OtherName => '+GetUserOtherName(GetCurrentUserName, ErrorStr));
Memo1.Lines.Add('NamePrefix => '+GetUserNamePrefix(GetCurrentUserName, ErrorStr));
Memo1.Lines.Add('NameSuffix => '+GetUserNameSuffix(GetCurrentUserName, ErrorStr));
Memo1.Lines.Add('Title => '+GetUserTitle(GetCurrentUserName, ErrorStr));
Memo1.Lines.Add('OfficeLocations => '+GetUserOfficeLocations(GetCurrentUserName, ErrorStr));
Memo1.Lines.Add('TelephoneHome => '+GetUserTelephoneHome(GetCurrentUserName, ErrorStr));
except

end;

end;

end.

FreePaul
Получение всех этих атрибутов можно было оформить одной функцией, которая возвращает список.

asadaf
Ну, я самоучка. Вообще я по образованию - бухгалтер. )) Понимаю, что что-то не так, но как та собака - сказать не могу... ))