PC Online 1996 November/PCO96_11.ISO/filesbbs/taskmon.arj/PASCAL/TASKDLL0.PAS

Pascal/Delphi Source File | 1996-08-23 | 12.3 KB | 301 lines

unit taskdll0;

// NOTE! - NOTE! - NOTE! - NOTE! - NOTE! - NOTE! - NOTE! - NOTE! - NOTE! - NOTE!
//
// In order to recompile this DLL you will need at the minimum REBASE.EXE (a
// utility supplied in the Windows SDK) and a hex editor.  Alternatively, if
// the Delphi compiler has undocumented switches that allow you to load DLL's
// successfully above the 2GB line (hex addresses > $80000000), then that will
// be more convenient.  (The $IMAGEBASE directive alone does not do the job in
// my experience because we cannot mark segments as "SHARED" in the Delphi2
// environment.) Specifically, the "DATA", ".idata", and "BSS" segments must be
// marked "Shareable" and the DLL's base address must be placed in an unused
// address above $80000000 (The compiled DLL is rebased to $BFF70000 - the same
// as KERNEL32.DLL - the Windows loader will move it to a more appropriate
// free shared area).
//
// Modification of this code, especially in the callbacks, must be made very
// carefully.  Be prepared to reboot your machine often.  This is not a problem
// with the FH95 library, but it is the nature of the beast.  You are, after all,
// altering the Win32 API flow and CreateProcessA and ExitProcess are fundamental
// to your operating system!
//
// NOTE! - NOTE! - NOTE! - NOTE! - NOTE! - NOTE! - NOTE! - NOTE! - NOTE! - NOTE!

interface

uses
  Windows, SysUtils, Messages;

{$I TASKMONI.PAS}

// Standard exported functions for use by TASKMON.EXE
function InitTaskDLL: Boolean; stdcall; export;
function InstallHookCreateProcess: Boolean; stdcall; export;
function InstallHookExitProcess: Boolean; stdcall; export;
function UninstallHooks: Boolean; stdcall; export;
function GetItemInLog (FirstItemInList: Boolean): PLogInfo; stdcall; export;
function SetAlarm (SetTheAlarm: Boolean): Boolean; stdcall; export;

// Callbacks that will become wrappers around CreateProcessA and ExitProcess.
// These will not be called by TASKMON.EXE but by FH95.DLL and the Windows 95
// operating system.  Note that these prototypes must match EXACTLY the
// prototype for the real Win32 API.
function MyCreateProcessA (lpApplicationName: PAnsiChar;
                           lpCommandLine: PAnsiChar;
                           lpProcessAttributes, lpThreadAttributes: PSecurityAttributes;
                           bInheritHandles: BOOL;
                           dwCreationFlags: DWORD;
                           lpEnvironment: Pointer;
                           lpCurrentDirectory: PAnsiChar;
                           const lpStartupInfo: TStartupInfo;
                           var lpProcessInformation: TProcessInformation): WordBool; stdcall; export;
procedure MyExitProcess (uExitCode: UINT); stdcall; export;

// A storage object used for storing the starting and ending of tasks.
// TASKMON.EXE will display the task list by reading each item in the list.
type
  PItemListObject = ^TItemListObject;
  TItemListObject = record
    Heap: LongInt;
    List: PByte;
  end;

// There are no local variables in the callbacks.  While this is not strictly
// prevented, it does avoid stack overflows if an API has a small stack.
var
  ItemListObject: TItemListObject;        // Stores task starting and ending
                                          // information.  See PLogInfo type.
  lCreateProcessA, lExitProcess: LongInt; // FH95 hook identifiers
  TheAlarmIsSet: Boolean;
  fRC: WordBool;                          // Value returned by CreateProcessA
  StatusMask, Skip, Last: Integer;        // Status variables from FH95.DLL
  LogInfoP: PLogInfo;                     // Information structure about
                                          // tasks starting and ending.
  MainWindow: HWnd;                       // Main window of TASKMON.EXE

implementation

{$I FUNCHOOK.PAS} // Partial header file for FH95.DLL.

function
  GetItemInLog
    (FirstItemInList: Boolean): PLogInfo;
begin
  if FirstItemInList then
    LogInfoP := PLogInfo (SLMFirst (ItemListObject.List))
  else
    LogInfoP := PLogInfo (SLMNext (ItemListObject.List));
  Result := LogInfoP;
end; {GetItemInLog}

function
  SetAlarm
    (SetTheAlarm: Boolean): Boolean;
begin
  TheAlarmIsSet := SetTheAlarm;
  Result := TheAlarmIsSet;
end; {SetAlarm}

function
  InitTaskDLL: Boolean;
var
  rc: Boolean;
begin
  rc := False;
  // First, remember the window handle for TASKMON.EXE.  Messages will be sent
  // to it by the hook/callbacks.
  MainWindow := FindWindow (Nil, 'Task Monitor for Windows 95');
  // Next, create our storage area.  Note that this will exist in the shareable
  // memory area (hmmm...sounds like a memory-mapped file concept).
  ItemListObject.Heap :=
    SMMCreate (64000, SMM_ATTR_EXTENSIBLE + SMM_ATTR_ZEROINIT);
  if ItemListObject.Heap <> SMM_BAD_HEAP then begin
    ItemListObject.List :=
      SLMCreateEx (SizeOf (TLogInfo), ItemListObject.Heap);
    if ItemListObject.List = Nil then
      SMMDestroy (ItemListObject.Heap)
    else
      rc := True;
  end;
  Result := rc;
end; {InitTaskDLL}

function
  InstallHookCreateProcess: Boolean;
var
  pfnHook: TFarProc;
  rc: Boolean;
begin
  rc := False;
  // Note that this is a generic hooking capability.  Virtually all published
  // (and several undocumented) API's can be hooked (the constraint is that
  // there must be enough "room" to establish the hook).  Approximately 40 Win32
  // API's have been successfully hooked by FH95.  See EXESpy95 and INISpy95
  // for further examples.
  if lCreateProcessA = 0 then begin
    // Install the hook/callback for CreateProcessA.
    pfnHook := MakeProcInstance (TFarProc (Addr (MyCreateProcessA)), HInstance);
    lCreateProcessA := FuncHookInstallHookEx ('KERNEL32', 'CreateProcessA', pfnHook, 40, True);
    if lCreateProcessA <> 0 then begin
      rc := True;
      FuncHookConfigureHook (lCreateProcessA, FUNCHOOK_CONFIG_RTNSIZE , 0, 4);
      FuncHookConfigureHook (lCreateProcessA, FUNCHOOK_CONFIG_BRTNSIZE, 0, 4);
      FuncHookConfigureHook (lCreateProcessA, FUNCHOOK_CONFIG_EXITCOND , 0, FUNCHOOK_COND_NE);
      FuncHookConfigureHook (lCreateProcessA, FUNCHOOK_CONFIG_BEXITCOND, 0, FUNCHOOK_COND_NE);
    end;
  end;
  Result := rc;
end; {InstallHookCreateProcess}

function
  InstallHookExitProcess: Boolean;
var
  pfnHook: TFarProc;
  rc: Boolean;
begin
  rc := False;
  // Note that this is a generic hooking capability.  Virtually all published
  // (and several undocumented) API's can be hooked (the constraint is that
  // there must be enough "room" to establish the hook).  Approximately 40 Win32
  // API's have been successfully hooked by FH95.  See EXESpy95 and INISpy95
  // for further examples.
  if lExitProcess = 0 then begin
    // Install the hook/callback for ExitProcess.
    pfnHook := MakeProcInstance (TFarProc (Addr (MyExitProcess)), HInstance);
    lExitProcess := FuncHookInstallHookEx ('KERNEL32', 'ExitProcess', pfnHook, 4, True);
    if lExitProcess <> 0 then begin
      rc := True;
      FuncHookConfigureHook (lExitProcess, FUNCHOOK_CONFIG_EXITCOND , 0, FUNCHOOK_COND_STOP);
      FuncHookConfigureHook (lExitProcess, FUNCHOOK_CONFIG_BEXITCOND, 0, FUNCHOOK_COND_STOP);
    end;
  end;
  Result := rc;
end; {InstallHookExitProcess}

function
  UninstallHooks: Boolean;
// This routine will remove the hook code in the CreateProcessA and ExitProcess
// API's and destroy the shared memory area.
var
  rc: Boolean;
begin
  if lCreateProcessA <> 0 then
    FuncHookUnInstallHook (lCreateProcessA);
  lCreateProcessA := 0;
  if lExitProcess <> 0 then
    FuncHookUnInstallHook (lExitProcess);
  lExitProcess := 0;
  if ItemListObject.Heap <> SMM_BAD_HEAP then
    rc := SMMDestroy (ItemListObject.Heap);
  ItemListObject.Heap := SMM_BAD_HEAP;
  ItemListObject.List := Nil;
  Result := rc;
end; {UninstallHooks}

// The following routines are not called directly by any program.  When they
// have been successfully installed, they become "part of" the Windows 95
// operating system.  As such, they appear in any process space that makes
// use of the hooked API, e.g., CreateProcessA and ExitProcess.  But,
// because they reside in TASKDLL.DLL, we can grab information, add additional
// processing, or change parameters as needed.  In effect, we have "injected"
// TASKDLL.DLL into any and all processes that make use of, in this case,
// CreateProcessA and/or ExitProcess.  This is known as in other words a
// systemwide hook.
function
  MyCreateProcessA
    (lpApplicationName: PAnsiChar;
     lpCommandLine: PAnsiChar;
     lpProcessAttributes, lpThreadAttributes: PSecurityAttributes;
     bInheritHandles: BOOL;
     dwCreationFlags: DWORD;
     lpEnvironment: Pointer;
     lpCurrentDirectory: PAnsiChar;
     const lpStartupInfo: TStartupInfo;
     var lpProcessInformation: TProcessInformation): WordBool;
begin
  // Some additional processing - an alert - if the user requests it.
  if TheAlarmIsSet then
    MessageBeep (MB_OK);
  // Remember some internal hook states from FH95.
  StatusMask := FuncHookGetInfo (FUNCHOOK_CMD_STATUS, lCreateProcessA);
  StatusMask := StatusMask and FUNCHOOK_STATUS_MASK;
  // If FH95 commands our callback to perform the "real" API, then do it!
  // The "real" API must be called ONCE AND ONLY ONCE!  (Note - this call
  // may or may not perform the real CreateProcessA; there may be other
  // hooks on the chain waiting for their chance.
  if StatusMask = FUNCHOOK_STATUS_DOIT then
    fRC := CreateProcessA (lpApplicationName, lpCommandLine, lpProcessAttributes,
                           lpThreadAttributes, bInheritHandles, dwCreationFlags,
                           lpEnvironment, lpCurrentDirectory, lpStartupInfo,
                           lpProcessInformation)
  else
    // In this case the "real" API has already been performed but we need to
    // return the results back to the real world.
    fRC := WordBool (FuncHookGetInfo (FUNCHOOK_CMD_LASTRESULT, lCreateProcessA));
  // Now, we will save some information from the CreateProcessA call.
  LogInfoP := PLogInfo (SMMAlloc (ItemListObject.Heap, SizeOf (TLogInfo)));
  if LogInfoP <> Nil then begin
    with LogInfoP^ do begin
      HookType := CREATINGPROCESS;
      ProcessID := lpProcessInformation.dwProcessId;
      if lpCommandLine <> Nil then begin
        Application := SMMAlloc (ItemListObject.Heap, StrLen (lpCommandLine) + 1);
        // Grab the command line parameter; this will be "beautified" later.
        StrCopy (Application, lpCommandLine);
      end;
    end;
    SLMAdd (ItemListObject.List, PByte (LogInfoP));
  end;
  // Notify TASKMON.EXE that its listbox needs refreshing.
  SendMessage (MainWindow, WM_REFRESHMSG, 0, 0);
  Result := fRC;
end; {MyCreateProcessA}

procedure
  MyExitProcess
    (uExitCode: UINT);
begin
  // Some additional processing - an alert - if the user requests it.
  if TheAlarmIsSet then
    MessageBeep (MB_OK);
  // First, we will save some information from the ExitProcess call.
  LogInfoP := PLogInfo (SMMAlloc (ItemListObject.Heap, SizeOf (TLogInfo)));
  if LogInfoP <> Nil then begin
    with LogInfoP^ do begin
      HookType := EXITINGPROCESS;
      // In the CreateProcessA hook/callback we saved the ProcessId as part
      // of the parameter list; here we must rely upon FH95 to give us that
      // value.
      ProcessID := FuncHookGetInfo (FUNCHOOK_CMD_PROCESSID, lExitProcess);
      Application := SMMAlloc (ItemListObject.Heap, 20);
      ProcProcessName (ProcessId, Application);
    end;
    SLMAdd (ItemListObject.List, PByte (LogInfoP));
  end;
  // Notify TASKMON.EXE that its listbox needs refreshing.
  SendMessage (MainWindow, WM_REFRESHMSG, 0, 0);
  // Remember some internal hook states from FH95.
  StatusMask := FuncHookGetInfo (FUNCHOOK_CMD_STATUS, lExitProcess);
  Skip := StatusMask and FUNCHOOK_STATUS_MASK;
  if Skip <> FUNCHOOK_STATUS_SKIP then begin
    Last := StatusMask and FUNCHOOK_STATUS_LAST;
    if Last <> 0 then begin
      // If we are the last hook, then we must perform the one and only one
      // API call.
      FuncHookUnlockDeletion (1);
      ExitProcess (uExitCode);
    end
    else
      FuncHookSetInfo (FUNCHOOK_CMD_STATUS, lExitProcess, FUNCHOOK_STATUS_NOTDONE);
  end;
end; {MyExitProcess}

initialization
  TheAlarmIsSet := False;
  ItemListObject.Heap := 0;
  ItemListObject.List := Nil;
  lCreateProcessA := 0;
  lExitProcess := 0;
end. {taskdll0}