Consultar grupos de distribuição do Active Directory

A classe ADSI, implementada aqui, faz isso.

Abaixo está o código traduzido.

unit ADSI;

interface

uses
  SysUtils, Classes, ActiveX, Windows, ComCtrls, ExtCtrls, ActiveDs_TLB,
  adshlp, oleserver, Variants;

type
  TSenha = record
    Expirada: boolean;
    NuncaExpira: boolean;
    NaoMuda: boolean;
end;

type
  TADSIUserInfo = record
    UID: string;
    Usuario: string;
    Descricao: string;
    Senha: TPassword;
    Desabilitado: boolean;
    Travado: boolean;
    Grupos: string; //CSV
end;

type
  TADSI = class(TComponent)

  private
    FUsuario:  string;
    FSenha:  string;
    FUsuarioAtual: string;
    FDominioAtual: string;

    function ObterUsuarioAtual: string;
    function ObterDominioAtual: string;


  protected
    { Protected declarations }
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    property UsuarioAtual: string read FUsuarioAtual;
    property DominioAtual: string read FDominioAtual;

    function ObterUsuario(Dominio, Usuario: string; var ADSIUser: TADSIUserInfo): boolean;
    function Autenticar(Dominio, Usuario, Grupo: string): boolean;

  published
    property LoginUsuario: string read FUsuario write FUsuario ;
    property LoginSenha: string read FSenha write FSenha;
  end;

procedure Registrar;

implementation


function ContainsValComma(s1,s: string): boolean; 
var 
  sub,str: string; 
begin 
  Result:=false; 
  if (s='') or (s1='') then exit; 
  if SameText(s1,s) then begin 
    Result:=true; 
    exit; 
  end; 
  sub:=','+lowercase(trim(s1))+','; str:=','+lowercase(trim(s))+','; 
  Result:=(pos(sub, str)>0); 
end;

procedure Registrar;
begin
  RegisterComponents('ADSI', [TADSI]);
end;

constructor TADSI.Create(AOwner: TComponent);
begin
   inherited Create(AOwner);

   FUsuarioAtual := ObterUsuarioAtual;
   FDominioAtual := ObterDominioAtual;
   FUsuario := '';
   FSenha := '';
end;

destructor TADSI.Destroy;
begin

   inherited Destroy;
end;

function TADSI.ObterUsuarioAtual : string;
const
  cnMaxUserNameLen = 254;
var
  sUserName     : string;
  dwUserNameLen : DWord;
begin
  dwUserNameLen := cnMaxUserNameLen-1;
  SetLength(sUserName, cnMaxUserNameLen );
  GetUserName(PChar(sUserName), dwUserNameLen );
  SetLength(sUserName, dwUserNameLen);
  Result := sUserName;
end;

function TADSI.ObterDominioAtual: string;
const
  DNLEN = 255;
var
  sid               : PSID;
  sidSize           : DWORD;
  sidNameUse        : DWORD;
  domainNameSize    : DWORD; 
  domainName        : array[0..DNLEN] of char;

begin
  sidSize := 65536; 
  GetMem(sid, sidSize); 
  domainNameSize := DNLEN + 1;
  sidNameUse := SidTypeUser;
  try
     if LookupAccountName(nil, PChar(FCurrentUser), sid, sidSize,
        domainName, domainNameSize, sidNameUse) then
         Result:=StrPas(domainName);
  finally
    FreeMem(sid);
  end;
end;

function TADSI.Autenticar(Dominio, Usuario, Grupo: string): boolean;
var
  aUser: TADSIUserInfo;
begin
  Result:=false;
  if ObterUsuario(Dominio, Usuario,aUser) then begin
     if not aUser.Desabilitado and not aUser.Travado then begin
        if Group='' then
           Result:=true
        else
           Result:=ContainsValComma(Grupo, aUser.Grupos);
     end;
  end;
end;

function TADSI.ObterUsuario(Dominio, Usuario: string; var ADSIUser: TADSIUserInfo): boolean;
var
  usr   :    IAdsUser;
  flags :    integer;
  Enum  :    IEnumVariant;
  grps  :    IAdsMembers;
  grp   :    IAdsGroup;
  varGroup : OleVariant;
  Temp :     LongWord;
  dom1, uid1: string;

  //ui: TADSIUserInfo;

begin
  ADSIUser.UID:='';
  ADSIUser.Usuario:='';
  ADSIUser.Descricao:='';
  ADSIUser.Desabilitado:=true;
  ADSIUser.Travado:=true;
  ADSIUser.Grupos:='';
  Result:=false;

  if Usuario='' then
     uid1:=FUsuarioAtual
  else
     uid1:=Usuario;

  if Domain='' then
     dom1:=FDominioAtual
  else
     dom1:=Dominio;

  if uid1='' then exit;
  if dom1='' then exit;

  try
     if trim(FUsuario)<>'' then
        ADsOpenObject('WinNT://' + dom1 + '/' + uid1, FUsuario, FSenha, 1, IADsUser, usr)
     else
        ADsGetObject('WinNT://' + dom1 + '/' + uid1, IADsUser, usr);

     if usr=nil then exit;

     ADSIUser.UID:= Usuario;
     ADSIUser.Usuario := usr.FullName;
     ADSIUser.Descricao := usr.Description;
     flags := usr.Get('userFlags');
     ADSIUser.Senha.Expirada := usr.Get('PasswordExpired');
     ADSIUser.Senha.NaoMuda := (flags AND ADS_UF_PASSWD_CANT_CHANGE)<>0;
     ADSIUser.Senha.NuncaExpira := (flags and ADS_UF_DONT_EXPIRE_PASSWD)<>0;
     ADSIUser.Desabilitado := usr.AccountDisabled;
     ADSIUser.Travado := usr.IsAccountLocked;

     ADSIUser.Grupos:='';
     grps := usr.Groups;
     Enum := grps._NewEnum as IEnumVariant;
     if Enum <> nil then begin
       while (Enum.Next(1,varGroup, Temp) = S_OK) do begin
         grp := IDispatch(varGroup) as IAdsGroup;
         //sGroupType := GetGroupType(grp);
         if ADSIUser.Grupos<>'' then ADSIUser.Grupos:=ADSIUser.Grupos+',';
         ADSIUser.Grupos:=ADSIUser.Grupos+grp.Name;
         VariantClear(varGroup);
       end;
     end;
     usr:=nil;
     Result:=true;
  except
     on e: exception do begin
        Result:=false;
        exit;
     end;
  end;
end;

end.