program superviseprocess;
{$APPTYPE CONSOLE}
uses
Windows,
SysUtils,
Classes,
JwaTlHelp32,
DateUtils;
type
TSupervisorThread = class(TThread)
private
{ Private declarations }
StartCommandline,RestartCommandline:string;
LastAppResponseTime:TDateTime;
UpdateLog:boolean;
procedure Synchronization;
public
{ Public declarations }
protected
procedure Execute; override;
end;
type
TWorkerThread = class(TThread)
private
Commandline:string;
ProcessCommandLine:string;
ProcessID:cardinal;
procedure RunProcess(CMD:String;Priority_:cardinal;WindowStatus:Word);
procedure OutputSynchronizationWhite;
{ Private declarations }
public
{ Public declarations }
protected
procedure Execute; override;
end;
var SupervisorThread:TSupervisorThread;
WorkerThread:TWorkerThread;
CriticalSection: TRTLCriticalSection;
ApplicationFinishedGracefully:boolean;
Log:TStringList;
ProcessIDtoSupervise:cardinal;
function GetTempDirectory:String;
var tempFolder: array[0..MAX_PATH] of Char;
begin
GetTempPath(MAX_PATH, @tempFolder);
result:=StrPas(tempFolder);
end;
function SaveLog(var Log:TStringList):boolean;
var OldLog:TStringList;
TempPath,LogFile:string;
begin
OldLog:=TStringList.Create;
TempPath:=GetTempDirectory;
LogFile:=TempPath+'\SuperviseProcessLog.txt';
try
if FileExists(LogFile)=true then OldLog.LoadFromFile(LogFile);
OldLog.AddStrings(Log);
while OldLog.Count>100000 do OldLog.Delete(0); //remove the oldest entries
OldLog.SaveToFile(LogFile);
Log.Clear;
Result:=true;
except
Result:=false;
end;
OldLog.Free;
end;
function ExtractFileNameEx(path:string):string;
begin
Result:=ExtractFileName( Copy(Path,0,Pos('.exe',AnsiLowerCase(path))+3) );
end;
type
PEnumInfo = ^TEnumInfo;
TEnumInfo = record
ProcessID: DWORD;
HWND: THandle;
end;
function EnumWindowsProc(Wnd: HWND; EI: LPARAM): Bool; stdcall;
var PID: DWORD;
begin
GetWindowThreadProcessID(Wnd, @PID);
Result := (PID <> PEnumInfo(EI)^.ProcessID) {or (not IsWindowVisible(WND)) or (not IsWindowEnabled(WND))};
if not Result then PEnumInfo(EI)^.HWND := WND; //break on return FALSE
end;
function GetHWndByPID(const hPID: THandle): THandle;
function FindMainWindow(PID: DWORD): DWORD;
var EI: TEnumInfo;
begin
EI.ProcessID := PID;
EI.HWND := 0;
EnumWindows(@EnumWindowsProc, LPARAM(@EI));
Result := EI.HWND;
end;
begin
if hPID<>0 then Result:=FindMainWindow(hPID)
else Result:=0;
end;
function IsAppRespondingNT(wnd: HWND): Boolean;
type TIsHungAppWindow = function(wnd:hWnd): BOOL; stdcall;
var hUser32: THandle;
IsHungAppWindow: TIsHungAppWindow;
begin
Result := True;
hUser32 := GetModuleHandle('user32.dll');
if (hUser32 > 0) then
begin
pointer(IsHungAppWindow) := GetProcAddress(hUser32, 'IsHungAppWindow');
if Assigned(IsHungAppWindow) then
begin
Result := not IsHungAppWindow(wnd);
end;
end;
end;
procedure FindChildPID(ParentPID:cardinal;var PIDlist:TStringlist);
var bFound : Boolean;
SnapshotHandle : THandle;
ProcessEntry32 : TProcessEntry32;
begin
SnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0);
ProcessEntry32.dwSize := Sizeof(ProcessEntry32);
bFound := Process32First(SnapshotHandle,ProcessEntry32);
while bFound do
begin
if ProcessEntry32.th32ParentProcessID = ParentPID then PIDlist.Add( inttostr(ProcessEntry32.th32ProcessID) );
bFound := Process32Next(SnapshotHandle,ProcessEntry32);
end;
CloseHandle(SnapshotHandle);
end;
function KillProcess(PID:cardinal;KillParentProcess,KillChildProcess:boolean):boolean;
var PIDList:TStringList;
x:integer;
ProcessHandle,CurrentPID:cardinal;
begin
if (KillParentProcess=false) and (KillChildProcess=false) then
begin
Result:=false;
exit;
end;
PIDList:=TStringList.Create;
try
PIDList.Add(IntToStr(PID)); //parent PID first on list
if KillChildProcess=true then
begin
x:=0;
begin
FindChildPID(StrToInt(PIDList.Strings[x]),PIDList);
inc(x);
end;
end;
if KillParentProcess=false then PIDList.Delete(0); //delete parent PID from list
if PIDList.Count>0 then
begin
for x:=0 to PIDList.Count-1 do
begin
CurrentPID:=StrToInt(PIDList.Strings[x]);
ProcessHandle:=OpenProcess(PROCESS_TERMINATE,False,CurrentPID);
TerminateProcess(ProcessHandle,0);
CloseHandle(ProcessHandle);
end;
Result:=true;
end
else Result:=false;
except
Result:=false;
end;
PIDList.Free;
end;
procedure TWorkerThread.RunProcess(CMD:String;Priority_:cardinal;WindowStatus:Word);
const ReadBuffer = 2400;
var
Security : TSecurityAttributes;
ReadPipe,WritePipe : THandle;
start_ : TStartUpInfo;
ProcessInfo : TProcessInformation;
Buffer : Pchar;
BytesRead : DWord;
Apprunning : DWord;
begin
With Security do
begin
nlength := SizeOf(TSecurityAttributes) ;
binherithandle := true;
lpsecuritydescriptor := nil;
end;
if Createpipe (ReadPipe, WritePipe, @Security, 0) then
begin
Buffer := AllocMem(ReadBuffer + 1) ;
FillChar(start_,Sizeof(start_),#0) ;
start_.cb := SizeOf(start_) ;
start_.dwFlags := STARTF_USESHOWWINDOW;
start_.wShowWindow := WindowStatus;
if CreateProcess(nil,PChar(CMD),nil,nil,true,Priority_,nil,nil,start_,ProcessInfo) then
begin
ProcessCommandLine:=CMD;
ProcessID:=ProcessInfo.dwProcessId;
Synchronize(@OutputSynchronizationWhite);
repeat
Apprunning := WaitForSingleObject(ProcessInfo.hProcess,100);
until (Apprunning <> WAIT_TIMEOUT);
end;
FreeMem(Buffer);
CloseHandle(ProcessInfo.hProcess);
CloseHandle(ProcessInfo.hThread);
CloseHandle(ReadPipe);
CloseHandle(WritePipe);
end;
end;
procedure TWorkerThread.OutputSynchronizationWhite;
var text:string;
begin
ProcessIDtoSupervise:=ProcessID;
SetConsoleTextAttribute(GetStdHandle(STD_OUTPUT_HANDLE),15);
text:='['+DateTimeToStr(Now)+'] '+ProcessCommandLine+' (PID:'+IntToStr(ProcessID)+') executed.';
WriteLn(text);
Log.Add(text);
end;
procedure TWorkerThread.Execute;
begin
RunProcess(CommandLine,GetPriorityClass(GetCurrentProcess),SW_SHOW);
end;
procedure TSupervisorThread.Execute;
var WaitStatus:cardinal;
WorkerThreadHandlesArray: array of THandle;
begin
ApplicationFinishedGracefully:=true;
SetLength(WorkerThreadHandlesArray,1);
WorkerThread:=TWorkerThread.Create(true);
WorkerThreadHandlesArray[0]:=WorkerThread.Handle;
WorkerThread.FreeOnTerminate:=false;
WorkerThread.Commandline:=StartCommandline;
WorkerThread.Resume;
repeat
Synchronize(@Synchronization);
WaitStatus:=WaitForMultipleObjects(1, @WorkerThreadHandlesArray[0], True, 1000);
until WaitStatus<>WAIT_TIMEOUT;
if Assigned(WorkerThread)=true then FreeAndNil(WorkerThread);
end;
procedure TSupervisorThread.Synchronization;
var x:integer;
h:HWND;
text:string;
begin
if ProcessIDtoSupervise>0 then
begin
h:=GetHWndByPID(ProcessIDtoSupervise);
if h<>0 then
begin
if IsAppRespondingNT(h)=true then
begin
LastAppResponseTime:=Now;
SetConsoleTextAttribute(GetStdHandle(STD_OUTPUT_HANDLE),FOREGROUND_GREEN or FOREGROUND_INTENSITY);
WriteLn('['+DateTimeToStr(Now)+'] '+ExtractFileNameEx(StartCommandline)+' (PID:'+IntToStr(ProcessIDtoSupervise)+') is responding.');
end
else
begin
SetConsoleTextAttribute(GetStdHandle(STD_OUTPUT_HANDLE),FOREGROUND_RED or FOREGROUND_INTENSITY);
text:='['+DateTimeToStr(Now)+'] '+ExtractFileNameEx(StartCommandline)+' (PID:'+IntToStr(ProcessIDtoSupervise)+') is NOT responding.';
WriteLn(text);
Log.Add(text);
UpdateLog:=true;
if Now>=IncMinute(LastAppResponseTime) then
begin
KillProcess(ProcessIDtoSupervise,true,true);
ApplicationFinishedGracefully:=false;
SetConsoleTextAttribute(GetStdHandle(STD_OUTPUT_HANDLE),FOREGROUND_RED or FOREGROUND_INTENSITY);
text:='['+DateTimeToStr(Now)+'] '+ExtractFileNameEx(StartCommandline)+' (PID:'+IntToStr(ProcessIDtoSupervise)+') has been killed. No response for 1 minute.';
WriteLn(text);
Log.Add(text);
UpdateLog:=true;
end;
end;
end
else
begin
SetConsoleTextAttribute(GetStdHandle(STD_OUTPUT_HANDLE),8);
text:='['+DateTimeToStr(Now)+'] '+ExtractFileNameEx(StartCommandline)+' (PID:'+IntToStr(ProcessIDtoSupervise)+') has no window.';
WriteLn(text);
end;
if (UpdateLog=true) and (SaveLog(Log)=true) then UpdateLog:=false;
end;
end;
begin
{ TODO -oUser -cConsole Main : Insert code here }
DateSeparator:='-';
TimeSeparator:=':';
ShortDateFormat:='yyyy/mm/dd';
LongTimeFormat:='hh:mm:ss';
Log:=TStringList.Create;
if ParamCount>0 then
begin
repeat
//InitializeCriticalSection(CriticalSection);
ProcessIDtoSupervise:=0;
SupervisorThread:=TSupervisorThread.Create(true);
SupervisorThread.FreeOnTerminate:=false;
SupervisorThread.StartCommandline:=ParamStr(1);
if ParamCount>1 then SupervisorThread.RestartCommandline:=ParamStr(2)
else SupervisorThread.RestartCommandline:='';
SupervisorThread.Resume;
SupervisorThread.WaitFor;
if Assigned(SupervisorThread)=true then FreeAndNil(SupervisorThread);
//DeleteCriticalSection(CriticalSection);
until ApplicationFinishedGracefully=true;
end;
Log.Free;
SetConsoleTextAttribute(GetStdHandle(STD_OUTPUT_HANDLE),7);
end.
Recent
