I have a Delphi server that run python scripts in the background (they run similar to "python Sync.py **params**
").
This scripts can do things like connect to external servers, open ssh connections and scary stuff where they can hang.
I need to detect if they hang, and kill it. Also, if the server is closed, and want to kill the process too (if not, the Delphi server hang, disappear from the des开发者_如何转开发ktop but get invisible in the background. This cause issues later if the server is executed again).
By first try not work. The process get killed but if I close the app, the server hang.
So the question is if exist a more reliable/better way to kill the child process.
Now, I save their Handle and their GetTickCount , like this: "handle=tickcount", then running with a TTimer each 4 seconds and see if the process timeout:
procedure TfrmMain.CheckProcess(Sender: TObject);
var
i: Integer;
Fecha:TDateTime;
start, stop, elapsed,Handle : cardinal;
begin
stop := GetTickCount;
for i := (FProcesos.Count - 1) downto 0 do
begin
start := StrToInt( FProcesos.ValueFromIndex[i] );
elapsed := stop - start; //milliseconds
//Esta muerto el proceso??
if ((elapsed>TIMEOUT_PROCESS) or (FTimer.Enabled=False)) then
begin
Handle := StrToInt( FProcesos.Names[i] );
TerminateProcess(Handle,0);
CloseHandle( Handle );
FProcesos.Delete( i );
LogMsg('A process timed out!',msgError);
end;
end;//for
end;
I didn't understand how you are checking if a process is not responsive. If your child processes have GUI, then you can send a message to one of the windows belonging to the process using SendMessageTimeOut API function, and check if the message is processed by it within the specified time or not.
Here is a sample code which uses my TProcessInfo for listing all child processes for the current thread, and terminating any of them which is not responsive - please take note that since I couldn't understand your method for detecting unresponsive processes, IsProcessUnResponsive function is not implemented in my code, and is left for you:
function IsProcessUnResponsive(const ProcessID: Cardinal): Boolean;
begin
//Use your own technique for determining if a process is not responsive.
end;
procedure TerminateUnResponsiveProcesses;
var
Process: TProcessItem;
ProcessInfo : TProcessInfo;
begin
ProcessInfo := TProcessInfo.Create(nil);
try
for Process in ProcessInfo.RunningProcesses do
begin
if Process.ParentProcessID = GetCurrentProcessId then
if IsProcessUnResponsive(Process.ProcessID) then
Process.TerminateProcess;
end;
finally
ProcessInfo.Free;
end;
end;
Calling TerminateProcess
is the only reliable way to kill a process.
There are more graceful ways, but to use them, you need to know something about how the process expects to be told to close. GUI processes usually expect their main windows to be closed, so you need to figure out which windows those are and then send wm_Close
messages to them. Batch-mode console programs might expect you to press Ctrl+C; interactive console programs might have a special command you're supposed to type.
And that all assumes the process is still responding to input. If the process has hung, it might never see the "graceful" command, so forceful termination by TerminateProcess
is the only remaining option.
If I were you, I'd avoid using the term zombie process in the error message. What you're dealing with are not zombies at all. Zombies are processes that have terminated, but which some other process still has an open handle for. What you're doing is detecting processes that have run too long and timed out. They're not necessarily hung processes, just processes that are taking longer than the allotted time. So just say that in your error message: "A process has timed out." (Even better if you can log some meaningful indication of which process.)
精彩评论