View Issue Details

IDProjectCategoryView StatusLast Update
0005795JEDI VCL00 JVCL Componentspublic2012-09-10 14:15
ReporterKiriakosAssigned Toobones 
PrioritynormalSeverityfeatureReproducibilityalways
Status resolvedResolutionfixed 
Product VersionDaily / GIT 
Target VersionFixed in Version3.46 
Summary0005795: Add TerminateTree to JvCreateProcess
DescriptionJvCreateProcess.Terminate fails if the created process has running sub-processes. I have added a TerminateTree method that kills the whole process tree.

Patch attached.
TagsNo tags attached.

Activities

2012-02-14 22:48

 

JvCreateProcess.pas.patch (2,996 bytes)
Index: JvCreateProcess.pas
===================================================================
--- JvCreateProcess.pas	(revision 13192)
+++ JvCreateProcess.pas	(working copy)
@@ -1,4 +1,4 @@
-{-----------------------------------------------------------------------------
+{-----------------------------------------------------------------------------
 The contents of this file are subject to the Mozilla Public License
 Version 1.1 (the "License"); you may not use this file except in compliance
 with the License. You may obtain a copy of the License at
@@ -204,6 +204,7 @@
     procedure Run;
     procedure StopWaiting;
     procedure Terminate;
+    procedure TerminateTree;
     function Write(const S: AnsiString): Boolean;
     function WriteLn(const S: AnsiString): Boolean;
     property ProcessInfo: TProcessInformation read FProcessInfo;
@@ -243,7 +244,7 @@
 uses
   Math,
   JclStrings,
-  JvJCLUtils, JvJVCLUtils, JvConsts, JvResources;
+  JvJCLUtils, JvJVCLUtils, JvConsts, JvResources, TlHelp32;
 
 const
   CM_READ = WM_USER + 1;
@@ -405,6 +406,53 @@
   CloseHandle(ProcessHandle);
 end;
 
+type
+ TProcessArray = array of DWORD;
+
+function InternalTerminateProcessTree(ProcessID: DWORD): Boolean;
+
+  function GetChildrenProcesses(const Process: DWORD; const IncludeParent: Boolean): TProcessArray;
+  var
+    Snapshot: Cardinal;
+    ProcessList: PROCESSENTRY32;
+    Current: Integer;
+  begin
+    Current := 0;
+    SetLength(Result, 1);
+    Result[0] := Process;
+    repeat
+      ProcessList.dwSize := SizeOf(PROCESSENTRY32);
+      Snapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
+      if (Snapshot = INVALID_HANDLE_VALUE) or not Process32First(Snapshot, ProcessList) then
+        Continue;
+      repeat
+        if ProcessList.th32ParentProcessID = Result[Current] then
+        begin
+          SetLength(Result, Length(Result) + 1);
+          Result[Length(Result) - 1] := ProcessList.th32ProcessID;
+        end;
+      until Process32Next(Snapshot, ProcessList) = False;
+      Inc(Current);
+    until Current >= Length(Result);
+    if not IncludeParent then
+      Result := Copy(Result, 2, Length(Result));
+  end;
+
+var
+  Handle: THandle;
+  List: TProcessArray;
+  I: Integer;
+begin
+  Result := True;
+  List := GetChildrenProcesses(ProcessID, True);
+  for I := Length(List) - 1 downto 0 do
+    if Result then
+    begin
+      Handle := OpenProcess(PROCESS_TERMINATE, false, List[I]);
+      Result := (Handle <> 0) and TerminateProcess(Handle, 0) and CloseHandle(Handle);
+    end;
+end;
+
 function SafeCloseHandle(var H: THandle): Boolean;
 begin
   if H <> 0 then
@@ -1352,6 +1400,12 @@
   InternalTerminateProcess(FProcessInfo.dwProcessId);
 end;
 
+procedure TJvCreateProcess.TerminateTree;
+begin
+  CheckRunning;
+  InternalTerminateProcessTree(FProcessInfo.dwProcessId);
+end;
+
 procedure TJvCreateProcess.TerminateWaitThread;
 begin
   { This is a dangerous function; because the read thread uses a blocking

obones

2012-02-22 15:14

administrator   ~0019470

Please provide the zipped sources of a sample application showing this

Kiriakos

2012-02-22 16:12

reporter   ~0019476

Maybe I did not make myself clear. Current JvCreateProcess provide a couple of ways to terminate a running process, Quit and Terminate. Terminate is the more drastic one killing the process. However even Terminate may fail if the running process has started further subprocesses. The patch provided adds a third way to terminate the running process: a new method called TerminateTree which kills the process and its subprocesses. It is an enhancement, which does not interfere with the existing code. To use it just call TerminateTree instead of calling Terminate.

obones

2012-06-12 16:42

administrator   ~0019933

This is now in SVN

Issue History

Date Modified Username Field Change
2012-02-14 22:48 Kiriakos New Issue
2012-02-14 22:48 Kiriakos File Added: JvCreateProcess.pas.patch
2012-02-22 15:14 obones Note Added: 0019470
2012-02-22 15:14 obones Status new => feedback
2012-02-22 16:12 Kiriakos Note Added: 0019476
2012-06-11 17:44 obones Status feedback => acknowledged
2012-06-12 16:42 obones Note Added: 0019933
2012-06-12 16:42 obones Status acknowledged => resolved
2012-06-12 16:42 obones Fixed in Version => Daily / SVN
2012-06-12 16:42 obones Resolution open => fixed
2012-06-12 16:42 obones Assigned To => obones
2012-09-10 14:15 obones Fixed in Version Daily / SVN => 3.46