Programm auf eigenem "Desktop" ausführen

[Codewalker]

Hallo zusammen.

Ich möchte über mein Programm eine Installation durchführen. Wichtig ist aber, dass der Benutzer währenddessen nicht interagiert oder die Fenster wechselt. Dazu blocke ich mit BlockInput die Eingabe. Leider ist das durch die IBM-Kralle (Strg+Alt+Entf) leicht umgehbar. Ich würde daher gerne das Programm auf einem eigenen Desktop (sowas wie der SecureDesktop ab Vista) ausführen und auch die Anzeige dorthin wechseln, so dass der User nur abwarten kann. Hat jemand eine Idee wie ich sowas (oder eine Alternativlösung) realisieren kann?

[himitsu]

CreateDesktop CreateDesktop
aber nicht vergessen, der Thread, mit welchem dieses "Fenster" angezeigt werden soll, darf kein "Fensterhandle" irgendeiner Art auf einem anderem Desktop besitzen, sonst kann man nicht auf den anderen/neuen Desktop wechseln und dort ein Fenster erzeugen.

Heißt, wenn du mit der VCL arbeiten willst, daß du 2 Programme oder zumindestens 2 Programminstanzen benötigst, da die VCL einige "unsichtbare" Fenster zur Verwaltung im Hauptthread erstellt.
Wegen diesen kannst du den Hauptthread nicht auf den anderen Desktop übergeben und die VCL kann/darf man aber nur von Hauptthread aus verwenden.

Ergo:
- Programm 1 erstellt Desktop
- Programm 1 macht diesen Desktop sichtbar
- Programm 1 startet Programm 2 geziehlt auf diesem Desktop
- Programm 2 arbeitet
- ...
- Programm 2 beendet sich und übergibt die Kontrolle an Programm 1
- Programm 1 macht den ursprünglichen Desktop wieder sichtbar
- Programm 1 löscht den erstellten Desktop

(Programm 2 kann auch eine weitere Instantz des 1. Programms sein)

[hathor]

Wenn irgendein Installationsprogramm mich blockieren würde, wäre ich doch sehr misstrauisch und würde als Erstes die Internetverbindung kappen mit ZoneAlarm. Wenn das nicht ginge, wäre da immer noch der Powerknopf...

[Codewalker]

Zitat von hathor:

Wenn irgendein Installationsprogramm mich blockieren würde, wäre ich doch sehr misstrauisch und würde als Erstes die Internetverbindung kappen mit ZoneAlarm. Wenn das nicht ginge, wäre da immer noch der Powerknopf...

Ist ein automatisches Installationsprogramm für interne Zwecke. Von daher dürfte das wohl als vertrauenswürdig durchgehen

@himitsu: Ich hoffe du meinst Desktop . Ist komplizierter als ich gewollt habe, aber ich werde mich mal drangeben.

[Astat]

Zitat von Codewalker:

..Hat jemand eine Idee wie ich sowas (oder eine Alternativlösung) realisieren kann?

Hallo Codewalker.

Folgende Möglichkeiten, Switch Desktop oder bei allen Prozessen vorübergehend die Threads deaktivieren.
D.h. Prozesse suchen, deren Threads ermitteln und diese suspenden, nach der Installation wieder resumen.

Anbei Desktop Switch sample und Thread Suspend Demo, getestet unter W2K

Delphi-Quellcode:

{$APPTYPE CONSOLE}

uses
  Windows,
  Sysutils;

var
  OldDesktop: HDESK = 0;
  NewDesktop: HDESK = 0;
  Deskname: array [0..255] of Char;

procedure CreateNewDesktop;
begin
  OldDesktop := GetThreadDesktop(GetCurrentThreadID);
  StrPCopy(Deskname, 'Desktop' + IntToStr(GetCurrentThreadID));
  NewDesktop := CreateDesktop(Deskname, nil, nil, 0, DESKTOP_CREATEMENU or
    DESKTOP_CREATEWINDOW or DESKTOP_SWITCHDESKTOP or DESKTOP_READOBJECTS or
    DESKTOP_WRITEOBJECTS or STANDARD_RIGHTS_REQUIRED, nil);

  if NewDesktop <> 0 then begin
    SetThreadDesktop(NewDesktop);
    SwitchDesktop(NewDesktop);
  end;
end;

procedure ReleaseDesktop;
begin
  if newDesktop <> 0 then begin
    SetThreadDesktop(OldDesktop);
    SwitchDesktop(OldDesktop);
  end;
end;


function lpThreadFunc(ptrData: Pointer): Integer;
var
  si: TStartupInfo;
  pi: TProcessInformation;
begin
  ZeroMemory(@si, SizeOf(si));
  si.cb := SizeOf(si);
  si.dwFlags := CREATE_NEW_CONSOLE or CREATE_NEW_PROCESS_GROUP or
    DETACHED_PROCESS;
  si.wShowWindow := SW_SHOWNORMAl;
  si.lpDesktop := ptrData;
  CreateProcess(nil, PChar('calc.exe'), nil, nil, false, CREATE_NEW_CONSOLE,
    nil, nil, si, pi);
  WaitForSingleObject(pi.hProcess, INFINITE);
  GetExitCodeProcess(pi.hProcess, DWORD(result));
  CloseHandle(pi.hProcess);
  CloseHandle(pi.hThread);
end;

var
  dwThreadID: DWORD;
  hThread: DWORD;
begin
  CreateNewDesktop;
  hThread := beginThread(nil, 0, lpThreadFunc, @deskname, 0 , dwThreadID);
  WaitForSingleObject(hThread, INFINITE);
  CloseHandle(dwThreadID);
  ReleaseDesktop;
end.

Thread Suspend Demo, startet calc.exe

Delphi-Quellcode:

{$APPTYPE CONSOLE}

uses
  windows,
  psapi,
  tlhelp32,
  SysUtils;

const
  THREAD_GET_CONTEXT    = $0008;
  THREAD_SET_CONTEXT    = $0010;
  THREAD_SUSPEND_RESUME = $0002;

function AdjustTokenPrivileges(TokenHandle: THandle; DisableAllPrivileges: BOOL;
  const NewState: TTokenPrivileges; BufferLength: DWORD;
  PreviousState: PTokenPrivileges; ReturnLength: PDWORD): BOOL; stdcall;
  external 'advapi32.dll' name 'AdjustTokenPrivileges'

function OpenThread(dwDesiredAccess: DWORD; bInheritHandle: BOOL; dwThreadId:
  DWORD): DWORD; stdcall; external 'kernel32.dll';

function EnableThreadPrivilege(const Enable: Boolean;
  const Privilege: string): Boolean;
const
  PrivAttrs: array [Boolean] of DWORD = (0, SE_PRIVILEGE_ENABLED);
var
  Token: THandle;
  TokenPriv: TTokenPrivileges;
  HaveToken: Boolean;
begin
  result := false;
  Token := 0;
  HaveToken := OpenThreadToken(GetCurrentThread, TOKEN_ADJUST_PRIVILEGES,
    False, Token);
  if (not HaveToken) and (GetLastError = ERROR_NO_TOKEN) then
    HaveToken := OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES, Token);
  if HaveToken then
  begin
    TokenPriv.PrivilegeCount := 1;
    LookupPrivilegeValue(nil, PChar(Privilege), TokenPriv.Privileges[0].Luid);
    TokenPriv.Privileges[0].Attributes := PrivAttrs[Enable];
    AdjustTokenPrivileges(Token, False, TokenPriv, SizeOf(TokenPriv), nil, nil);
    Result := GetLastError = ERROR_SUCCESS;
    CloseHandle(Token);
  end;
end;

function EnableProcessPrivilegeEx(hProcess: DWORD; const Privilege: string): Boolean;
var
  Token: THandle;
  TokenPriv: TTokenPrivileges;
begin
  Result := False;
  if OpenProcessToken(hProcess, TOKEN_ADJUST_PRIVILEGES, Token) then begin
    TokenPriv.PrivilegeCount := 1;
    LookupPrivilegeValue(nil, PChar(Privilege), TokenPriv.Privileges[0].Luid);
    TokenPriv.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
    AdjustTokenPrivileges(Token, False, TokenPriv, SizeOf(TokenPriv), nil, nil);
    Result := GetLastError = ERROR_SUCCESS;
    CloseHandle(Token);
  end;
end;

function EnableProcessPrivilege(const Enable: Boolean;
  const Privilege: string): Boolean;
const
  PrivAttrs: array [Boolean] of DWORD = (0, SE_PRIVILEGE_ENABLED);
var
  Token: THandle;
  TokenPriv: TTokenPrivileges;
begin
  Result := False;
  if OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES, Token) then
  begin
    TokenPriv.PrivilegeCount := 1;
    LookupPrivilegeValue(nil, PChar(Privilege), TokenPriv.Privileges[0].Luid);
    TokenPriv.Privileges[0].Attributes := PrivAttrs[Enable];
    AdjustTokenPrivileges(Token, False, TokenPriv, SizeOf(TokenPriv),
      nil, nil);
    Result := GetLastError = ERROR_SUCCESS;
    CloseHandle(Token);
  end;
end;

procedure SetThreadState(Suspend: Boolean);
var
  hProc, h32: DWORD;
  hThread: DWORD;
  PE32: TProcessEntry32;
  TE32: TThreadEntry32;
  szName: array[0..MAX_PATH -1] of char;
  sName, sCurName: string;
begin
  sCurName := ExtractFileName(ParamStr(0));
  h32 := CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS or TH32CS_SNAPTHREAD, 0);
  if h32 <> ERROR_INVALID_HANDLE then begin
    PE32.dwSize := SizeOf(ProcessEntry32);
    TE32.dwSize := Sizeof(ThreadEntry32);
    if Thread32First(h32, TE32) then begin
      repeat
        EnableProcessPrivilege(true, 'SeDebugPrivilege');
        EnableProcessPrivilege(true, 'SeSecurityPrivilege');
        EnableProcessPrivilege(true, 'SeTakeOwnershipPrivilege');
        EnableProcessPrivilege(true, 'SeCreateTokenPrivilege');
        //-- ToDo für jeden Prozess nur einmal aufrufen, 
        //--      Exclude Liste mit GetSecurityInfo -> NT_ATHORITÄT_SYSTEM ersetzen usw.
        hProc := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ,
          False, TE32.th32OwnerProcessID);

        if hProc <> 0 then begin
          ZeroMemory(@szName, MAX_PATH);
          GetModuleFileNameEx(hProc, 0, szName, MAX_PATH);
          sName := ExtractFileName(string(szName));
          if (CompareText(sName, '?') = 0) or
             (CompareText(sName, 'lsass.exe') = 0) or
             (CompareText(sName, 'calc.exe') = 0) or
             (CompareText(sName, sCurName) = 0) or
             (CompareText(sName, 'winlogon.exe') = 0) or
             (CompareText(sName, 'csrss.exe') = 0) or
             (CompareText(sName, 'services.exe') = 0) or
             (CompareText(sName, 'smss.exe') = 0)
           then begin
            CloseHandle(hProc);
            continue;
          end;
          CloseHandle(hProc);
        end else
          continue;

        EnableThreadPrivilege(true, 'SeDebugPrivilege');
        EnableThreadPrivilege(true, 'SeSecurityPrivilege');
        EnableThreadPrivilege(true, 'SeTakeOwnershipPrivilege');
        EnableThreadPrivilege(true, 'SeCreateTokenPrivilege');

        hThread := OpenThread(THREAD_GET_CONTEXT or THREAD_SET_CONTEXT or
          THREAD_SUSPEND_RESUME, false, TE32.th32ThreadID);

        if hThread <> 0 then begin
          if Suspend then
            SuspendThread(hThread)
          else
            ResumeThread(hThread);
        end;

      until not Thread32Next(h32, TE32);
    end;
  end;
  CloseHandle(h32);
end;


procedure StartTestApp;
var
  si: TStartupInfo;
  pi: TProcessInformation;
begin
  ZeroMemory(@si, SizeOf(si));
  si.cb := SizeOf(si);
  si.dwFlags := CREATE_NEW_CONSOLE or CREATE_NEW_PROCESS_GROUP or
    DETACHED_PROCESS;
  si.wShowWindow := SW_SHOWNORMAl;
  si.lpDesktop := nil;
  CreateProcess(nil, PChar('calc.exe'), nil, nil, false, CREATE_NEW_CONSOLE,
    nil, nil, si, pi);
  WaitForInputIdle(pi.hProcess, INFINITE);
  SetThreadState(True);
  WaitForSingleObject(pi.hProcess, INFINITE);
  SetThreadState(false);
  CloseHandle(pi.hProcess);
  CloseHandle(pi.hThread);
end;

begin
  StartTestApp;
end.

lg. Astat

[Codewalker]

@Astat: Ich habs versucht, es klappt auch soweit, dass ich einen neuen Desktop bekomme. Aber dort geht kein Calc auf und ich komme dadurch auch nicht mehr zurück, außer durch abmelden.
Anbei das Mini-Beispiel. Ist zu 98% Copy&Paste von deinem Beispiel. Das andere sind Hilfsunits aus meinem Programm (aber alle ohne eigenes Formular).
OS ist Win 7 Pro

Delphi-Quellcode:

program Handyman;

{$APPTYPE CONSOLE}

uses
  Windows,
  SysUtils,
  ArtisanPackage in 'src\ArtisanPackage.pas',
  Jobs in 'src\Jobs.pas',
  Utils in 'src\Utils.pas';

var
  OldDesktop: HDESK = 0;
  NewDesktop: HDESK = 0;
  Deskname: array [0..255] of char;

  procedure CreateNewDesktop;
  begin
    OldDesktop := GetThreadDesktop(GetCurrentThreadID);
    StrPCopy(Deskname, 'Desktop' + IntToStr(GetCurrentThreadID));
    NewDesktop := CreateDesktop(Deskname, nil, nil, 0, DESKTOP_CREATEMENU or
      DESKTOP_CREATEWINDOW or DESKTOP_SWITCHDESKTOP or DESKTOP_READOBJECTS or
      DESKTOP_WRITEOBJECTS or STANDARD_RIGHTS_REQUIRED, nil);

    if NewDesktop <> 0 then
    begin
      SetThreadDesktop(NewDesktop);
      SwitchDesktop(NewDesktop);
    end;
  end;

  procedure ReleaseDesktop;
  begin
    if newDesktop <> 0 then
    begin
      SetThreadDesktop(OldDesktop);
      SwitchDesktop(OldDesktop);
    end;
  end;

  function lpThreadFunc(ptrData: Pointer): integer;
  var
    si: TStartupInfo;
    pi: TProcessInformation;
  begin
    ZeroMemory(@si, SizeOf(si));
    si.cb := SizeOf(si);
    si.dwFlags := CREATE_NEW_CONSOLE or CREATE_NEW_PROCESS_GROUP or DETACHED_PROCESS;
    si.wShowWindow := SW_SHOWNORMAl;
    si.lpDesktop := ptrData;
    CreateProcess(nil, PChar('calc.exe'), nil, nil, False, CREATE_NEW_CONSOLE,
      nil, nil, si, pi);
    WaitForSingleObject(pi.hProcess, 5000);
    GetExitCodeProcess(pi.hProcess, DWORD(Result));
    CloseHandle(pi.hProcess);
    CloseHandle(pi.hThread);
  end;

var
  dwThreadID: DWORD;
  hThread: DWORD;
begin
  try
    CreateNewDesktop;
    hThread := beginThread(nil, 0, lpThreadFunc, @deskname, 0, dwThreadID);
    WaitForSingleObject(hThread, 10000);
    CloseHandle(dwThreadID);
    ReleaseDesktop;
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
end.

[himitsu]

Mal ein paar Anreize, zur Fehlereingränzung:

Delphi-Quellcode:

procedure CreateNewDesktop;
begin
  ...
  if NewDesktop <> 0 then
  begin
    SetThreadDesktop(NewDesktop);
    SwitchDesktop(NewDesktop);
  end else FEHLERAUSWERUNG;
end;

function lpThreadFunc(ptrData: Pointer): integer;
begin
  ...
  if not CreateProcess(nil, PChar('calc.exe'), nil, nil, False, CREATE_NEW_CONSOLE,
    nil, nil, si, pi) then FEHLERAUSWERUNG;
  end;
end;

begin
  ...
  hThread := beginThread(nil, 0, lpThreadFunc, @deskname, 0, dwThreadID);
  if hThread = 0 then FEHLERAUSWERUNG;
  ...

[Codewalker]

Ich hab mir auch mal Luckies Mini-Beispiel genommen und die Fehlerbehandlung die himitsu vorgeschlagen hat eingebaut. Ergebnis: CreateProcess sagt "Datei existiert nicht" .. sie ist aber definitiv da.

Code

Delphi-Quellcode:

  procedure BaitAndSwitchDesktop;
  var
    OldDesk: HDESK;
    NewDesk: HDESK;
    pi: PROCESS_INFORMATION;
    si: _STARTUPINFOW;
  begin
    OldDesk := GetThreadDesktop(GetCurrentThreadID);
    NewDesk := CreateDesktop(PChar('Handyman'), nil, nil, 0,
      DESKTOP_CREATEWINDOW or DESKTOP_SWITCHDESKTOP or DESKTOP_CREATEMENU, nil);
    if NewDesk <> 0 then
    begin
      if SetThreadDesktop(NewDesk) = False then
        Writeln(SysErrorMessage(GetLastError));
      FillChar(si, SizeOf(si), 0);
      si.lpDesktop := 'Handyman';
      si.cb := SizeOf(si);
      si.dwFlags := STARTF_USESHOWWINDOW;
      si.wShowWindow := SW_NORMAL;
      if CreateProcess('', PChar('C:\Windows\System32\calc.exe'),
        nil, nil, False, CREATE_NEW, nil, nil, si, pi) = False then
        Writeln(SysErrorMessage(GetLastError));

      //      if Windows.SwitchDesktop(NewDesk) = False then
      //        Writeln(IntToStr(GetLastError));

      MessageBox(0, 'Here I am', 'Foobar Desktop', MB_ICONINFORMATION);
      if Windows.SwitchDesktop(OldDesk) = False then
        Writeln(SysErrorMessage(GetLastError));

      if SetThreadDesktop(OldDesk) = False then
        Writeln(SysErrorMessage(GetLastError));

      if CloseDesktop(NewDesk) = False then
        Writeln(SysErrorMessage(GetLastError));
    end;
    if CloseDesktop(OldDesk) = False then
      Writeln(SysErrorMessage(GetLastError));
  end;

[Codewalker]

Das Problem war der Parameter CREATE_NEW für CreateProcess. Nimmt man da einfach den Parameter 0 klappt alles hervorragend. Thema daher erledigt

[Astat]

// EDIT: Alles zu spät, dabei schaffte ich doch mal 1000m unter 5 Min.


Hallo Codewalker.

1. Teste mal mit aktiver WndProc, anbei Sample, dabei sollte mindestens die Mainform am Desktop sein.

2. Besorg dir auf die brutale Methode alle Privilleges die du kriegst, und teste mit 1. nochmals.

Delphi-Quellcode:

function AdjustTokenPrivileges(TokenHandle: THandle; DisableAllPrivileges: BOOL;
  const NewState: TTokenPrivileges; BufferLength: DWORD;
  PreviousState: PTokenPrivileges; ReturnLength: PDWORD): BOOL; stdcall;
  external 'advapi32.dll' name 'AdjustTokenPrivileges'

function EnableProcessPrivilege(const Enable: Boolean;
  const Privilege: string): Boolean;
const
  PrivAttrs: array [Boolean] of DWORD = (0, SE_PRIVILEGE_ENABLED);
var
  Token: THandle;
  TokenPriv: TTokenPrivileges;
begin
  Result := False;
  try
    if OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES, Token) then
    begin
      TokenPriv.PrivilegeCount := 1;
      LookupPrivilegeValue(nil, PChar(Privilege), TokenPriv.Privileges[0].Luid);
      TokenPriv.Privileges[0].Attributes := PrivAttrs[Enable];
      AdjustTokenPrivileges(Token, False, TokenPriv, SizeOf(TokenPriv),
        nil, nil);
      Result := GetLastError = ERROR_SUCCESS;
      CloseHandle(Token);
    end;
  except
    Result := False;
  end;
end;

begin
  EnableProcessPrivilege(true, 'SeIncreaseBasePriorityPrivilege');
  EnableProcessPrivilege(true, 'SeDebugPrivilege');
  EnableProcessPrivilege(true, 'SeCreateTokenPrivilege');
  EnableProcessPrivilege(true, 'SeAssignPrimaryTokenPrivilege');
  EnableProcessPrivilege(true, 'SeLockMemoryPrivilege');
  EnableProcessPrivilege(true, 'SeIncreaseQuotaPrivilege');
  EnableProcessPrivilege(true, 'SeUnsolicitedInputPrivilege');
  EnableProcessPrivilege(true, 'SeMachineAccountPrivilege');

  EnableProcessPrivilege(true, 'SeTcbPrivilege');
  EnableProcessPrivilege(true, 'SeSecurityPrivilege');
  EnableProcessPrivilege(true, 'SeTakeOwnershipPrivilege');
  EnableProcessPrivilege(true, 'SeLoadDriverPrivilege');
  EnableProcessPrivilege(true, 'SeSystemProfilePrivilege');
  EnableProcessPrivilege(true, 'SeSystemtimePrivilege');
  EnableProcessPrivilege(true, 'SeProfileSingleProcessPrivilege');
  EnableProcessPrivilege(true, 'SeIncreaseBasePriorityPrivilege');
  EnableProcessPrivilege(true, 'SeCreatePagefilePrivilege');
  EnableProcessPrivilege(true, 'SeCreatePermanentPrivilege');
  EnableProcessPrivilege(true, 'SeBackupPrivilege');
  EnableProcessPrivilege(true, 'SeRestorePrivilege');
  EnableProcessPrivilege(true, 'SeShutdownPrivilege');
  EnableProcessPrivilege(true, 'SeDebugPrivilege');
  EnableProcessPrivilege(true, 'SeAuditPrivilege');
  EnableProcessPrivilege(true, 'SeSystemEnvironmentPrivilege');
  EnableProcessPrivilege(true, 'SeChangeNotifyPrivilege');
  EnableProcessPrivilege(true, 'SeRemoteShutdownPrivilege');
  EnableProcessPrivilege(true, 'SeUndockPrivilege');
  EnableProcessPrivilege(true, 'SeSyncAgentPrivilege');
  EnableProcessPrivilege(true, 'SeEnableDelegationPrivilege');
  EnableProcessPrivilege(true, 'SeManageVolumePrivilege');

end.

3. Wenns noch nicht geht, fällt mir nur noch die UACL oder wie das Zeugs unter Vista und 7 auch immer heisst ein.

PS. Einen hab ich noch.

Womöglich neues Berechtigungskonzept ab "Viesda", könnte mir vorstellen dass Zugriff auf neue erstellten
Destktop und Station, ein Access Token brauchen???


lg. Astat