{
(******************************************************************************)
 (* SPGetSid - Retrieve the current user''s SID in text format *)
 (* *)
 (* Copyright (c) 2004 Shorter Path Software *)
 (* <a href="http://www.shorterpath.com" title="http://www.shorterpath.com">http://www.shorterpath.com</a> *)
(******************************************************************************)

 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.