User-Spezifische Folder ermitteln wenn mit "Run als Administrator" gestartet wurde

[Christoph Schneider]

Unterdessen habe ich meinen Fehler entdeckt. Es lag an einem Seiteneffekt und gar nicht am gezeigten Code - der funktionierte bereits richtig.
Ich habe für Test-Zwecke das Token noch gebraucht um Domain und UserName darzustellen. Dafür hätte ich aber das
Token vorher noch duplizieren müssen. Hier zeige ich gerne die jetzt implementierte Lösung:

Code:

function CreateTokenOfProcess(ProcessId: DWORD): THandle;
const
  PROCESS_QUERY_LIMITED_INFORMATION = $1000;
var
  ProcessHandle, TokenHandle: THandle;
begin
  result := 0;
  ProcessHandle := 0;
  try
    ProcessHandle:= OpenProcess(PROCESS_QUERY_LIMITED_INFORMATION, True, ProcessId);
    if ProcessHandle <> 0 then
    begin
      if OpenProcessToken(ProcessHandle, TOKEN_QUERY or TOKEN_IMPERSONATE, TokenHandle) then
        result := TokenHandle;
      // Call CloseHandle(TokenHandle) by caller
    end;
  finally
    CloseHandle(ProcessHandle);
  end;
end;

function GetParentProcessID: DWORD;
// This function should be part of the API!
var
  Snap: THandle;
  Proc: TProcessEntry32;
  CurrentProc: cardinal;
begin
  result := 0;
  Snap := CreateToolHelp32SnapShot(TH32CS_SNAPALL, 0);
  try
    CurrentProc := GetCurrentProcessId;
    Proc.dwSize := SizeOf(TProcessEntry32);
    Process32First(Snap, Proc);
    repeat
      if Proc.th32ProcessID = CurrentProc then
      begin
        result := Proc.th32ParentProcessID;
        Break;
      end;
    until (not Process32Next(Snap, Proc));
  finally
    CloseHandle(Snap);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  hres: HResult;
  Folder: array[0..Max_Path] of Char;
  Token: THandle;
begin
  Token := CreateTokenOfProcess(GetParentProcessID);
  try
    hRes := SHGetFolderPath(Handle, CSIDL_PROGRAMS, Token, SHGFP_TYPE_DEFAULT, Folder);
    if not Succeeded(hRes) then
      raise Exception.Create(SysErrorMessage(hRes)));
    ShowMessage('SHGetFolderPath Succeeded:' + string(Folder));
  finally
    CloseHandle(Token);
  end;
end;

Den Ansatz über die Session ID bringe ich leider nicht zum Laufen. Hier kurz der Abriss:

Code:

function WTSQueryUserToken(SessionId: DWORD; phToken: pHandle):bool; stdcall; external 'wtsapi32.dll';
function ProcessIdToSessionId(dwProcessId: DWORD; pSessionId: DWORD): bool; stdcall; external 'Kernel32.dll';

function CreateTokenFromSession: THandle;
var
  SessionID: cardinal; 
begin
  if not ProcessIdToSessionId(GetCurrentProcessId, DWORD(@SessionID)) then
    raise Exception.Create(SysErrorMessage(GetLastError)));
  { Korrekte Session ID erhalten }
  if not WTSQueryUserToken(SessionId, @result) then
    raise Exception.Create(SysErrorMessage(GetLastError)));
    { Hier bekomme ich immer "A required privilege is not held by the client" }
end;

Ich versuchte noch das Privileg SE_TCB_NAME zu setzen, scheiterte aber auch damit.

Die Lösung mit dem Parent-Prozess sollten im normalen Umfeld eigentlich gut funktieren. Probleme entstehen,
wenn der Installer aus einem Batch oder einer anderen Applikation gestartet wird, die bereits den User-Switch
vorgenommen haben. Da mein Installer über kein Command-Line Interface verfügt, mache ich mir hierzu aber
keine weiteren Sorgen.
Im Gegensatz zu Unix fehlt unter Windows ein richtiger Root-Process, der die User-Session gestartet hat. Der
Explorer-Prozess übernimmt zwar mehrheitlich diese Aufgabe, kann aber jederzeit beendet und neugestartet werden.
Ergo ist es schwierig über den Prozessbaum den gültigen Root-Prozess zu finden. Aus diesem Grunde versuche ich
mal mit diesem Workaround zu leben.