Einzelnen Beitrag anzeigen

Benutzerbild von Codewalker
Codewalker

Registriert seit: 18. Nov 2005
Ort: Ratingen
945 Beiträge
 
Delphi XE2 Professional
 
#6

Re: Programm auf eigenem "Desktop" ausführen

  Alt 1. Mär 2010, 16:34
@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.
  Mit Zitat antworten Zitat