unit MsgSimulator;
{
June 23, 1998 by Ben Ziegler
6/30/98 - Added a Record Macro function
}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
type
TWMMessage = (mmMouseDown, mmMouseUp, mmMouseMove, mmKeyDown, mmKeyUp);
TMessageItem =
class(TCollectionItem)
protected
em : TEventMsg;
// Structure required by JournalPlayback Proc
FMsg : TWMMessage;
FDelay : DWORD;
// Delay in msec before next message is played
FX : integer;
// This means nothing for keystrokes
FY : integer;
// This means nothing for keystrokes
FKey : integer;
// This means nothing for mouse clicks
FHWND : integer;
// Window Handle (not used for keystrokes)
FButton : TMouseButton;
// This means nothing for keystrokes
procedure Fill_EM_From_Props;
procedure Fill_Props_From_EM;
public
constructor Create(Collection: TCollection);
override;
property HWND : integer
read FHWND
write FHWND;
// No need to save it - it will be different after each run
published
property Msg : TWMMessage
read FMsg
write FMsg;
property PosX : integer
read FX
write FX;
property PosY : integer
read FY
write FY;
property VkKey : integer
read FKey
write FKey;
property Delay : DWORD
read FDelay
write FDelay;
property Button : TMouseButton
read FButton
write FButton;
end;
TMsgSimulator =
class;
TMessageCollection =
class(TCollection)
private
FOwner : TMsgSimulator;
function GetItem(
Index: Integer): TMessageItem;
procedure SetItem(
Index: Integer; Value: TMessageItem);
protected
function GetOwner: TPersistent;
override;
procedure Update(Item: TCollectionItem);
override;
public
constructor Create(AOwner: TMsgSimulator);
function Add: TMessageItem;
property AOwner: TMsgSimulator
read FOwner;
property Items[
Index: Integer]: TMessageItem
read GetItem
write SetItem;
default;
end;
TMsgSimulator =
class(TComponent)
protected
FRunning : boolean;
// Simulation is currently running
play_hk : THandle;
// JournalPlayback Hook handle
rec_hk : THandle;
// RecordPlayback Hook handle
PlayDone : boolean;
// Flag to signal that all messages have been simulated
AbortSim : boolean;
// Flag to signal aborting the playback of messages
StartTime : DWORD;
// Time simulation started (msec)
StopTime : DWORD;
// Time simulation stoped (msec)
FDelay : integer;
// Default delay between messages
FMsgList : TMessageCollection;
// Messages to playback
FTopWin :
string;
FindText :
string;
FindHandle : THandle;
StopRec : integer;
FRecording : boolean;
FOnStopRec : TNotifyEvent;
function GetElapTime: integer;
procedure SetMsgList(MsgList: TMessageCollection);
function Add_Raw_Message(Msg: TWMMessage; x, y, VkKey, Delay, HWND: integer; Button: TMouseButton): TMessageItem;
procedure Add_Shift(hwnd: THandle; Shift: TShiftState; UpDown: TWMMessage; Delay: integer);
procedure SimClientToScreen(hwnd: THandle;
var x, y: integer);
procedure FixUp_Playback_Delays;
procedure FixUp_Record_Delays;
public
constructor Create(AOwner: TComponent);
override;
destructor Destroy;
override;
// Low-level Message Creation Functions
procedure Add_ClickEx(hwnd: THandle; Button: TMouseButton; Shift: TShiftState;
x, y, Delay: integer);
procedure Add_DragEx(hwnd: THandle; Button: TMouseButton; Shift: TShiftState;
StartX, StartY, StopX, StopY, NumMoves, Delay: integer);
procedure Add_VirtualKey(hwnd: THandle; VkKey, Delay: integer; UpDown: TWMMessage);
// High-level Message Creation Functions
procedure Add_Window_Click(hwnd: THandle; x, y: integer);
procedure Add_Window_Drag(hwnd: THandle; StartX, StartY, StopX, StopY: integer);
procedure Add_Screen_Click(x, y: integer);
procedure Add_Screen_Drag(StartX, StartY, StopX, StopY: integer);
procedure Add_ASCII_Keys(
const Keystrokes:
string);
public
// Playback & Cancel Functions
procedure Play;
// Plays messages, then returns
procedure Play_Async;
// Returns immediately
procedure Abort;
procedure Record_Input;
procedure Stop_Record;
property Running: boolean
read FRunning;
property Recording: boolean
read FRecording;
property ElapTime: integer
read GetElapTime;
// Elapsed running time in msec
// Helper Functions
procedure FocusWin(hwnd: THandle);
function FindTopLevelWin(
const FindText:
string): THandle;
published
property Messages: TMessageCollection
read FMsgList
write SetMsgList;
property DefaultDelay: integer
read FDelay
write FDelay
default 50;
property OnStopRecord: TNotifyEvent
read FOnStopRec
write FOnStopRec;
end;
procedure Register;
implementation
var
CurSim : TMsgSimulator;
// Only one TMsgSimulator can play at a time
Cur : integer;
// Current Message to play in the MsgList
NumCur : integer;
// Number of times current message has been played
procedure Register;
begin
RegisterComponents('
Samples', [TMsgSimulator]);
end;
// *********************************************************************
// TMessageItem
constructor TMessageItem.Create(Collection: TCollection);
begin
inherited;
Delay := TMessageCollection(Collection).AOwner.DefaultDelay;
end;
procedure TMessageItem.Fill_EM_From_Props;
begin
em.hwnd := hwnd;
if (Msg = mmMouseDown)
and (Button = mbLeft)
then em.
message := WM_LBUTTONDOWN;
if (Msg = mmMouseUp)
and (Button = mbLeft)
then em.
message := WM_LBUTTONUP;
if (Msg = mmMouseDown)
and (Button = mbRight)
then em.
message := WM_RBUTTONDOWN;
if (Msg = mmMouseUp)
and (Button = mbRight)
then em.
message := WM_RBUTTONUP;
if (Msg = mmMouseDown)
and (Button = mbMiddle)
then em.
message := WM_MBUTTONDOWN;
if (Msg = mmMouseUp)
and (Button = mbMiddle)
then em.
message := WM_MBUTTONUP;
case Msg
of
mmMouseMove : em.
message := WM_MOUSEMOVE;
mmKeyDown : em.
message := WM_KEYDOWN;
mmKeyUp : em.
message := WM_KEYUP;
end;
if (Msg = mmKeyDown)
or (Msg = mmKeyUp)
then begin
// Keystroke Message
em.paramL := VkKey;
em.paramH := MapVirtualKey(VkKey, 0);
end else begin
// Mouse Message
em.paramL := PosX;
em.paramH := PosY;
end;
end;
procedure TMessageItem.Fill_Props_From_EM;
begin
hwnd := em.hwnd;
case em.
message of
WM_LBUTTONDOWN :
begin Msg := mmMouseDown; Button := mbLeft;
end;
WM_LBUTTONUP :
begin Msg := mmMouseUp; Button := mbLeft;
end;
WM_RBUTTONDOWN :
begin Msg := mmMouseDown; Button := mbRight;
end;
WM_RBUTTONUP :
begin Msg := mmMouseUp; Button := mbRight;
end;
WM_MBUTTONDOWN :
begin Msg := mmMouseDown; Button := mbMiddle;
end;
WM_MBUTTONUP :
begin Msg := mmMouseUp; Button := mbMiddle;
end;
WM_MOUSEMOVE : Msg := mmMouseMove;
WM_KEYDOWN : Msg := mmKeyDown;
WM_KEYUP : Msg := mmKeyUp;
end;
if (Msg = mmKeyDown)
or (Msg = mmKeyUp)
then begin
// Keystroke Message
VkKey := em.paramL;
end else begin
// Mouse Message
PosX := em.paramL;
PosY := em.paramH;
end;
end;
// *********************************************************************
// TMessageCollection
constructor TMessageCollection.Create(AOwner: TMsgSimulator);
begin
inherited Create(TMessageItem);
FOwner := AOwner;
end;
function TMessageCollection.Add: TMessageItem;
begin
Result := TMessageItem(
inherited Add);
end;
function TMessageCollection.GetItem(
Index: Integer): TMessageItem;
begin
Result := TMessageItem(
inherited GetItem(
Index));
end;
function TMessageCollection.GetOwner: TPersistent;
begin
Result := FOwner;
end;
procedure TMessageCollection.SetItem(
Index: Integer; Value: TMessageItem);
begin
inherited SetItem(
Index, Value);
end;
procedure TMessageCollection.Update(Item: TCollectionItem);
begin
Assert(
not FOwner.Running);
end;
// *********************************************************************
// TMsgSimulator
constructor TMsgSimulator.Create(AOwner: TComponent);
begin
inherited;
FDelay := 50;
FMsgList := TMessageCollection.Create(Self);
end;
destructor TMsgSimulator.Destroy;
begin
if Running
then Abort;
FMsgList.Free;
FMsgList :=
nil;
inherited;
end;
procedure TMsgSimulator.SetMsgList(MsgList: TMessageCollection);
begin
FMsgList.Assign(MsgList);
end;
function TMsgSimulator.Add_Raw_Message(Msg: TWMMessage; x, y, VkKey, Delay, HWND: integer; Button: TMouseButton): TMessageItem;
begin
Result := Messages.Add;
Result.Msg := Msg;
Result.PosX := x;
Result.PosY := y;
Result.VkKey := VkKey;
Result.Delay := Delay;
Result.HWND := HWND;
Result.Button := Button;
end;
procedure TMsgSimulator.Add_Shift(hwnd: THandle; Shift: TShiftState; UpDown: TWMMessage; Delay: integer);
begin
// NOTE: Keystrokes do not require an hwnd, so use 0
if Shift = []
then exit;
if ssShift
in Shift
then Add_Raw_Message(UpDown, 0, 0, VK_SHIFT, Delay, 0, mbLeft);
if ssCtrl
in Shift
then Add_Raw_Message(UpDown, 0, 0, VK_CONTROL, Delay, 0, mbLeft);
if ssAlt
in Shift
then Add_Raw_Message(UpDown, 0, 0, VK_MENU, Delay, 0, mbLeft);
end;
// x, y are in Screen coordinates
procedure TMsgSimulator.Add_ClickEx(hwnd: THandle; Button: TMouseButton; Shift: TShiftState;
x, y, Delay: integer);
begin
Add_Shift(hwnd, Shift, mmKeyDown, Delay);
Add_Raw_Message(mmMouseDown, x, y, 0, Delay, hwnd, Button);
Add_Raw_Message(mmMouseUp, x, y, 0, Delay, hwnd, Button);
Add_Raw_Message(mmMouseMove, x, y, 0, Delay, hwnd, Button);
Add_Shift(hwnd, Shift, mmKeyUp, Delay);
end;
// x, y are in Screen coordinates
procedure TMsgSimulator.Add_DragEx(hwnd: THandle; Button: TMouseButton; Shift: TShiftState;
StartX, StartY, StopX, StopY, NumMoves, Delay: integer);
var
i, x, y : integer;
begin
Add_Shift(hwnd, Shift, mmKeyDown, Delay);
Add_Raw_Message(mmMouseDown, StartX, StartY, 0, Delay, hwnd, Button);
for i := 0
to NumMoves
do begin
x := (StopX - StartX) * i
div NumMoves + StartX;
y := (StopY - StartY) * i
div NumMoves + StartY;
Add_Raw_Message(mmMouseMove, x, y, 0, Delay, hwnd, Button);
end;
Add_Raw_Message(mmMouseUp, StopX, StopY, 0, Delay, hwnd, Button);
Add_Shift(hwnd, Shift, mmKeyUp, Delay);
end;
procedure TMsgSimulator.Add_VirtualKey(hwnd: THandle; VkKey, Delay: integer; UpDown: TWMMessage);
begin
Add_Raw_Message(upDown, 0, 0, vkKey, Delay, hwnd, mbLeft);
end;
procedure TMsgSimulator.SimClientToScreen(hwnd: THandle;
var x, y: integer);
var
p : TPoint;
begin
if hwnd = 0
then exit;
p := Point(x, y);
Windows.ClientToScreen(hwnd, p);
x := p.x;
y := p.y;
end;
// x, y are in the Window's coordinates
procedure TMsgSimulator.Add_Window_Click(hwnd: THandle; x, y: integer);
begin
SimClientToScreen(hwnd, x, y);
Add_ClickEx(hwnd, mbLeft, [], x, y, DefaultDelay);
end;
// StartXY & StopXY are in the Window's coordinates
procedure TMsgSimulator.Add_Window_Drag(hwnd: THandle; StartX, StartY, StopX, StopY: integer);
begin
SimClientToScreen(hwnd, StartX, StartY);
SimClientToScreen(hwnd, StopX, StopY);
Add_DragEx(hwnd, mbLeft, [], StartX, StartY, StopX, StopY, 10, DefaultDelay);
end;
// x, y are in Screen coordinates
procedure TMsgSimulator.Add_Screen_Click(x, y: integer);
var
hwnd : THandle;
begin
hwnd := Windows.WindowFromPoint(Point(x, y));
Add_ClickEx(hwnd, mbLeft, [], x, y, DefaultDelay);
end;
// x, y are in Screen coordinates
procedure TMsgSimulator.Add_Screen_Drag(StartX, StartY, StopX, StopY: integer);
var
hwnd : THandle;
begin
hwnd := Windows.WindowFromPoint(Point(StartX, StartY));
Add_DragEx(hwnd, mbLeft, [], StartX, StartY, StopX, StopY, 10, DefaultDelay);
end;
procedure TMsgSimulator.Add_ASCII_Keys(
const Keystrokes:
string);
var
i : integer;
c : byte;
Shift : boolean;
begin
for i := 1
to Length(Keystrokes)
do begin
c := VkKeyScan(Keystrokes[i])
and 255;
Shift := (VkKeyScan(Keystrokes[i])
and 256) <> 0;
if Shift
then Add_Raw_Message(mmKeyDown, 0, 0, VK_SHIFT, 1
{DefaultDelay}, 0, mbLeft);
Add_Raw_Message(mmKeyDown, 0, 0, c, DefaultDelay, 0, mbLeft);
Add_Raw_Message(mmKeyUp, 0, 0, c, 1
{DefaultDelay}, 0, mbLeft);
if Shift
then Add_Raw_Message(mmKeyUp, 0, 0, VK_SHIFT, 1
{DefaultDelay}, 0, mbLeft);
end;
end;
procedure TMsgSimulator.Play;
begin
Play_Async;
Assert(Application <>
nil, '
TMsgSimulator.Play: Application = nil');
while (
not Application.Terminated)
and (
not AbortSim)
and (
not PlayDone)
do begin
Application.ProcessMessages;
Sleep(1);
end;
end;
procedure UnHook;
begin
Win32Check(UnhookWindowsHookEx(CurSim.play_hk));
CurSim.play_hk := 0;
CurSim.PlayDone := True;
CurSim.StopTime := GetTickCount;
CurSim.FRunning := False;
CurSim :=
nil;
end;
function JournalPlaybackProc(code: integer; wp: WParam; lp: LPARAM): LResult;
stdcall;
var
pe : PEventMsg;
begin
Assert(CurSim <>
nil, '
CurSim = nil!');
Assert(CurSim.PlayDone = False, '
Still Playing?');
Result := CallNextHookEx(CurSim.play_hk, code, wp, lp);
if code < 0
then exit;
if CurSim.AbortSim
then begin
UnHook;
exit;
end;
if code = HC_GETNEXT
then begin
pe := @CurSim.Messages[Cur].em;
PEventMsg(lp)^ :=
pe^;
Result := 0;
if (NumCur = 0)
and (Cur > 0)
then begin
Result := CurSim.Messages[Cur].em.time - CurSim.Messages[Cur-1].em.time;
end;
NumCur := NumCur + 1;
exit;
end;
if code = HC_SKIP
then begin
Cur := Cur + 1;
NumCur := 0;
if Cur = CurSim.Messages.Count
then begin
UnHook;
end;
exit;
end;
end;
procedure TMsgSimulator.FixUp_Playback_Delays;
var
i : integer;
begin
for i := 0
to Messages.Count-1
do begin
Messages[i].Fill_EM_From_Props;
if i = 0
then Messages[i].em.time := 0
else Messages[i].em.time := Messages[i-1].em.time + Messages[i].Delay;
// TODO: Fix up HWNDs? -bpz
end;
end;
// This function returns immediately
procedure TMsgSimulator.Play_Async;
begin
StartTime := GetTickCount;
StopTime := StartTime;
if Messages.Count = 0
then exit;
FRunning := True;
AbortSim := False;
PlayDone := False;
Assert(CurSim =
nil, '
A TMsgSimulator is already playing or recording!');
CurSim := Self;
FixUp_Playback_Delays;
// Set up the JournalPlayback Hook
Cur := 0;
NumCur := 0;
play_hk := SetWindowsHookEx(WH_JOURNALPLAYBACK, JournalPlaybackProc, HInstance, 0);
end;
function TMsgSimulator.GetElapTime: integer;
begin
if Running
then
Result := GetTickCount - StartTime
else
Result := StopTime - StartTime;
end;
procedure TMsgSimulator.Abort;
begin
Assert(Running, '
Must be running to Abort!');
AbortSim := True;
end;
function JournalRecordProc(code: integer; wp: WParam; lp: LPARAM): LResult;
stdcall;
var
pe : PEventMsg;
mi : TMessageItem;
begin
Result := 0;
case code
of
HC_ACTION :
if (CurSim.StopRec = 0)
then begin
pe := PEventMsg(lp);
if (
pe.
message = WM_KEYDOWN)
and ((
pe.paramL
and 255) = VK_CANCEL)
then begin
CurSim.Stop_Record;
exit;
end;
mi := CurSim.Messages.Add;
mi.em :=
pe^;
mi.Fill_Props_From_EM;
end;
HC_SYSMODALON : Inc(CurSim.StopRec);
HC_SYSMODALOFF :
Dec(CurSim.StopRec);
end;
end;
procedure TMsgSimulator.Record_Input;
begin
Assert(CurSim =
nil, '
A TMsgSimulator is already playing or recording!');
CurSim := Self;
StopRec := 0;
Messages.Clear;
FRecording := True;
rec_hk := SetWindowsHookEx(WH_JOURNALRECORD, JournalRecordProc, HInstance, 0);
end;
procedure TMsgSimulator.FixUp_Record_Delays;
var
i : integer;
begin
for i := 0
to Messages.Count-1
do begin
if i = Messages.Count-1
then Messages[i].Delay := 0
else Messages[i].Delay := Messages[i+1].em.time - Messages[i].em.time;
end;
end;
procedure TMsgSimulator.Stop_Record;
begin
if Recording
then begin
Win32Check(UnhookWindowsHookEx(CurSim.rec_hk));
rec_hk := 0;
CurSim :=
nil;
FRecording := False;
FixUp_Record_Delays;
if Assigned(OnStopRecord)
then
OnStopRecord(Self);
// This is useful when the user hits CTRL-BREAK to stop recording rather than pressing a "Stop" button
end;
end;
procedure TMsgSimulator.FocusWin(hwnd: THandle);
var
tmp : THandle;
begin
// Get the top-level window
tmp := hwnd;
while GetParent(tmp)<>0
do
tmp := GetParent(tmp);
SetForegroundWindow(tmp);
Windows.SetFocus(hwnd);
end;
function EnumWindowsProc(hwnd: THandle; lp: LParam): boolean;
stdcall;
var
buf :
array[0..MAX_PATH]
of char;
ms : TMsgSimulator;
begin
Result := True;
ms := TMsgSimulator(lp);
Assert(ms<>
nil);
GetWindowText(hwnd, buf, sizeof(buf));
if Pos(ms.FindText, buf)<>0
then ms.FindHandle := hwnd;
end;
function TMsgSimulator.FindTopLevelWin(
const FindText:
string): THandle;
begin
Self.FindText := FindText;
FindHandle := DWORD(-1);
EnumWindows(@EnumWindowsProc, LParam(Self));
Result := FindHandle;
end;
initialization
CurSim :=
nil;
end.