{$C FIXED PRELOAD PERMANENT}

library HOOKLIB;

{$IFDEF Win32}

uses
  Windows;

type
  TwMsg = Longint;
  TwParam = Longint;
  TlParam = Longint;

{$ELSE}

uses
 {$IFDEF VER15}
  WinTypes, WinProcs, Win31;
 {$ELSE}
 {$IFDEF VER70}
  WinTypes, WinProcs, Win31;
 {$ELSE}
  WinTypes, WinProcs;
 {$ENDIF}
 {$ENDIF}

type
  TwMsg = Word;
  TwParam = Word;
  TlParam = Longint;

{$ENDIF}

const
  MAXMSG = 6500;

type
  PEventMsg = ^TEventMsg;
  TMsgBuff = Array[0..MAXMSG]of TEventMsg;
  TcbPlaybackFinishedProc = Procedure(AppData: Longint)
                          {$IFDEF Win32} stdcall; {$ELSE} ; {$ENDIF}

var
  PMsgBuff: ^TMsgBuff;
  TheHook: HHook;
  StartTime: Longint;
  MsgCount: Longint;
  CurrentMsg: Longint;
  ReportDelayTime: Bool;
  SysModalOn: Bool;
  cbPlaybackFinishedProc:
  TcbPlaybackFinishedProc;
  cbAppData: Longint;


{ *********************************************************************** }
{ function JournalRecordProc(Code: Integer;                               }
{                            wParam: TwParam;                             }
{                            lParam: TlParam): Longint;                   }
{ Parameters: action to perform and message data.                         }
{ Returns: zero unless code < 0, in which case return the result          }
{          from CallNextHookEx().                                         }
{ *********************************************************************** }

function JournalRecordProc(Code: Integer;  wParam: TwParam; lParam: TlParam): Longint
                                     {$IFDEF Win32} stdcall;
                                     {$ELSE} ; export; {$ENDIF}
begin
  JournalRecordProc := 0;
  case Code of

    HC_ACTION: begin
      if SysModalOn then exit;
      if MsgCount > MAXMSG then exit;
     {record the message}
      PMsgBuff^[MsgCount] := PEventMsg(lParam)^;
     {set the delta time of the message}
      Dec(PMsgBuff^[MsgCount].Time,StartTime);
      Inc(MsgCount);
      exit;
    end;

    HC_SYSMODALON: begin
      SysModalOn := True;
      CallNextHookEx(TheHook, Code, wParam, lParam);
      exit;
    end;

    HC_SYSMODALOFF: begin
      SysModalOn := False;
      CallNextHookEx(TheHook, Code, wParam, lParam);
      exit;
    end;

  end;
  if code < 0 then
    JournalRecordProc := CallNextHookEx(TheHook, Code, wParam, lParam);
end;


{ *********************************************************************** }
{ function StartRecording: Integer;                                       }
{ Parameters: none.                                                       }
{ Returns: non zero if successful.                                        }
{ *********************************************************************** }
function StartRecording: Integer
                      {$IFDEF Win32} stdcall;
                      {$ELSE} ; export; {$ENDIF}
begin
  StartRecording := 0;
  if pMsgBuff <> nil then exit;
  GetMem(PMsgBuff, Sizeof(TMsgBuff));
  if PMsgBuff = nil then exit;
  SysModalOn := False;
  MsgCount := 0;
  StartTime := GetTickCount;
  TheHook := SetWindowsHookEx(WH_JOURNALRECORD, JournalRecordProc, hInstance, 0);
  if TheHook <> 0 then begin
    StartRecording := 1;
    exit;
   end
  else begin
    FreeMem(PMsgBuff, Sizeof(TMsgBuff));
    PMsgBuff := nil;
  end;
end;


{ *********************************************************************** }
{ function StopRecording(lpFileName: PChar): Integer;                     }
{ Parameters: pointer to filename to save to.                             }
{ Returns: number of records written.                                     }
{          -1 if not recording.                                           }
{          -2 unable to unhook.                                           }
{ *********************************************************************** }
function StopRecording(lpFileName: PChar): Longint
                      {$IFDEF Win32} stdcall;
                      {$ELSE} ; export; {$ENDIF}

var TheFile: File;
begin
  if PMsgBuff = nil then begin
    StopRecording := -1;
    exit;
  end;
  if UnHookWindowsHookEx(TheHook) = False then begin
    StopRecording := -2;
    exit;
  end;
  TheHook := 0;
  if MsgCount > 0 then begin
    Assign(TheFile, lpFileName);
   {$I-}
    Rewrite(TheFile, Sizeof(TEventMsg));
   {$I+}
    if IOResult <> 0 then begin
      FreeMem(PMsgBuff, Sizeof(TMsgBuff));
      PMsgBuff := nil;
      StopRecording := 0;
      exit;
    end;
   {$I-}
    Blockwrite(TheFile, PMsgBuff^, MsgCount);
   {$I+}
    if IOResult <> 0 then begin
      FreeMem(PMsgBuff, Sizeof(TMsgBuff));
      PMsgBuff := nil;
      StopRecording := 0;
     {$I-}
      Close(TheFile);
     {$I+}
      if IOResult <> 0 then exit;
      exit;
    end;
   {$I-}
    Close(TheFile);
   {$I+}
    if IOResult <> 0 then begin
      FreeMem(PMsgBuff, Sizeof(TMsgBuff));
      PMsgBuff := nil;
      StopRecording := 0;
      exit;
    end;
  end;
  FreeMem(PMsgBuff, Sizeof(TMsgBuff));
  PMsgBuff := nil;
  StopRecording := MsgCount;
end;


{ *********************************************************************** }
{ function JournalPlaybackProc(Code: Integer;                             }
{                              wParam: TwParam;                           }
{                              lParam: TlParam): Longint;                 }
{ Parameters: action to perform and message data.                         }
{ Returns:  if Code < 0, returns the result from CallNextHookEx(),        }
{            otherwise returns the requested time to wait to fire         }
{            the next event or zero.                                      }
{ *********************************************************************** }
function JournalPlaybackProc(Code: Integer;
                wParam: TwParam; lParam: TlParam): Longint
                                 {$IFDEF Win32} stdcall;
                                 {$ELSE} ; export; {$ENDIF}
var
  TimeToFire: Longint;
begin
  JournalPlaybackProc := 0;
  case Code of

    HC_SKIP: begin
     {get the next message}
      Inc(CurrentMsg);
      ReportDelayTime := True;
     {are we finished?}
      if CurrentMsg >= (MsgCount-1) then
        if TheHook <> 0 then
          if UnHookWindowsHookEx(TheHook) = True then begin
            TheHook := 0;
            FreeMem(PMsgBuff, Sizeof(TMsgBuff));
            PMsgBuff := nil;
           {callback to the application announcing we are finished}
            cbPlaybackFinishedProc(cbAppData);
          end;
      exit;
    end;

    HC_GETNEXT: begin
     {play the current message}
      PEventMsg(lParam)^ := PMsgBuff^[CurrentMsg];
      PEventMsg(lParam)^.Time := StartTime + PMsgBuff^[CurrentMsg].Time;
     {if first time this message has played - report the delay time}
      if ReportDelayTime then begin
        ReportDelayTime := False;
        TimeToFire := PEventMsg(lParam)^.Time - GetTickCount;
        if TimeToFire > 0 then JournalPlaybackProc := TimeToFire;
      end;
      exit;
    end;

    HC_SYSMODALON:begin
     {something is wrong}
      SysModalOn := True;
      CallNextHookEx(TheHook, Code, wParam, lParam);
      exit;
    end;

    HC_SYSMODALOFF:begin
     {we have been hosed by the system - our hook has been pulled!}
      SysModalOn := False;
      TheHook := 0;
      FreeMem(PMsgBuff, Sizeof(TMsgBuff));
      PMsgBuff := nil;
     {callback to the application announcing we are finished}
      cbPlaybackFinishedProc(cbAppData);
      CallNextHookEx(TheHook, Code, wParam, lParam);
      exit;
    end;

  end;
  If code < 0  then
    JournalPlaybackProc := CallNextHookEx(TheHook, Code, wParam, lParam);
end;


{ *********************************************************************** }
{ function Playback(lpFileName: PChar;                                    }
{                    EndPlayProc: TcbPlaybackFinishedProc;                }
{                    AppData: Longint): Integer;                          }
{ Parameters: pointer to filename to play.                                }
{             application's EndPlay callback function.                    }
{             application's defined data.                                 }
{ Returns: non zero if successful.                                        }
{ *********************************************************************** }
function Playback(lpFileName: PChar;
                   EndPlayProc: TcbPlaybackFinishedProc;
                   AppData: Longint): Integer
                             {$IFDEF Win32} stdcall;
                             {$ELSE} ; export; {$ENDIF}
var
  TheFile: File;
begin
  Playback := 0;
  If PMsgBuff <> nil then exit;
  GetMem(PMsgBuff, Sizeof(TMsgBuff));
  If PMsgBuff = nil then exit;
  Assign(TheFile, lpFileName);
 {$I-}
  Reset(TheFile, Sizeof(TEventMsg));
 {$I+}
  if IOResult <> 0 then
begin
    FreeMem(PMsgBuff, Sizeof(TMsgBuff));
    PMsgBuff := nil;
    exit;
  end;
 {$I-}
  MsgCount := FileSize(TheFile);
 {$I+}
  if IOResult <> 0 then begin
    FreeMem(PMsgBuff, Sizeof(TMsgBuff));
    PMsgBuff := nil;
   {$I-}
    Close(TheFile);
   {$I+}
    if IOResult <> 0 then exit;
    exit;
  end;
  if MsgCount = 0 then begin
    FreeMem(PMsgBuff, Sizeof(TMsgBuff));
    PMsgBuff := nil;
   {$I-}
    Close(TheFile);
   {$I+}
    if IOResult <> 0 then exit;
    exit;
  end;
 {$I-}
  Blockread(TheFile, PMsgBuff^, MsgCount);
 {$I+}
  if IOResult <> 0 then begin
    FreeMem(PMsgBuff, Sizeof(TMsgBuff));
    PMsgBuff := nil;
   {$I-}
    Close(TheFile);
   {$I+}
    if IOResult <> 0 then exit;
    exit;
  end;
 {$I-}
  Close(TheFile);
 {$I+}
  if IOResult <> 0 then begin
    FreeMem(PMsgBuff, Sizeof(TMsgBuff));
    PMsgBuff := nil;
    exit;
  end;
  CurrentMsg := 0;
  ReportDelayTime := True;
  SysModalOn := False;
 {save the application's callback procedure}
  cbPlaybackFinishedProc := EndPlayProc;
 {save the application's defined data parameter}
  cbAppData := AppData;
  StartTime := GetTickCount;
  TheHook := SetWindowsHookEx(WH_JOURNALPLAYBACK,
                JournalPlayBackProc, hInstance, 0);
  if TheHook = 0 then begin
    FreeMem(PMsgBuff, Sizeof(TMsgBuff));
    PMsgBuff := nil;
    exit;
  end;
  Playback := 1;
end;


exports
  JournalRecordProc   index 1 name 'JOURNALRECORDPROC' resident,
  StartRecording      index 2 name 'STARTRECORDING' resident,
  StopRecording       index 3 name 'STOPRECORDING' resident,
  JournalPlayBackProc index 4 name 'JOURNALPLAYBACKPROC' resident,
  Playback            index 5 name 'PLAYBACK' resident;


begin
  PMsgBuff := nil;
end.
