AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Win32/Win64 API (native code) Delphi Programm auf eigenem "Desktop" ausführen
Thema durchsuchen
Ansicht
Themen-Optionen

Programm auf eigenem "Desktop" ausführen

Ein Thema von Codewalker · begonnen am 27. Feb 2010 · letzter Beitrag vom 3. Mär 2010
 
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
 


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 16:32 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz