Windows XP - 2019 Получить Username и его группы

yemets63
Дата: 09.08.2019 13:43:22
всем привет,

я сам такое делал, и не могу найти и не получается сделать.
без чтения из реестра, как получить функциями Delphi, пусть компоненты Delphi сами считывают, Имя текущего пользователя Windows под которым был вход, и какие ему назначены группы.

возможно пора уже по пивасику, но хочется доделать,
очень благодарен
Мимопроходящий
Дата: 09.08.2019 13:44:39

юзера легко.
а группы, тут думать надо.
лень.

Posted via ActualForum NNTP Server 1.5

_Vasilisk_
Дата: 09.08.2019 14:49:13
yemets63,

Для локальных групп все просто
+
class function TUserInfo.GetCurrentUserSID: PSID;
var
  LToken: THandle;
begin
  Win32Check(OpenProcessToken(GetCurrentProcess, TOKEN_QUERY, LToken));
  try
    Result := CreateUserSID(LToken);
  finally
    CloseHandle(LToken);
  end;
end;

class procedure TUserInfo.GetUserName(ASID: PSID; out ADomain, AUser: string);
var
  LError: Cardinal;
  LUserLen: Cardinal;
  LDomainLen: Cardinal;
  LUse: SID_NAME_USE;
begin
  LUserLen := 0;
  LDomainLen := 0;
  LookupAccountSid(nil, ASID, nil, LUserLen, nil, LDomainLen, LUse);
  LError := GetLastError;
  if LError <> ERROR_INSUFFICIENT_BUFFER then
    RaiseLastOSError(LError);
  if LUserLen > 0 then begin
    SetLength(AUser, LUserLen - 1);
    SetLength(ADomain, LDomainLen - 1);
    Win32Check(LookupAccountSid(nil, ASID, PChar(AUser), LUserLen, PChar(ADomain), LDomainLen, LUse));
  end else begin
    ADomain := '';
    AUser := SIDToString(ASID);
  end;
end;

function TUserInfo.GetFullQualifiedUserName: string;
begin
  Result := GetFullQualifiedUserName(SID);
end;

class function TUserInfo.GetFullQualifiedUserName(ASID: PSID): string;
var
  LDomain, LUser: string;
begin
  GetUserName(ASID, LDomain, LUser);
  Result := LDomain + '\' + LUser;
end;

function TUserInfo.GetLocalGroups: TArray<string>;
var
  LErr: NET_API_STATUS;
  LBuf: PByte;
  LCurBuf: PLOCALGROUP_USERS_INFO_0;
  LRead, LTotal: Cardinal;
  Li: Cardinal;
begin
  LErr := NetUserGetLocalGroups(
    nil, PChar(GetFullQualifiedUserName),
    0,
    LG_INCLUDE_INDIRECT,
    LBuf,
    MAX_PREFERRED_LENGTH,
    @LRead,
    @LTotal
  );
  if LErr <> ERROR_SUCCESS then
    RaiseLastOSError(LErr);
  try
    SetLength(Result, LRead);
    if LRead <> 0 then begin
      LCurBuf := PLOCALGROUP_USERS_INFO_0(LBuf);
      for Li := 0 to LRead - 1 do begin
        Result[Li] := LCurBuf^.lgrui0_name;
        Inc(LCurBuf);
      end;
    end;
  finally
    NetApiBufferFree(LBuf);
  end;
end;

для доменных сложнее
+
class procedure TUserInfo.FillMembers(const AMembers: IADsMembers;
  const AList: TList<IADsGroup>);
var
  LEnum: IEnumVARIANT2;
  LGroup: IADsGroup;
  LVar: OleVariant;
  LFetched: Cardinal;
begin
  LEnum := AMembers._NewEnum as IEnumVARIANT2;
  while LEnum.Next(1, LVar, LFetched) = S_OK do begin
    if rsVarSupports(LVar, IID_IADsGroup, LGroup) then begin
      AList.Add(LGroup);
      FillMembers(LGroup.Members, AList);
    end;
  end;
end;

function TUserInfo.GetADsUser: IADsUser;
begin
  if FADsUser = nil then begin
    OleCheck(ADsGetObject(
      PChar(Format('LDAP://<SID=%s>', [SIDStr])),
      IID_IADsUser,
      FADsUser
    ));
    FADsUser.GetInfo;
  end;
  Result := FADsUser;
end;

procedure TUserInfo.FillGlobalGroups(const AList: TList<IADsGroup>);
begin
  FillMembers(ADsUser.Groups, AList);
end;

function TUserInfo.GetGlobalGroupNames: TArray<string>;
var
  LGroups: TList<IADsGroup>;
  Li: Integer;
begin
  LGroups := TList<IADsGroup>.Create;
  try
    FillGlobalGroups(LGroups);
    SetLength(Result, LGroups.Count);
    for Li := 0 to LGroups.Count - 1 do
      Result[Li] := LGroups[Li].Get(CDistinguishedNameAttr);
  finally
    LGroups.Free;
  end;
end;