Commits

Christopher Nilsson committed 437f92d

initial import

  • Participants

Comments (0)

Files changed (6)

File ProcessExitWatcher.dpr

+program ProcessExitWatcher;
+
+uses
+  Forms,
+  uMain in 'uMain.pas' {Form1},
+  uUmProcessExitNotifier in 'uUmProcessExitNotifier.pas';
+
+{$R *.res}
+
+begin
+  Application.Initialize;
+  Application.MainFormOnTaskbar := True;
+  Application.CreateForm(TForm1, Form1);
+  Application.Run;
+end.

File ProcessExitWatcher.dproj

+<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
+  <PropertyGroup>
+    <ProjectGuid>{0811d715-8ca6-47b7-86db-30ceaeeb16cc}</ProjectGuid>
+    <Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>
+    <Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform>
+    <DCC_DCCCompiler>DCC32</DCC_DCCCompiler>
+    <DCC_DependencyCheckOutputName>ProcessExitWatcher.exe</DCC_DependencyCheckOutputName>
+    <MainSource>ProcessExitWatcher.dpr</MainSource>
+  </PropertyGroup>
+  <PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">
+    <Version>7.0</Version>
+    <DCC_DebugInformation>False</DCC_DebugInformation>
+    <DCC_LocalDebugSymbols>False</DCC_LocalDebugSymbols>
+    <DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
+    <DCC_Define>RELEASE</DCC_Define>
+  </PropertyGroup>
+  <PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' ">
+    <Version>7.0</Version>
+    <DCC_Define>DEBUG</DCC_Define>
+  </PropertyGroup>
+  <ProjectExtensions>
+    <Borland.Personality>Delphi.Personality</Borland.Personality>
+    <Borland.ProjectType />
+    <BorlandProject>
+<BorlandProject xmlns=""> <Delphi.Personality>   <Parameters>
+      <Parameters Name="UseLauncher">False</Parameters>
+      <Parameters Name="LoadAllSymbols">True</Parameters>
+      <Parameters Name="LoadUnspecifiedSymbols">False</Parameters>
+    </Parameters>
+    <VersionInfo>
+      <VersionInfo Name="IncludeVerInfo">False</VersionInfo>
+      <VersionInfo Name="AutoIncBuild">False</VersionInfo>
+      <VersionInfo Name="MajorVer">1</VersionInfo>
+      <VersionInfo Name="MinorVer">0</VersionInfo>
+      <VersionInfo Name="Release">0</VersionInfo>
+      <VersionInfo Name="Build">0</VersionInfo>
+      <VersionInfo Name="Debug">False</VersionInfo>
+      <VersionInfo Name="PreRelease">False</VersionInfo>
+      <VersionInfo Name="Special">False</VersionInfo>
+      <VersionInfo Name="Private">False</VersionInfo>
+      <VersionInfo Name="DLL">False</VersionInfo>
+      <VersionInfo Name="Locale">3081</VersionInfo>
+      <VersionInfo Name="CodePage">1252</VersionInfo>
+    </VersionInfo>
+    <VersionInfoKeys>
+      <VersionInfoKeys Name="CompanyName"></VersionInfoKeys>
+      <VersionInfoKeys Name="FileDescription"></VersionInfoKeys>
+      <VersionInfoKeys Name="FileVersion">1.0.0.0</VersionInfoKeys>
+      <VersionInfoKeys Name="InternalName"></VersionInfoKeys>
+      <VersionInfoKeys Name="LegalCopyright"></VersionInfoKeys>
+      <VersionInfoKeys Name="LegalTrademarks"></VersionInfoKeys>
+      <VersionInfoKeys Name="OriginalFilename"></VersionInfoKeys>
+      <VersionInfoKeys Name="ProductName"></VersionInfoKeys>
+      <VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys>
+      <VersionInfoKeys Name="Comments"></VersionInfoKeys>
+    </VersionInfoKeys>
+    <Source>
+      <Source Name="MainSource">ProcessExitWatcher.dpr</Source>
+    </Source>
+  </Delphi.Personality> </BorlandProject></BorlandProject>
+  </ProjectExtensions>
+  <Import Project="$(MSBuildBinPath)\Borland.Delphi.Targets" />
+  <ItemGroup>
+    <DelphiCompile Include="ProcessExitWatcher.dpr">
+      <MainSource>MainSource</MainSource>
+    </DelphiCompile>
+    <DCCReference Include="uMain.pas">
+      <Form>Form1</Form>
+    </DCCReference>
+    <DCCReference Include="uUmProcessExitNotifier.pas" />
+  </ItemGroup>
+</Project>

File ProcessExitWatcher.res

Binary file added.
+object Form1: TForm1
+  Left = 0
+  Top = 0
+  Caption = 'Process Exit Watcher'
+  ClientHeight = 479
+  ClientWidth = 601
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -13
+  Font.Name = 'Tahoma'
+  Font.Style = []
+  OldCreateOrder = False
+  OnCreate = FormCreate
+  OnDestroy = FormDestroy
+  DesignSize = (
+    601
+    479)
+  PixelsPerInch = 120
+  TextHeight = 16
+  object ListView1: TListView
+    Left = 8
+    Top = 8
+    Width = 585
+    Height = 433
+    Anchors = [akLeft, akTop, akRight, akBottom]
+    Columns = <
+      item
+        Caption = 'PID'
+      end
+      item
+        Caption = 'Path'
+        Width = 300
+      end>
+    TabOrder = 0
+    ViewStyle = vsReport
+    OnAdvancedCustomDrawItem = ListView1AdvancedCustomDrawItem
+  end
+  object Button1: TButton
+    Left = 8
+    Top = 447
+    Width = 585
+    Height = 25
+    Anchors = [akLeft, akRight, akBottom]
+    Caption = 'Refresh'
+    TabOrder = 1
+    OnClick = Button1Click
+  end
+end
+unit uMain;
+
+interface
+
+uses
+  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
+  Dialogs, ComCtrls, StdCtrls, uUmProcessExitNotifier;
+
+type
+  TForm1 = class(TForm)
+    ListView1: TListView;
+    Button1: TButton;
+    procedure Button1Click(Sender: TObject);
+    procedure ListView1AdvancedCustomDrawItem(Sender: TCustomListView;
+      Item: TListItem; State: TCustomDrawState; Stage: TCustomDrawStage;
+      var DefaultDraw: Boolean);
+    procedure FormCreate(Sender: TObject);
+    procedure FormDestroy(Sender: TObject);
+  private
+    FProcessExitWatcher: TUmProcessExitNotifier;
+    FRemovedEntries: TStringList;
+  protected
+    procedure ClearAll;
+    procedure OnProcessExitNotification(Sender: TObject; const APID: TPidType);
+  public
+    procedure PopulateProcessList;
+  end;
+
+var
+  Form1: TForm1;
+
+implementation
+
+uses
+  TlHelp32;
+
+{$R *.dfm}
+
+// -----------------------------------------------------------------------------
+
+procedure TForm1.Button1Click(Sender: TObject);
+begin
+  ClearAll;
+  PopulateProcessList;
+end;
+
+procedure TForm1.ClearAll;
+begin
+  FRemovedEntries.Clear;
+  FProcessExitWatcher.ClearAll;
+end;
+
+procedure TForm1.FormCreate(Sender: TObject);
+begin
+  FProcessExitWatcher := TUmProcessExitNotifier.Create;
+  FProcessExitWatcher.OnProcessExit := OnProcessExitNotification;
+  
+  FRemovedEntries := TStringList.Create;
+  FRemovedEntries.Sorted := True;
+  FRemovedEntries.Duplicates := dupIgnore;
+end;
+
+procedure TForm1.FormDestroy(Sender: TObject);
+begin
+  ClearAll;
+  FRemovedEntries.Free;
+
+  FProcessExitWatcher.Free;
+end;
+
+procedure TForm1.ListView1AdvancedCustomDrawItem(Sender: TCustomListView;
+  Item: TListItem; State: TCustomDrawState; Stage: TCustomDrawStage;
+  var DefaultDraw: Boolean);
+var
+  idx : integer;
+begin
+  if (Stage = cdPrePaint) then
+  begin
+    idx := FRemovedEntries.IndexOf(Item.Caption);
+    if idx >= 0 then
+    begin
+      Sender.Canvas.Brush.Color := clRed;
+      Sender.Canvas.Font.Color := clWhite;
+    end;
+  end;
+end;
+
+procedure TForm1.OnProcessExitNotification(Sender: TObject;
+  const APID: TPidType);
+var
+  li : TListItem;
+  key : string;
+begin
+  key := IntToStr(APid);
+  li := ListView1.FindCaption(0, key, False, True, False);
+  if Assigned(li) then
+  begin
+    FRemovedEntries.Add(key);
+  end;
+  ListView1.Repaint;
+end;
+
+procedure TForm1.PopulateProcessList;
+const
+  LIDX_PATH = 0;
+var
+  snapshot : THandle;
+  procEntry : PROCESSENTRY32;
+  li : TListItem;
+  path : string;
+begin
+  ListView1.Clear;
+
+  ZeroMemory(@procEntry, sizeof(PROCESSENTRY32));
+  procEntry.dwSize := sizeof(PROCESSENTRY32);
+
+  snapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
+  if (snapshot <> 0) and Process32First(snapshot, procEntry) then
+  begin
+    try
+      repeat
+
+        if (procEntry.th32ProcessID = GetCurrentProcessId()) or (procEntry.th32ProcessID in [0, 4]) then
+          continue;
+          
+        li := ListView1.Items.Add();
+
+        li.Caption := IntToStr(procEntry.th32ProcessID);
+
+        if procEntry.szExeFile[0] <> #0 then
+          path := string(PChar(@procEntry.szExeFile[0]))
+        else
+          path := '';
+
+        li.SubItems.Add(path);
+
+        if not FProcessExitWatcher.AddProcessWatch(procEntry.th32ProcessID) then
+          li.Delete;
+
+      until not Process32Next(snapshot, procEntry);
+    finally
+      CloseHandle(snapshot);
+    end;
+  end;
+end;
+
+initialization
+  ReportMemoryLeaksOnShutdown := True;
+
+finalization
+
+end.

File uUmProcessExitNotifier.pas

+unit uUmProcessExitNotifier;
+
+interface
+
+uses
+  Windows, SysUtils, Classes;
+
+type
+  TPidType = Cardinal; // Aliased, for the day we need to support 64bit PIDs. Next delphi version? Lol.
+
+  TProcessExitNotification = procedure(Sender: TObject; const APID: TPidType) of object;
+
+  TUmProcessExitNotifier = class
+  private
+    FWaitObjects: TList;
+    FOnProcessExit : TProcessExitNotification;
+  protected
+    procedure CloseWaitInfo(const AWaitInfo: pointer);
+    procedure HandleProcessExitNotification(const AWaitInfo: pointer);
+  public
+    constructor Create;
+    destructor Destroy; override;
+
+    procedure AddAllRunningProcessesToWatch;
+    function AddProcessWatch(const APid: TPidType): boolean;
+    procedure RemoveProcessWatch(const APid: TPidType);
+
+    procedure ClearAll;
+
+    property OnProcessExit : TProcessExitNotification read FOnProcessExit write FOnProcessExit;
+  end;
+
+implementation
+
+uses
+  TlHelp32;
+
+type
+  // We'll send a pointer to one of these guys as the RegisterWaitForSingleObject context parameter.
+  TWaitInfo = record
+    PID : TPidType;
+    WaitObject: THandle;
+    ProcessHandle: THandle;
+    Sender : TObject;
+  end;
+  PWaitInfo = ^TWaitInfo;
+
+// Define the API functions not provided by the standard Delphi libs.
+const
+  WT_EXECUTEONLYONCE = 8;
+  
+type
+  TWaitOrTimerCallback = procedure(const AParameter: pointer; const ATimerOrWaitFired: boolean); stdcall;
+
+function RegisterWaitForSingleObject(const ANewWaitObject: PHandle;
+                                     const AObject: THandle;
+                                     const ACallback: TWaitOrTimerCallback;
+                                     const AContext: pointer;
+                                     const ATimeoutMS: ULONG;
+                                     const AFlags: ULONG): BOOL; stdcall; external kernel32 name 'RegisterWaitForSingleObject';
+
+// NOTE: AWaitObject here is the "ANewWaitObject" returned by RegisterWaitForSingleObject.
+function UnregisterWait(AWaitObject: THandle): BOOL; stdcall; external kernel32 name 'UnregisterWait';
+
+// -----------------------------------------------------------------------------
+
+procedure PIDRemovalCallback(const AParameter: pointer; const ATimerOrWaitFired: boolean); stdcall;
+var
+  waitInfo : PWaitInfo;
+  exitNotifier : TUmProcessExitNotifier;
+begin
+  if not ATimerOrWaitFired then
+  begin
+    if Assigned(AParameter) then
+    begin
+      waitInfo := PWaitInfo(AParameter);
+      try
+        exitNotifier := TUmProcessExitNotifier(waitInfo^.Sender);
+        if Assigned(exitNotifier) then
+          exitNotifier.HandleProcessExitNotification(AParameter);
+      except
+        on Err: Exception do
+          OutputDebugString(PChar(Format('PIDRemovalCallback(%d): %s - %s', [waitInfo^.PID, Err.ClassName, Err.Message])));
+      end;
+    end;
+  end;
+end;
+
+// -----------------------------------------------------------------------------
+
+{ TUmProcessExitNotifier }
+
+procedure TUmProcessExitNotifier.AddAllRunningProcessesToWatch;
+const
+  SYS_IDLE = 0;
+  SYS_PROC = 4;
+var
+  snapshot : THandle;
+  procEntry : PROCESSENTRY32;
+  pid : TPidType;
+begin
+  ClearAll;
+  
+  ZeroMemory(@procEntry, sizeof(PROCESSENTRY32));
+  procEntry.dwSize := sizeof(PROCESSENTRY32);
+
+  snapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
+  if (snapshot <> 0) and Process32First(snapshot, procEntry) then
+  begin
+    try
+      repeat
+        pid := TPidType(procEntry.th32ProcessID);
+
+        if (pid in [SYS_IDLE, SYS_PROC]) or (pid = GetCurrentProcessId()) then
+          continue;
+
+        AddProcessWatch(pid);
+
+      until not Process32Next(snapshot, procEntry);
+    finally
+      CloseHandle(snapshot);
+    end;
+  end;
+end;
+
+function TUmProcessExitNotifier.AddProcessWatch(const APid: TPidType): boolean;
+var
+  waitInfo : PWaitInfo;
+  regResult : BOOL;
+begin
+  Result := False;
+  waitInfo := AllocMem(sizeof(TWaitInfo));
+
+  waitInfo^.PID := APid;
+  waitInfo^.Sender := self;
+  waitInfo^.ProcessHandle := OpenProcess(SYNCHRONIZE, False, APid);
+  
+  if waitInfo^.ProcessHandle <> 0 then
+  begin
+    // We'll just ask the system's thread pool to let us know when the process is
+    // "signalled" (ie. gone).
+    regResult := RegisterWaitForSingleObject(@waitInfo^.WaitObject,
+                                             waitInfo^.ProcessHandle,
+                                             PIDRemovalCallback,
+                                             pointer(waitInfo),
+                                             INFINITE, WT_EXECUTEONLYONCE);
+    if not regResult then
+    begin
+      OutputDebugString(PChar(Format('AddProcessWatch(%d): RegisterWaitForSingleObject Failed. %d - %s',
+                                     [APid, GetLastError(), SysErrorMessage(GetLastError())])));
+      CloseHandle(waitInfo^.ProcessHandle);
+      FreeMem(waitInfo);
+    end
+    else
+    begin
+      // remember the chunk of memory we just allocated, so we can clean up eventually.
+      FWaitObjects.Add(waitInfo);
+      Result := True;
+    end;
+  end
+  else
+  begin
+    OutputDebugString(PChar(Format('AddProcessWatch(%d): Failed. %d - %s', [APid, GetLastError(), SysErrorMessage(GetLastError())])));
+    FreeMem(waitInfo);
+  end;
+end;
+
+procedure TUmProcessExitNotifier.ClearAll;
+var
+  li : TListEnumerator;
+  waitInfo : PWaitInfo;
+begin
+  li := FWaitObjects.GetEnumerator();
+  try
+    while li.MoveNext do
+    begin
+      waitInfo := li.GetCurrent();
+      CloseWaitInfo(waitInfo);
+      FreeMem(waitInfo);
+    end;
+  finally
+    li.Free;
+  end;
+  FWaitObjects.Clear;
+end;
+
+constructor TUmProcessExitNotifier.Create;
+begin
+  inherited Create;
+
+  FWaitObjects := TList.Create;
+end;
+
+destructor TUmProcessExitNotifier.Destroy;
+begin
+  ClearAll;
+  FWaitObjects.Free;
+  
+  inherited;
+end;
+
+procedure TUmProcessExitNotifier.CloseWaitInfo(const AWaitInfo: pointer);
+var
+  waitInfo : PWaitInfo;
+begin
+  if Assigned(AWaitInfo) then
+  begin
+    waitInfo := AWaitInfo;
+    try
+      UnregisterWait(waitInfo^.WaitObject);
+      CloseHandle(waitInfo^.ProcessHandle);
+    except
+      on Err: Exception do
+        OutputDebugString(PChar(Format('CloseWaitInfo: exception destroying waitinfo {%d, w=%x, p=%x}', [waitInfo^.PID, waitInfo^.WaitObject, waitInfo^.ProcessHandle])));
+    end;
+  end;
+end;
+
+procedure TUmProcessExitNotifier.HandleProcessExitNotification(
+  const AWaitInfo: pointer);
+var
+  waitInfo : PWaitInfo;
+begin
+  waitInfo := PWaitInfo(AWaitInfo);
+  try
+    if Assigned(OnProcessExit) then
+      OnProcessExit(self, waitInfo^.PID);
+  finally
+    RemoveProcessWatch(waitInfo^.PID);
+  end;
+end;
+
+procedure TUmProcessExitNotifier.RemoveProcessWatch(const APid: TPidType);
+var
+  iter : TListEnumerator;
+  waitInfo : PWaitInfo;
+  waitIdx : integer;
+  found : boolean;
+begin
+  waitIdx := 0;
+  found := False;
+
+  iter := FWaitObjects.GetEnumerator();
+  try
+    while iter.MoveNext do
+    begin
+      waitInfo := iter.GetCurrent();
+      if waitInfo^.PID = APid then
+      begin
+        found := True;
+        CloseWaitInfo(waitInfo);
+        FreeMem(waitInfo);
+        break;
+      end
+      else
+        Inc(waitIdx);
+    end;
+  finally
+    iter.Free;
+  end;
+
+  if found then
+  begin
+    FWaitObjects.Delete(waitIdx);
+  end;
+end;
+
+end.