钩子及其应用（三）

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.youkuaiyun.com/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[EventIndex])^.time -

PEventMsg(EventList.Items[EventIndex - 1])^.time

else

Result:= Speed;

end

else

Result := 0;

PEventMsg(lParam)^ := TEventMsg(EventList.Items[EventIndex]^);

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[i]^).message);

ApendNode(ParenNode, 'Message', temStr);

temStr := IntToStr(TEventMsg(EventList.Items[i]^).paramL);

ApendNode(ParenNode, 'ParamL', temStr);

temStr := IntToStr(TEventMsg(EventList.Items[i]^).paramH);

ApendNode(ParenNode, 'ParamH', temStr);

temStr := IntToStr(TEventMsg(EventList.Items[i]^).time);

ApendNode(ParenNode, 'Time', temStr);

temStr := IntToStr(TEventMsg(EventList.Items[i]^).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[i].childNodes[0]);

PE^.paramL := GetNodeValue(childNodes[i].childNodes[1]);

PE^.paramH := GetNodeValue(childNodes[i].childNodes[2]);

PE^.time := GetNodeValue(childNodes[i].childNodes[3]);

PE^.hwnd := GetNodeValue(childNodes[i].childNodes[4]);

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