powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Windows XP - 2019 Получить Username и его группы
3 сообщений из 3, страница 1 из 1
Windows XP - 2019 Получить Username и его группы
    #39847467
yemets63
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
всем привет,

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

возможно пора уже по пивасику, но хочется доделать,
очень благодарен
...
Рейтинг: 0 / 0
Windows XP - 2019 Получить Username и его группы
    #39847468
Мимопроходящий
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
юзера легко.
а группы, тут думать надо.
лень.
Posted via ActualForum NNTP Server 1.5
...
Рейтинг: 0 / 0
Windows XP - 2019 Получить Username и его группы
    #39847512
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
yemets63,

Для локальных групп все просто
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
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;


для доменных сложнее
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
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;

...
Рейтинг: 0 / 0
3 сообщений из 3, страница 1 из 1
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Windows XP - 2019 Получить Username и его группы
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]