 {
 ****************************************************************************
 CRW32 project
 Copyright (C) by Kuryakin Alexey, Sarov, Russia, 2007, <kouriakine@mail.ru>
 Anti-Zombie, i.e. parent process monitoring routines.
 Modifications:
 20071224 - Creation
 20080119 - 1st tested release
 ****************************************************************************
 }

unit _az; { Anti - Zombie, i.e. parent process monitoring }

interface

uses
 windows, sysutils, tlhelp32;

 ////////////////////////////////////////////////////////////////////////////
 // GetParentProcessId  - Return parent process ID.
 // GetParentProcessExe - Return parent process Exe file name.
 // ParentProcessDied   - Return TRUE if parent process died.
 ////////////////////////////////////////////////////////////////////////////
function GetParentProcessId:DWORD;
function GetParentProcessExe:String;
function ParentProcessDied:Boolean;

 ////////////////////////////////////////////////////////////////////////////
 // Return file type of standard input/output handles.
 // That is one of next values:
 //  FILE_TYPE_UNKNOWN - unknown file type or file not assigned.
 //  FILE_TYPE_DISK    - disk file.
 //  FILE_TYPE_CHAR    - character file, like an LPT device or a console.
 //  FILE_TYPE_PIPE    - named or anonymous pipe.
 //  FILE_TYPE_REMOTE  - remote network file.
 ////////////////////////////////////////////////////////////////////////////
function StdInFileType:DWORD;
function StdOutFileType:DWORD;
function StdErrFileType:DWORD;

 ////////////////////////////////////////////////////////////////////////////
 // Child process became Zombie, when his parent process died.
 // Usually it's normal situation, if child process independent from parent.
 // But if child process depend from parent and interact with parent process,
 // zombie have to die when parent process died.
 // BecameZombie                   - return True if parent process died.
 // BecameZombie(FILE_TYPE_PIPE)   - return True if parent process died and
 //                                  standard I/O redirected to pipe.
 // BecameZombie(0,0,'crw32.exe')  - return True if parent process died and
 //                                  parent process name equal to specified.
 // Example:
 // program Test; {$APPTYPE CONSOLE} uses _az;
 // begin
 //  while not BecameZombie(FILE_TYPE_PIPE) do begin
 //   Application.ProcessMessages; Sleep(1);
 //  end;
 // end.
 ////////////////////////////////////////////////////////////////////////////
function BecameZombie(FileType:DWORD=0; aPollPeriod:DWORD=0; const ParentExe:String=''):Boolean;

implementation

const
 myParentPid : DWORD   = 0;
 myParentExe : String  = '';
 myParentRef : THandle = INVALID_HANDLE_VALUE;

function GetParentProcessId:DWORD;
begin
 Result:=myParentPid;
end;

function GetParentProcessExe:String;
begin
 Result:=myParentExe;
end;

function ParentProcessDied:Boolean;
begin
 if (myParentRef<>0) and (myParentRef<>INVALID_HANDLE_VALUE)
 then Result:=(WaitForSingleObject(myParentRef,0)=WAIT_OBJECT_0)
 else Result:=False;
end;

function StdInFileType:DWORD;
begin
 Result:=GetFileType(GetStdHandle(STD_INPUT_HANDLE));
end;

function StdOutFileType:DWORD;
begin
 Result:=GetFileType(GetStdHandle(STD_OUTPUT_HANDLE));
end;

function StdErrFileType:DWORD;
begin
 Result:=GetFileType(GetStdHandle(STD_ERROR_HANDLE));
end;

function BecameZombie(FileType:DWORD; aPollPeriod:DWORD; const ParentExe:String):Boolean;
const
 LastTicks:DWORD=0;
var
 CurrTicks:DWORD;
begin
 CurrTicks:=GetTickCount;
 if CurrTicks-LastTicks<aPollPeriod then Result:=False else begin
  LastTicks:=CurrTicks;
  Result:=ParentProcessDied;
  if Result and (FileType<>FILE_TYPE_UNKNOWN)
  then Result:=Result and ( (StdInFileType=FileType) or (StdOutFileType=FileType) or (StdErrFileType=FileType) );
  if Result and (Length(ParentExe)>0)
  then Result:=Result and SameText(Trim(ParentExe),GetParentProcessExe);
 end;
end;

procedure FindParentProcess(var pPid:DWORD; var pExe:AnsiString);
var
 cPid       : DWORD;
 NextProc   : Boolean;
 SnapHandle : THandle;
 ProcEntry  : TProcessEntry32;
begin
 pPid:=0;
 pExe:='';
 try
  SnapHandle:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0);
  if SnapHandle<>0 then
  if SnapHandle<>INVALID_HANDLE_VALUE then
  try
   ProcEntry.dwSize:=SizeOf(ProcEntry);
   cPid:=GetCurrentProcessId;
   if cPid<>0 then begin
    NextProc:=Process32First(SnapHandle,ProcEntry);
    while NextProc do begin
     if ProcEntry.th32ProcessID=cPid then begin
      pPid:=ProcEntry.th32ParentProcessID;
      Break;
     end;
     NextProc:=Process32Next(SnapHandle,ProcEntry);
    end;
   end;
   if pPid<>0 then begin
    NextProc:=Process32First(SnapHandle,ProcEntry);
    while NextProc do begin
     if ProcEntry.th32ProcessID=pPid then begin
      pExe:=Trim(ProcEntry.szExeFile);
      Break;
     end;
     NextProc:=Process32Next(SnapHandle,ProcEntry);
    end;
   end;
   if pExe='' then pPid:=0;
   if pPid=0  then pExe:='';
  finally
   CloseHandle(SnapHandle);
  end;
 except
  on E:Exception do begin
   pExe:='';
   pPid:=0;
  end;
 end;
end;

function OpenParentProcess(pPid:DWORD):THandle;
begin
 Result:=INVALID_HANDLE_VALUE;
 if pPid<>0 then
 if pPid<>GetCurrentProcessId then
 try
  Result:=OpenProcess(PROCESS_QUERY_INFORMATION or SYNCHRONIZE,False,pPid);
 except
  on E:Exception do Result:=INVALID_HANDLE_VALUE;
 end;
end;

initialization

 FindParentProcess(myParentPid,myParentExe);
 myParentRef:=OpenParentProcess(myParentPid);

finalization
 
 myParentPid:=0;
 myParentExe:='';
 if myParentRef<>INVALID_HANDLE_VALUE then CloseHandle(myParentRef);
 myParentRef:=INVALID_HANDLE_VALUE;

end.

