{ The contents of this file are subject to the Mozilla Public License  }
{ Version 1.1 (the "License"); you may not use this file except in     }
{ compliance with the License. You may obtain a copy of the License at }
{ http://www.mozilla.org/MPL/                                          }
{                                                                      }
{ Software distributed under the License is distributed on an "AS IS"  }
{ basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See  }
{ the License for the specific language governing rights and           }
{ limitations under the License.                                       }
{                                                                      }
{ The Original Code is UserGroups.pas.                                 }
{                                                                      }
{ The Initial Developer of the Original Code is Ashley Godfrey, all    }
{ Portions created by these individuals are Copyright (C) of Ashley    }
{ Godfrey.                                                             }
{                                                                      }
{**********************************************************************}
{                                                                      }
{ This unit accesses the list of groups assigned to a particular user  }
{ on listed within either a specific or first available domain.        }
{                                                                      }
{ Unit owner: Ashley Godfrey.                                          }
{ Last modified: April 27, 2004.                                       }
{ Updates available from http://www.evocorp.com                        }
{                                                                      }
{**********************************************************************}

{**********************************************************************}
{ THIS UNIT WILL ONLY WORK ON NT-BASED OPERATING SYSTEMS, FOR EXAMPLE  }
{ WINDOWS NT CLIENT, WINDOWS 2000, WINDOWS XP.                         }
{**********************************************************************}

unit UserGroups;
interface
uses
  SysUtils, Windows, Classes;

type
  // TGroupType defines a specific set of group information
  // that you want to obtain information for (in this case,
  // local, global or using TGroupTypes, both).
  TGroupType = (gtGlobal, gtLocal);
  TGroupTypes = set of TGroupType;

// The functions contained within this unit are defined as:
//
//   GetDomainController:
//   Returns the domain controller trusted by the current machine.
//
//   GetPrimaryDomainControllers:
//   Returns a complete list of primary domain controllers for the
//   current user's domain login. Therefore a user MUST be logged
//   onto a domain controller (and NOT the local machine) for this call
//   to work.
//
//   GetUserGroups(Groups: TStrings);
//   Returns the complete list of groups found for the current user
//   within the primary domain controller as defined by a call to
//   GetDomainController.
//
//   GetUserGroups(const UserName: WideString; Groups: TStrings);
//   Returns the complete list of groups found for user "UserName"
//   within the primary domain controller as defined by a call
//   to GetDomainController.
//
//   GetUserGroups(const PDC, UserName: WideString; Groups: TStrings);
//   Returns the complete list of groups found for user "UserName"
//   as defined on the primary domain controller machine "PDC".
//
//   IsUserInGroup(const GroupName: WideString): Boolean;
//   Identifies whether the current user within the first primary domain
//   controller as defined by a call to GetPrimaryDomainControllers exists
//   within group "GroupName".
//
//   IsUserInGroup(const UserName, GroupName: WideString): Boolean;
//   Identifies whether the user "UserName" within the first primary domain
//   controller as defined by a call to GetPrimaryDomainControllers exists
//   within group "GroupName".
//
//   IsUserInGroup(const PDC, UserName, GroupName: WideString): Boolean;
//   Identifies whether the user "UserName" within primary domain controller
//   "PDC" exists within group "GroupName".

function GetDomainController: string;
procedure GetPrimaryDomainControllers(Controllers: TStrings);
procedure GetUserGroups(Groups: TStrings; GroupTypes: TGroupTypes); overload;
procedure GetUserGroups(const UserName: WideString;
  Groups: TStrings; GroupTypes: TGroupTypes); overload;
procedure GetUserGroups(const PDC, UserName: WideString;
  Groups: TStrings; GroupTypes: TGroupTypes); overload;
function IsUserInGroup(const GroupName: WideString;
  GroupTypes: TGroupTypes): Boolean; overload;
function IsUserInGroup(const UserName, GroupName: WideString;
  GroupTypes: TGroupTypes): Boolean; overload;
function IsUserInGroup(const PDC, UserName, GroupName: WideString;
  GroupTypes: TGroupTypes): Boolean; overload;

implementation

const
  netapi32lib = 'netapi32.dll';

  SV_TYPE_DOMAIN_CTRL = $00000008;
  MAX_PREFERRED_LENGTH = DWORD(-1);
  NERR_Success = 0;

  sNetNoGroups = 'None';

type
  ESecurity = class(Exception);

  PServerInfo101 = ^TServerInfo101;
  _SERVER_INFO_101 = record
    sv101_platform_id: DWORD;
    sv101_name: LPWSTR;
    sv101_version_major: DWORD;
    sv101_version_minor: DWORD;
    sv101_type: DWORD;
    sv101_comment: LPWSTR;
  end;
  TServerInfo101 = _SERVER_INFO_101;

  PGroupUsersInfo0 = ^TGroupUsersInfo0;
  _GROUP_USERS_INFO_0 = record
    grui0_name: LPWSTR;
  end;
  TGroupUsersInfo0 = _GROUP_USERS_INFO_0;

  PLocalGroupUserInfo0 = ^TLocalGroupUserInfo0;
  _LOCALGROUP_USERS_INFO_0 = record
    lgrui0_name: LPWSTR;
  end;
  TLocalGroupUserInfo0 = _LOCALGROUP_USERS_INFO_0;

function NetApiBufferFree(Buffer: Pointer): DWORD; stdcall;
  external netapi32lib name 'NetApiBufferFree';

function NetGetAnyDCName(ServerName: LPCWSTR; DomainName: LPCWSTR;
  var bufptr: pointer): DWORD; stdcall;
  external netapi32lib name 'NetGetAnyDCName';

function NetServerEnum(servername: LPCWSTR; level: DWORD; var bufptr: Pointer;
  prefmaxlen: DWORD; var entriesread: DWORD; var totalentries: DWORD;
  servertype: DWORD; domain: LPCWSTR; resume_handle: PDWORD): DWORD; stdcall;
  external netapi32lib name 'NetServerEnum';

function NetUserGetGroups(servername: LPCWSTR; username: LPCWSTR; level: DWORD;
  var bufptr: Pointer; prefmaxlen: DWORD; var entriesread: DWORD;
  var totalentries: DWORD): DWORD; stdcall;
  external netapi32lib name 'NetUserGetGroups';

function NetUserGetLocalGroups(servername: LPCWSTR; username: LPCWSTR;
  level: DWORD; flags: DWORD; var bufptr: Pointer; prefmaxlen: DWORD;
  var entriesread: DWORD; var totalentries: DWORD): DWORD; stdcall;
  external netapi32lib name 'NetUserGetLocalGroups';

function GetDomainController: string;
var BufPtr: pointer;
begin
  if NetGetAnyDCName(nil, nil, BufPtr) <> NERR_Success then
    Result := ''
  else try
    Result := pWideChar(BufPtr);
  finally
    NetApiBufferFree(BufPtr);
  end;
end;

procedure GetPrimaryDomainControllers(Controllers: TStrings);
var dwEntriesRead: DWORD;
    i, dwTotalEntries: DWORD;
    dwResumeHandle: DWORD;
    p: pointer;
    Buffer: PServerInfo101;
begin
  if NetServerEnum(nil, 101, p, DWORD(-1), dwEntriesRead,
    dwTotalEntries, SV_TYPE_DOMAIN_CTRL, nil, @dwResumeHandle) = 0 then
  try
    Buffer := p;
    for i := 0 to dwEntriesRead - 1 do
    begin
      Controllers.Add(Buffer^.sv101_name);
      Inc(Buffer);
    end;
  finally
    NetApiBufferFree(p);
  end;
end;

function GetCurrentUserName: string;
var lpBuffer: array of char;
    dwBufferSize: DWORD;
begin
  dwBufferSize := 0;
  Windows.GetUserName(@lpBuffer, dwBufferSize);
  if dwBufferSize = 0 then
    raise ESecurity.Create('Unable to determine user name for current user.');
  SetLength(lpBuffer, dwBufferSize);
  Windows.GetUserName(@lpBuffer[0], dwBufferSize);
  Result := pChar(@lpBuffer[0]);
end;

procedure GetUserGroups(const UserName: WideString; Groups: TStrings;
  GroupTypes: TGroupTypes);
begin
  GetUserGroups(GetDomainController, UserName, Groups, GroupTypes);
end;

procedure GetUserGroups(Groups: TStrings; GroupTypes: TGroupTypes);
begin
  GetUserGroups(GetDomainController,
    WideString(GetCurrentUserName), Groups, GroupTypes);
end;

procedure GetUserGroups(const PDC, UserName: WideString;
  Groups: TStrings; GroupTypes: TGroupTypes);
var Buffer: pointer;
    dwEntriesRead: DWORD;
    i, dwTotalEntries: DWORD;
    GroupInfo: PGroupUsersInfo0;
    LocalInfo: PLocalGroupUserInfo0;
begin
  if Assigned(Groups) then
  begin
    Groups.Clear;
    if gtGlobal in GroupTypes then
      if NetUserGetGroups(pWideChar(PDC), pWideChar(UserName), 0, Buffer,
          MAX_PREFERRED_LENGTH, dwEntriesRead, dwTotalEntries) = NERR_Success then
      try
        GroupInfo := Buffer;
        if (dwEntriesRead > 0) or (GroupInfo^.grui0_name <> sNetNoGroups) then
          for i := 0 to dwEntriesRead - 1 do
          begin
            Groups.Add(GroupInfo^.grui0_name);
            Inc(GroupInfo);
          end;
      finally
        NetApiBufferFree(Buffer);
      end;

    if gtLocal in GroupTypes then
      if NetUserGetLocalGroups(pWideChar(PDC), pWideChar(UserName), 0, 0,
           Buffer, MAX_PREFERRED_LENGTH, dwEntriesRead, dwTotalEntries) = NERR_Success then
      try
        LocalInfo := Buffer;
        if dwEntriesRead > 0 then
          for i := 0 to dwEntriesRead - 1 do
          begin
            Groups.Add(LocalInfo^.lgrui0_name);
            Inc(LocalInfo);
          end;
      finally
        NetApiBufferFree(Buffer);
      end;
  end;
end;

function IsUserInGroup(
  const GroupName: WideString; GroupTypes: TGroupTypes): Boolean;
begin
  Result := IsUserInGroup(GetDomainController,
    WideString(GetCurrentUserName), GroupName, GroupTypes);
end;

function IsUserInGroup(const UserName, GroupName: WideString;
  GroupTypes: TGroupTypes): Boolean;
begin
  Result := IsUserInGroup(GetDomainController,
    UserName, GroupName, GroupTypes);
end;

function IsUserInGroup(const PDC, UserName, GroupName: WideString;
  GroupTypes: TGroupTypes): Boolean;
var Groups: TStringList;
    i: Integer;
begin
  Result := True;
  Groups := TStringList.Create;
  try
    GetUserGroups(PDC, UserName, Groups, GroupTypes);
    if Groups.Count > 0 then
      for i := 0 to Groups.Count - 1 do
        if WideCompareText(WideString(Groups[i]), GroupName) = 0 then
          Exit;
    Result := False;
  finally
    Groups.Free;
  end;
end;

end.