Определить SID текущего пользователя

=== Определить SID текущего пользователя ===
{
(******************************************************************************)
(* SPGetSid - Retrieve the current users 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 accounts SID
 rather than the accounts 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.
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 01733