Delphi Windows Job

Helper.System.JobObject.Header.pas

unit Helper.System.JobObject.Header;

interface

uses
	WinAPI.Windows;

type

	{TODO -oJM -cCleanup : Unit aufräumen und Ansi/UniCode-Versionen in eigene
	Units packen und per Compiler-Direktive nur eine davon includen}

	PJobObjectBasicProcessIDList = ^TJobObjectBasicProcessIDList;

	TJobObjectBasicProcessIDList = Record
		NumberOfAssignedProcesses: DWORD;
		NumberOfProcessIdsInList: DWORD;
		{TODO -oJM -cGeneral : Woher kann ich wissen, wieviele es sein werden !?!}
		// funktioniert unter 64 Bit nicht. Siehe Windows-Typenhilfe zu ULONG und ULONG_PTR
		// 64 Bit exe sagt: Error 87: Falscher Parameter. Wahrscheinlich stimmt Strukturlänge nicht
		ProcessIdList: Array [0 .. 25] of ULONG_PTR;
	End;


	TJobObjectInfoClass = (
		AssociateCompletionPortInformation = 7,
		BasicLimitInformation = 2,
		BasicUIRestrictions = 4,
		EndOfJobTimeInformation = 6,
		ExtendedLimitInformation = 9,
		SecurityLimitInformation = 5,
		GroupInformation = 11,
		JobObjectBasicProcessIdList = 3
	);

	TJobObjectBasicLimitInformation = record
		PerProcessUserTimeLimit: LARGE_INTEGER;
		PerJobUserTimeLimit: LARGE_INTEGER;
		LimitFlags: DWORD;
		MinimumWorkingSetSize: SIZE_T;
		MaximumWorkingSetSize: SIZE_T;
		ActiveProcessLimit: DWORD;
		Affinity: ULONG_PTR;
		PriorityClass: DWORD;
		SchedulingClass: DWORD;
	end;

	(*
	  typedef struct _IO_COUNTERS {
	  ULONGLONG ReadOperationCount;
	  ULONGLONG WriteOperationCount;
	  ULONGLONG OtherOperationCount;
	  ULONGLONG ReadTransferCount;
	  ULONGLONG WriteTransferCount;
	  ULONGLONG OtherTransferCount;
	*)

	TIOCounter = record
		ReadOperationCount: ULONGLONG;
		WriteOperationCount: ULONGLONG;
		OtherOperationCount: ULONGLONG;
		ReadTransferCount: ULONGLONG;
		WriteTransferCount: ULONGLONG;
		OtherTransferCount: ULONGLONG;

	end;

	TJobObjectExtendedLimitInformation = record
		BasicLimitInformation: TJobObjectBasicLimitInformation;
		IoInfo: TIOCounter;
		ProcessMemoryLimit: SIZE_T;
		JobMemoryLimit: SIZE_T;
		PeakProcessMemoryUsed: SIZE_T;
		PeakJobMemoryUsed: SIZE_T;
	end;

const
{$IFDEF UNICODE}
	AWSuffix = 'W';
{$ELSE}
	AWSuffix = 'A';
{$ENDIF UNICODE}

const

	JOB_OBJECT_ASSIGN_PROCESS = $0001;
{$EXTERNALSYM JOB_OBJECT_ASSIGN_PROCESS}
	JOB_OBJECT_SET_ATTRIBUTES = $0002;
{$EXTERNALSYM JOB_OBJECT_SET_ATTRIBUTES}
	JOB_OBJECT_QUERY = $0004;
{$EXTERNALSYM JOB_OBJECT_QUERY}
	JOB_OBJECT_TERMINATE = $0008;
{$EXTERNALSYM JOB_OBJECT_TERMINATE}
	JOB_OBJECT_SET_SECURITY_ATTRIBUTES = $0010;
{$EXTERNALSYM JOB_OBJECT_SET_SECURITY_ATTRIBUTES}
	JOB_OBJECT_ALL_ACCESS = STANDARD_RIGHTS_REQUIRED or SYNCHRONIZE or $1F;
{$EXTERNALSYM JOB_OBJECT_ALL_ACCESS}



// CreateProcess-Flags

CREATE_BREAKAWAY_FROM_JOB =  $1000000;


	//
	// Extended Limits
	//

	JOB_OBJECT_LIMIT_PROCESS_MEMORY = $00000100;
{$EXTERNALSYM JOB_OBJECT_LIMIT_PROCESS_MEMORY}
	JOB_OBJECT_LIMIT_JOB_MEMORY = $00000200;
{$EXTERNALSYM JOB_OBJECT_LIMIT_JOB_MEMORY}
	JOB_OBJECT_LIMIT_DIE_ON_UNHANDLED_EXCEPTION = $00000400;
{$EXTERNALSYM JOB_OBJECT_LIMIT_DIE_ON_UNHANDLED_EXCEPTION}
	JOB_OBJECT_LIMIT_BREAKAWAY_OK = $00000800;
{$EXTERNALSYM JOB_OBJECT_LIMIT_BREAKAWAY_OK}
	JOB_OBJECT_LIMIT_SILENT_BREAKAWAY_OK = $00001000;
{$EXTERNALSYM JOB_OBJECT_LIMIT_SILENT_BREAKAWAY_OK}
	JOB_OBJECT_LIMIT_KILL_ON_JOB_CLOSE = $00002000;
{$EXTERNALSYM JOB_OBJECT_LIMIT_KILL_ON_JOB_CLOSE}
	// const




function CreateJobObjectA(lpJobAttributes: PSecurityAttributes; lpName: LPCSTR)
  : THANDLE; stdcall;
{$EXTERNALSYM CreateJobObjectA}
function CreateJobObjectW(lpJobAttributes: PSecurityAttributes; lpName: LPCWSTR)
  : THANDLE; stdcall;
{$EXTERNALSYM CreateJobObjectW}
function CreateJobObject(lpJobAttributes: PSecurityAttributes; lpName: LPCTSTR)
  : THANDLE; stdcall;
{$EXTERNALSYM CreateJobObject}
function OpenJobObjectA(dwDesiredAccess: DWORD; bInheritHandle: BOOL;
  lpName: LPCSTR): THANDLE; stdcall;
{$EXTERNALSYM OpenJobObjectA}
function OpenJobObjectW(dwDesiredAccess: DWORD; bInheritHandle: BOOL;
  lpName: LPCWSTR): THANDLE; stdcall;
{$EXTERNALSYM OpenJobObjectW}
function OpenJobObject(dwDesiredAccess: DWORD; bInheritHandle: BOOL;
  lpName: LPCTSTR): THANDLE; stdcall;
{$EXTERNALSYM OpenJobObject}
function AssignProcessToJobObject(hJob, hProcess: THANDLE): BOOL; stdcall;
{$EXTERNALSYM AssignProcessToJobObject}
function TerminateJobObject(hJob: THANDLE; uExitCode: UINT): BOOL; stdcall;
{$EXTERNALSYM TerminateJobObject}
function IsProcessInJob(ProcessHandle, JobHandle: THANDLE; var Result_: BOOL)
  : BOOL; stdcall;
{$EXTERNALSYM IsProcessInJob}
Function QueryInformationJobObject(hJob: THANDLE;
  JobObjectInformationClass: TJobObjectInfoClass;
  lpJobObjectInformation: Pointer; cbJobObjectInformationLength: DWORD;
  lpReturnLength: PDWORD): BOOL; StdCall;
  External Kernel32 Name 'QueryInformationJobObject';
(* BOOL WINAPI SetInformationJobObject(
  _In_  HANDLE hJob,
  _In_  JOBOBJECTINFOCLASS JobObjectInfoClass,
  _In_  LPVOID lpJobObjectInfo,
  _In_  DWORD cbJobObjectInfoLength
  ); *)
function SetInformationJobObject(hJob: THANDLE;
  JobObjectInfoClass: TJobObjectInfoClass; lpJobObjectInfo: Pointer;
  cbJobObjectInfoLength: DWORD): BOOL; stdcall;
  External Kernel32 Name 'SetInformationJobObject';

function CreateJobObjectA; external Kernel32 name 'CreateJobObjectA';
function CreateJobObjectW; external Kernel32 name 'CreateJobObjectW';
function CreateJobObject; external Kernel32 name 'CreateJobObject' + AWSuffix;
function OpenJobObjectA; external Kernel32 name 'OpenJobObjectA';
function OpenJobObjectW; external Kernel32 name 'OpenJobObjectW';
function OpenJobObject; external Kernel32 name 'OpenJobObject' + AWSuffix;
function AssignProcessToJobObject;
  external Kernel32 name 'AssignProcessToJobObject';
function TerminateJobObject; external Kernel32 name 'TerminateJobObject';
function IsProcessInJob; external Kernel32 name 'IsProcessInJob';

implementation

end.

Helper.System.JobObject.pas

unit Helper.System.JobObject platform;

interface uses Winapi.Windows, Helper.System.JobObject.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.