How to run a process non-elevated with Delphi2007

Question

I have an installer-like application that I have to run as elevated on Vista. But from there I have to start a new process as non-elevated. Any hints how to do this with Delphi2007?

Answer 1

This blog post is detailed and useful

http://developersoven.blogspot.com/2007/02/leveraging-vistas-uac-with-delphi-part.html

The idea is to use your app with low privilege and COM Dll with elevated privilege. Then when you need elevation, you just fire up COM. Full MPLed source link is included in the post.

Answer 2

I found an excellent example for C++ and adapted it for Delphi:

unit MediumIL;

interface

uses
  Winapi.Windows;

function CreateProcessMediumIL(lpApplicationName: PWChar; lpCommandLine: PWChar; lpProcessAttributes: PSecurityAttributes; lpThreadAttributes: PSecurityAttributes; bInheritHandle: BOOL; dwCreationFlags: DWORD; lpEnvironment: LPVOID; lpCurrentDirectory: PWChar; const lpStartupInfo: TStartupInfoW; var lpProcessInformation: TProcessInformation): DWORD;

implementation

type
  TOKEN_MANDATORY_LABEL = record
    Label_: SID_AND_ATTRIBUTES;
  end;

  PTOKEN_MANDATORY_LABEL = ^TOKEN_MANDATORY_LABEL;

  TTokenMandatoryLabel = TOKEN_MANDATORY_LABEL;
  PTokenMandatoryLabel = ^TTokenMandatoryLabel;

  TCreateProcessWithTokenW = function (hToken: THandle; dwLogonFlags: DWORD; lpApplicationName: LPCWSTR; lpCommandLine: LPWSTR; dwCreationFlags: DWORD; lpEnvironment: LPVOID; lpCurrentDirectory: LPCWSTR; const lpStartupInfo: TStartupInfoW; out lpProcessInfo: TProcessInformation): BOOL; stdcall;

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 GetShellWindow: HWND; stdcall; external 'user32.dll' name 'GetShellWindow';

// writes Integration Level of the process with the given ID into dwProcessIL
// returns Win32 API error or 0 if succeeded
function GetProcessIL(dwProcessID: DWORD; var dwProcessIL: DWORD): DWORD;
label
  _CleanUp;
var
  hProcess: THandle;
  hToken: THandle;
  dwSize: DWORD;
  pbCount: PByte;
  pdwProcIL: PDWORD;
  pTIL: PTokenMandatoryLabel;
  dwError: DWORD;
begin
  dwProcessIL := 0;

  pTIL := nil;

  hProcess := OpenProcess(PROCESS_QUERY_INFORMATION, False, dwProcessID);
  if (hProcess = 0) then
    goto _CleanUp;

  if (not OpenProcessToken(hProcess, TOKEN_QUERY, hToken)) then
    goto _CleanUp;

  if (not GetTokenInformation(hToken, TokenIntegrityLevel, nil, 0, dwSize) and (GetLastError() <> ERROR_INSUFFICIENT_BUFFER)) then
    goto _CleanUp;

  pTIL := HeapAlloc(GetProcessHeap(), 0, dwSize);
  if (pTIL = nil) then
    goto _CleanUp;

  if (not GetTokenInformation(hToken, TokenIntegrityLevel, pTIL, dwSize, dwSize)) then
    goto _CleanUp;

  pbCount := PByte(GetSidSubAuthorityCount(pTIL^.Label_.Sid));
  if (pbCount = nil) then
    goto _CleanUp;

  pdwProcIL := GetSidSubAuthority(pTIL^.Label_.Sid, pbCount^ - 1);
  if (pdwProcIL = nil) then
    goto _CleanUp;

  dwProcessIL := pdwProcIL^;
  SetLastError(ERROR_SUCCESS);

  _CleanUp:
  dwError := GetLastError();
  if (pTIL <> nil) then
    HeapFree(GetProcessHeap(), 0, pTIL);
  if (hToken <> 0) then
    CloseHandle(hToken);
  if (hProcess <> 0) then
    CloseHandle(hProcess);
  Result := dwError;
end;

// Creates a new process lpApplicationName with the integration level of the Explorer process (MEDIUM IL)
// If you need this function in a service you must replace FindWindow() with another API to find Explorer process
// The parent process of the new process will be svchost.exe if this EXE was run "As Administrator"
// returns Win32 API error or 0 if succeeded
function CreateProcessMediumIL(lpApplicationName: PWChar; lpCommandLine: PWChar; lpProcessAttributes: PSecurityAttributes; lpThreadAttributes: PSecurityAttributes; bInheritHandle: BOOL; dwCreationFlags: DWORD; lpEnvironment: LPVOID; lpCurrentDirectory: PWChar; const lpStartupInfo: TStartupInfoW; var lpProcessInformation: TProcessInformation): DWORD;
label
  _CleanUp;
var
  hProcess: THandle;
  hToken: THandle;
  hToken2: THandle;
  bUseToken: BOOL;
  dwCurIL: DWORD;
  dwErr: DWORD;
  f_CreateProcessWithTokenW: TCreateProcessWithTokenW;
  hProgman: HWND;
  dwExplorerPID: DWORD;
  dwError: DWORD;
begin
  bUseToken := False;

  // Detect Windows Vista, 2008, Windows 7 and higher
  if (GetProcAddress(GetModuleHandleA('Kernel32'), 'GetProductInfo') <> nil) then
  begin
    dwErr := GetProcessIL(GetCurrentProcessId(), dwCurIL);
    if (dwErr <> 0) then
    begin
      Result := dwErr;
      Exit;
    end;
      if (dwCurIL > SECURITY_MANDATORY_MEDIUM_RID) then
        bUseToken := True;
  end;

  // Create the process normally (before Windows Vista or if current process runs with a medium IL)
  if (not bUseToken) then
  begin
    if (not CreateProcessW(lpApplicationName, lpCommandLine, lpProcessAttributes, lpThreadAttributes, bInheritHandle, dwCreationFlags, lpEnvironment, lpCurrentDirectory, lpStartupInfo, lpProcessInformation)) then
    begin
      Result := GetLastError();
      Exit;
    end;

    CloseHandle(lpProcessInformation.hThread);
    CloseHandle(lpProcessInformation.hProcess);
    Result := ERROR_SUCCESS;
    Exit;
  end;

  f_CreateProcessWithTokenW := GetProcAddress(GetModuleHandleA('Advapi32'), 'CreateProcessWithTokenW');

  if (not Assigned(f_CreateProcessWithTokenW)) then // This will never happen on Vista!
  begin
    Result := ERROR_INVALID_FUNCTION;
    Exit;
  end;

  hProgman := GetShellWindow();

  dwExplorerPID := 0;
  GetWindowThreadProcessId(hProgman, dwExplorerPID);

  // ATTENTION:
  // If UAC is turned OFF all processes run with SECURITY_MANDATORY_HIGH_RID, also Explorer!
  // But this does not matter because to start the new process without UAC no elevation is required.
  hProcess := OpenProcess(PROCESS_QUERY_INFORMATION, False, dwExplorerPID);
  if (hProcess = 0) then
    goto _CleanUp;

  if (not OpenProcessToken(hProcess, TOKEN_DUPLICATE, hToken)) then
    goto _CleanUp;

  if (not DuplicateTokenEx(hToken, TOKEN_ALL_ACCESS, nil, SecurityImpersonation, TokenPrimary, hToken2)) then
    goto _CleanUp;

  if (not f_CreateProcessWithTokenW(hToken2, 0, lpApplicationName, lpCommandLine, dwCreationFlags, lpEnvironment, lpCurrentDirectory, lpStartupInfo, lpProcessInformation)) then
    goto _CleanUp;

  SetLastError(ERROR_SUCCESS);

  _CleanUp:
  dwError := GetLastError();
  if (hToken <> 0) then
    CloseHandle(hToken);
  if (hToken2 <> 0) then
    CloseHandle(hToken2);
  if (hProcess <> 0) then
    CloseHandle(hProcess);
  CloseHandle(lpProcessInformation.hThread);
  CloseHandle(lpProcessInformation.hProcess);
  Result := dwError;
end;

end.

To use this in your project, simply use unit MediumIL:

uses MediumIL;

…

procedure TForm1.FormCreate(Sender: TObject);
var
  StartupInfo: TStartupInfo;
  ProcessInfo: TProcessInformation;
begin
  ZeroMemory(@StartupInfo, SizeOf(StartupInfo));
  ZeroMemory(@ProcessInfo, SizeOf(ProcessInfo));
  CreateProcessMediumIL('C:\Windows\notepad.exe', nil, nil, nil, False, 0, nil, nil, StartupInfo, ProcessInfo);
end;