How to determine the integrity level of current process in Delphi (Windows Vista).

OS : Windows Vista.
Development environment: Delphi 5 and higher.

In Windows Vista applications running with different privilege levels (Integrity Level)
There are four integrity levels available to user-mode processes:
  •  Low
  •  Medium
  •  High
  •  System
We will create a function GetIntegrityLevel() that will determine this level.
If the function succeeds, the return value is the current integrity level (SECURITY_MANDATORY_LOW_RID, SECURITY_MANDATORY_MEDIUM_RID, SECURITY_MANDATORY_HIGH_RID, SECURITY_MANDATORY_SYSTEM_RID)
If the function fails, return value is 0.

Our steps:
  1. Open a handle to the current process's token.
  2. Get the integrity level of the token.
In first call of GetTokenInformation with dwTokenUserLength = 0 we determine size of buffer that will receive the information.

const
  SECURITY_MANDATORY_UNTRUSTED_RID = $00000000;
  SECURITY_MANDATORY_LOW_RID = $00001000;
  SECURITY_MANDATORY_MEDIUM_RID = $00002000;
  SECURITY_MANDATORY_HIGH_RID = $00003000;
  SECURITY_MANDATORY_SYSTEM_RID = $00004000;
  SECURITY_MANDATORY_PROTECTED_PROCESS_RID = $00005000;

type
  PTokenMandatoryLabel = ^TTokenMandatoryLabel;
  TTokenMandatoryLabel = packed record
   Label_ : TSidAndAttributes;
  end;

type
 //Extend existing enumeration in Windows.pas with new Vista constants
TTokenInformationClass = (TokenICPad, TokenUser, TokenGroups, TokenPrivileges, TokenOwner, TokenPrimaryGroup, TokenDefaultDacl, TokenSource, TokenType, TokenImpersonationLevel, TokenStatistics, TokenRestrictedSids, TokenSessionId, TokenGroupsAndPrivileges, TokenSessionReference, TokenSandBoxInert, TokenAuditPolicy, TokenOrigin, TokenElevationType, TokenLinkedToken, TokenElevation, TokenHasRestrictions, TokenAccessInformation, TokenVirtualizationAllowed, TokenVirtualizationEnabled, TokenIntegrityLevel, TokenUIAccess, TokenMandatoryPolicy, TokenLogonSid);

function GetIntegrityLevel() : DWORD;
var hProcess, hToken : THandle;
    pTIL : PTokenMandatoryLabel;
    dwReturnLength: DWORD;
    dwTokenUserLength: DWORD;
    psaCount : PUCHAR;
    SubAuthority : DWORD;
begin
 Result := 0;
 dwReturnLength := 0;
 dwTokenUserLength := 0;
 pTIL := nil;

  hProcess := GetCurrentProcess();
  OpenProcessToken(hProcess, TOKEN_QUERY or TOKEN_QUERY_SOURCE, hToken);
  if hToken = 0 then Exit;
   if not GetTokenInformation(hToken, Windows.TTokenInformationClass(TokenIntegrityLevel),
                                    pTIL, dwTokenUserLength, dwReturnLength) then
     begin
      if GetLastError = ERROR_INSUFFICIENT_BUFFER then
       Begin
        pTIL := Pointer(LocalAlloc(0, dwReturnLength));
         if pTIL = nil then Exit;
        dwTokenUserLength := dwReturnLength;
        dwReturnLength := 0;

        if GetTokenInformation(hToken, Windows.TTokenInformationClass(TokenIntegrityLevel),
                                    pTIL, dwTokenUserLength, dwReturnLength) and
           IsValidSid( (pTIL.Label_).Sid ) then
            begin
             psaCount := GetSidSubAuthorityCount((pTIL.Label_).Sid );
             SubAuthority := psaCount^;
             SubAuthority := SubAuthority - 1;
             Result := GetSidSubAuthority((pTIL.Label_).Sid, SubAuthority)^;
            end;
           LocalFree(Cardinal(pTIL));
       End;
     end;

  CloseHandle(hToken);
end;

Usage:

procedure TForm1.Button1Click(Sender: TObject);
var dwRes : DWORD;
begin
 dwRes := GetIntegrityLevel();
 if dwRes > 0 then
  case dwRes of
    SECURITY_MANDATORY_LOW_RID : Memo1.Lines.Add('Low Integrity level');
    SECURITY_MANDATORY_MEDIUM_RID : Memo1.Lines.Add('Medium Integrity level');
    SECURITY_MANDATORY_HIGH_RID : Memo1.Lines.Add('High Integrity level');
    SECURITY_MANDATORY_SYSTEM_RID : Memo1.Lines.Add('System Integrity level');
  end;
end;