unit UnitIntegrity;

interface

type TIntegrity = class(TObject)
    private
       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;

        function GetHigh : cardinal;
    public
        function GetLevel(hwnd : THANDLE) : integer;

        function isHigh(hwnd : THandle) : boolean;
        property IL_HIGH : cardinal read GetHigh;
end;


var integrity : TIntegrity;

implementation

uses Windows, SysUtils,  Dialogs, tlhelp32, System.Win.Registry;

{ TIntegrity }


const PROCESS_QUERY_LIMITED_INFORMATION = $1000;

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

type
 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 OpenThread(dwDesiredAccess: dword; bInheritHandle: bool;
                    dwThreadId: dword): dword; stdcall; external 'kernel32.dll';

{ TIntegrity }


function TIntegrity.isHigh(hwnd : THandle) : boolean;
var
    lvl : integer;
begin
    lvl := getLevel(hwnd);
    result := (lvl >=  SECURITY_MANDATORY_HIGH_RID) and
    ( lvl <=  SECURITY_MANDATORY_PROTECTED_PROCESS_RID);
end;

function TIntegrity.GetHigh: cardinal;
begin
    result := SECURITY_MANDATORY_HIGH_RID;
end;

function TIntegrity.GetLevel(hwnd: THANDLE): integer;
var  hToken : THandle;
     hProcess : THandle;
     pid : cardinal;
     pTIL : PTokenMandatoryLabel;
     dwReturnLength: DWORD;
     dwTokenUserLength: DWORD;
     psaCount : PUCHAR;
     SubAuthority : DWORD;

     reg : TRegistry;
const
    ENABLE_LUA =  'EnableLUA';
begin
    result := 0;
    dwReturnLength := 0;
    dwTokenUserLength := 0;
    pTIL := nil;

    if lo(Windows.GetVersion) < 6 then EXIT;
    

    // convert HWND to PID to HProcess to HTOKEN
    GetWindowThreadProcessId(hwnd, @pid);
    hProcess := OpenProcess(PROCESS_QUERY_LIMITED_INFORMATION, false, pid);
    if (hProcess = 0) then begin
        //ShowMessage( SysErrorMessage(GetLastError) );
        EXIT;
    end;

    if not OpenProcessToken(
        hProcess, TOKEN_QUERY or TOKEN_QUERY_SOURCE, hToken
    ) then begin
        //ShowMessage( SysErrorMessage(GetLastError) );
        EXIT;
    end;


    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)^;

                reg := TRegistry.Create;
                reg.RootKey := HKEY_LOCAL_MACHINE;
                if reg.OpenKeyReadOnly('SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\System')
                then begin
                    if  (reg.ValueExists(ENABLE_LUA)) and (reg.ReadInteger(ENABLE_LUA) =  0) then begin
                        result := 0;
                    end;
                end;
                reg.Free;
            end;
            LocalFree(Cardinal(pTIL));
        end;
    end;

   CloseHandle(hToken);
   CloseHandle(hProcess);
end;

begin
    integrity := TIntegrity.create;
end.
