Message from discussion Service launching exe in security context of logged in user

From: "Colin Wilson" <co...@wilsonc.demon.co.uk>
Subject: Re: Service launching exe in security context of logged in user
Newsgroups: borland.public.delphi.nativeapi.win32
References: <4165b2ba@newsgroups.borland.com> <4166E1CE.AEC9E17@no-spam.gmx.net> <416709e5@newsgroups.borland.com>
User-Agent: XanaNews/1.16.4.6
MIME-Version: 1.0
Content-Type: text/plain; charset=iso-8859-1
NNTP-Posting-Host: 217.44.213.140
Message-ID: <416a98a9$1@newsgroups.borland.com>
Date: 11 Oct 2004 07:28:57 -0700
X-Trace: newsgroups.borland.com 1097504937 217.44.213.140 (11 Oct 2004 07:28:57 -0700)
Lines: 220
Path: g2news1.google.com!news1.google.com!news.glorb.com!logbridge.uoregon.edu!newsfeeds.ihug.co.nz!ihug.co.nz!newsgroups.borland.com!not-for-mail

Steve McGrath wrote:

> Do you have working code sample for this.

You can use the code below.  People keep complaining that I forgot to
upload this to my website, so posting it here will kill two birds with
one stone!

It impersonates the logged on user, then loads their profile - so that
things like HKEY_CURRENT_USER work correctly in the context of the user
being impersonated.

You use it like this, from within your service's thread...

procedure TMyServiceThread.Execute;
var
  impersonator : TImpersonator;
begin
  impersonator := TImpersonator.CreateLoggedOn;
  try
    
    ...  Do whatever you like in the context of the logged on user ...

  finally
    impersonator.Free  // Revert to the SYSTEM account
  end
end;

-- 
Colin - using XanaNews HTTP Transport
e-mail :co...@wilsonc.demon.co.uk
web: http://www.wilsonc.demon.co.uk/delphi.htm

Posted with XanaNews 1.16.4.6

---  Here's the code...  ----

unit unitImpersonator;

interface

uses Windows, Classes, SysUtils;

type

TProfileInfo = record
  dwSize : DWORD;
  dwFlags : DWORD;
  lpUserName : PChar;
  lpProfilePath : PChar;
  lpDefaultPath : PChar;
  lpServerName : PChar;
  lpPolicyPath : PChar;
  hProfile : HKEY;
end;


TImpersonator = class
private
  fTokenHandle : THandle;
  fImpersonating: boolean;
  fProfileLoaded : boolean;
  fProfileInfo : TProfileInfo;
  procedure Impersonate;
  function GetImpersonating: boolean;
  function GetHKCURootKey: HKEY;
public
  constructor Create (const domain, user, password : string);
  constructor CreateLoggedOn;   // Impersonate the currently logged on
user.

  destructor Destroy; override;

  property Impersonating : boolean read GetImpersonating;
  property HKCURootKey : HKEY read GetHKCURootKey;
end;

const
  PI_NOUI        = 1;     // Prevents displaying of messages
  PI_APPLYPOLICY = 2;     // Apply NT4 style policy

function LoadUserProfile (hToken : THandle; var profileInfo :
TProfileInfo) : BOOL; stdcall;
function UnloadUserProfile (hToken, HKEY : THandle) : BOOL; stdcall;
function GetCurrentUserName : string;
function OpenProcessHandle (const process : string) : THandle;

implementation

uses psapi;

function LoadUserProfile (hToken : THandle; var profileInfo :
TProfileInfo) : BOOL; external 'userenv.dll' name 'LoadUserProfileA';
function UnLoadUserProfile (hToken, HKEY : THandle) : BOOL; external
'userenv.dll';

function OpenProcessHandle (const process : string) : THandle;
var
  buffer, pid : PDWORD;
  bufLen, cbNeeded : DWORD;
  hp : THandle;
  fileName : array [0..256] of char;
  i : Integer;
begin
  result := 0;
  bufLen := 65536;
  GetMem (buffer, bufLen);
  try
    if EnumProcesses (buffer, bufLen, cbNeeded) then
    begin
      pid := buffer;
      for i := 0 to cbNeeded div sizeof (DWORD) - 1 do
      begin
        hp := OpenProcess (PROCESS_VM_READ or
PROCESS_QUERY_INFORMATION, False, pid^);
        if hp <> 0 then
        try
          if (GetModuleBaseName (hp, 0, fileName, sizeof (fileName)) >
0) and
             (CompareText (fileName, process) = 0) then
          begin
            result := hp;
            break
          end
        finally
          if result = 0 then
            CloseHandle (hp)
        end;

        Inc (pid)
      end
    end
  finally
    FreeMem (buffer)
  end
end;

function GetExplorerProcessToken : THandle;
var
  explorerProcessHandle : THandle;
begin
  explorerProcessHandle := OpenProcessHandle ('explorer.exe');
  if explorerProcesshandle <> 0 then
  try
    if not OpenProcessToken (explorerProcessHandle, TOKEN_QUERY or
TOKEN_IMPERSONATE or TOKEN_DUPLICATE, result) then
      RaiseLastOSError;
  finally
    CloseHandle (explorerProcessHandle)
  end
  else
    result := INVALID_HANDLE_VALUE;
end;

function GetCurrentUserName : string;
var
  unLen : DWORD;
begin
  unLen := 512;
  SetLength (result, unLen);
  GetUserName (PChar (result), unLen);
  result := PChar (result);
end;

{ TImpersonator }

constructor TImpersonator.Create(const domain, user, password: string);
begin
  if LogonUser (PChar (user), PChar (domain), PChar (password),
LOGON32_LOGON_INTERACTIVE, LOGON32_PROVIDER_DEFAULT, fTokenHandle) then
    Impersonate;
end;

procedure TImpersonator.Impersonate;
var
  userName : string;
begin
  fImpersonating := ImpersonateLoggedOnUser (fTokenHandle);
  if fImpersonating then
  begin
    userName := GetCurrentUserName;

    ZeroMemory (@fProfileInfo, sizeof (fProfileInfo));
    fProfileInfo.dwSize := sizeof (fProfileInfo);
    fProfileInfo.lpUserName := PChar (userName);
    fProfileInfo.dwFlags := PI_APPLYPOLICY;
    fprofileLoaded := LoadUserProfile (fTokenHandle, fProfileInfo);
  end
end;

constructor TImpersonator.CreateLoggedOn;
begin
  fTokenHandle := GetExplorerProcessToken;

  if fTokenHandle <> INVALID_HANDLE_VALUE then
    Impersonate;
end;

destructor TImpersonator.Destroy;
begin
  if fProfileLoaded then
    UnloadUserProfile (fTokenHandle, fProfileInfo.hProfile);

  if fImpersonating then
    RevertToSelf;

  CloseHandle (fTokenHandle);
end;

function TImpersonator.GetImpersonating: boolean;
begin
  result := fImpersonating and fProfileLoaded;
end;

function TImpersonator.GetHKCURootKey: HKEY;
begin
  result := fProfileInfo.hProfile
end;

end.