Self Elevate ProcessTop

Sometimes a process must run with Administrator privileges. This Unit can start the own process with Administrator privileges.

UsageTop

Include this unit in your project and call RunElevated at the beginning of your program. It will then:

  1. Check if the process has Administrator privileges
  2. If is doesn’t have:
    1. Start the same program with Administrator privileges and pass the arguments to it.
    2. Terminate itself.
program elevate_test;
{$APPTYPE CONSOLE}

uses
  SysUtils, elevate;

begin
  RunElevated;

  // Now the process has elevated privileges and we can do important stuff.
  WriteLn('Running with elevated privileges');
end.

CodeTop

unit Elevate;

interface

uses
  SysUtils, Windows, ShellAPI, ComObj;

procedure RunElevated;

implementation

function CheckTokenMembership(TokenHandle: THANDLE; SidToCheck: Pointer; var IsMember: BOOL): BOOL; stdcall; external advapi32 name 'CheckTokenMembership';

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

function IsRunningAsAdmin: boolean;
var
  dwError: DWORD;
  pAdministratorsGroup: Pointer;
  NtAuthority: TSIDIdentifierAuthority;
  b: BOOL;
begin
  Result := false;
  dwError := ERROR_SUCCESS;
  pAdministratorsGroup := nil;
  NtAuthority := SECURITY_NT_AUTHORITY;

  try
    if (AllocateAndInitializeSid(
      @NtAuthority,
      2,
      SECURITY_BUILTIN_DOMAIN_RID,
      DOMAIN_ALIAS_RID_ADMINS,
      0, 0, 0, 0, 0, 0,
      pAdministratorsGroup))
    then begin
      if (CheckTokenMembership(0, pAdministratorsGroup, b)) then begin
        Result := b;
      end else begin
        dwError := GetLastError;
      end;
    end else begin
      dwError := GetLastError;
    end;
  finally
    if (pAdministratorsGroup <> nil) then begin
      FreeSid(pAdministratorsGroup);
    end;
  end;
  if (dwError <> ERROR_SUCCESS) then
    raise Exception.Create(SysErrorMessage(dwError));
end;

procedure RunElevated;
{$IFDEF FPC}
type
  PShellExecuteInfo = ^TShellExecuteInfo;
{$ENDIF}
var
  SEI: TShellExecuteInfo;
  Host: string;
  Args: string;
  i: integer;
begin
  if not IsRunningAsAdmin then begin
    Host := ParamStr(0);
    Args := '';
    for i := 1 to ParamCount do begin
      Args := Args + ' "' + ParamStr(i) + '"';
    end;
    Args := Trim(Args);

    SEI := Default(TShellExecuteInfo);
    SEI.cbSize := SizeOf(SEI);
    SEI.fMask := SEE_MASK_NOCLOSEPROCESS;
{$IFDEF UNICODE}
    SEI.fMask := SEI.fMask or SEE_MASK_UNICODE;
{$ENDIF}
    SEI.Wnd := 0;
    SEI.lpVerb := 'runas';
    SEI.lpFile := PChar(Host);
    SEI.lpParameters := PChar(Args);
    SEI.nShow := SW_NORMAL;
    if not ShellExecuteEx({$IFDEF FPC}PShellExecuteInfo{$ENDIF}(@SEI)) then
      RaiseLastOSError;
    Halt(0);
  end;
end;

end.

DownloadTop