////////////////////////////////////////////////////////////////////////////////
// Copyright (c) 2001-2026 Alexey Kuryakin daqgroup@mail.ru under MIT license //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// This file is part of the CRW-DAQ project by DaqGroup - component CRWLIB.   //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// Purpose:                                                                   //
// User access control routines (usually known as UAC). Windows only.         //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// History:                                                                   //
// 20170130 - Creation                                                        //
// 20170203 - First release                                                   //
// 20180619 - StrictUacCheck                                                  //
// 20230812 - Modified for FPC (A.K.)                                         //
////////////////////////////////////////////////////////////////////////////////

unit _crw_uac; // User Access Control

{$I _crw_sysdef.inc}

{$I _crw_sysmode.inc}

{$WARN 5023 off : Unit "$1" not used in $2}

interface

uses
 //////////////////////////////////////////////////////
 {$I _crw_uses_first.inc} // NB: MUST BE FIRST USES !!!
 //////////////////////////////////////////////////////
 {$IFDEF WINDOWS} messages, shellapi, comobj,registry, {$ENDIF}
 {$IFDEF UNIX} baseunix, unix, users, {$ENDIF}
 sysutils, classes, process,
 _crw_alloc, _crw_proc, _crw_rtc, _crw_str, _crw_fio;

{$IFDEF WINDOWS}

//////////////////////////////////////////////////////////////////////////////////
// Domain RID Values, see https://msdn.microsoft.com/en-us/library/cc223144.aspx
// https://msdn.microsoft.com/en-us/library/windows/desktop/aa379649(v=vs.85).aspx
// Remark:
// RID (relative identifier) is the portion of a security identifier (SID) that
// identifies a user or group in relation to the authority that issued the SID.
// SID (security identifier) 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.
//////////////////////////////////////////////////////////////////////////////////
const
 DOMAIN_GROUP_RID_ADMINS                         = $00000200;
 DOMAIN_GROUP_RID_USERS                          = $00000201;
 DOMAIN_GROUP_RID_GUESTS                         = $00000202;
 DOMAIN_GROUP_RID_COMPUTERS                      = $00000203;
 DOMAIN_GROUP_RID_CONTROLLERS                    = $00000204;
 DOMAIN_GROUP_RID_CERT_ADMINS                    = $00000205;
 DOMAIN_GROUP_RID_SCHEMA_ADMINS                  = $00000206;
 DOMAIN_GROUP_RID_ENTERPRISE_ADMINS              = $00000207;
 DOMAIN_GROUP_RID_POLICY_ADMINS                  = $00000208;
 DOMAIN_GROUP_RID_READONLY_CONTROLLERS           = $00000209;
 DOMAIN_ALIAS_RID_ADMINS                         = $00000220;
 DOMAIN_ALIAS_RID_USERS                          = $00000221;
 DOMAIN_ALIAS_RID_GUESTS                         = $00000222;
 DOMAIN_ALIAS_RID_POWER_USERS                    = $00000223;
 DOMAIN_ALIAS_RID_ACCOUNT_OPS                    = $00000224;
 DOMAIN_ALIAS_RID_SYSTEM_OPS                     = $00000225;
 DOMAIN_ALIAS_RID_PRINT_OPS                      = $00000226;
 DOMAIN_ALIAS_RID_BACKUP_OPS                     = $00000227;
 DOMAIN_ALIAS_RID_REPLICATOR                     = $00000228;
 DOMAIN_ALIAS_RID_RAS_SERVERS                    = $00000229;
 DOMAIN_ALIAS_RID_PREW2KCOMPACCESS               = $0000022A;
 DOMAIN_ALIAS_RID_REMOTE_DESKTOP_USERS           = $0000022B;
 DOMAIN_ALIAS_RID_NETWORK_CONFIGURATION_OPS      = $0000022C;
 DOMAIN_ALIAS_RID_INCOMING_FOREST_TRUST_BUILDERS = $0000022D;
 DOMAIN_ALIAS_RID_MONITORING_USERS               = $0000022E;
 DOMAIN_ALIAS_RID_LOGGING_USERS                  = $0000022F;
 DOMAIN_ALIAS_RID_AUTHORIZATIONACCESS            = $00000230;
 DOMAIN_ALIAS_RID_TS_LICENSE_SERVERS             = $00000231;
 DOMAIN_ALIAS_RID_DCOM_USERS                     = $00000232;
 DOMAIN_ALIAS_RID_IUSERS                         = $00000238;
 DOMAIN_ALIAS_RID_CRYPTO_OPERATORS               = $00000239;
 DOMAIN_ALIAS_RID_CACHEABLE_PRINCIPALS_GROUP     = $0000023B;
 DOMAIN_ALIAS_RID_NON_CACHEABLE_PRINCIPALS_GROUP = $0000023C;
 DOMAIN_ALIAS_RID_EVENT_LOG_READERS_GROUP        = $0000023D;
 DOMAIN_ALIAS_RID_CERTSVC_DCOM_ACCESS_GROUP      = $0000023E;

const
 SECURITY_BUILTIN_DOMAIN_RID                     = $00000020;
 SECURITY_NT_AUTHORITY : TSidIdentifierAuthority = (Value:(0,0,0,0,0,5));

const
 WellKnownRidsTable : array[0..24] of record rid:DWORD; name:PChar; note:PChar; end =
 ((rid:DOMAIN_ALIAS_RID_ADMINS;                          name:'ADMINS';                           note:'A local group used for administration of the domain.'),
  (rid:DOMAIN_ALIAS_RID_USERS;                           name:'USERS';                            note:'A local group that represents all users in the domain.'),
  (rid:DOMAIN_ALIAS_RID_GUESTS;                          name:'GUESTS';                           note:'A local group that represents guests of the domain.'),
  (rid:DOMAIN_ALIAS_RID_POWER_USERS;                     name:'POWER_USERS';                      note:'A local group used to represent a user or set of users who expect to treat a system as if it were their personal computer rather than as a workstation for multiple users.'),
  (rid:DOMAIN_ALIAS_RID_ACCOUNT_OPS;                     name:'ACCOUNT_OPS';                      note:'A local group that exists only on systems running server operating systems. This local group permits control over nonadministrator accounts.'),
  (rid:DOMAIN_ALIAS_RID_SYSTEM_OPS;                      name:'SYSTEM_OPS';                       note:'A local group that exists only on systems running server operating systems. This local group performs system administrative functions, not including security functions.'+' It establishes network shares, controls printers, unlocks workstations, and performs other operations.'),
  (rid:DOMAIN_ALIAS_RID_PRINT_OPS;                       name:'RID_PRINT_OPS';                    note:'A local group that exists only on systems running server operating systems. This local group controls printers and print queues.'),
  (rid:DOMAIN_ALIAS_RID_BACKUP_OPS;                      name:'BACKUP_OPS';                       note:'A local group used for controlling assignment of file backup-and-restore privileges.'),
  (rid:DOMAIN_ALIAS_RID_REPLICATOR;                      name:'REPLICATOR';                       note:'A local group responsible for copying security databases from the primary domain controller to the backup domain controllers. These accounts are used only by the system.'),
  (rid:DOMAIN_ALIAS_RID_RAS_SERVERS;                     name:'RAS_SERVERS';                      note:'A local group that represents RAS and IAS servers. This group permits access to various attributes of user objects.'),
  (rid:DOMAIN_ALIAS_RID_PREW2KCOMPACCESS;                name:'PREW2KCOMPACCESS';                 note:'A local group that exists only on systems running Windows 2000 Server. For more information, see Allowing Anonymous Access.'),
  (rid:DOMAIN_ALIAS_RID_REMOTE_DESKTOP_USERS;            name:'REMOTE_DESKTOP_USERS';             note:'A local group that represents all remote desktop users.'),
  (rid:DOMAIN_ALIAS_RID_NETWORK_CONFIGURATION_OPS;       name:'NETWORK_CONFIGURATION_OPS';        note:'A local group that represents the network configuration.'),
  (rid:DOMAIN_ALIAS_RID_INCOMING_FOREST_TRUST_BUILDERS;  name:'INCOMING_FOREST_TRUST_BUILDERS';   note:'A local group that represents any forest trust users.'),
  (rid:DOMAIN_ALIAS_RID_MONITORING_USERS;                name:'MONITORING_USERS';                 note:'A local group that represents all users being monitored.'),
  (rid:DOMAIN_ALIAS_RID_LOGGING_USERS;                   name:'LOGGING_USERS';                    note:'A local group responsible for logging users.'),
  (rid:DOMAIN_ALIAS_RID_AUTHORIZATIONACCESS;             name:'AUTHORIZATIONACCESS';              note:'A local group that represents all authorized access.'),
  (rid:DOMAIN_ALIAS_RID_TS_LICENSE_SERVERS;              name:'TS_LICENSE_SERVERS';               note:'A local group that exists only on systems running server operating systems that allow for terminal services and remote access.'),
  (rid:DOMAIN_ALIAS_RID_DCOM_USERS;                      name:'DCOM_USERS';                       note:'A local group that represents users who can use Distributed Component Object Model (DCOM).'),
  (rid:DOMAIN_ALIAS_RID_IUSERS;                          name:'IUSERS';                           note:'A local group that represents Internet users.'),
  (rid:DOMAIN_ALIAS_RID_CRYPTO_OPERATORS;                name:'CRYPTO_OPERATORS';                 note:'A local group that represents access to cryptography operators.'),
  (rid:DOMAIN_ALIAS_RID_CACHEABLE_PRINCIPALS_GROUP;      name:'CACHEABLE_PRINCIPALS_GROUP';       note:'A local group that represents principals that can be cached.'),
  (rid:DOMAIN_ALIAS_RID_NON_CACHEABLE_PRINCIPALS_GROUP;  name:'NON_CACHEABLE_PRINCIPALS_GROUP';   note:'A local group that represents principals that cannot be cached.'),
  (rid:DOMAIN_ALIAS_RID_EVENT_LOG_READERS_GROUP;         name:'EVENT_LOG_READERS_GROUP';          note:'A local group that represents event log readers.'),
  (rid:DOMAIN_ALIAS_RID_CERTSVC_DCOM_ACCESS_GROUP;       name:'CERTSVC_DCOM_ACCESS_GROUP';        note:'The local group of users who can connect to certification authorities using Distributed Component Object Model (DCOM).')
 );

function GetNameByRid(Rid:DWORD):LongString;
function GetNoteByRid(Rid:DWORD):LongString;
function GetRidByName(const Name:LongString):DWORD;
function GetRidNameByName(const Name:LongString):LongString;
function GetRidNoteByName(const Name:LongString):LongString;
function GetListOfWellKnownRids(mode:Integer=0):LongString;
function GetListOfUserMembership(Delim:Char=' '; Header:Boolean=false):LongString;

//////////////////////////////////////////////////////////////////////////////////
// https://msdn.microsoft.com/en-us/library/windows/desktop/aa379626(v=vs.85).aspx
// https://msdn.microsoft.com/en-us/library/windows/desktop/aa446671(v=vs.85).aspx
//////////////////////////////////////////////////////////////////////////////////
const // TTokenInformationClass
 tic_TokenUser                                   = 1;
 tic_TokenGroups                                 = 2;
 tic_TokenPrivileges                             = 3;
 tic_TokenOwner                                  = 4;
 tic_TokenPrimaryGroup                           = 5;
 tic_TokenDefaultDacl                            = 6;
 tic_TokenSource                                 = 7;
 tic_TokenType                                   = 8;
 tic_TokenImpersonationLevel                     = 9;
 tic_TokenStatistics                             = 10;
 tic_TokenRestrictedSids                         = 11;
 tic_TokenSessionId                              = 12;
 tic_TokenGroupsAndPrivileges                    = 13;
 tic_TokenSessionReference                       = 14;
 tic_TokenSandBoxInert                           = 15;
 tic_TokenAuditPolicy                            = 16;
 tic_TokenOrigin                                 = 17;
 tic_TokenElevationType                          = 18;
 tic_TokenLinkedToken                            = 19;
 tic_TokenElevation                              = 20;
 tic_TokenHasRestrictions                        = 21;
 tic_TokenAccessInformation                      = 22;
 tic_TokenVirtualizationAllowed                  = 23;
 tic_TokenVirtualizationEnabled                  = 24;
 tic_TokenIntegrityLevel                         = 25;
 tic_TokenUIAccess                               = 26;
 tic_TokenMandatoryPolicy                        = 27;
 tic_TokenLogonSid                               = 28;
 tic_TokenIsAppContainer                         = 29;
 tic_TokenCapabilities                           = 30;
 tic_TokenAppContainerSid                        = 31;
 tic_TokenAppContainerNumber                     = 32;
 tic_TokenUserClaimAttributes                    = 33;
 tic_TokenDeviceClaimAttributes                  = 34;
 tic_TokenRestrictedUserClaimAttributes          = 35;
 tic_TokenRestrictedDeviceClaimAttributes        = 36;
 tic_TokenDeviceGroups                           = 37;
 tic_TokenRestrictedDeviceGroups                 = 38;
 tic_TokenSecurityAttributes                     = 39;
 tic_TokenIsRestricted                           = 40;
 tic_MaxTokenInfoClass                           = 41;

//////////////////////////////////////////////////////////////////////////////////
// Kernel32.dll; Minimum supported client: Win XP SP1, server: Windows Server 2003
// https://msdn.microsoft.com/en-us/library/windows/desktop/ms683215(v=vs.85).aspx
//////////////////////////////////////////////////////////////////////////////////
function GetProcessId(hProcess:THandle):DWORD; stdcall;
function SupportsGetProcessId:Boolean;

//////////////////////////////////////////////////////////////////////////////////
// Advapi32.dll; Minimum supported client: Windows XP, server: Windows Server 2003
// https://msdn.microsoft.com/en-us/library/windows/desktop/aa376389(v=vs.85).aspx
//////////////////////////////////////////////////////////////////////////////////
function CheckTokenMembership(TokenHandle:THANDLE; SidToCheck:PSID; IsMember:PBOOL):BOOL; stdcall;
function SupportsCheckTokenMembership:Boolean;

//////////////////////////////////////////////////////////////////////////////////
// Check if Win32 version greater or equals relative to specified.
// https://msdn.microsoft.com/en-us/library/ms724451(VS.85).aspx
//////////////////////////////////////////////////////////////////////////////////
function CheckWin32Version(AMajor:Cardinal; AMinor:Cardinal=0):Boolean;

//////////////////////////////////////////////////////////////////////////////////
// Check if UAC is available and enabled.
// http://stackoverflow.com/questions/923350
// http://stackoverflow.com/questions/15319158
//////////////////////////////////////////////////////////////////////////////////
function IsUACAvailable:Boolean;
function IsUACEnabled:Boolean;

//////////////////////////////////////////////////////////////////////////////////
// Get UAC Group Policy Settings and Registry Key Settings
// https://technet.microsoft.com/en-us/library/dd835564(v=ws.10).aspx
//////////////////////////////////////////////////////////////////////////////////
type
 TUACStatus = record
  UACAvail                    : BOOL;
  EnableLUA                   : DWORD;
  EnableInstallerDetection    : DWORD;
  PromptOnSecureDesktop       : DWORD;
  ConsentPromptBehaviorAdmin  : DWORD;
  ConsentPromptBehaviorUser   : DWORD;
  EnableSecureUIAPaths        : DWORD;
  ValidateAdminCodeSignatures : DWORD;
  EnableVirtualization        : DWORD;
  EnableUIADesktopToggle      : DWORD;
  FilterAdministratorToken    : DWORD;
  IsAdministratorAccount      : BOOL;
  IsAdministrator             : BOOL;
  IsElevated                  : BOOL;
 end;

function GetUACStatus:TUACStatus;
function GetUACStatusAsText(const Title:LongString='UAC Settings:'):LongString;

///////////////////////////////////////////////////////////////////////
// Description:
//  This routine returns TRUE if the caller's process is member of the
//  local group specified by DomainAliasRid.
// Notes:
//  Required WinXP desktop or Server 2003 at least.
//  Caller is NOT expected to be impersonating anyone and is expected
//  to be able to open its own process and process token.
// Arguments:
//  rid - specify domain alias RID.
// Return Value:
//      TRUE  - Caller has    membership in Administrators local group.
//      FALSE - Caller has no membership in Administrators local group.
// see http://msdn.microsoft.com/en-us/library/aa376389%28VS.85%29.aspx
///////////////////////////////////////////////////////////////////////
function IsMemberOfGroup(rid:DWORD):Boolean;

///////////////////////////////////////////////////////////////////////
// Description:
//  This routine returns TRUE if the caller's process is a member
//  of the Administrators local group.
//  Caller is NOT expected to be impersonating anyone and is expected
//  to be able to open its own process and process token.
// Arguments: None.
// Return Value: 
//      TRUE  - Caller has    membership in Administrators local group. 
//      FALSE - Caller has no membership in Administrators local group.
// Remark
//  IsUserAnAdmin is synonym of IsAdministrator.
//  IsAdministratorAccount equals to IsAdministrator of UAC is OFF.
//  IsAdministrator = IsAdministratorAccount and IsElevated.
///////////////////////////////////////////////////////////////////////
function IsUserAnAdmin:Boolean;
function IsAdministrator:Boolean;
function IsAdministratorAccount:Boolean;


function IsElevated:Boolean;
procedure SetButtonElevated(const AButtonHandle: THandle);

////////////////////////////////////////////////////////////////////////////////
// Wrapper for ShellExecuteEx invokation.
// https://msdn.microsoft.com/en-us/library/windows/desktop/bb762154(v=vs.85).aspx
// https://msdn.microsoft.com/en-us/library/windows/desktop/bb759784(v=vs.85).aspx
// Arguments:
// fMask        - required; in;  SEE_XXX flags indicate content & validity of other fields.
// Wnd          - optional; in;  A handle to parent window, used to display message boxes. May be nil.
// lpVerb       - required; in;  A string, referred to as a verb, that specifies the action to be performed.
//                               Can be: edit,explore,find,open,print,properties,runas.
// lpFile       - required; in;  Name of file or object on which ShellExecuteEx will perform the action specified by lpVerb.
// lpParameters - optional; in;  String that contains the application parameters. May be emppty.
// lpDirectory  - optional; in;  Name of the working directory. If empty, the current directory is used.
// nShow        - required; in;  Flags specify how application will be shown when opened; one of the SW_ values.
// lpdwhInstApp - optional; out; If SEE_MASK_NOCLOSEPROCESS is set and the ShellExecuteEx call succeeds,
//                               it sets this member to a value greater than 32. If the function fails,
//                               it is set to an SE_ERR_XXX error value that indicates the cause of the failure.
//                               Although hInstApp is declared as an HINSTANCE for compatibility with 16-bit Windows
//                               applications, it is not a true HINSTANCE. It can be cast only to an int and compared
//                               to either 32 or the following SE_ERR_XXX error codes.
// lpIDList     - optional; in;  The address of an absolute ITEMIDLIST structure (PCIDLIST_ABSOLUTE) to contain an item
//                               identifier list that uniquely identifies the file to execute. This member is ignored
//                               if the fMask member does not include SEE_MASK_IDLIST or SEE_MASK_INVOKEIDLIST.
// lpClass      - optional; in;  String that specifies one of the following: 1) A ProgId. For example, "Paint.Picture".
//                               2) A URI protocol scheme. For example, "http". 3) A file extension. For example, ".txt".
//                               3) A registry path under HKEY_CLASSES_ROOT that names a subkey that contains
//                               one or more Shell verbs. This key will have a subkey that conforms to the Shell verb
//                               registry schema, such as shell\verb name.
//                               This member is ignored if fMask does not include SEE_MASK_CLASSNAME.
// hkeyClass    - optional; in;  A handle to the registry key for the file type. The access rights for this registry key should be set to KEY_READ.
//                               This member is ignored if fMask does not include SEE_MASK_CLASSKEY.
// dwHotKey     - optional; in;  A keyboard shortcut to associate with the application.
//                               This member is ignored if fMask does not include SEE_MASK_HOTKEY.
// hIcon        - optional; in;  A handle to the icon for the file type. This value is used only in Windows XP and earlier. It is ignored as of Windows Vista.
//                               This member is ignored if fMask does not include SEE_MASK_ICON.
// hMonitor     = hIcon          A handle to the monitor upon which the document is to be displayed.
//                               This member is ignored if fMask does not include SEE_MASK_HMONITOR.
// lpdwhProcess - optional; out; A handle to the newly started application. This member is set on return and
//                               is always NULL unless fMask is set to SEE_MASK_NOCLOSEPROCESS. Even if fMask is set
//                               to SEE_MASK_NOCLOSEPROCESS, hProcess will be NULL if no process was launched.
//                               For example, if a document to be launched is a URL and an instance of Internet Explorer
//                               is already running, it will display the document. No new process is launched,
//                               and hProcess will be NULL.
// dwTimeOutMs - optional; in;   wait timeout while executed, SEE_MASK_NOCLOSEPROCESS required.
// lpdwPid     - optional; out;  process id of created process, SEE_MASK_NOCLOSEPROCESS required.
// lpdwExitCode- optional; out;  process exit code, SEE_MASK_NOCLOSEPROCESS required.
// 
// Return value
//  Returns TRUE if successful; otherwise, FALSE. Call GetLastError for extended error information.
// Remarks:
// 1) Because ShellExecuteEx can delegate execution to Shell extensions (data sources, context menu handlers,
//    verb implementations) that are activated using Component Object Model (COM), COM should be initialized
//    before ShellExecuteEx is called. Some Shell extensions require the COM single-threaded apartment (STA) type.
//    In that case, COM should be initialized as shown here:
//     CoInitializeEx(NULL, COINIT_APARTMENTTHREADED | COINIT_DISABLE_OLE1DDE)
//    There are instances where ShellExecuteEx does not use one of these types of Shell extension and those instances
//    would not require COM to be initialized at all.
//    Nonetheless, it is good practice to always initalize COM before using this function.
// 2) If the function succeeds, it sets the hInstApp member of the SHELLEXECUTEINFO structure to a value
//    greater than 32. If the function fails, hInstApp is set to the SE_ERR_XXX error value that best indicates
//    the cause of the failure. Although hInstApp is declared as an HINSTANCE for compatibility with 16-bit Windows
//    applications, it is not a true HINSTANCE. It can be cast only to an int and can be compared only to either
//    the value 32 or the SE_ERR_XXX error codes.
// 3) The SEE_MASK_NOASYNC flag must be specified if the thread calling ShellExecuteEx does not have a message loop
//    or if the thread or process will terminate soon after ShellExecuteEx returns. Under such conditions, the calling
//    thread will not be available to complete the DDE conversation, so it is important that ShellExecuteEx complete
//    the conversation before returning control to the calling application. Failure to complete the conversation can
//    result in an unsuccessful launch of the document.
////////////////////////////////////////////////////////////////////////////////
function CallShellExecuteEx(fMask:ULONG; Wnd:HWND; lpVerb,lpFile,lpParameters,lpDirectory:LongString;
                            nShow:Integer=SW_SHOW; lpdwhInstApp:LPDWORD=nil; lpIDList:Pointer=nil; lpClass:LongString='';
                            hkeyClass:HKEY=0; dwHotKey:DWORD=0; hIcon:THandle=0; lpdwhProcess:PHandle=nil;
                            dwTimeOutMs:DWORD=0; lpdwPid:LPDWORD=nil; lpdwExitCode:LPDWORD=nil):BOOL;

const                                      // ShellExecuteEx fMask flags:
 SEE_MASK_DEFAULT            = $00000000; // Use default values.
 SEE_MASK_CLASSNAME          = $00000001; // Use the class name given by the lpClass member.
 SEE_MASK_CLASSKEY           = $00000003; // Use the class key given by the hkeyClass member.
 SEE_MASK_IDLIST             = $00000004; // Use the item identifier list given by the lpIDList member.
 SEE_MASK_INVOKEIDLIST       = $0000000C; // Use lpFile to identify the item by its file system path or lpIDList to identify the item by its PIDL.
 SEE_MASK_ICON               = $00000010; // Use the icon given by the hIcon member.
 SEE_MASK_HOTKEY             = $00000020; // Use the keyboard shortcut given by the dwHotKey member.
 SEE_MASK_NOCLOSEPROCESS     = $00000040; // Use to indicate that the hProcess member receives the process handle.
 SEE_MASK_CONNECTNETDRV      = $00000080; // Validate the share and connect to a drive letter. This enables reconnection of disconnected network drives. The lpFile member is a UNC path of a file on a network.
 SEE_MASK_NOASYNC            = $00000100; // Wait for the execute operation to complete before returning. Applications that exit immediately after calling ShellExecuteEx should specify this flag.
 SEE_MASK_DOENVSUBST         = $00000200; // Expand any environment variables specified in the string given by the lpDirectory or lpFile member.
 SEE_MASK_FLAG_NO_UI         = $00000400; // Do not display an error message box if an error occurs.
 SEE_MASK_UNICODE            = $00004000; // Use this flag to indicate a Unicode application.
 SEE_MASK_NO_CONSOLE         = $00008000; // Use to inherit the parent's console for the new process instead of having it create a new console.
 SEE_MASK_ASYNCOK            = $00100000; // The execution can be performed on a background thread and the call should return immediately without waiting for the background thread to finish.
 SEE_MASK_HMONITOR           = $00200000; // Use this flag when specifying a monitor on multi-monitor systems. The monitor is specified in the hMonitor member.
 SEE_MASK_NOZONECHECKS       = $00800000; // Introduced in Windows XP. Do not perform a zone check. This flag allows ShellExecuteEx to bypass zone checking put into place by IAttachmentExecute.
 SEE_MASK_NOQUERYCLASSSTORE  = $01000000; // Not used.
 SEE_MASK_WAITFORINPUTIDLE   = $02000000; // After the new process is created, wait for the process to become idle before returning, with a one minute timeout.
 SEE_MASK_FLAG_LOG_USAGE     = $04000000; // Introduced in Windows XP. Keep track of the number of times this application has been launched.
 SEE_MASK_FLAG_HINST_IS_SITE = $08000000; // The hInstApp member is used to specify the IUnknown of an object that implements IServiceProvider.

const                                     // WinExec/hInstApp error codes:
 SE_ERR_FNF                  = 2;         // File not found.
 SE_ERR_PNF                  = 3;         // Path not found.
 SE_ERR_ACCESSDENIED         = 5;         // Access denied.
 SE_ERR_OOM                  = 8;         // Out of memory.
 SE_ERR_SHARE                = 26;        // Cannot share an open file.
 SE_ERR_ASSOCINCOMPLETE      = 27;        // File association information not complete.
 SE_ERR_DDETIMEOUT           = 28;        // DDE operation timed out.
 SE_ERR_DDEFAIL              = 29;        // DDE operation failed.
 SE_ERR_DDEBUSY              = 30;        // DDE operation is busy.
 SE_ERR_NOASSOC              = 31;        // File association not available.
 SE_ERR_DLLNOTFOUND          = 32;        // Dynamic-link library not found.

////////////////////////////////////////////////////////////////////////////////
// Run process with elevated rights; use ShellExecuteEx + runas method.
// http://code.kliu.org/misc/elevate/
// https://www.codeproject.com/articles/19165/WebControls/
// https://www.codeproject.com/Articles/320748/Haephrati-Elevating-during-runtime
////////////////////////////////////////////////////////////////////////////////
function RunElevated(fMask:ULONG; Wnd:HWND; lpFile,lpParameters,lpDirectory:LongString;
                     nShow:Integer=SW_SHOW; lpdwhInstApp:LPDWORD=nil; lpdwhProcess:PHandle=nil;
                     dwTimeOutMs:DWORD=0; lpdwPid:LPDWORD=nil; lpdwExitCode:LPDWORD=nil):BOOL;
                     
////////////////////////////////////////////////////////////////////////////////
// Run process with elevated rights; use ShellExecuteEx + runas + cmd /c method.
// Note that elevated process don't inherit current directory so use pushd to
// set required directory in started elevated process.
////////////////////////////////////////////////////////////////////////////////
function RunElevatedCmd(lpParameters,lpDirectory:LongString;
                        nShow:Integer=SW_SHOW; lpdwhInstApp:LPDWORD=nil; lpdwhProcess:PHandle=nil;
                        dwTimeOutMs:DWORD=0; lpdwPid:LPDWORD=nil; lpdwExitCode:LPDWORD=nil;
                        CmdOpt:LongString='/c'; UsePushd:Boolean=true):Boolean;

///////////////////////////////////////////////////////////////////////////////
// Create process to run with another user account (no login GUI).
// This call needs W2K or higher.
///////////////////////////////////////////////////////////////////////////////
const
 LOGON_WITH_PROFILE        = $00000001;
 LOGON_NETCREDENTIALS_ONLY = $00000002;

 // Create process to run with another user account.
 // See http://msdn.microsoft.com/library/default.asp?
 //          url=/library/en-us/dllproc/base/createprocesswithlogonw.asp
function CreateProcessWithLogon(lpUsername,lpDomain,lpPassword:PChar;
          dwLogonFlags:DWORD; lpApplicationName,lpCommandLine:PChar;
          dwCreationFlags:DWORD; lpEnvironment:Pointer;
          lpCurrentDirectory:PChar; const lpStartupInfo:TStartupInfo;
          var lpProcessInformation:TProcessInformation):BOOL stdcall;
{$ENDIF ~WINDOWS}

////////////////////////////////////////////////////////////////////////////////
// Echo procedure to be called on exceptions etc.
////////////////////////////////////////////////////////////////////////////////
const
 TheUacEchoProcedure : procedure(const Msg:LongString) = nil;

////////////////////////////////////////////////////////////////////////////////
// Miscellaneous options of UAC procedures.
////////////////////////////////////////////////////////////////////////////////

const
 StrictUacCheck : Boolean = true;

{$IFDEF UNIX}
 { Get list of user groups. }
function GetListOfUserMembership(Delim:Char=' '; Header:Boolean=false):LongString;

 { Check if user is root (Admin). }
function IsUserAnAdmin:Boolean;
function IsAdministrator:Boolean;
function IsAdministratorAccount:Boolean;

function IsElevated:Boolean;
{$ENDIF ~UNIX}

implementation

{$IFDEF WINDOWS}

procedure Echo(const Msg:LongString; const LineBreak:LongString=EOL);
begin
 if Assigned(TheUacEchoProcedure) then
 try
  TheUacEchoProcedure(Msg+LineBreak);
 except
 end;
end;

function ExceptionInfoFilter(Info:LongString):LongString;
begin
 Result:=SysUtils.Trim(Info); // See SysConst unit
 if (Pos('Exception ',Result)=1) then Result:=Copy(Result,11,Length(Result)-10);
 if (Result<>'') and (Result[Length(Result)]='.') then Result:=Copy(Result,1,Length(Result)-1);
 Result:=StringReplace(Result,'Cannot access package information for package ','Fail package ',[rfReplaceAll]);
 Result:=StringReplace(Result,'Access violation ','Violation ',[rfReplaceAll]);
 Result:=StringReplace(Result,' is not a valid ',' is bad ',[rfReplaceAll]);
 Result:=StringReplace(Result,' floating point ',' float ',[rfReplaceAll]);
 Result:=StringReplace(Result,'Floating point ','Float ',[rfReplaceAll]);
 Result:=StringReplace(Result,' of address ',' of ',[rfReplaceAll]);
 Result:=StringReplace(Result,' at address ',' at ',[rfReplaceAll]);
 Result:=StringReplace(Result,' in module ',' in ',[rfReplaceAll]);
 Result:=StringReplace(Result,'Invalid ','Bad ',[rfReplaceAll]);
 Result:=StringReplace(Result,'.'+EOL,' «',[]);
 Result:=StringReplace(Result,'.'+ASCII_LF,' «',[]);
 if Pos('«',Result)>0 then Result:=Result+'»';
end;

function GetExceptionInfo(ExceptObject:TObject; ExceptAddr:Pointer):LongString;
var Buffer: array[0..1023] of Char;
begin
 SetString(Result,Buffer,ExceptionErrorMessage(ExceptObject,ExceptAddr,Buffer,SizeOf(Buffer)));
 Result:=ExceptionInfoFilter(Result);
end;

procedure BugReport(E:Exception; Obj:TObject=nil; Note:LongString='');
const Exe:String[31]=''; var Info,What,Where,When,Who,Why:LongString;
begin
 if Assigned(E) then
 try
  What:='Exception «'+E.ClassName+'»';
  Info:=GetExceptionInfo(ExceptObject,ExceptAddr);
  When:=StdDateTimeStr(mSecNow);
  Why:=' cause «'+ExceptionInfoFilter(E.Message)+'»';
  if Exe='' then Exe:=SysUtils.ExtractFileName(ParamStr(0));
  Where:=' in '+Exe+' PID '+IntToStr(Int64(GetCurrentProcessId));
  if Obj is TObject then Who:=Obj.ClassName else Who:='Unknown';
  if Obj is TComponent then Who:=Who+'.'+(Obj as TComponent).Name;
  if (Who<>'') then Who:=' from «'+Who+'»';
  if (Note<>'') then Note:=' note «'+Note+'»';
  Echo(When+' => '+What+Where+Who+Note);
  Echo(When+' => '+What+Why);
  Echo(When+' => '+Info);
 except
  on E:Exception do Echo(E.Message);
 end;
end;

function CheckWin32Version(AMajor:Cardinal;AMinor:Cardinal=0):Boolean;
begin
 Result:=(Win32MajorVersion>AMajor) or ((Win32MajorVersion=AMajor) and (Win32MinorVersion>=AMinor));
end;

const _GetProcessId:function(hProcess:THandle):DWORD stdcall = nil;
const _CheckTokenMembership:function(TokenHandle:THANDLE;SidToCheck:PSID;IsMember:PBOOL):BOOL stdcall = nil;

procedure ImportLibraries;
var hModule:THandle;
begin
 if not Assigned(_GetProcessId) then begin
  hModule:=GetModuleHandle('kernel32.dll');
  if hModule<>0 then @_GetProcessId:=GetProcAddress(hModule,'GetProcessId');
 end;
 if not Assigned(_CheckTokenMembership) then begin
  hModule:=GetModuleHandle('advapi32.dll');
  if hModule<>0 then @_CheckTokenMembership:=GetProcAddress(hModule,'CheckTokenMembership');
 end;
end;

function SupportsGetProcessId:Boolean;
begin
 Result:=Assigned(_GetProcessId);
end;

function GetProcessId(hProcess:THandle):DWORD; stdcall;
begin
 if not Assigned(_GetProcessId) then begin
  SetLastError(ERROR_CALL_NOT_IMPLEMENTED);
  Result:=0;
 end else
 Result:=_GetProcessId(hProcess);
end;

function SupportsCheckTokenMembership:Boolean;
begin
 Result:=Assigned(_CheckTokenMembership);
end;

function CheckTokenMembership(TokenHandle:THANDLE; SidToCheck:PSID; IsMember:PBOOL):BOOL; stdcall;
begin
 if not Assigned(_CheckTokenMembership) then begin
  SetLastError(ERROR_CALL_NOT_IMPLEMENTED);
  Result:=FALSE;
 end else
 Result:=_CheckTokenMembership(TokenHandle,SidToCheck,IsMember);
end;

function IsMemberOfGroup(rid:DWORD):Boolean;
var sid:PSID; IsMember:BOOL;
begin
 Result:=FALSE;
 try
  sid:=nil;
  if AllocateAndInitializeSid(SECURITY_NT_AUTHORITY,2,SECURITY_BUILTIN_DOMAIN_RID,rid,0,0,0,0,0,0,sid) then
  try
   if CheckTokenMembership(0,sid,@IsMember) then Result:=IsMember;
  finally
   FreeSid(sid);
  end;
 except
  on E:Exception do BugReport(E,nil,'IsMemberOfGroup');
 end;
end;

function IsUserAnAdmin:Boolean;
begin
 Result:=IsMemberOfGroup(DOMAIN_ALIAS_RID_ADMINS);
end;

function IsAdministrator:Boolean;
begin
 Result:=IsMemberOfGroup(DOMAIN_ALIAS_RID_ADMINS);
end;

function IsAdministratorAccount:Boolean;
var
 I         : Integer;
 Count     : DWORD;
 Token     : THandle;
 psidAdmin : Pointer;
 TokenInfo : PTokenGroups;
 HaveToken : Boolean;
begin
 Result:=False;
 if Win32Platform<VER_PLATFORM_WIN32_NT then Result:=True else
 try
  psidAdmin:=nil;
  TokenInfo:=nil;
  HaveToken:=False;
  try
   Token:=0; Count:=0;
   HaveToken:=OpenThreadToken(GetCurrentThread, TOKEN_QUERY,True,Token);
   if (not HaveToken) and (GetLastError=ERROR_NO_TOKEN)
   then HaveToken:=OpenProcessToken(GetCurrentProcess,TOKEN_QUERY,Token);
   if HaveToken then begin
    Win32Check(AllocateAndInitializeSid(SECURITY_NT_AUTHORITY,2,
     SECURITY_BUILTIN_DOMAIN_RID,DOMAIN_ALIAS_RID_ADMINS,0,0,0,0,0,0,psidAdmin));
    if GetTokenInformation(Token, TokenGroups,nil,0,Count)
    or (GetLastError<>ERROR_INSUFFICIENT_BUFFER)
    then RaiseLastWin32Error;
    TokenInfo := PTokenGroups(AllocMem(Count));
    Win32Check(GetTokenInformation(Token,TokenGroups,TokenInfo,Count,Count));
    for I:=0 to TokenInfo^.GroupCount-1 do begin
     Result:=EqualSid(psidAdmin,TokenInfo^.Groups[I].Sid);
     if Result then Break;
    end;
   end;
  finally
   if TokenInfo <> nil then FreeMem(TokenInfo);
   if HaveToken then CloseHandle(Token);
   if psidAdmin <> nil then FreeSid(psidAdmin);
  end;
 except
  on E:Exception do BugReport(E,nil,'IsAdministratorAccount');
 end;
end;

function GetNameByRid(Rid:DWORD):LongString;
var i:Integer;
begin
 Result:='';
 try
  if Rid<>0 then
  for i:=Low(WellKnownRidsTable) to High(WellKnownRidsTable) do
  if Rid=WellKnownRidsTable[i].rid then begin
   Result:=WellKnownRidsTable[i].name;
   break;
  end;
 except
  on E:Exception do BugReport(E,nil,'GetNameByRid');
 end;
end;

function GetNoteByRid(Rid:DWORD):LongString;
var i:Integer;
begin
 Result:='';
 try
  if Rid<>0 then
  for i:=Low(WellKnownRidsTable) to High(WellKnownRidsTable) do
  if Rid=WellKnownRidsTable[i].rid then begin
   Result:=WellKnownRidsTable[i].note;
   break;
  end;
 except
  on E:Exception do BugReport(E,nil,'GetNoteByRid');
 end;
end;

function GetRidByName(const Name:LongString):DWORD;
var i:Integer;
begin
 Result:=0;
 try
  if Length(Trim(Name))>0 then
  for i:=Low(WellKnownRidsTable) to High(WellKnownRidsTable) do
  if SameText(Name,WellKnownRidsTable[i].name) then begin
   Result:=WellKnownRidsTable[i].rid;
   break;
  end;
 except
  on E:Exception do BugReport(E,nil,'GetRidByName');
 end;
end;

function GetRidNameByName(const Name:LongString):LongString;
var i:Integer;
begin
 Result:='';
 try
  if Length(Trim(Name))>0 then
  for i:=Low(WellKnownRidsTable) to High(WellKnownRidsTable) do
  if SameText(Name,WellKnownRidsTable[i].name) then begin
   Result:=WellKnownRidsTable[i].name;
   break;
  end;
 except
  on E:Exception do BugReport(E,nil,'GetRidNameByName');
 end;
end;

function GetRidNoteByName(const Name:LongString):LongString;
var i:Integer;
begin
 Result:='';
 try
  if Length(Trim(Name))>0 then
  for i:=Low(WellKnownRidsTable) to High(WellKnownRidsTable) do
  if SameText(Name,WellKnownRidsTable[i].name) then begin
   Result:=WellKnownRidsTable[i].note;
   break;
  end;
 except
  on E:Exception do BugReport(E,nil,'GetRidNoteByName');
 end;
end;

function GetListOfWellKnownRids(mode:Integer=0):LongString;
const LineDelim=EOL; var i:Integer;
begin
 Result:='';
 try
  for i:=Low(WellKnownRidsTable) to High(WellKnownRidsTable) do
  with WellKnownRidsTable[i] do
  case mode of
   1:   Result:=Result+Format('%-30s = 0x%8.8x',[name,rid])+LineDelim;
   2:   Result:=Result+Format('%-30s = 0x%8.8x - %s',[name,rid,note])+LineDelim;
   else Result:=Result+Format('%s',[name])+LineDelim;
  end;
 except
  on E:Exception do BugReport(E,nil,'GetListOfWellKnownRids');
 end;
end;

function GetListOfUserMembership(Delim:Char=' '; Header:Boolean=false):LongString;
const UacLev:array[Boolean] of PChar=('restricted','elevated');
var i:Integer; Len:DWORD; Buf:TMaxPathBuffer;
begin
 Result:='';
 try
  for i:=Low(WellKnownRidsTable) to High(WellKnownRidsTable) do
  with WellKnownRidsTable[i] do if(IsMemberOfGroup(rid)) then
  if Length(Result)=0 then Result:=name else Result:=Result+Delim+name;
  if Header then begin
   Len:=SizeOf(Buf);
   if Windows.GetUserName(@Buf[0],Len) then
   Result:=Format('%s is %s member of group(s) %s',[Buf,UacLev[IsElevated],Result]);
  end;
 except
  on E:Exception do BugReport(E,nil,'GetListOfUserMembership');
 end;
end;

function IsElevated: Boolean;
const TokenElevation=TTokenInformationClass(20);
type TOKEN_ELEVATION = record TokenIsElevated: DWORD; end;
var TokenHandle:THandle; ResultLength:Cardinal; ATokenElevation:TOKEN_ELEVATION; HaveToken:Boolean;
begin
 Result:=False;
 if IsUACAvailable then begin
  try
   TokenHandle:=0;
   HaveToken:=OpenThreadToken(GetCurrentThread,TOKEN_QUERY,True,TokenHandle);
   if (not HaveToken) and (GetLastError = ERROR_NO_TOKEN) then
   HaveToken:=OpenProcessToken(GetCurrentProcess,TOKEN_QUERY,TokenHandle);
   if HaveToken then begin
    try
     ResultLength := 0;
     if GetTokenInformation(TokenHandle,TokenElevation,@ATokenElevation,SizeOf(ATokenElevation),ResultLength)
     then Result:=ATokenElevation.TokenIsElevated<>0
     else Result:=False;
    finally
     CloseHandle(TokenHandle);
    end;
   end else Result := False;
  except
   on E:Exception do BugReport(E,nil,'IsElevated');
  end;
 end else Result:=IsAdministrator;
end;

procedure SetButtonElevated(const AButtonHandle: THandle);
const BCM_SETSHIELD = $160C;
var Required: BOOL;
begin
 if not IsUACAvailable then Exit;
 if IsElevated then Exit;
 Required := True;
 SendMessage(AButtonHandle,BCM_SETSHIELD,0,LPARAM(Required));
end;

function IsUACAvailable:Boolean;
begin
 Result:=CheckWin32Version(6,0);  // Windows Vista and above
end;

function IsUACEnabled:Boolean;
var Reg:TRegistry;
begin
 Result:=IsUACAvailable;
 if Result then
 try
  Reg:=TRegistry.Create(KEY_READ);
  try
   Reg.RootKey:=HKEY_LOCAL_MACHINE;
   if Reg.OpenKey('\Software\Microsoft\Windows\CurrentVersion\Policies\System',False) then begin
    if Reg.ValueExists('EnableLUA')
    then Result:=(Reg.ReadInteger('EnableLUA')<>0)
    else Result:=False;
   end else Result:=False;
  finally
   FreeAndNil(Reg);
  end;
 except
  on E:Exception do BugReport(E,nil,'IsUACEnabled');
 end;
end;

function GetUACStatus:TUACStatus;
var Reg:TRegistry;
 function ReadValue(Reg:TRegistry; Name:LongString; Default:DWORD):DWORD;
 begin
  if Reg.ValueExists(Name) then Result:=Reg.ReadInteger(Name) else Result:=Default;
 end;
begin
 SafeFillChar(Result,SizeOf(Result),0);
 try
  if IsUACAvailable then begin
   Reg:=TRegistry.Create(KEY_READ);
   try
    Reg.RootKey:=HKEY_LOCAL_MACHINE;
    if Reg.OpenKey('\Software\Microsoft\Windows\CurrentVersion\Policies\System',False) then begin
     Result.EnableLUA                   := ReadValue(Reg,'EnableLUA',                   0);
     Result.EnableInstallerDetection    := ReadValue(Reg,'EnableInstallerDetection',    0);
     Result.PromptOnSecureDesktop       := ReadValue(Reg,'PromptOnSecureDesktop',       0);
     Result.ConsentPromptBehaviorAdmin  := ReadValue(Reg,'ConsentPromptBehaviorAdmin',  0);
     Result.ConsentPromptBehaviorUser   := ReadValue(Reg,'ConsentPromptBehaviorUser',   0);
     Result.EnableSecureUIAPaths        := ReadValue(Reg,'EnableSecureUIAPaths',        0);
     Result.ValidateAdminCodeSignatures := ReadValue(Reg,'ValidateAdminCodeSignatures', 0);
     Result.EnableVirtualization        := ReadValue(Reg,'EnableVirtualization',        0);
     Result.EnableUIADesktopToggle      := ReadValue(Reg,'EnableUIADesktopToggle',      0);
     Result.FilterAdministratorToken    := ReadValue(Reg,'FilterAdministratorToken',    0);
     Result.UACAvail:=TRUE;
    end;
   finally
    FreeAndNil(Reg);
   end;
  end;
  Result.IsAdministratorAccount:=IsAdministratorAccount;
  Result.IsAdministrator:=IsAdministrator;
  Result.IsElevated:=IsElevated;
 except
  on E:Exception do BugReport(E,nil,'GetUACStatus');
 end;
end;

function GetUACStatusAsText(const Title:LongString='UAC Settings:'):LongString;
begin
 Result:='';
 try
  with GetUACStatus do
  Result:=Format('%s',                               [Title]                            )+EOL
         +Format('UACAvail                    = %d', [Ord(UACAvail=TRUE)]               )+EOL
         +Format('EnableLUA                   = %d', [EnableLUA]                        )+EOL
         +Format('EnableInstallerDetection    = %d', [EnableInstallerDetection]         )+EOL
         +Format('PromptOnSecureDesktop       = %d', [PromptOnSecureDesktop]            )+EOL
         +Format('ConsentPromptBehaviorAdmin  = %d', [ConsentPromptBehaviorAdmin]       )+EOL
         +Format('ConsentPromptBehaviorUser   = %d', [ConsentPromptBehaviorUser]        )+EOL
         +Format('EnableSecureUIAPaths        = %d', [EnableSecureUIAPaths]             )+EOL
         +Format('ValidateAdminCodeSignatures = %d', [ValidateAdminCodeSignatures]      )+EOL
         +Format('EnableVirtualization        = %d', [EnableVirtualization]             )+EOL
         +Format('EnableUIADesktopToggle      = %d', [EnableUIADesktopToggle]           )+EOL
         +Format('FilterAdministratorToken    = %d', [FilterAdministratorToken]         )+EOL
         +Format('IsAdministratorAccount      = %d', [Ord(IsAdministratorAccount=TRUE)] )+EOL
         +Format('IsAdministrator             = %d', [Ord(IsAdministrator=TRUE)]        )+EOL
         +Format('IsElevated                  = %d', [Ord(IsElevated=TRUE)]             )+EOL;
 except
  on E:Exception do BugReport(E,nil,'GetUACStatusAsText');
 end;
end;

function CallShellExecuteEx(fMask:ULONG; Wnd:HWND; lpVerb,lpFile,lpParameters,lpDirectory:LongString;
                            nShow:Integer=SW_SHOW; lpdwhInstApp:LPDWORD=nil; lpIDList:Pointer=nil; lpClass:LongString='';
                            hkeyClass:HKEY=0; dwHotKey:DWORD=0; hIcon:THandle=0; lpdwhProcess:PHandle=nil;
                            dwTimeOutMs:DWORD=0; lpdwPid:LPDWORD=nil; lpdwExitCode:LPDWORD=nil):BOOL;
var sei:TShellExecuteInfo; hInstApp:HINST; hProcess:THandle;
 function ArgChar(const Arg:LongString):PChar;
 begin
  if Length(Arg)>0 then Result:=PChar(Arg) else Result:=nil;
 end;
begin
 Result:=FALSE;
 try
  lpVerb:=Trim(lpVerb);
  lpFile:=Trim(lpFile);
  lpClass:=Trim(lpClass);
  lpParameters:=Trim(lpParameters);
  lpDirectory:=Trim(lpDirectory);
  if Assigned(lpdwhInstApp) then hInstApp:=lpdwhInstApp^ else hInstApp:=0;
  if Assigned(lpdwPid)      then lpdwPid^:=0;
  if Assigned(lpdwExitCode) then lpdwExitCode^:=0;
  if Assigned(lpdwhInstApp) then lpdwhInstApp^:=0;
  if Assigned(lpdwhProcess) then lpdwhProcess^:=0;
  ZeroMemory(@sei,SizeOf(sei));
  sei.cbSize:=SizeOf(sei);
  sei.fMask:=fMask;
  sei.Wnd:=Wnd;
  sei.lpVerb:=ArgChar(lpVerb);
  sei.lpFile:=ArgChar(lpFile);
  sei.lpParameters:=ArgChar(lpParameters);
  sei.lpDirectory:=ArgChar(lpDirectory);
  sei.nShow:=nShow;
  sei.hInstApp:=hInstApp;
  sei.lpIDList:=lpIDList;
  sei.lpClass:= ArgChar(lpClass);
  sei.hkeyClass:=hkeyClass;
  sei.dwHotKey:=dwHotKey;
  sei.DUMMYUNIONNAME.hIcon:=hIcon;
  Result:=ShellExecuteEx(LPSHELLEXECUTEINFO(@sei));
  hInstApp:=sei.hInstApp;
  hProcess:=sei.hProcess;
  if Assigned(lpdwhInstApp) then lpdwhInstApp^:=hInstApp;
  if Assigned(lpdwhProcess) then lpdwhProcess^:=hProcess;
  if Result then begin
   if hProcess<>0 then begin
    if dwTimeOutMs>0 then WaitForSingleObject(hProcess,dwTimeOutMs);
    if Assigned(lpdwPid)      then lpdwPid^:=GetProcessId(hProcess);
    if Assigned(lpdwExitCode) then GetExitCodeProcess(hProcess,lpdwExitCode^);
    if Assigned(lpdwhInstApp) then lpdwhInstApp^:=hInstApp;
    if Assigned(lpdwhProcess) then lpdwhProcess^:=hProcess else CloseHandle(hProcess);
   end;
  end;
 except
  on E:Exception do BugReport(E,nil,'CallShellExecuteEx');
 end;
end;

function RunElevated(fMask:ULONG; Wnd:HWND; lpFile,lpParameters,lpDirectory:LongString;
                     nShow:Integer=SW_SHOW; lpdwhInstApp:LPDWORD=nil; lpdwhProcess:PHandle=nil;
                     dwTimeOutMs:DWORD=0; lpdwPid:LPDWORD=nil; lpdwExitCode:LPDWORD=nil):BOOL;
 function lpVerb:LongString;
 begin
  if StrictUacCheck and not IsUACAvailable then Result:='' else  // UAC not available
  if IsAdministrator and IsElevated then Result:='' else  // Already elevated?
  Result:='runas';                                        // Request elevation
 end;
begin
 Result:=FALSE;
 try
  lpFile:=Trim(lpFile);
  lpDirectory:=Trim(lpDirectory);
  lpParameters:=Trim(lpParameters);
  fMask:=fMask or SEE_MASK_NOASYNC;
  fMask:=fMask or SEE_MASK_FLAG_NO_UI;
  fMask:=fMask or SEE_MASK_CONNECTNETDRV;
  fMask:=fMask or SEE_MASK_NOCLOSEPROCESS;
  if Length(lpDirectory)=0 then lpDirectory:=GetCurrentDir;
  Result:=CallShellExecuteEx(fMask,Wnd,lpVerb,lpFile,lpParameters,lpDirectory,
                             nShow,lpdwhInstApp,nil,'',0,0,0,lpdwhProcess,
                             dwTimeOutMs,lpdwPid,lpdwExitCode);
 except
  on E:Exception do BugReport(E,nil,'RunElevated');
 end;
end;

function RunElevatedCmd(lpParameters,lpDirectory:LongString;
                        nShow:Integer=SW_SHOW; lpdwhInstApp:LPDWORD=nil; lpdwhProcess:PHandle=nil;
                        dwTimeOutMs:DWORD=0; lpdwPid:LPDWORD=nil; lpdwExitCode:LPDWORD=nil;
                        CmdOpt:LongString='/c'; UsePushd:Boolean=true):Boolean;
var Buff:TMaxPathBuffer; lpFile,ComSpec:LongString;
begin
 Result:=FALSE;
 try
  CmdOpt:=Trim(CmdOpt);
  lpDirectory:=Trim(lpDirectory);
  lpParameters:=Trim(lpParameters);  
  SetString(ComSpec,Buff,Windows.GetEnvironmentVariable('ComSpec',Buff,SizeOf(Buff)));
  if Length(ComSpec)=0 then ComSpec:='cmd.exe'; // Fallback ComSpec
  lpFile:=ComSpec;
  if Length(CmdOpt)=0 then CmdOpt:='/c'; // Fallback cmd option
  if Length(lpDirectory)=0 then lpDirectory:=GetCurrentDir;
  if UsePushd
  then lpParameters:=Format('%s pushd "%s" & %s',[CmdOpt,lpDirectory,lpParameters])
  else lpParameters:=Format('%s %s',[CmdOpt,lpParameters]);
  Result:=RunElevated(SEE_MASK_NOASYNC or SEE_MASK_FLAG_NO_UI or SEE_MASK_CONNECTNETDRV or SEE_MASK_NOCLOSEPROCESS,0,
                      lpFile,lpParameters,lpDirectory,nShow,lpdwhInstApp,lpdwhProcess,dwTimeOutMs,lpdwPid,lpdwExitCode);
 except
  on E:Exception do BugReport(E,nil,'RunElevatedCmd');
 end;
end;

 ///////////////////////////////////////////////////////////////////////////////
 // Some special Win32 calls which are not presents in Windows.pas
 ///////////////////////////////////////////////////////////////////////////////
function CreateProcessWithLogon(lpUsername,lpDomain,lpPassword:PChar;
          dwLogonFlags:DWORD; lpApplicationName,lpCommandLine:PChar;
          dwCreationFlags:DWORD; lpEnvironment:Pointer;
          lpCurrentDirectory:PChar; const lpStartupInfo:TStartupInfo;
          var lpProcessInformation:TProcessInformation):BOOL stdcall;
const
 CreateProcessWithLogonW : function(lpUsername,lpDomain,lpPassword:PWideChar;
          dwLogonFlags:DWORD; lpApplicationName,lpCommandLine:PWideChar;
          dwCreationFlags:DWORD; lpEnvironment:Pointer;
          lpCurrentDirectory:PWideChar; const lpStartupInfo:TStartupInfo;
          var lpProcessInformation:TProcessInformation):BOOL stdcall = nil;
var hModule:THandle; LastError:DWORD;
 // We need wrapper procedure because function frame code resets GetLastError
 function WrapCreateProcessWithLogonW:BOOL;
 var wsUsername,wsDomain,wsPassword,wsApplicationName:WideString;
 var wsCommandLine,wsCurrentDirectory:WideString;
  function ArgWChar(const Str:WideString):PWideChar;
  begin
   if Length(Str)>0 then Result:=PWideChar(Str) else Result:=nil;
  end;
 begin
  wsUsername:=StrToWide(lpUsername);
  wsDomain:=StrToWide(lpDomain);
  wsPassword:=StrToWide(lpPassword);
  wsApplicationName:=StrToWide(lpApplicationName);
  wsCommandLine:=StrToWide(lpCommandLine);
  wsCurrentDirectory:=StrToWide(lpCurrentDirectory);
  Result:=CreateProcessWithLogonW(ArgWChar(wsUsername),ArgWChar(wsDomain),
            ArgWChar(wsPassword),dwLogonFlags,ArgWChar(wsApplicationName),
            ArgWChar(wsCommandLine),dwCreationFlags,lpEnvironment,
            ArgWChar(wsCurrentDirectory),lpStartupInfo,lpProcessInformation);
  LastError:=GetLastError;
 end;
begin
 Result:=false;
 if not Assigned(CreateProcessWithLogonW) then begin
  hModule:=GetModuleHandle('advapi32.dll');
  if hModule<>0 then @CreateProcessWithLogonW:=GetProcAddress(hModule,'CreateProcessWithLogonW');
 end;
 if Assigned(CreateProcessWithLogonW) then begin
  Result:=WrapCreateProcessWithLogonW;
  SetLastError(LastError);
 end else SetLastError(ERROR_CALL_NOT_IMPLEMENTED);
end;
{$ENDIF ~WINDOWS}

{$IFDEF UNIX}
function IsUserAnAdmin:Boolean;
begin
 Result:=IsIamRoot;
end;

function IsAdministrator:Boolean;
begin
 Result:=IsIamRoot;
end;

function IsAdministratorAccount:Boolean;
begin
 Result:=IsIamRoot;
end;

function IsElevated:Boolean;
begin
 Result:=IsIamRoot;
end;

function GetGroupNames(n:Integer=1024):LongString;
var i:Integer; ga:pGrpArr;
begin
 Result:='';
 if (n>0) then
 try
  ga:=Allocate(n*SizeOf(TGid));
  try
   n:=FpGetgroups(n,ga^);
   if (n<=0) then Exit('');
   for i:=0 to n-1 do begin
    if (Result='')
    then Result:=GetGroupName(ga[i])
    else Result:=Result+' '+GetGroupName(ga[i]);
   end;
  finally
   Deallocate(ga);
  end;
 except
  on E:Exception do BugReport(E,nil,'GetGroupNames');
 end;
end;

function GetListOfUserMembership(Delim:Char=' '; Header:Boolean=false):LongString;
const UacLev:array[Boolean] of PChar=('restricted','elevated');
var i:Integer; s:LongString;
begin
 Result:='';
 try
  s:='';
  if IsIamRoot then s:='root' else begin
   s:=Trim(GetGroupNames);
   if (s='') then // fallback solution
   if RunCommand('id --groups --name',s) then s:=Trim(s);
  end;
  for i:=1 to WordCount(s,JustSpaces) do begin
   if (Result='')
   then Result:=ExtractWord(i,s,JustSpaces)
   else Result:=Result+Delim+ExtractWord(i,s,JustSpaces);
  end;
  if Header then begin
   Result:=Format('%s is %s member of group(s) %s',[UserName,UacLev[IsElevated],Result]);
  end;
 except
  on E:Exception do BugReport(E,nil,'GetListOfUserMembership');
 end;
end;

{$ENDIF ~UNIX}

///////////////////////////////////////
// Unit initialization and finalization
///////////////////////////////////////

procedure Init_crw_uac;
begin
 {$IFDEF WINDOWS}
 ImportLibraries;
 {$ENDIF ~WINDOWS}
end;

procedure Free_crw_uac;
begin
end;

initialization

 Init_crw_uac;

finalization

 Free_crw_uac;

end.

//////////////
// END OF FILE
//////////////

