Delphi屏幕取词

aaie_ 2012-10-20

展开全文

屏幕取词(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;

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;
const
     SIZE=4;
Var
     Dos: PImageDosHeader; //DOS头
     NT: PImageNTHeaders;    //PE头
     ImportDesc: PImage_Import_Entry;//输入表
     rva: DWORD;     //RVA
     Func: PPointer;    //
     DLL: String;
     f: Pointer;
     written: DWORD;
     mbi_thunk:TMemoryBasicInformation;
     dwOldProtect:DWORD;
begin
    Result:=0;
    if hModule=0 then exit;
    Dos:=Pointer(hModule);
    {如果这个DLL模块已经处理过，则退出。BeenDone包含已处理的DLL模块}
    if BeenDone.IndexOf(Dos)>=0 then exit;
    BeenDone.Add(Dos);{把DLL模块名加入BeenDone}
    OldFunc:=FinalFunctionAddress(OldFunc);{取函数的实际地址}

    {如果这个DLL模块的地址不能访问，则退出}
    if IsBadReadPtr(Dos,SizeOf(TImageDosHeader)) then exit;
    {如果这个模块不是以'MZ'开头，表明不是DLL，则退出}
    if Dos.e_magic<>IMAGE_DOS_SIGNATURE then exit;{IMAGE_DOS_SIGNATURE='MZ'}//检查数字签名,最好再检查一下PE

    {定位至NT Header}
    NT :=Pointer(Integer(Dos) + dos._lfanew);
    {定位至引入函数表}
    RVA:=NT^.OptionalHeader.
       DataDirectory[IMAGE_DIRECTORY_ENTRY_IMPORT].VirtualAddress;//导入表
    if RVA=0 then exit;{如果引入函数表为空，则退出}
    {把函数引入表的相对地址RVA转换为绝对地址}
    ImportDesc := pointer(DWORD(Dos)+RVA);{Dos是此DLL模块的首地址}//RVA->VA

    {遍历所有被引入的下级DLL模块}
    While (ImportDesc^.Name<>0) do
    begin
      {被引入的下级DLL模块名字}
      DLL:=PChar(DWORD(Dos)+ImportDesc^.Name);
      {把被导入的下级DLL模块当做当前模块，进行递归调用}
      PatchAddressInModule(BeenDone,GetModuleHandle(PChar(DLL)),OldFunc,NewFunc);

      {定位至被引入的下级DLL模块的函数表}
      Func:=Pointer(DWORD(DOS)+ImportDesc.LookupTable);
      {遍历被引入的下级DLL模块的所有函数}
      While Func^<>nil do
      begin
        f:=FinalFunctionAddress(Func^);{取实际地址}
        if f=OldFunc then {如果函数实际地址就是所要找的地址}
        begin
           VirtualQuery(Func,mbi_thunk, sizeof(TMemoryBasicInformation));
           VirtualProtect(Func,SIZE,PAGE_EXECUTE_WRITECOPY,mbi_thunk.Protect);{更改内存属性}
           WriteProcessMemory(GetCurrentProcess,Func,@NewFunc,SIZE,written);{把新函数地址覆盖它}
           VirtualProtect(Func, SIZE, mbi_thunk.Protect,dwOldProtect);{恢复内存属性}
        end;
        If Written=4 then Inc(Result);
//        else showmessagefmt('error:%d',[Written]);
        Inc(Func);{下一个功能函数}
      end;
      Inc(ImportDesc);{下一个被引入的下级DLL模块}
    end;
end;

{HOOK的入口，其中IsTrap表示是否采用陷阱式}
constructor THookClass.Create(IsTrap:boolean;OldFun,NewFun:pointer);
begin
     {求被截函数、自定义函数的实际地址}
     OldFunction:=FinalFunctionAddress(OldFun);
     NewFunction:=FinalFunctionAddress(NewFun);

     Trap:=IsTrap;
     if Trap then{如果是陷阱式}
     begin
        {以特权的方式来打开当前进程}
        hProcess := OpenProcess(PROCESS_ALL_ACCESS,FALSE, GetCurrentProcessID);
        {生成jmp xxxx的代码，共5字节}
        Newcode.JmpCode := ShortInt($E9); {jmp指令的十六进制代码是E9}
        NewCode.FuncAddr := DWORD(NewFunction) - DWORD(OldFunction) - 5;
        {保存被截函数的前5个字节}
        move(OldFunction^,OldCode,5);
        {设置为还没有开始HOOK}
        AlreadyHook:=false;
     end;
     {如果是改引入表式，将允许HOOK}
     if not Trap then AllowChange:=true;
     Change; {开始HOOK}
     {如果是改引入表式，将暂时不允许HOOK}
     if not Trap then AllowChange:=false;
end;

{HOOK的出口}
constructor THookClass.Destroy;
begin
     {如果是改引入表式，将允许HOOK}
     if not Trap then AllowChange:=true;
     Restore; {停止HOOK}
     if Trap then{如果是陷阱式}
        CloseHandle(hProcess);
end;

{开始HOOK}
procedure THookClass.Change;
var
     nCount: DWORD;
     BeenDone: TList;
begin
    if Trap then{如果是陷阱式}
    begin
      if (AlreadyHook)or (hProcess = 0) or (OldFunction = nil) or (NewFunction = nil) then
          exit;
      AlreadyHook:=true;{表示已经HOOK}
      WriteProcessMemory(hProcess, OldFunction, @(Newcode), 5, nCount);
    end
    else begin{如果是改引入表式}
         if (not AllowChange)or(OldFunction=nil)or(NewFunction=nil)then exit;
         BeenDone:=TList.Create; {用于存放当前进程所有DLL模块的名字}
         try
           PatchAddressInModule(BeenDone,GetModuleHandle(nil),OldFunction,NewFunction);
         finally
           BeenDone.Free;
         end;
    end;
end;

{恢复系统函数的调用}
procedure THookClass.Restore;
var
     nCount: DWORD;
     BeenDone: TList;
begin
    if Trap then{如果是陷阱式}
    begin
      if (not AlreadyHook) or (hProcess = 0) or (OldFunction = nil) or (NewFunction = nil) then
          exit;
      WriteProcessMemory(hProcess, OldFunction, @(Oldcode), 5, nCount);
      AlreadyHook:=false;{表示退出HOOK}
    end
    else begin{如果是改引入表式}
      if (not AllowChange)or(OldFunction=nil)or(NewFunction=nil)then exit;
      BeenDone:=TList.Create;{用于存放当前进程所有DLL模块的名字}
      try
        PatchAddressInModule(BeenDone,GetModuleHandle(nil),NewFunction,OldFunction);
      finally
        BeenDone.Free;
      end;
    end;
end;