钩子及其应用（三）
unit wdMacro;{*******************************************
* brief: 日志钩子实现宏功能
* autor: linzhenqun
* date: <chsdate w:st="on" isrocdate="False" islunardate="False" day="11" month="9" year="2005">2005-9-11</chsdate>
* email: linzhengqun@163.com
* blog: http://blog.csdn.net/linzhengqun
********************************************}
interface
uses
Windows, Messages, Classes, SysUtils;
type
{回放可以调速度的哦!}
TPlaySpeed = (psFastest, psFaseter, psNormal, psSlower, psSlowest);
{录制和回放完毕的回调函数}
TSimpleProc = procedure;
{开始记录事件}
function StartRecord: Boolean;
{停止刻录事件}
function StopRecord: Boolean;
{开始回放事件}
function StartPlayBack(PlaySpeed: TPlaySpeed): Boolean;
{停止回放事件}
function StopPlayBack: Boolean;
{保存事件}
function SaveEventList(FileName: string): Boolean;
{打开事件列表}
function OpenEventList(FileName: string): Boolean;
{系统动作使得钩子停止}
procedure HookStopBySystem(Msg: LongWord);
var
RecordStop: TSimpleProc;
PlayStop: TSimpleProc;
implementation
uses
Math, XMLDoc, xmldom;
const
Max_EventNum = 1000000; //一百万个消息足矣
type
{管理事件结构指针，负责销毁它们}
TEventList = class(TList)
public
{覆盖该方法，释放指针的内存}
procedure Notify(Ptr: Pointer; Action: TListNotification); override;
end;
var
EventList: TEventList; //事件结构列表
HRecord: THandle; //记录钩子的句柄
HPlay: THandle; //回放钩子的句柄
Recording: Boolean; //标识是否正在记录
Playing: Boolean; //标识是否在回放
EventIndex: Integer; //当前回放的事件索引
IsReady: Boolean; //准备好拷贝了吗。
Speed: Integer; //回放速度，小于0表示正确速度
{ TEventList }
procedure TEventList.Notify(Ptr: Pointer; Action: TListNotification);
begin
inherited;
if (Action = lnDeleted) and (Ptr <> nil) then
Dispose(Ptr);
end;
{internal procedure}
function GetPlaySpeed(PlaySpeed: TPlaySpeed): Integer;
begin
case PlaySpeed of
psFastest: Result := 0;
psFaseter: Result := 5;
psNormal: Result := -1;
psSlower: Result := 50;
else Result := 80;
end;
end;
{ Hook proc }
function RecordProc(nCode: integer; wParam: WPARAM;
lParam: LPARAM): LRESULT; stdcall;
var
PEvent: PEventMsg;
begin
case nCode of
HC_ACTION:
begin
if EventList.Count >= Max_EventNum then
StopRecord
else begin
new(PEvent);
Move(PEventMsg(lParam)^, PEvent^, SizeOf(TEventMsg));
EventList.Add(PEvent);
end;
end;
end;
Result := CallNextHookEx(HRecord, nCode, wParam, lParam);
end;
function PlayBackProc(nCode: integer; wParam: WPARAM;
lParam: LPARAM): LRESULT; stdcall;
begin
Result := 0;
case nCode of
HC_SKIP:
begin
Inc(EventIndex);
if EventIndex >= EventList.Count then
begin
StopPlayBack;
IsReady := False;
end
else
IsReady := True;
end;
HC_GETNEXT:
begin
if IsReady then
begin
IsReady := False;
if Speed < 0 then
Result := PEventMsg(EventList.Items)^.time -
PEventMsg(EventList.Items)^.time
else
Result:= Speed;
end
else
Result := 0;
PEventMsg(lParam)^ := TEventMsg(EventList.Items^);
end;
else
Result := CallNextHookEx(HPlay, nCode, wParam, lParam);
end;
end;
{ save event to xml}
//将事件结构列表保存到XML文件中
function SaveEventListToXML(AEventList: TEventList; AXMLDoc: TXMLDocument): Boolean;
var
i: Integer;
RootNode, ParenNode: IDOMNode;
temStr: string;
{初始化XML文档}
procedure InitXMLDoc;
begin
AXMLDoc.XML.Text := '';
AXMLDoc.Active := True;
AXMLDoc.Encoding := 'utf-8';
end;
{在一个父结点下增加一个子结点}
function ApendNode(PNode: IDOMNode; tagName, Value: WideString): IDOMNode;
var
CNode: IDOMNode;
TextNode: IDOMText;
begin
with AXMLDoc.DOMDocument do
begin
CNode := createElement(tagName);
if Value <> '' then
begin
TextNode := createTextNode(Value);
CNode.appendChild(TextNode);
end;
Result := PNode.appendChild(CNode);
end;
end;
begin
Result := False;
if AEventList.Count = 0 then
Exit;
try
InitXMLDoc;
RootNode := AXMLDoc.DOMDocument.createElement('EventList');
AXMLDoc.DOMDocument.documentElement := IDOMElement(RootNode);
for i := 0 to AEventList.Count - 1 do
begin
ParenNode := ApendNode(RootNode, 'EventMsg', '');
temStr := IntToStr(TEventMsg(EventList.Items^).message);
ApendNode(ParenNode, 'Message', temStr);
temStr := IntToStr(TEventMsg(EventList.Items^).paramL);
ApendNode(ParenNode, 'ParamL', temStr);
temStr := IntToStr(TEventMsg(EventList.Items^).paramH);
ApendNode(ParenNode, 'ParamH', temStr);
temStr := IntToStr(TEventMsg(EventList.Items^).time);
ApendNode(ParenNode, 'Time', temStr);
temStr := IntToStr(TEventMsg(EventList.Items^).hwnd);
ApendNode(ParenNode, 'Hwnd', temStr);
end;
Result := True;
except
//什么也不做
end;
end;
//从XML文件中加载事件结构列表
function GetEventListFromXML(AEventList: TEventList; AXMLDoc: TXMLDocument): Boolean;
var
i: Integer;
PE: PEventMsg;
function GetNodeValue(ANode: IDOMNode): Integer;
begin
Result := StrToInt(ANode.firstChild.nodeValue);
end;
begin
Result := False;
try
with AXMLDoc.DOMDocument.documentElement do
for i := 0 to childNodes.length - 1 do
begin
new(PE);
PE^.message := GetNodeValue(childNodes.childNodes);
PE^.paramL := GetNodeValue(childNodes.childNodes);
PE^.paramH := GetNodeValue(childNodes.childNodes);
PE^.time := GetNodeValue(childNodes.childNodes);
PE^.hwnd := GetNodeValue(childNodes.childNodes);
EventList.Add(PE);
end;
Result := True;
except
end;
end;
{ macro API }
function OpenEventList(FileName: string): Boolean;
var
XMLDoc: TXMLDocument;
begin
Result := False;
XMLDoc := TXMLDocument.Create(nil);
try
EventList.Clear;
XMLDoc.LoadFromFile(FileName);
if GetEventListFromXML(EventList, XMLDoc) then
Result := True;
finally
XMLDoc.Free;
end;
end;
function SaveEventList(FileName: string): Boolean;
var
XMLDoc: TXMLDocument;
begin
Result := False;
XMLDoc := TXMLDocument.Create(nil);
try
if SaveEventListToXML(EventList, XMLDoc) then
begin
XMLDoc.SaveToFile(FileName);
Result := True;
end;
finally
XMLDoc.Free;
end;
end;
function StartPlayBack(PlaySpeed: TPlaySpeed): Boolean;
begin
Result := False;
if Recording or Playing then
Exit;
if EventList.Count = 0 then
Exit;
EventIndex := 0;
Speed := GetPlaySpeed(PlaySpeed);
HPlay := SetWindowsHookEx(WH_JOURNALPLAYBACK, @PlayBackProc, HInstance, 0);
Result := HPlay <> 0;
Playing := Result;
end;
function StartRecord: Boolean;
begin
Result := False;
if Playing or Recording then
Exit;
EventList.Clear;
HRecord := SetWindowsHookEx(WH_JOURNALRECORD, @RecordProc, HInstance, 0);
Result := HRecord <> 0;
Recording := Result;
end;
function StopPlayBack: Boolean;
begin
Result := False;
if not Playing or Recording then
Exit;
Result := UnhookWindowsHookEx(HPlay);
if Result then
begin
if Assigned(PlayStop) then
PlayStop();
Playing := False;
end;
end;
function StopRecord: Boolean;
begin
Result := False;
if not Recording or Playing then
Exit;
Result := UnhookWindowsHookEx(HRecord);
if Result then
begin
Recording := False;
//通知外部，记录已经停止
if Assigned(RecordStop) then
RecordStop();
end;
end;
procedure HookStopBySystem(Msg: LongWord);
begin
if Msg = WM_CANCELJOURNAL then
begin
if Playing then
begin
Playing := False;
if Assigned(PlayStop) then
PlayStop();
end
else if Recording then
begin
Recording := False;
if Assigned(RecordStop) then
RecordStop();
end;
end;
end;
initialization
<spa
页:
[1]