home *** CD-ROM | disk | FTP | other *** search
/ PC Online 1996 November / PCO96_11.ISO / filesbbs / taskmon.arj / PASCAL / TASKMON0.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-08-23  |  6.5 KB  |  207 lines
  1. unit taskmon0;
  2.  
  3. // This Delphi 2.0 application can be compiled without any special procedures.
  4. // Note that this is Delphi 2.0 code (not Delphi 1.0)
  5. // and that the hook code works only under Windows 95.
  6. // See the companion project, TASKDLL.DPR, for sample code illustrating
  7. // how to hook virtually any Win32 API.
  8. //
  9. // This sample code is provided as-is with no warranties regarding its
  10. // correctness or suitability to task.  Its sole purpose is to demonstrate
  11. // one way to hook Win32 API's.  You may freely modify the sample.  See the
  12. // file PRUDENS.TXT for information on how to remove the initial dialogbox.
  13.  
  14. interface
  15.  
  16. uses
  17.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  18.   StdCtrls, Buttons;
  19.  
  20. {$I TASKMONI.PAS} // Declarations common to the main program and DLL.
  21.  
  22. type
  23.   TMainForm = class(TForm)
  24.     AlarmCheckBox: TCheckBox;
  25.     TaskListBox: TListBox;
  26.     CreateProcessLabel: TLabel;
  27.     ExitProcessLabel: TLabel;
  28.     StartButton: TButton;
  29.     CloseBitBtn: TBitBtn;
  30.     procedure FormCreate(Sender: TObject);
  31.     procedure FormDestroy(Sender: TObject);
  32.     procedure AlarmCheckBoxClick(Sender: TObject);
  33.     procedure StartButtonClick(Sender: TObject);
  34.     procedure CloseBitBtnClick(Sender: TObject);
  35.   private
  36.     HooksInstalled: Boolean;
  37.   public
  38.     procedure MessageWM_REFRESHMSG (var Message: TMsg); message WM_REFRESHMSG;
  39.   end;
  40.  
  41. var
  42.   MainForm: TMainForm;
  43.  
  44. implementation
  45.  
  46. {$R *.DFM}
  47.  
  48. // Exported functions from TASKDLL.DLL - implicit links.
  49. function
  50.   InitTaskDLL: Boolean;
  51.     stdcall; external 'TASKDLL.DLL';
  52. function
  53.   InstallHookCreateProcess: Boolean;
  54.     stdcall; external 'TASKDLL.DLL';
  55. function
  56.   InstallHookExitProcess: Boolean;
  57.     stdcall; external 'TASKDLL.DLL';
  58. function
  59.   UninstallHooks: Boolean;
  60.     stdcall; external 'TASKDLL.DLL';
  61. function
  62.   GetItemInLog
  63.     (FirstItem: Boolean): PLogInfo;
  64.       stdcall; external 'TASKDLL.DLL';
  65. function
  66.   SetAlarm
  67.     (SetTheAlarm: Boolean): Boolean;
  68.       stdcall; external 'TASKDLL.DLL';
  69.  
  70. procedure
  71.   TMainForm.FormCreate
  72.     (Sender: TObject);
  73. begin
  74.   HooksInstalled := False;
  75.   InitTaskDLL;
  76. end; {TMainForm.FormCreate}
  77.  
  78. procedure
  79.   TMainForm.FormDestroy
  80.     (Sender: TObject);
  81. begin
  82.   // If any hooks have been installed, they MUST BE removed;
  83.   // otherwise, dire things happen to your system!
  84.   if HooksInstalled then
  85.     UninstallHooks;
  86. end; {TMainForm.FormDestroy}
  87.  
  88. procedure
  89.   TMainForm.AlarmCheckBoxClick
  90.     (Sender: TObject);
  91. begin
  92.   SetAlarm (AlarmCheckBox.Checked);
  93. end; {TMainForm.AlarmCheckBoxClick}
  94.  
  95. procedure
  96.   TMainForm.StartButtonClick
  97.     (Sender: TObject);
  98. const
  99.   InfoFormat = '%2.2x%2.2x%2.2x%2.2x%2.2x%2.2x%2.2x%2.2x%2.2x%2.2x%2.2x';
  100. var
  101.   LibraryHandle: THandle;
  102.   FunctionAddr: Pointer;
  103.   Hook1, Hook2: Boolean;
  104.   Function1st11Bytes: array [0 .. 11] of Byte;
  105. // InstallHookCreateProcess and InstallHookExitProcess can, of course, be
  106. // done at form creation, or, as here, placed under user control.
  107. //
  108. // There is some error checking performed here in case the version of
  109. // Windows 95 does not match the pattern FH95 expects.
  110. begin
  111.   if not HooksInstalled then begin
  112.     Hook1 := InstallHookCreateProcess;
  113.     if not Hook1 then begin
  114.       LibraryHandle := LoadLibrary ('KERNEL32.DLL');
  115.       FunctionAddr := GetProcAddress (LibraryHandle, 'CreateProcessA');
  116.       CopyMemory (@Function1st11Bytes, FunctionAddr, 11);
  117.       CreateProcessLabel.Caption :=
  118.         Format (InfoFormat,
  119.                 [Function1st11Bytes [00],
  120.                  Function1st11Bytes [01],
  121.                  Function1st11Bytes [02],
  122.                  Function1st11Bytes [03],
  123.                  Function1st11Bytes [04],
  124.                  Function1st11Bytes [05],
  125.                  Function1st11Bytes [06],
  126.                  Function1st11Bytes [07],
  127.                  Function1st11Bytes [08],
  128.                  Function1st11Bytes [09],
  129.                  Function1st11Bytes [10]]);
  130.       FreeLibrary (LibraryHandle);
  131.     end;
  132.     Hook2 := InstallHookExitProcess;
  133.     if not Hook2 then begin
  134.       LibraryHandle := LoadLibrary ('KERNEL32.DLL');
  135.       FunctionAddr := GetProcAddress (LibraryHandle, 'ExitProcess');
  136.       CopyMemory (@Function1st11Bytes, FunctionAddr, 11);
  137.       ExitProcessLabel.Caption :=
  138.         Format (InfoFormat,
  139.                 [Function1st11Bytes [00],
  140.                  Function1st11Bytes [01],
  141.                  Function1st11Bytes [02],
  142.                  Function1st11Bytes [03],
  143.                  Function1st11Bytes [04],
  144.                  Function1st11Bytes [05],
  145.                  Function1st11Bytes [06],
  146.                  Function1st11Bytes [07],
  147.                  Function1st11Bytes [08],
  148.                  Function1st11Bytes [09],
  149.                  Function1st11Bytes [10]]);
  150.       FreeLibrary (LibraryHandle);
  151.     end;
  152.     if Hook1 or Hook2 then
  153.       HooksInstalled := True;
  154.     if HooksInstalled then
  155.       StartButton.Caption := 'Stop Monitor';
  156.   end
  157.   else begin
  158.     HooksInstalled := not UninstallHooks;
  159.     if not HooksInstalled then
  160.       StartButton.Caption := 'Start Monitor';
  161.   end;
  162. end; {TMainForm.StartButtonClick}
  163.  
  164. procedure
  165.   TMainForm.CloseBitBtnClick
  166.     (Sender: TObject);
  167. begin
  168.   Close;
  169. end; {TMainForm.CloseBitBtnClick}
  170.  
  171. procedure
  172.   TMainForm.MessageWM_REFRESHMSG
  173.     (var Message: TMsg);
  174. // In general, it is best to perform any prolonged or unnecessary processing
  175. // (like special formatting of the output) at a time outside the callback.
  176. // The callbacks will SendMessage WM_REFRESHMSG to the main window notifying
  177. // it of new tasks that have been started or ended.
  178. var
  179.   LogInfoP: PLogInfo;
  180.   AnApplication: String;
  181. begin
  182.   TaskListBox.Items.Clear;
  183.   LogInfoP := GetItemInLog (True);
  184.   while LogInfoP <> Nil do begin
  185.     with LogInfoP^ do begin
  186.       AnApplication := StrPas (Application);
  187.       case HookType of
  188.         CREATINGPROCESS:
  189.           begin
  190.             AnApplication := Copy (AnApplication, 2, Length (AnApplication) - 3);
  191.             AnApplication := ExtractFileName (AnApplication);
  192.             TaskListBox.Items.Add (Format ('(%.8x) %s is starting',
  193.                                             [ProcessID,
  194.                                              UpperCase (AnApplication)]));
  195.           end;
  196.         EXITINGPROCESS:
  197.           TaskListBox.Items.Add (Format ('(%.8x) %s is ending',
  198.                                          [ProcessID,
  199.                                           UpperCase (AnApplication)]));
  200.       end;
  201.     end;
  202.     LogInfoP := GetItemInLog (False);
  203.   end;
  204. end; {TMainForm.MessageWM_REFRESHMSG}
  205.  
  206. end. {taskmon0}
  207.