钩子及其应用（三）

最新推荐文章于 2019-06-24 15:57:47 发布

linzhengqun

最新推荐文章于 2019-06-24 15:57:47 发布

阅读量2.7k

点赞数

分类专栏： Delphi 文章标签： function integer string action initialization xml

本文链接：https://blog.csdn.net/linzhengqun/article/details/496076

版权

Delphi 专栏收录该内容

39 篇文章 4 订阅

订阅专栏

unit wdMacro;

{*******************************************

* brief: 日志钩子实现宏功能

* autor: linzhenqun

* date: 2005-9-11

* 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;

{ 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;

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;

{ 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;

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;

//从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;

{ 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;

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;

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;

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;

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;

initialization

EventList := TEventList.Create;

finalization

EventList.Free;

end.

没有想到代码一贴竟是这么多，实在不敢将界面的代码贴出来了，读者可以自己建一个界面调用其中的函数。

这里有几点要说明，以免新手迷惑：

1：RecordStop: TSimpleProc;

PlayStop: TSimpleProc;

有这两个全局的回调函数，当停止记录和播放时，会调用它们，如果外面单元有赋值的，则可以在这个事件中作一些操作，比如提示信息。

2：关于那个TList的子类，当List增加删除一项时，会调用Notify方法，这个方法是一个虚方法，子类可以覆盖它，EventList子类即覆盖它，并判断如果是删除操作时，把指针给销毁掉，这样就免去我们的很多的麻烦。有兴趣可以读一读VCL的源码，则更加明白了。

3：SaveEventListToXML和GetEventListFromXML是两个操作XML文件的函数，其中的方法与这篇文章无关，所以这里就不想再去作什么解释了，不然又要一大篇，有兴趣者去看一看关于XML的应用吧，或者有机会我再写一篇文章说明之。

4：{系统使得钩子停止}

procedure HookStopBySystem(Msg: LongWord);这一过程是当你按下Ctrl+Alt+Del时系统发送WM_CANCELJOURNAL给应用程序时，程序的处理过程调用的。比如外部有了Application的OnMessage的处理函数，当处理到WM_CANCELJOURNAL时，则调用HookStopBySystem作一些操作。