Solved

Capturing keystrokes and mouse events in another application

Posted on 2004-10-15
12
1,356 Views
Last Modified: 2010-07-27
I have found a component (TMsgSimulator) for capturing keystrokes and mouse events in another application from the website http://www.radix.net/~bziegler/Delphi/Source.html.

Help me modify the component so that the captured keystrokes and mouse events can be written to a file and later retrieved to play back. I am looking for the two additional procedures "SaveToFile(filename :string)" and "ReadFromFile(filename : string)" added to the component. Source code please.
0
Comment
Question by:darsan128
  • 6
  • 5
12 Comments
 
LVL 12

Expert Comment

by:esoftbg
ID: 12330336
I downloaded TMsgSimulator, installed it, then compiled and ran the MsgSimDemo.exe. But my opinion is that is an component for simulating Keystrokes, Button-clicks, Type Text into Notepad ....
It is not for capturing keystrokes and mouse events ....
0
 

Author Comment

by:darsan128
ID: 12340523
If you look at the source code of TMsgSimulator, you shall find a published property "messages" in which all the keystrokes and mouse events are recorded. In the recording mode this property holds all the windows messages and at the playback mode it plays back those messages serially using the procedure "play". I have been trying to write the recorded messages to a file and play it back by reading the file. I succeeded only partially -- in the sense it is not always playing those events correctly. Hence I asked for help.
0
 
LVL 33

Expert Comment

by:Slick812
ID: 12341408
hello darsan128 , I looked at the source code for the TMsgSimulator, , and it seems like he did this as Example code to show some different methods for delphi (Collection Item) and the Journal hook API. . .  but for me he has much code that is unnessary (the whole TCollection stuff) and he leaves out code that might make it a useful thing, like he has NO CODE to save and load an event file? ? . . . . . .
are you wanting help with this TMsgSimulator code methods OR do you just want a way to get and save a Macro event file?
I have a Macro Recorder unit, that I made for me, some time ago for the Journal Hook methods, I can post some code for that if you like.
0
 

Author Comment

by:darsan128
ID: 12342034
Hello Slick812,

You are right, TMsgSimulator does not have any code to save and load. That's where I required some help. It looked llike we could add those save and load procedures. As you pointed out there are some code, which are unused, and I was trying to use those to extend the component. However, my point is to be able to get and save a Macro event file, form which I can play back at a later time. If you have such code please post it to me, I shall let you know if that is what I have been looking for.

Many thanks...
0
 
LVL 33

Expert Comment

by:Slick812
ID: 12343632
Here is the code for my Makemacro unit, I made this unit for me, not caring about what it does, except if it does what I need done to record MY key and mouse, save to file and then load from file and play the Macro back.
this will check the desk top work area for saved and loaded files, and WILL NOT LOAD a file with a different desk top area, because any change in the work area will offset ALL mouse positions, ,  and I do NOT make any attempt to correct it, I just have it Fail.
Also, this TMakeMacro does NOT have an Owner, so if you Create one you will need to FREE it.



unit MakeMacro;

interface

uses
  Windows, extctrls;

type
  TMakeMacro = class
    protected
      FaryEventMsg: Array of TEVENTMSG;
      FTimer1: TTimer;
      FTimerStr: String;
      procedure FSetWorkRect(Timer: Boolean = False);
      procedure FDrawDesk(Red: Boolean);
      procedure FTimer1Timer(Sender: TObject);

   public
     RealTime: Boolean; // default as false, , set to True for Slower Event Play
     DeskTopWarn: Boolean; // default as True, set to False for NON DeskTop Warning
     OnStopRecord: Procedure of Object; // procedure called when Recording Ends
     OnStopPlay: Procedure of Object; // procedure called when Playing Ends
     constructor Create;
     destructor  Destroy; override;
     function StartMacroRecd: Boolean; // Start the Macro Recording begin
     function PlayBackMacro: Boolean;  // start the Macro PlayBack
     procedure KillHooks; // stops ALL Journal Hooks and resets
     function EventCount: Integer; // function to get the number of Events Recorded
     function SaveMacroFile(FileName: String): Boolean; // save Macro File
     function LoadMacroFile(FileName: String): Boolean; // load macro File
     
  end;

implementation

uses
  Messages, Classes, SysUtils;

const
  Zero = 0;
  FileID = 531173501;

var
  TempEvMsg: TEventMsg;
  Recd, SysModal, GotMove, DoDelay: Boolean;
  iniTime, FirstGo: Cardinal;
  NumMsgs, PlayNum: Integer;
  hJHook: THandle;
  Hooked: Boolean = False;
  curInst: TMakeMacro;
  SRect, WRect: TRect;


procedure ResetJour;
begin
UnhookWindowsHookEx(hJHook);
hJHook := Zero;
Hooked := False;
Recd := False;

if Assigned(curInst.FTimer1) then
  begin
  curInst.FTimer1.Enabled := False;
  FreeAndNil(curInst.FTimer1);
  end;
RedrawWindow(Zero,@SRect,Zero, RDW_INVALIDATE or RDW_ERASE
                   or RDW_ALLCHILDREN or RDW_ERASENOW);
end;


function JourRecdFunc(Code, wParam: Integer; var EventStrut: TEVENTMSG): Integer; stdcall;
begin
Result := Zero;
if Code = HC_SYSMODALON then SysModal := True
else if Code = HC_SYSMODALOFF then SysModal := False;

if Code = HC_ACTION then
  begin
  if SysModal then Exit;
  if EventStrut.message = WM_KEYDOWN then
    begin
    if (EventStrut.paramL = 17923) {17923 is for Ctrl+Break}
    or (Chr(LOBYTE(LOWORD(EventStrut.paramL)))='Q') and (GetKeyState(VK_CONTROL) < Zero) then
      curInst.KillHooks;  {Ctrl+Q and Ctrl+Break will End the Journal record}
    end else
    if (Chr(LOBYTE(LOWORD(EventStrut.paramL)))='S') and (GetKeyState(VK_CONTROL) < Zero) then
      begin
      {Ctrl+S will start the journal record}
      if Recd = False then
        begin
        iniTime := GetTickCount;
        FirstGo := Zero;
      {FirstGo is used to remove the Ctrl and S key up events}
        curInst.FTimerStr := 'MACRO now RECORDING'#10'Press Ctrl+Q to Stop';
     
        curInst.FDrawDesk(False);
        end;
    Recd := True;
    end;
If Recd then
  begin
  if NumMsgs < 2048 then
    {I have limited the event log to 2048 for NO reason
    except for those who forget or don't know how to stop
    the the journaling}
    begin
    if EventStrut.message = WM_MOUSEMOVE then
      begin
      TempEvMsg := EventStrut;
      GotMove := True;
      end else
      begin
      if GotMove then
        begin
        GotMove := False;
        curInst.FaryEventMsg[NumMsgs] := TempEvMsg;
        Dec(curInst.FaryEventMsg[NumMsgs].time,iniTime);
        Inc(NumMsgs);
        SetLength(curInst.FaryEventMsg, NumMsgs+1);
        end;
      if (FirstGo < 2) then
        if (EventStrut.message = WM_KEYUP) then
          begin
          if EventStrut.paramL = 7441 then Inc(FirstGo);
          if Chr(LOBYTE(LOWORD(EventStrut.paramL))) = 'S' then Inc(FirstGo);
          Exit
          end else FirstGo := 2;
      curInst.FaryEventMsg[NumMsgs] := EventStrut;
      Dec(curInst.FaryEventMsg[NumMsgs].time,iniTime);
      Inc(NumMsgs);
      SetLength(curInst.FaryEventMsg, NumMsgs+1);
      end;
      end;
    end;
  end;
end;


function PlaybackFunc(Code, WParam: Integer; var EventStrut: TEVENTMSG): Integer; stdcall;
begin
Result := Zero;
case Code of
  HC_SKIP: begin
    if SysModal then Exit;
    Inc(PlayNum);
    DoDelay := True;
    {set this to true to get a Delay in the HC_GETNEXT}
    if (PlayNum >= NumMsgs-1) or (PlayNum > 2047) then
      begin
      {this ends the playback}
      ResetJour;
      Sleep(200);
      if Assigned(curInst.OnStopPlay) then
        curInst.OnStopPlay;
      end;
    end;

  HC_GETNEXT: begin
    if SysModal then Exit;
    EventStrut := curInst.FaryEventMsg[PlayNum];
    if DoDelay then
      begin
      Result := 400;
      if PlayNum > 1 then
      Result := curInst.FaryEventMsg[PlayNum].time - curInst.FaryEventMsg[PlayNum-1].time;
      if (not curInst.RealTime) and (Result > 400) then
        Result := 400;
      DoDelay := False;
      end;
    end;

  HC_SYSMODALON: SysModal := True;
  HC_SYSMODALOFF: SysModal := False;
  end; // case
end;


procedure TMakeMacro.FSetWorkRect(Timer: Boolean = False);
begin
if not SystemParametersInfo(SPI_GETWORKAREA,Zero,@WRect,Zero) then
WRect := Rect(Zero,Zero,GetSystemMetrics(SM_CXSCREEN),GetSystemMetrics(SM_CYSCREEN) - 32);
SRect := WRect;
SRect.TopLeft := Point(SRect.Right-158,SRect.Bottom-60);
if DeskTopWarn and Timer and (not Assigned(FTimer1)) then
  begin
  FTimer1 := TTimer.Create(nil);
  FTimer1.OnTimer := FTimer1Timer;
  end;
end;


constructor TMakeMacro.Create;
begin
if curInst <> nil then
  raise EInvalidOperation.Create(
        'ERROR, can NOT Create TMakeMacro'#10'Only ONE Instance of TMakeMacro Allowed');
inherited;
curInst := Self;
hJHook := Zero;
NumMsgs := Zero;
hJHook := Zero;
PlayNum := Zero;
RealTime := False;
SysModal := False;
SetLength(FaryEventMsg,1);
Recd := False;
DeskTopWarn := True;
FSetWorkRect;
end;

destructor TMakeMacro.Destroy;
begin
ResetJour;
curInst := nil;
SetLength(FaryEventMsg,Zero);
inherited;
end;


function TMakeMacro.StartMacroRecd: Boolean;
begin
Result := False;
{this starts the Journal Record hook}
if Hooked then
  begin
  Messagebox(Zero,'Mouse and Keyboard Recording has already been started',
             'No can Restart', MB_OK or MB_ICONQUESTION or MB_TOPMOST);
  Exit;
  end;

GotMove := False;
FirstGo := Zero;
hJHook := SetWindowsHookEx(WH_JOURNALRECORD , @JourRecdFunc, hInstance, Zero);

if hJHook <> Zero then
  begin
  NumMsgs := 1;
{set NumMsgs to 1 because the first EventMsgArray is used for
file verification and NOT for events}
  Hooked := True;
  Recd := False;
  SysModal := False;
  SetLength(FaryEventMsg,2);
  FSetWorkRect(True);
  with FaryEventMsg[Zero] do
    begin
    message := WRect.Left;
    paramL := WRect.Top;
    paramH := WRect.Right;
    time := WRect.Bottom;
    hwnd := FileID;
    end;
  FTimerStr := 'Macro Record READY'#10'Press Ctrl+S to Start'#10'Ctrl+Break to Cancel';
  FDrawDesk( False);
  Result := True;
  end else
  Messagebox(Zero,'ERROR System could NOT start Journal Hook',
             'ERROR, No can START', MB_OK or MB_ICONERROR or MB_TOPMOST);
end;


procedure TMakeMacro.KillHooks;
begin
{This is to Stop Journaling}
ResetJour;
if Assigned(curInst.OnStopRecord) then
  curInst.OnStopRecord;
end;

function TMakeMacro.EventCount: Integer;
begin
Result := Zero;
if NumMsgs > 2 then
  Result := NumMsgs-2;
end;


function TMakeMacro.PlayBackMacro: Boolean;
begin
Result := False;
if Hooked then
  begin
  Messagebox(Zero,'Journal HOOK has already been started',
             'No can Restart', MB_OK or MB_ICONQUESTION or MB_TOPMOST);
  Exit;
  end;

if NumMsgs > 1 then
  begin
  PlayNum := 1;
  DoDelay := False;
  ReleaseCapture;
  SysModal := False;

  hJHook := SetWindowsHookEx(WH_JOURNALPLAYBACK , @PlaybackFunc, hInstance, Zero);
  if hJHook <> Zero then
    begin
    Result := True;
    Hooked := True;
    iniTime := GetTickCount;
    FSetWorkRect(True);
    FTimerStr := #10'MACRO PLAYBACK'#10'Please Wait';
    FDrawDesk(False);
    end else
    Messagebox(Zero,'ERROR, system did NOT start Journal Hook',
             'ERROR - No Hook', MB_OK or MB_ICONERROR or MB_TOPMOST);
  end;
end;


procedure TMakeMacro.FTimer1Timer(Sender: TObject);
begin
If FTimer1.Tag = Zero then
  begin
  FDrawDesk(True);
  FTimer1.Tag := 1;
  FTimer1.Interval := 300;
  end else
  begin
  FDrawDesk(False);
  FTimer1.Tag := Zero;
  FTimer1.Interval := 800;
  end;
end;


procedure TMakeMacro.FDrawDesk(Red: Boolean);
var
DeskDC, hBrush: Integer;
begin
if not DeskTopWarn then Exit;
DeskDC := GetDC(Zero);
hBrush := Zero;
if Red then
  begin
  hBrush := CreateSolidBrush($FF);
  SelectObject(DeskDC,hBrush);
  SetBkColor(DeskDC,$FF);
  end;
Rectangle(DeskDC,SRect.Left,SRect.Top,SRect.Right,SRect.Bottom);
InflateRect(SRect,-3,-2);
DrawText(DeskDC,PChar(FTimerStr),Length(FTimerStr),SRect, DT_LEFT or DT_WORDBREAK);
InflateRect(SRect,3,2);
ReleaseDC(Zero,DeskDC);
DeleteObject(hBrush);

FTimer1.Tag := Zero;
FTimer1.Interval := 700;
FTimer1.Enabled := True;
end;


function TMakeMacro.SaveMacroFile(FileName: String): Boolean;
var
SaveFile: File of TEventMsg;
i: Integer;
begin
Result := False;
if NumMsgs > 2 then
  begin
  AssignFile(SaveFile, FileName);
  Rewrite(SaveFile);
  for i := Zero to NumMsgs-2 do
  Write(SaveFile,FaryEventMsg[i]);
  CloseFile(SaveFile);
  Result := True;
  end else
  Messagebox(Zero,'ERROR, There are NO Macro Events to save to File',
             'ERROR - No Events', MB_OK or MB_ICONERROR or MB_TOPMOST);
end;

function TMakeMacro.LoadMacroFile(FileName: String): Boolean;
var
LoadFile: File of TEventMsg;
i: Integer;
begin
Result := False;
if FileExists(FileName) then
  begin
  AssignFile(LoadFile, FileName);
  Reset(LoadFile);
  NumMsgs := FileSize(LoadFile);
  if NumMsgs > 1 then
    begin
    Inc(NumMsgs);
    SetLength(FaryEventMsg, NumMsgs);
    for i := Zero to NumMsgs-2 do
    Read(LoadFile,FaryEventMsg[i]);
    CloseFile(LoadFile);
    FSetWorkRect;
    if FaryEventMsg[Zero].hwnd <> FileID then
      begin
      {the FileID is a number just to verify that this is a valid Macro file}
      SetLength(FaryEventMsg, Zero);
      Messagebox(Zero, PChar('the file "'+FileName+
        '" is NOT an Event File compatible with this version. No Playback is availible'),
        'ERROR, Invalid File', MB_OK or MB_ICONERROR or MB_TOPMOST);
      Exit;
      end else
          {check to see if the Desktop work area matches}
      if (FaryEventMsg[Zero].message <> Cardinal(WRect.Left)) or
      (FaryEventMsg[Zero].paramL <> Cardinal(WRect.Top)) or
      (FaryEventMsg[Zero].paramH <> Cardinal(WRect.Right)) or
      (FaryEventMsg[Zero].time <> Cardinal(WRect.Bottom)) then
        begin
        SetLength(FaryEventMsg, Zero);
        Messagebox(Zero, 'the DeskTop Dimentions are NOT compatible with this Playback File. No Playback is availible',
                 'ERROR, Invalid DeskTop Dimentions', MB_OK or MB_ICONERROR or MB_TOPMOST);
       end else
      Result := True;
    end;
  end;
end;

end.

0
 
LVL 33

Expert Comment

by:Slick812
ID: 12343658
  Info to use makeMacro -
In the MakeMacro unit there are several public Boolean and functions (procedures), here is some explanation for these public values -

RealTime : Default as False, if you set to True, it will slow Down the events to be as they were executed, but this seemed sad to me so I speeded up all events for the default

DeskTopWarn : Default as True, I have a blinking warning on the desk top, whenever an event RECORDING or PLAYBACK is happining, and as soon as it is over the warning is gone. So you can know if the Macro is happening, without the warning you are clueless. . .
              But you can set DeskTopWarn to False and NOTHING will give any indication that anything is happening. . . .

OnStopRecord : set this procedure variable to a procedure in YOUR unit, which will be called when the Recording has stopped.

OnStopPlay : set this procedure variable to a procedure in YOUR unit, which will be called when the Play Back has stopped.


StartMacroRecd : Call this function to START the Macro Recording of Events, a blinking warning will appear, , , And then you must press the Ctrl+S Keys to begin placing the key and mouse events in the array. Any previous events in storage will be cleared. It this function returns False, then there was an error and no recording happened.

PlayBackMacro : Call this function to Play Back a Recorded Macro Events, a blinking warning will appear while playing, , , A False result means that there was an error and it did not play back.

KillHooks : stops ALL Journal Hooks and resets, call this to END any Macro processing that may be happening, , ,  fast out or emegincy Kill.

EventCount :  call this function to get the number of Events Recorded, if it returns Zero, then there are NO events recorded and the PlayBackMacro will not work.

SaveMacroFile(FileName: String) : function saves a recorded Macro to the FileName location on Disk, there MUST be at least ONE event recorded to save file. If no file was saved then it returns False.

LoadMacroFile(FileName: String):  function loads a Macro File from disk at the FileName location, if the file does not exist or other error, then it returns False.

+ + + +  + + +  + +
the file Save and Load will Check the Desk Top Working Area, if you load a file and it's recorded Desk Top work area does NOT match the current Desk Top Work Area, then you will get an error and a message box, and the file will NOT be loaded.

= = = = = = = = = = = = =  = = = = =

below is some code examples for using the TMakeMacro, it's all button clicks except the ApplicationEvents1  OnMessage  ApplicationEvents1Message( ) procedure, this is a TApplicationEvents OnMessage procedure, which you should have for system modal conditions

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  MakeMacro; // add MakeMacro


type
  TForm1 = class(TForm)
    Label2: TLabel;
    sbut_StartMacroRecd: TSpeedButton;
    sbut_PlayMacro: TSpeedButton;
    sbut_FreeMacro: TSpeedButton;
    sbut_SaveMacro: TSpeedButton;
    sbut_LoadMacro: TSpeedButton;
    ApplicationEvents1: TApplicationEvents;
  private
    { Private declarations }
    MMacro1: TMakeMacro;
    procedure OnMacroRecStop;
    procedure PlayBackStop;

  end;



 - - - - - - - -  - --

procedure TForm1.FormDestroy(Sender: TObject);
begin
// Be Sure to Free the TMakeMacro
FreeAndNil(MMacro1);
end;

procedure TForm1.OnMacroRecStop;
begin
{this procedure is set after you create MMacro1. .
this procedure is called at the finish of a Macro Recording}
Label2.Caption := 'Journal Has Stopped';
Application.Restore;
end;

procedure TForm1.PlayBackStop;
begin
{this procedure is called at the finish of a Macro PlayBack}
Label2.Caption := 'PlayBack Has Stopped';
Application.Restore;
end;

procedure TForm1.sbut_StartMacroRecdClick(Sender: TObject);
begin
{ this button click will Create a TMakeMacro and set it's
event procedures, then start the }
if not Assigned(MMacro1) then
  begin
  MMacro1 := TMakeMacro.Create;
// this MMacro1 is NOT owned, so you must free it later
  MMacro1.OnStopRecord := OnMacroRecStop;
// to get the On Stop Record event, set OnStopRecord to the procedure in your unit
  MMacro1.OnStopPlay := PlayBackStop;
// to get the On Stop PlayBack event, set OnStopPlay to the procedure in your unit
  end;

//KMMacro.RealTime := True;
   {if you set Real Time to True, events will happen Slower}
//KMMacro.DeskTopWarn := False;
  {if you set DeskTopWarn to False the DeskTop warning will not be shown.
   A BAD Idea, I think}
if MMacro1.StartMacroRecd then // starts the recording
  begin
  Label2.Caption := 'STARTED the Macro Record';
  Application.Minimize; // get this Form out of the way
  end;
end;

procedure TForm1.sbut_PlayMacroClick(Sender: TObject);
begin
if Assigned(MMacro1) then
  begin
  if MMacro1.EventCount > 0 then // there need be at least ONE event to play
    begin
    Label2.Caption := 'Start Play';
    Application.Minimize; // get this Form out of the way
    if not MMacro1.PlayBackMacro then // PlayBack recorded events
      Application.Restore;
    end else
    ShowMessage('ERROR - There are NO Events loaded to Play back');
  end else
  ShowMessage('ERROR - There are NO MMacro1');
end;

procedure TForm1.sbut_FreeMacroClick(Sender: TObject);
begin
// call FreeAndNil to Kill the TMakeMacro
FreeAndNil(MMacro1);
end;

procedure TForm1.sbut_SaveMacroClick(Sender: TObject);
var
aFileName: String;
begin
// this button click saves a Macro to file
aFileName := 'E:\Macro File1.mef';
if not Assigned(MMacro1) then
  begin
  ShowMessage('ERROR - There is No MakeMacro1 to use');
  Exit;
  end;
// SaveMacroFile will save the recorded events to a Macro file path
if MMacro1.SaveMacroFile(aFileName) then //returns True if file saved
  ShowMessage('Macro File was Saved to file '+aFileName)
  else
  ShowMessage('ERROR - SaveMacroFile was NOT able to Save the file');
end;

procedure TForm1.sbut_LoadMacroClick(Sender: TObject);
var
aFileName: String;
begin
// this button click loads a Macro from file
aFileName := 'E:\Macro File1.mef';
if not Assigned(MMacro1) then
  begin
  MMacro1 := TMakeMacro.Create;
  MMacro1.OnStopRecord := OnMacroRecStop;
  MMacro1.OnStopPlay := PlayBackStop;
  end;
// LoadMacroFile will load the Macro from a file path
if MMacro1.LoadMacroFile(aFileName) then //returns True if file loaded
  ShowMessage('Macro File was Loaded from file '+aFileName)
  else
  ShowMessage('ERROR - LoadMacroFile was NOT able to Load that file');
end;

procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;
  var Handled: Boolean);
begin
{this is the only unusual thing for this, you will neeed to get the
Application Messages. I use the TApplicationEvents.OnMessage}
if Msg.message = WM_CANCELJOURNAL then // test for the WM_CANCELJOURNAL message
 if Assigned(MMacro1) then
   begin
   Handled := True;
   MMacro1.KillHooks; // Kill any hooks
   Application.Restore; // restore the Form
   end;
end;


 - - - - - - - - - - - - - -  - - - - - - -  - -

this works for me
0
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 

Author Comment

by:darsan128
ID: 12349368
Hello Slick812,

Many thanks for the source code and the explanation! Please allow me some time to check this out. I shall get back to you ASAP.

Thanks again.
0
 
LVL 33

Expert Comment

by:Slick812
ID: 12350101
OK, I was thinking about the reason and use I had for my MakeMacro, and I remembered that I had modified it to skip mouse move messages and RUSH the events, , but since I thought about it, this will probally not be what you need or want, so I cranked it up to change it back to a standard key mouse recorder, here is the new code -



unit MakeMacro;

interface

uses
  Windows, extctrls;

type
  TMakeMacro = class
    protected
      FaryEventMsg: Array of TEVENTMSG;
      FTimer1: TTimer;
      FTimerStr: String;
      procedure FSetWorkRect(Timer: Boolean = False);
      procedure FDrawDesk(Red: Boolean);
      procedure FTimer1Timer(Sender: TObject);

   public
     DeskTopWarn: Boolean; // default as True, set to False for NON DeskTop Warning
     OnStopRecord: Procedure of Object; // procedure called when Recording Ends
     OnStopPlay: Procedure of Object; // procedure called when Playing Ends
     constructor Create;
     destructor  Destroy; override;
     function StartMacroRecd: Boolean; // Start the Macro Recording begin
     function PlayBackMacro: Boolean;  // start the Macro PlayBack
     procedure KillHooks; // stops ALL Journal Hooks and resets
     function EventCount: Integer; // function to get the number of Events Recorded
     function SaveMacroFile(FileName: String): Boolean; // save Macro File
     function LoadMacroFile(FileName: String): Boolean; // load macro File
     
  end;

implementation

uses
  Messages, Classes, SysUtils;

const
  Zero = 0;
  FileID = 531173502;

var
  Recd, SysModal, DoDelay: Boolean;
  iniTime: Cardinal;
  NumMsgs, PlayNum: Integer;
  hJHook: THandle;
  Hooked: Boolean = False;
  curInst: TMakeMacro;
  SRect, WRect: TRect;


procedure ResetJour;
begin
UnhookWindowsHookEx(hJHook);
hJHook := Zero;
Hooked := False;
Recd := False;

if Assigned(curInst.FTimer1) then
  begin
  curInst.FTimer1.Enabled := False;
  FreeAndNil(curInst.FTimer1);
  end;
RedrawWindow(Zero,@SRect,Zero, RDW_INVALIDATE or RDW_ERASE
                   or RDW_ALLCHILDREN or RDW_ERASENOW);
end;


function JourRecdFunc(Code, wParam: Integer; var EventStrut: TEVENTMSG): Integer; stdcall;
begin
Result := Zero;
case Code of
  HC_ACTION:
    begin
    if SysModal then Exit;
    if EventStrut.message = WM_KEYDOWN then
    if (EventStrut.paramL = 17923) //17923 is for Ctrl+Break
    or ((Chr(LOBYTE(LOWORD(EventStrut.paramL)))='Q')
    and (GetKeyState(VK_CONTROL) < Zero)) then
      begin
      curInst.KillHooks;  //Ctrl+Q and Ctrl+Break will End the Journal record
      Exit;
      end;

   if (not Recd) and (EventStrut.message = WM_KEYUP) then
      if (Chr(LOBYTE(LOWORD(EventStrut.paramL)))='S')
        and (GetKeyState(VK_CONTROL) < Zero) then
      begin
      // Ctrl+S will start the journal record
      iniTime := GetTickCount;
      curInst.FTimerStr := 'MACRO now RECORDING'#10'Press Ctrl+Q to Stop';
      curInst.FDrawDesk(False);
      Recd := True;
      Exit;
      end;

  If Recd and (NumMsgs < 4096) then
    begin
// limited the event log to 4096 for those who forget or don't know how to stop it
    Inc(NumMsgs);
    SetLength(curInst.FaryEventMsg, NumMsgs+1);
    curInst.FaryEventMsg[NumMsgs] := EventStrut;
    Dec(curInst.FaryEventMsg[NumMsgs].time, iniTime);
    end;
  end; // hc_action

  HC_SYSMODALON: SysModal := True;
  HC_SYSMODALOFF: SysModal := False;
  end; //case
end;


function PlaybackFunc(Code, WParam: Integer; var EventStrut: TEVENTMSG): Integer; stdcall;
begin
Result := Zero;
case Code of
  HC_GETNEXT: begin
    if SysModal then Exit;
    EventStrut := curInst.FaryEventMsg[PlayNum];
    if DoDelay then
      begin
      if PlayNum > 1 then
        Result := curInst.FaryEventMsg[PlayNum].time - curInst.FaryEventMsg[PlayNum-1].time;
      DoDelay := False;
      end;
    end;

  HC_SKIP: begin
    if SysModal then Exit;
    Inc(PlayNum);
    DoDelay := True;
    {set this to true to get a Delay in the HC_GETNEXT}
    if PlayNum > NumMsgs then
      begin
      {this ends the playback}
      ResetJour;
      Sleep(200);
      if Assigned(curInst.OnStopPlay) then
        curInst.OnStopPlay;
      end;
    end;

  HC_SYSMODALON: SysModal := True;
  HC_SYSMODALOFF: SysModal := False;
  end; // case
end;


procedure TMakeMacro.FSetWorkRect(Timer: Boolean = False);
begin
if not SystemParametersInfo(SPI_GETWORKAREA,Zero,@WRect,Zero) then
WRect := Rect(Zero,Zero,GetSystemMetrics(SM_CXSCREEN),GetSystemMetrics(SM_CYSCREEN) - 32);
SRect := WRect;
SRect.TopLeft := Point(SRect.Right-158,SRect.Bottom-60);
if DeskTopWarn and Timer and (not Assigned(FTimer1)) then
  begin
  FTimer1 := TTimer.Create(nil);
  FTimer1.OnTimer := FTimer1Timer;
  end;
end;


constructor TMakeMacro.Create;
begin
if curInst <> nil then
  raise EInvalidOperation.Create(
        'ERROR, can NOT Create TMakeMacro'#10'Only ONE Instance of TMakeMacro Allowed');
inherited;
curInst := Self;
hJHook := Zero;
NumMsgs := Zero;
hJHook := Zero;
PlayNum := Zero;
SysModal := False;
Recd := False;
DeskTopWarn := True;
FSetWorkRect;
end;

destructor TMakeMacro.Destroy;
begin
ResetJour;
curInst := nil;
SetLength(FaryEventMsg,Zero);
inherited;
end;


function TMakeMacro.StartMacroRecd: Boolean;
begin
Result := False;
{this starts the Journal Record hook}
if Hooked then
  begin
  Messagebox(Zero,'Mouse and Keyboard Recording has already been started',
             'No can Restart', MB_OK or MB_ICONQUESTION or MB_TOPMOST);
  Exit;
  end;

hJHook := SetWindowsHookEx(WH_JOURNALRECORD , @JourRecdFunc, hInstance, Zero);

if hJHook <> Zero then
  begin
  NumMsgs := 0;
  Hooked := True;
  Recd := False;
  SysModal := False;
  SetLength(FaryEventMsg,1);
  FSetWorkRect(True);
  with FaryEventMsg[Zero] do
    begin
    message := WRect.Left;
    paramL := WRect.Top;
    paramH := WRect.Right;
    time := WRect.Bottom;
    hwnd := FileID;
    end;
  FTimerStr := 'Macro Record READY'#10'Press Ctrl+S to Start'#10'Ctrl+Break to Cancel';
  FDrawDesk(False);
  Result := True;
  end else
  Messagebox(Zero,'ERROR System could NOT start Journal Hook',
             'ERROR, No can START', MB_OK or MB_ICONERROR or MB_TOPMOST);
end;


procedure TMakeMacro.KillHooks;
begin
{This is to Stop Journaling}
ResetJour;
if Assigned(curInst.OnStopRecord) then
  curInst.OnStopRecord;
end;

function TMakeMacro.EventCount: Integer;
begin
Result := Zero;
if NumMsgs > 0 then
  Result := NumMsgs;
end;


function TMakeMacro.PlayBackMacro: Boolean;
begin
Result := False;
if Hooked then
  begin
  Messagebox(Zero,'Journal HOOK has already been started',
             'No can Restart', MB_OK or MB_ICONQUESTION or MB_TOPMOST);
  Exit;
  end;

if NumMsgs > 0 then
  begin
  PlayNum := 1;
  DoDelay := False;
  ReleaseCapture;
  SysModal := False;

  hJHook := SetWindowsHookEx(WH_JOURNALPLAYBACK , @PlaybackFunc, hInstance, Zero);
  if hJHook <> Zero then
    begin
    Result := True;
    Hooked := True;
    iniTime := GetTickCount;
    FSetWorkRect(True);
    FTimerStr := #10'MACRO PLAYBACK'#10'Please Wait';
    FDrawDesk(False);
    end else
    Messagebox(Zero,'ERROR, system did NOT start Journal Hook',
             'ERROR - No Hook', MB_OK or MB_ICONERROR or MB_TOPMOST);
  end;
end;


procedure TMakeMacro.FTimer1Timer(Sender: TObject);
begin
If FTimer1.Tag = Zero then
  begin
  FDrawDesk(True);
  FTimer1.Tag := 1;
  FTimer1.Interval := 300;
  end else
  begin
  FDrawDesk(False);
  FTimer1.Tag := Zero;
  FTimer1.Interval := 800;
  end;
end;


procedure TMakeMacro.FDrawDesk(Red: Boolean);
var
DeskDC, hBrush: Integer;
begin
if not DeskTopWarn then Exit;
DeskDC := GetDC(Zero);
hBrush := Zero;
if Red then
  begin
  hBrush := CreateSolidBrush($FF);
  SelectObject(DeskDC,hBrush);
  SetBkColor(DeskDC,$FF);
  end;
Rectangle(DeskDC,SRect.Left,SRect.Top,SRect.Right,SRect.Bottom);
InflateRect(SRect,-3,-2);
DrawText(DeskDC,PChar(FTimerStr),Length(FTimerStr),SRect, DT_LEFT or DT_WORDBREAK);
InflateRect(SRect,3,2);
ReleaseDC(Zero,DeskDC);
DeleteObject(hBrush);

FTimer1.Tag := Zero;
FTimer1.Interval := 700;
FTimer1.Enabled := True;
end;


function TMakeMacro.SaveMacroFile(FileName: String): Boolean;
var
SaveFile: File of TEventMsg;
i: Integer;
begin
Result := False;
if NumMsgs > 0 then
  begin
  AssignFile(SaveFile, FileName);
  Rewrite(SaveFile);
  for i := Zero to High(FaryEventMsg) do
  Write(SaveFile,FaryEventMsg[i]);
  CloseFile(SaveFile);
  Result := True;
  end else
  Messagebox(Zero,'ERROR, There are NO Macro Events to save to File',
             'ERROR - No Events', MB_OK or MB_ICONERROR or MB_TOPMOST);
end;

function TMakeMacro.LoadMacroFile(FileName: String): Boolean;
var
LoadFile: File of TEventMsg;
i: Integer;
begin
Result := False;
if FileExists(FileName) then
  begin
  AssignFile(LoadFile, FileName);
  Reset(LoadFile);
  NumMsgs := FileSize(LoadFile);
  Dec(NumMsgs);
  if NumMsgs > 1 then
    begin
    Inc(NumMsgs);
    SetLength(FaryEventMsg, NumMsgs);
    for i := Zero to NumMsgs-1 do
    Read(LoadFile,FaryEventMsg[i]);
    CloseFile(LoadFile);
    FSetWorkRect;
    if FaryEventMsg[Zero].hwnd <> FileID then
      begin
      {the FileID is a number just to verify that this is a valid Macro file}
      SetLength(FaryEventMsg, Zero);
      Messagebox(Zero, PChar('the file "'+FileName+
        '" is NOT an Event File compatible with this version. No Playback is availible'),
        'ERROR, Invalid File', MB_OK or MB_ICONERROR or MB_TOPMOST);
      Exit;
      end else
          {check to see if the Desktop work area matches}
      if (FaryEventMsg[Zero].message <> Cardinal(WRect.Left)) or
      (FaryEventMsg[Zero].paramL <> Cardinal(WRect.Top)) or
      (FaryEventMsg[Zero].paramH <> Cardinal(WRect.Right)) or
      (FaryEventMsg[Zero].time <> Cardinal(WRect.Bottom)) then
        begin
        SetLength(FaryEventMsg, Zero);
        Messagebox(Zero, 'the DeskTop Dimentions are NOT compatible with this Playback File. No Playback is availible',
                 'ERROR, Invalid DeskTop Dimentions', MB_OK or MB_ICONERROR or MB_TOPMOST);
       end else
      Result := True;
    end;
  end;
end;

end.


 = = = = = = = = = = = = = = = = = = = = = =  = =

the public var and functions still do the same things, except the ones that are not there now
0
 

Author Comment

by:darsan128
ID: 12353115
Hi Slick812,

Your code as it is runs fine!

However, I would like to have two more modifications to it:

1. Procedures for starting and stopping the recording (instead of Ctrl+S and Ctrl+Q, I want to use some events form my main program to start and stop recording. If I had the explicit starting and stopping procedures (right now it is embeded in "JourRecdFunc(Code, wParam: Integer; var EventStrut: TEVENTMSG): Integer; stdcall;" it would enable me to have a better control.

2. When "RealTime" property is true, it is playing back a bit slower, but I would like it to play with pauses exactly as it has been recorded. If I have long inactivity between my keystrokes/mouse events it is not recording it.

I have doubled the points for these modifications. Please let me know if you are interested. I can see that you are a fine programmer -- it should not be a challenge to your knowledge at all!

Best...

0
 

Author Comment

by:darsan128
ID: 12353178
Hi Slick128,

I love your modified code -- it takes care of the point # 2 in my earlier response.

I shall be grateful if you could make the modification as per point # 1.

If I now get the explicit Start and Stop recording procedures -- instead of being stuck to Ctrl+S and Ctrl+Q -- the points are YOURS!!

All the best...
0
 
LVL 33

Expert Comment

by:Slick812
ID: 12354790
I was hoping I was clear about describing the  KillHooks  procedure, which will END the recording process (or playing process), as a matter of fact, it is what is called when the  Ctrl+Q  is used. . . ? ? ?

if you just want the recording to begin with the  StartMacroRecd, and NOT wait for the Ctrl+S, then I think you only need to change ONE LINE, set the  Recd   to true in the StartMacroRecd function, , ,  like this -


f hJHook <> Zero then
  begin
  NumMsgs := 0;
  Hooked := True;
  Recd := True;  //  CHANGE THIS LINE TO TRUE
  SysModal := False;

0
 
LVL 33

Accepted Solution

by:
Slick812 earned 250 total points
ID: 12354820
you will need to add this line also

iniTime := GetTickCount;

 = = = = = = =  = ==


f hJHook <> Zero then
  begin
  NumMsgs := 0;
  Hooked := True;
  iniTime := GetTickCount;  // added line
  Recd := True;  //  CHANGE THIS LINE TO TRUE
  SysModal := False;
0

Featured Post

What Should I Do With This Threat Intelligence?

Are you wondering if you actually need threat intelligence? The answer is yes. We explain the basics for creating useful threat intelligence.

Join & Write a Comment

A lot of questions regard threads in Delphi.   One of the more specific questions is how to show progress of the thread.   Updating a progressbar from inside a thread is a mistake. A solution to this would be to send a synchronized message to the…
Objective: - This article will help user in how to convert their numeric value become words. How to use 1. You can copy this code in your Unit as function 2. than you can perform your function by type this code The Code   (CODE) The Im…
It is a freely distributed piece of software for such tasks as photo retouching, image composition and image authoring. It works on many operating systems, in many languages.
Get a first impression of how PRTG looks and learn how it works.   This video is a short introduction to PRTG, as an initial overview or as a quick start for new PRTG users.

758 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

23 Experts available now in Live!

Get 1:1 Help Now