Delphi屏幕取词
屏幕取词(Delphi)(1)
“ 屏幕取词”的实现
//-----------------------------------------------------------------
１ 用SetWindowsHookEx()安装鼠标钩子MouseProc；
２ 在屏幕上移动鼠标时，系统就会调用鼠标钩子MouseProc；
３ 进入MouseProc，获得鼠标的坐标（x,y)，
设置对TextOut()、ExtTextOut()等的跟踪程序，
用invalidateRect()告诉系统该点(x,y)“失效”；
４
系统发出WM_PAINT消息，指示该点（x,y)处的应用程序重绘“失效”的区域。
５ 负责绘制该点（）的应用程序在受到 WM_PAINT 消息后， 就有机会调用
TextOut()、 ExtTextOut()等函数。
６ 调用的函数被拦截进入跟踪程序：设置好了的跟踪程序截获了该次调用，
从应用程序的堆栈中取出 该点（x,y）“文字”的指针；
７ 从应用程序的数据段中将“文字”指针的内容取出，即完成了一次“屏幕
抓字”；
８ 退出跟踪程序，返回到鼠标钩子MouseProc；
９ 在MouseProc中解除对TextOut() ExtTextOut()的跟踪；
１０ 退出MouseProc鼠标钩子程序，控制权交给系统。
１１ 在屏幕上移动鼠标，开始下一次“屏幕抓字”，返回步骤２。
//-----------------------------------------------------------------
Dll工程.
GetWordDll.dpr
//-----------------------------------------------------------------------------------
library GetWordDll;
uses
Windows,
SysUtils,
Classes,
UnitHookDll in 'UnitHookDll.pas',
UnitNt2000Hook in 'UnitNt2000Hook.pas',
UnitHookType in 'UnitHookType.pas';
exports
StartHook,
StopHook,
//      MouseWndProc,
{以下导出列表都是必须的，
不能少，因为程序要取其地址}
NewBeginPaint,
NewCreateCompatibleDC,
NewTextOutA,
NewTextOutW,
NewExtTextOutA,
NewExtTextOutW,
NewDrawTextA,
NewDrawTextW;
begin
end.
UnitHookType.pas
unit UnitHookType;
interface
uses windows, messages;
const
MaxStringLen = 100;
WM_MOUSEPT = WM_USER + 1138;
MappingFileName = 'GetWord32 for 9x NT 2000';
fBeginPaint=0;
fGetWindowDC=1;
fGetDC=2;
fCreateCompatibleDC=3;
fTextOutA=4;
fTextOutW=5;
fExtTextOutA=6;
fExtTextOutW=7;
fDrawTextA=8;
fDrawTextW=9;
type
PPointer = ^Pointer;
TShareMem = packed record
hProcWnd: HWND; {主应用窗口句柄}
hHookWnd: HWND; {鼠标所在窗口}
pMouse: TPoint; {鼠标信息}
DCMouse,DCCompatible: HDC;
fTimerID: integer;
fStrMouseQueue: array[0..MaxStringLen] of Char; {鼠标信息串}
nTimePassed: integer; {鼠标停留的时间}
bCanSpyNow: Boolean; {开始取词}
Text: array[0..MaxStringLen] of Char; {字符串}
end;
PShareMem = ^TShareMem;
implementation
end.
UnitNt2000Hook.pas
//-----------------------------------------------------------------------------------
unit UnitNt2000Hook;
interface
uses classes, Windows,SysUtils, messages,dialogs;
type
TImportCode = packed record
JumpInstruction: Word;
AddressOfPointerToFunction: PPointer;
end;
PImportCode = ^TImportCode;
PImage_Import_Entry = ^Image_Import_Entry;
Image_Import_Entry = record
Characteristics: DWORD;
TimeDateStamp: DWORD;
MajorVersion: Word;
MinorVersion: Word;
Name: DWORD;
LookupTable: DWORD;
end;
TLongJmp = packed record
JmpCode: ShortInt; {指令，用$E9来代替系统的指令}
FuncAddr: DWORD; {函数地址}
end;
THookClass = class
private
Trap:boolean; {调用方式：True陷阱式，False改引入表式}
hProcess: Cardinal; {进程句柄，只用于陷阱式}
AlreadyHook:boolean; {是否已安装Hook，只用于陷阱式}
AllowChange:boolean; {是否允许安装、卸载Hook，只用于改引入表式}
Oldcode: array[0..4]of byte; {系统函数原来的前5个字节}
Newcode: TLongJmp; {将要写在系统函数的前5个字节}
private
public
OldFunction,NewFunction:Pointer;{被截函数、自定义函数}
constructor Create(IsTrap:boolean;OldFun,NewFun:pointer);
constructor Destroy;
procedure Restore;
procedure Change;
published
end;
implementation字符串长度不同怎样取
{取函数的实际地址。如果函数的第一个指令是Jmp，则取出它的跳转地址（实际地址），这往往是由于程序中含有Debug调试信息引起的}
function FinalFunctionAddress(Code: Pointer): Pointer;
Var
func: PImportCode;
begin
Result:=Code;
if Code=nil then exit;
try
func:=code;
if (func.JumpInstruction=$25FF) then
{指令二进制码FF 25    汇编指令jmp [...]}
Func:=func.AddressOfPointerToFunction^;
result:=Func;
except
Result:=nil;
end;
end;
{更改引入表中指定函数的地址，只用于改引入表式}
function PatchAddressInModule(BeenDone:Tlist;hModule: THandle; OldFunc,NewFunc: Pointer):integer;

版权声明：本站内容均来自互联网，仅供演示用，请勿用于商业和其他非法用途。如果侵犯了您的权益请与我们联系QQ:729038198，我们将在24小时内删除。