{$H+,V-,P-}
library RecordEventHooks;
uses
ShareMem,
SysUtils,
Classes,
Dialogs,
Windows,
Messages;
var
LastEventTime : Integer = 0;
FirstTime: Boolean = True;
DefaultSpeed : Integer = 1;
CanRecord: Boolean = True;
CanPlay: Boolean = True;
MacroFileOpened: Boolean = False;
Recording: Boolean = False;
Playing: Boolean = False;
HookHandle: HHook = 0;
MacroFileName: string = '';
MacroFile: file of TEventMsg;
CurEvent, LastEvent: TEventMsg;
function PlaybackSpeed: Integer; stdcall; export;
begin
Result := DefaultSpeed;
end;
procedure SetPlaybackSpeed(NewSpeed: Integer); stdcall; export;
begin
if (NewSpeed >= 0) and (NewSpeed <= 1000) then DefaultSpeed := NewSpeed;
end;
procedure CloseMacroFile;
begin
if MacroFileOpened then Close(MacroFile);
MacroFileOpened := False;
end;
procedure ResetHooks; stdcall; export;
begin
if HookHandle <> 0 then UnhookWindowsHookEx(HookHandle);
HookHandle := 0;
CloseMacroFile;
Playing := False;
Recording := False;
end;
function RecordMacro(HookCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; export;
{ JournalRecordProc hook procedure }
var Event: TEventMsg;
begin
Result := CallNextHookEx(HookHandle, HookCode, wParam, lParam);
case HookCode of
HC_ACTION: begin
if not CanRecord then Exit;
try
Event := PEventMsg(lParam)^;
if (Event.message = WM_KEYUP) and ((Event.paramL and $FF)= VK_CANCEL) then
begin
ResetHooks;
ShowMessage('Запись макро прервана пользователем');
end else Write(MacroFile, Event);
except
ResetHooks;
ShowMessage('Ошибка при записи в файл' + MacroFileName +
'. Запись макро прекращена');
raise;
end;
end;
HC_SYSMODALON: CanRecord := False;
HC_SYSMODALOFF: CanRecord := True;
end; {case...}
end;
procedure PlayPause; stdcall; export;
begin
if Playing then
begin
if HookHandle <> 0 then UnhookWindowsHookEx(HookHandle);
HookHandle := 0;
Playing := False;
FirstTime := True;
end;
end;
function PlayMacro(HookCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; export;
begin
Result := CallNextHookEx(HookHandle, HookCode, wParam, lParam);
case HookCode of
HC_GETNEXT:
begin
if not CanPlay then Exit;
PEventMsg(lParam)^ := CurEvent;
if FirstTime
then Result := 0
else begin
Result := Integer(CurEvent.Time) - LastEventTime;
if Result > 0 then
begin
if (CurEvent.Message = WM_MOUSEMOVE)
or (CurEvent.Message = WM_NCMOUSEMOVE)
or (CurEvent.Message = WM_NCHITTEST)
or (CurEvent.Message = WM_MOUSEACTIVATE)
or (CurEvent.Message = WM_CAPTURECHANGED)
or (LastEvent.Message = WM_MOUSEMOVE)
or (LastEvent.Message = WM_NCMOUSEMOVE)
or (LastEvent.Message = WM_NCHITTEST)
or (LastEvent.Message = WM_MOUSEACTIVATE)
or (LastEvent.Message = WM_CAPTURECHANGED)
then Result := DefaultSpeed;
if (CurEvent.Message >= WM_KEYFIRST)
and (CurEvent.Message <= WM_KEYLAST)
then begin
if DefaultSpeed < 100
then Result := DefaultSpeed
else if Result < DefaultSpeed
then Result := DefaultSpeed;
end;
end;
end;
LastEventTime := CurEvent.Time;
FirstTime := False;
end;
HC_SKIP:
begin
if not CanPlay then Exit;
if EOF(MacroFile) then
begin
ResetHooks;
ShowMessage('Выполнение макро прекращено');
end else
try
LastEvent := CurEvent;
Read(MacroFile, CurEvent);
except
ResetHooks;
ShowMessage('Ошибка при чтении из файла' + MacroFileName +
'. Выполнение макро прекращено');
raise;
end;
end;
HC_SYSMODALON: CanPlay := False;
HC_SYSMODALOFF: CanPlay := True;
end; {case}
end;
procedure PlayResume; stdcall; export;
begin
if not Playing and not Recording then
begin
if HookHandle = 0
then HookHandle := SetWindowsHookEx(WH_JOURNALPLAYBACK, PlayMacro, HInstance, 0);
Assert(HookHandle <> 0,'Не удалось установить Hook!');
Playing := True;
end;
end;
procedure SetRecord(const MacroFName: string); stdcall; export;
begin
MacroFileName := MacroFName;
Assign(MacroFile, MacroFileName);
try
Rewrite(MacroFile);
MacroFileOpened := True;
HookHandle := SetWindowsHookEx(WH_JOURNALRECORD, RecordMacro, HInstance, 0);
Assert(HookHandle <> 0,'Не удалось установить Hook!');
Recording := True;
except
if MacroFileOpened
then begin
CloseMacroFile;
raise;
end
else ShowMessage('Ошибка при открытии файла ' + MacroFileName +
'. Запись макро прекращена');
end;
end;
procedure PlayRecord(const MacroFName: string); stdcall; export;
begin
MacroFileName := MacroFName;
Assign(MacroFile, MacroFileName);
try
FirstTime := True;
Reset(MacroFile);
MacroFileOpened := True;
HookHandle := SetWindowsHookEx(WH_JOURNALPLAYBACK, PlayMacro, HInstance, 0);
Assert(HookHandle <> 0,'Не удалось установить Hook!');
Playing := True;
except
if MacroFileOpened
then begin
CloseMacroFile;
raise;
end
else ShowMessage('Ошибка при открытии файла ' + MacroFileName +
'. Выполнение макро прекращено');
end;
end;
exports
SetRecord,
PlayRecord,
RecordMacro,
PlayMacro,
PlayPause,
PlayResume,
ResetHooks,
PlaybackSpeed,
SetPlaybackSpeed;
end.
