Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Win32/Win64 API (native code) (https://www.delphipraxis.net/17-win32-win64-api-native-code/)
-   -   Delphi CreateProcess und gestarteten Prozess automatisch beenden wenn Anwendung beendet wird (https://www.delphipraxis.net/179513-createprocess-und-gestarteten-prozess-automatisch-beenden-wenn-anwendung-beendet-wird.html)

Bernhard Geyer 12. Mär 2014 10:03

CreateProcess und gestarteten Prozess automatisch beenden wenn Anwendung beendet wird
 
Über welche Option/Flag/Parameter kann ich steuern das mein gestarteter Child-Prozess automatisch beendet wird wenn der Hauptprozess beendet wird (z.B. Absturz Hauptanwendung - Childprozess sollte nicht mehr weiter laufen).

Der schöne Günther 12. Mär 2014 10:13

AW: CreateProcess und gestarteten Prozess automatisch beenden wenn Anwendung beendet
 
Unter Windows gibt es da (im Gegensatz zu Unix) spontan nichts. Bei
Delphi-Quellcode:
CreateProcess
gibt es kein einfaches Flag, um so etwas zu erreichen.

Die einzige Lösung die ich kenne sind Jobs. Du kannst in deinem Parent-Prozess einen Job aufmachen, selbst dort als einziger hineinziehen und deine Kindprozesse dann auch dort drinnen aufmachen. Den Job kannst du dann so einstellen dass alle enthaltenen Prozesse terminiert werden wenn das letzte Handle auf den Job geschlossen wird. Da dein Parent der einzige mit einem Handle auf den Job ist, werden alle Kindprozesse terminiert wenn das Parent endet (kontrolliert oder Absturz).

Ich mache das bei mir so, funktioniert auch einwandfrei. Mich würde mal interessieren wie Anwendungen wie der Internet Explorer oder Google Chrome das lösen. Beide waren über ihre Multi-Prozess-Architektur anfangs total stolz und haben viele Blogbeiträge verfasst, vielleicht findet man da ja was.

Delphi bringt auch in der aktuellsten Fassung die Header-Files für die Job-Geschichte noch nicht mit, siehe hier.
Wenn du willst suche ich bei Gelegenheit nochmal alles zusammen was ich mache und stelle es rein.

War jedenfalls schon ein bisschen Arbeit wenn man damit noch nichts gemacht hatte und alle Eventualitäten abdecken will :?

Bernhard Geyer 12. Mär 2014 11:46

AW: CreateProcess und gestarteten Prozess automatisch beenden wenn Anwendung beendet
 
Zitat:

Zitat von Der schöne Günther (Beitrag 1251648)
Wenn du willst suche ich bei Gelegenheit nochmal alles zusammen was ich mache und stelle es rein.

Super :thumb: Das wäre gut wenn man hier mal ein gute zusammenfassung hätte.

Der schöne Günther 12. Mär 2014 15:06

AW: CreateProcess und gestarteten Prozess automatisch beenden wenn Anwendung beendet
 
Liste der Anhänge anzeigen (Anzahl: 1)
Heute wird das knapp :(

Im Endeffekt ist es nicht viel:
Ein netter Forenbenutzer hatte sich schonmal die Arbeit gemacht, die notwendigen Header einzubinden.

Ich weiß nicht mehr, was ich daran noch herumgedoktert habe, aber im Anhang meine (schlimm anzusehende) Version.

Bei deinem Kindprozess gibst in CreateProcess bei den
Delphi-Quellcode:
dwCreationFlags
eventuell ein
Delphi-Quellcode:
CREATE_BREAKAWAY_FROM_JOB
an.

Anschließend kannst du sie mit
Delphi-Quellcode:
AssignProcessToJobObject
in deinem Job packen.


Das ist ungefähr so wie ich den Job angelegt habe:

Delphi-Quellcode:
const
   jobName: String = 'meinJob';
var
   errorCode: Cardinal;

   basicInfo: TJobObjectBasicLimitInformation;
   extInfo: TJobObjectExtendedLimitInformation;
begin

   // (1) Job-Objekt anlegen
   jobHandle := CreateJobObject(
      nil, // Das Handle kann nicht vererbt werden
      PWidechar(jobName)
   );

   if (jobHandle = INVALID_HANDLE_VALUE) or (jobHandle = 0) then begin
      errorCode := GetLastError();
      log('Konnte kein Job-Objekt erstellen. Fehlercode ' +
         IntToStr(errorCode) + ': ' + SysErrorMessage(errorCode), ltError);
      Exit;
   end;

   // Weitere interessante Job-Eigenschaften:
   // JOB_OBJECT_LIMIT_DIE_ON_UNHANDLED_EXCEPTION

   // (2) Eigenschaften setzen
   FillChar(basicInfo, SizeOf(basicInfo), 0);
   if terminatePluginsOnJobClose then
      basicInfo.LimitFlags := JOB_OBJECT_LIMIT_KILL_ON_JOB_CLOSE;

   FillChar(extInfo, SizeOf(extInfo), 0);
   extInfo.BasicLimitInformation := basicInfo;

   if not SetInformationJobObject(
      jobHandle,
      TJobObjectInfoClass.ExtendedLimitInformation,
      @extInfo,
      SizeOf(extInfo)
   )
   then begin
      errorCode := GetLastError();
      log('Konnte Eigenschaften des erstellten Job-Objekts NICHT setzen! Plugins werden'
        + 'möglicherweise nach unerwartetem Beenden des Hauptprogramms NICHT beendet!'
        + 'Fehlercode ' + IntToStr(errorCode) + ': ' +
        SysErrorMessage(errorCode), ltWarning);
   end;
end;

DeddyH 12. Mär 2014 15:46

AW: CreateProcess und gestarteten Prozess automatisch beenden wenn Anwendung beendet
 
@Günter: deklariere doch einmal die Records als packed und das "fragliche" Array als Array[0..0]. Behebt das die Probleme?

Der schöne Günther 12. Mär 2014 17:31

AW: CreateProcess und gestarteten Prozess automatisch beenden wenn Anwendung beendet
 
Ich werde es bei nächster Gelegenheit ausprobieren und dich wissen lassen, danke :-)

Nur warum
Delphi-Quellcode:
[0..0]
? Die 25 waren von mir jetzt rein willkürlich gewählt. Ich erwarte schon, dass da mehr als nur eins zurückkommt...
Auch wenn es nur WinAPI-Header sind, die Unit ist wirklich peinlich :oops:
Irgendwann. Irgendwann mach ich das mal ordentlich 8-)

DeddyH 12. Mär 2014 17:50

AW: CreateProcess und gestarteten Prozess automatisch beenden wenn Anwendung beendet
 
Hast Du den Link in meinem letzten Post übersehen? Da wird erklärt, was es mit dem 0..0 auf sich hat.

Der schöne Günther 12. Mär 2014 17:53

AW: CreateProcess und gestarteten Prozess automatisch beenden wenn Anwendung beendet
 
Jepp, übersehen. Blöde Sonne knallt zu stark auf den Monitor 8-)

DeddyH 12. Mär 2014 17:59

AW: CreateProcess und gestarteten Prozess automatisch beenden wenn Anwendung beendet
 
Einfach das Haus umdrehen :lol:

Bernhard Geyer 17. Apr 2014 10:22

AW: CreateProcess und gestarteten Prozess automatisch beenden wenn Anwendung beendet
 
So, habs jetzt eingebaut. Funktioniert wie erwartet.


Deine HeaderUnit habe ich aber nicht benötigt sondern bin auf die Headerübersetzung der Jedi (JwaWinType, JwaWinNT, JwaWinBase) gegangen da diese eh schon verwendet werden.

Der schöne Günther 19. Sep 2014 19:01

AW: CreateProcess und gestarteten Prozess automatisch beenden wenn Anwendung beendet
 
Falls es nochmal jemanden interessiert:

Ich habe das ganze mal in einen etwas komfortableren Wrapper gepackt. Die Benutzung sieht dann so aus:

Delphi-Quellcode:
begin
   jobObj := TWinJob.Create('meinJob');
   jobObj.KillContainingProcessesOnExit := True;

   // [Prozess mit CREATE_BREAKAWAY_FROM_JOB-Flag erstellen]

   jobObj.moveProcessTo(dasProzessHandle);

   ReadLn;

   jobObj.Free(); // Damit wird der Prozess wieder geschlossen
end.


Die passende Unit:
Delphi-Quellcode:
unit WindowsJob platform;

interface uses Winapi.Windows, WinAPI_Job_Header;

type

   /// <summary>
   ///     Repräsentiert einen Windows-Job- Siehe
   ///    <see href="http://msdn.microsoft.com/en-us/library/windows/desktop/ms684161(v=vs.85).aspx">
   ///     MSDN: Job Objects
   ///    </see>.
    /// </summary>
   TWinJob = class
      public type
         TProcessHandle = Winapi.Windows.THandle;
         TJobHandle = Winapi.Windows.THandle;

      private
         /// <seealso cref="KillContainingProcessesOnExit" />
         FKillContainingProcessesOnExit: Boolean;

      protected var
         /// <seealso cref="JobHandle" />
         FJobHandle: TJobHandle;
         /// <remarks>
         ///     Wird kein Name verwendet entspricht der Wert des Feldes
         ///    <c>EmptyStr</c>
            /// </remarks>
         jobName: String;

         /// <summary>
         ///     Enthält die
         ///    <see href="http://msdn.microsoft.com/en-us/library/windows/desktop/ms684156(v=vs.85).aspx">
         ///       JOBOBJECT_EXTENDED_LIMIT_INFORMATION
         ///    </see>-Informationen des Jobs. Wird von
         ///    <see cref="queryJobInformation" /> abgefragt.
         /// </summary>
         /// <seealso cref="KillContainingProcessesOnExit" />
         extInfo: TJobObjectExtendedLimitInformation;

      protected
         /// <summary>
         ///     Prüft, ob das in <see cref="JobHandle" /> abgelegte
         ///    Handle auf eine fehlgeschlagene Job-Erstellung hindeutet.
         ///    In diesem Fall wird eine <c>EOSError</c>-Exception
         ///    geworfen
         /// </summary>
            /// <exception cref="EOSError" />
         procedure checkJobHandle();
         /// <summary>
         ///     Aktualisiert die <c>ExtendedLimitInformation</c> dieses
         ///    Jobs und legt diese im Feld
         ///    <see cref="extInfo" /> ab.
            /// </summary>
         procedure queryJobInformation(); virtual;
         procedure setKillContainingProcessesOnExit(const Value: Boolean);

      public
         constructor Create(); overload;
         /// <exception cref="EOSError">
         ///    Wenn bereits ein event, semaphore, mutex, waitable timer oder
         ///    file-mapping mit dem gleichen Namen existiert
         /// </exception>
         constructor Create(const jobName: String); overload;
            destructor Destroy(); override;

         /// <returns>
         ///     Gibt an ob der Prozess erfolgreich in diesen Job
         ///    verschoben werden konnte
         /// </returns>
         /// <remarks>
         ///     Der mit <c>CreateProcess</c> erstellte Prozess muss mit dem
         ///    <see cref="WinAPI_Job_Header.CREATE_BREAKAWAY_FROM_JOB" />-Flag
         ///    in seinem <c>dwCreationFlags</c>-Parameter erstellt werden.
            ///    Ansonsten schlägt die Methode fehl und gibt <c>False</c> zurück
         /// </remarks>
         function moveProcessTo(const processHandle: TProcessHandle): Boolean;

      public // properties
         /// <summary>
         ///     Gibt an ob die im Job enthaltenen Prozesse <b>beim Schließen
         ///    des letzten Handles auf den Job</b> vom Betriebssystem
         ///    terminiert werden sollen
         /// </summary>
         property KillContainingProcessesOnExit: Boolean
            read FKillContainingProcessesOnExit
            write setKillContainingProcessesOnExit;

         property JobHandle: TJobHandle
            read FJobHandle;
   end;

implementation uses System.SysUtils;

{ TWinJob }

constructor TWinJob.Create();
begin
   inherited Create();

   FJobHandle := CreateJobObject(nil, nil);
   jobName := EmptyStr;
   checkJobHandle();
end;

procedure TWinJob.checkJobHandle();
var
   lastError: DWORD;
begin
   if (jobHandle = 0) then begin
      lastError := GetLastError();
      case lastError of
         ERROR_INVALID_HANDLE: raise {$REGION 'EOSError'}
            EOSError.Create(
               'An event, semaphore, mutex, waitable timer, or file-mapping '
               +'with the same name of "'+jobName+'" already '
               +'exists. Cannot create Job.'
            );
         {$ENDREGION 'EOSError'}
      else
         SetLastError(lastError);
         RaiseLastOSError();
      end;
   end;
end;

constructor TWinJob.Create(const jobName: String);
begin
   inherited Create();
   self.jobName := jobName;

   FJobHandle := CreateJobObject(nil, PChar(jobName));
   checkJobHandle();
end;


destructor TWinJob.Destroy();
begin
   CloseHandle(jobHandle);
   inherited;
end;

function TWinJob.moveProcessTo(const processHandle: TProcessHandle): Boolean;
begin
   Result := AssignProcessToJobObject(jobHandle, processHandle);
end;

procedure TWinJob.queryJobInformation();
begin
   Win32Check(
      QueryInformationJobObject(
         jobHandle,
         TJobObjectInfoClass.ExtendedLimitInformation,
         Addr(extInfo),
         SizeOf(extInfo),
         nil
      )
   );
end;

procedure TWinJob.setKillContainingProcessesOnExit(const Value: Boolean);
const
   queryFirst: Boolean = True;
var
   basicInfo: TJobObjectBasicLimitInformation;
begin
   FKillContainingProcessesOnExit := Value;

   if queryFirst then queryJobInformation();
   basicInfo := extInfo.BasicLimitInformation;

   if KillContainingProcessesOnExit then
      basicInfo.LimitFlags := basicInfo.LimitFlags or JOB_OBJECT_LIMIT_KILL_ON_JOB_CLOSE
   else
      basicInfo.LimitFlags := basicInfo.LimitFlags and (not JOB_OBJECT_LIMIT_KILL_ON_JOB_CLOSE);

   extInfo.BasicLimitInformation := basicInfo;

   Win32Check(
      SetInformationJobObject(
         jobHandle,
         TJobObjectInfoClass.ExtendedLimitInformation,
         Addr(extInfo),
         SizeOf(extInfo)
      )
   );
end;

end.


Alle Zeitangaben in WEZ +1. Es ist jetzt 11:54 Uhr.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz