Delphi LDAP对象管理（用户登录认证、组、组织）

unit login;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics,
Controls, Forms, uniGUITypes, uniGUIAbstractClasses,
uniGUIClasses, uniGUIRegClasses, uniGUIForm, uniButton, uniGUIBaseClasses,
uniEdit, REST.Types, uniMemo, REST.Client, Data.Bind.Components,
Data.Bind.ObjectScope, system.json, system.Hash, uniImage, uniPanel,
Vcl.Imaging.pngimage, uniImageList, ActiveDs_TLB, ActiveX, system.Win.ComObj,
uniMainMenu;

type
TUniLoginForm1 = class(TUniLoginForm)
UserID: TUniEdit;
Password: TUniEdit;
UniButton1: TUniButton;
UniContainerPanel2: TUniContainerPanel;
UniImage1: TUniImage;
UniImageList1: TUniImageList;
procedure UniButton1Click(Sender: TObject);
procedure UniLoginFormReady(Sender: TObject);
procedure LoginADInfo(aUser, aPass, aDomainPath: WideString);
procedure PasswordKeyPress(Sender: TObject; var Key: Char);
private
{ Private declarations }
procedure LDAPLogin;
public
{ Public declarations }
end;

// 缺省条件下，ADsGetObject函数根据当前用户进行安全认证。
function ADsGetObject(lpszPathName: PWideChar; // 第一个参数是对象的路径名
const riid: TIID; // 第二个参数是对象的接口标识符
out obj): HResult; stdcall; external 'activeds.dll'; // 第三个参数用于返回得到的被请求的接口指针

// ADsOpenObject 函数在不同的安全认证机制下绑定 ADSI 对象，
// 它主要是通过调用参数返回的用户名和口令来认证的
function ADsOpenObject(lpszPathName: PWideChar; // 第一个参数是对象的路径名
lpszUserName: PWideChar; // 第二个参数是调用者提供的用户名
lpszPassword: PWideChar; // 第三个参数是调用者提供的口令
dwReserved: LongInt; // 第四个参数是一个保留的 provider 标识，用来确定绑定的认证方法
const riid: TIID; // 第五个参数是请求接口的接口标识符，
out obj): HResult; stdcall; external 'activeds.dll'; // 最后一个参数用来返回请求的接口指针。
function UniLoginForm1: TUniLoginForm1;

implementation

{$R *.dfm}

uses
uniGUIVars, MainModule, uniGUIApplication, Main;

function UniLoginForm1: TUniLoginForm1;
begin
Result := TUniLoginForm1(UniMainModule.GetFormInstance(TUniLoginForm1));
end;

procedure TUniLoginForm1.UniButton1Click(Sender: TObject);
begin
LDAPLogin;
end;

procedure TUniLoginForm1.LDAPLogin;
var
DomainPath, ADUser, ADPass: WideString;
begin
DomainPath := 'LDAP://192.168.162.250/DC=ttri,DC=com'; // LDAP访问AD的路径。
ADUser := UserID.Text + '@ttri.com'; // 注意用户名称的写法：域名称 + 用户名称 或 User@domain.com
// ADUser:='OAWebUser@Hebmc.com'; //注意用户名称的写法：域名称 + 用户名称 或 User@domain.com
ADPass := Password.Text; // 用户密码。
LoginADInfo(ADUser, ADPass, DomainPath);

end;

procedure TUniLoginForm1.LoginADInfo(aUser, aPass, aDomainPath: WideString);
var
UnknownObject: IUnknown;
Enum: IEnumVariant;
ADsTempObj: OLEVariant;
Domain: IADsContainer;
Container: IADsContainer;
ADsObj: IADs;
Value: LongWord;
userpath: string;
User: IADsUser;
grp: IAdsGroup;
grps: IAdsMembers;
varGroup: OLEVariant;
Temp: LongWord;
sGroupType: string;

begin
OleCheck(ADsOpenObject(PWideChar(aDomainPath), PWideChar(aUser),
PWideChar(aPass), 0, IID_IADsContainer, UnknownObject));

// 设定域对象
Domain := UnknownObject as IADsContainer;

// 获取枚举对象，并赋值给 Enum 变量
Enum := (Domain._NewEnum) as IEnumVariant;

// 利用枚举对象查找，把每个子对象赋值给临时的 OLEVariant 对象
while (Enum.Next(1, ADsTempObj, Value) = S_OK) do
begin
ADsObj := IUnknown(ADsTempObj) as IADs; // 获得临时对象：OLEVariant 变量赋值给 ADSI 对象

if ADsObj.Class_ = 'user' then
// 如果是用户对象  displayName    sAMAccountName  objectSID
begin
  if ADsObj.Get('sAMAccountName') = UserID.Text then
  begin
    userpath := ADsObj.ADsPath;
    MainForm.UniPanel3.Caption := ADsObj.Get('cn');
    user_id:=ADsObj.Get('sAMAccountName');
    ADsGetObject(PWideChar(userpath), IADsUser, User);
    // User.GetInfo;
    grps := User.Groups;
    Enum := grps._NewEnum as IEnumVariant;
    if Enum <> nil then
      group := TStringList.Create;

    begin
      while (Enum.Next(1, varGroup, Temp) = S_OK) do
      begin
        grp := IDispatch(varGroup) as IAdsGroup;
        group.Add(grp.Get('cn'));
        //MainForm.UniTreeView1.Items.Add(nil, grp.Get('cn'));
      end;
    end;
  end;
end;
LoginADInfo(aUser, aPass, ADsObj.ADsPath);
ADsTempObj := Null; // 释放OLEVariant
varGroup := Null;
ModalResult := mrOK;

end;
end;

procedure TUniLoginForm1.PasswordKeyPress(Sender: TObject; var Key: Char);
begin
if key = #13 then
begin
UniButton1Click(sender);
end;
end;

procedure TUniLoginForm1.UniLoginFormReady(Sender: TObject);
begin
with UserID, JSInterface do
begin
JSCall('inputWrap.addCls', ['fa fa-user icon-textfield']);
JSCall('inputEl.setWidth', [Width - 2]);
end;
with Password, JSInterface do
begin
JSCall('inputWrap.addCls', ['fa fa-key icon icon-textfield']);
JSCall('inputEl.setWidth', [Width - 2]);
end;

end;

initialization

RegisterAppFormClass(TUniLoginForm1);

end.