Delphi World - Определить SID текущего пользователя
Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Определить SID текущего пользователя

Оформил: DeeCo
Автор: http://www.swissdelphicenter.ch

(******************************************************************************)
 (* SPGetSid - Retrieve the current user''s SID in text format                  *)
 (*                                                                            *)
 (* Copyright (c) 2004 Shorter Path Software                                   *)
 (* http://www.shorterpath.com                                                 *) 
(******************************************************************************)


 { 
  SID is a data structure of variable length that identifies user, group, 
  and computer accounts. 
  Every account on a network is issued a unique SID when the account is first created. 
  Internal processes in Windows refer to an account''s SID 
  rather than the account''s user or group name. 
}


 unit SPGetSid;

 interface

 uses
   Windows, SysUtils;

 function GetCurrentUserSid: string;

 implementation

 const
   HEAP_ZERO_MEMORY = $00000008;
   SID_REVISION     = 1; // Current revision level 

type
   PTokenUser = ^TTokenUser;
   TTokenUser = packed record
     User: TSidAndAttributes;
   end;

 function ConvertSid(Sid: PSID; pszSidText: PChar; var dwBufferLen: DWORD): BOOL;
 var
   psia: PSIDIdentifierAuthority;
   dwSubAuthorities: DWORD;
   dwSidRev: DWORD;
   dwCounter: DWORD;
   dwSidSize: DWORD;
 begin
   Result := False;

   dwSidRev := SID_REVISION;

   if not IsValidSid(Sid) then Exit;

   psia := GetSidIdentifierAuthority(Sid);

   dwSubAuthorities := GetSidSubAuthorityCount(Sid)^;

   dwSidSize := (15 + 12 + (12 * dwSubAuthorities) + 1) * SizeOf(Char);

   if (dwBufferLen < dwSidSize) then
   begin
     dwBufferLen := dwSidSize;
     SetLastError(ERROR_INSUFFICIENT_BUFFER);
     Exit;
   end;

   StrFmt(pszSidText, 'S-%u-', [dwSidRev]);

   if (psia.Value[0] <> 0) or (psia.Value[1] <> 0) then
     StrFmt(pszSidText + StrLen(pszSidText),
       '0x%.2x%.2x%.2x%.2x%.2x%.2x',
       [psia.Value[0], psia.Value[1], psia.Value[2],
       psia.Value[3], psia.Value[4], psia.Value[5]])
   else
     StrFmt(pszSidText + StrLen(pszSidText),
       '%u',
       [DWORD(psia.Value[5]) +
       DWORD(psia.Value[4] shl 8) +
       DWORD(psia.Value[3] shl 16) +
       DWORD(psia.Value[2] shl 24)]);

   dwSidSize := StrLen(pszSidText);

   for dwCounter := 0 to dwSubAuthorities - 1 do
   begin
     StrFmt(pszSidText + dwSidSize, '-%u',
       [GetSidSubAuthority(Sid, dwCounter)^]);
     dwSidSize := StrLen(pszSidText);
   end;

   Result := True;
 end;

 function ObtainTextSid(hToken: THandle; pszSid: PChar;
   var dwBufferLen: DWORD): BOOL;
 var
   dwReturnLength: DWORD;
   dwTokenUserLength: DWORD;
   tic: TTokenInformationClass;
   ptu: Pointer;
 begin
   Result := False;
   dwReturnLength := 0;
   dwTokenUserLength := 0;
   tic := TokenUser;
   ptu := nil;

   if not GetTokenInformation(hToken, tic, ptu, dwTokenUserLength,
     dwReturnLength) then
   begin
     if GetLastError = ERROR_INSUFFICIENT_BUFFER then
     begin
       ptu := HeapAlloc(GetProcessHeap, HEAP_ZERO_MEMORY, dwReturnLength);
       if ptu = nil then Exit;
       dwTokenUserLength := dwReturnLength;
       dwReturnLength    := 0;

       if not GetTokenInformation(hToken, tic, ptu, dwTokenUserLength,
         dwReturnLength) then Exit;
     end
      else
        Exit;
   end;

   if not ConvertSid((PTokenUser(ptu).User).Sid, pszSid, dwBufferLen) then Exit;

   if not HeapFree(GetProcessHeap, 0, ptu) then Exit;

   Result := True;
 end;

 function GetCurrentUserSid: string;
 var
   hAccessToken: THandle;
   bSuccess: BOOL;
   dwBufferLen: DWORD;
   szSid: array[0..260] of Char;
 begin
   Result := '';

   bSuccess := OpenThreadToken(GetCurrentThread, TOKEN_QUERY, True,
     hAccessToken);
   if not bSuccess then
   begin
     if GetLastError = ERROR_NO_TOKEN then
       bSuccess := OpenProcessToken(GetCurrentProcess, TOKEN_QUERY,
         hAccessToken);
   end;
   if bSuccess then
   begin
     ZeroMemory(@szSid, SizeOf(szSid));
     dwBufferLen := SizeOf(szSid);

     if ObtainTextSid(hAccessToken, szSid, dwBufferLen) then
       Result := szSid;
     CloseHandle(hAccessToken);
   end;
 end;

 end.
Проект Delphi World © Выпуск 2002 - 2017
Автор проекта: Эксклюзивные курсы программирования