delphi屏幕取词  
官方Delphi 学习QQ群： 682628230（三千人）
频道

  1. 人气：
  2. 放大
  3. 缩小
  4. 二维码
  5. 赞赏

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

end.

$show_page$

屏幕取词(Delphi)(2)

Dll工程(续)

UnitHookDll.pas

//-----------------------------------------------------------------------------------

unit UnitHookDll;

interface

uses
Windows, SysUtils, Classes, math, messages, dialogs,
UnitNt2000Hook,
      UnitHookType;

const
     COLOR1=255;
     COLOR2=0;
     COLOR3=255;
     Trap=true; //True陷阱式，False表示改引入表式

     procedure StartHook; stdcall; {开始取词}//安装钩子
     procedure StopHook; stdcall; {停止取词}//卸载钩子
     function NewBeginPaint(Wnd: HWND; var lpPaint: TPaintStruct): HDC; stdcall;
     function NewCreateCompatibleDC(DC: HDC): HDC; stdcall;
     function NewTextOutA(theDC: HDC; nXStart, nYStart: integer; str: pchar; count: integer): bool;   stdcall;
     function NewTextOutW(theDC: HDC; nXStart, nYStart: integer; str: pWidechar; count: integer): bool; stdcall;
     function NewExtTextOutA(theDC: HDC; nXStart, nYStart: integer; toOptions:Longint;
     rect: PRect; Str: PAnsiChar; Count: Longint; Dx: PInteger): BOOL; stdcall;
     function NewExtTextOutW(theDC: HDC; nXStart, nYStart: integer; toOptions:
     Longint; rect: PRect;
     Str: Pwidechar; Count: Longint; Dx: PInteger): BOOL; stdcall;
     function NewDrawTextA(theDC: HDC; lpString: PAnsiChar; nCount: Integer;
     var lpRect: TRect; uFormat: UINT): Integer; stdcall;
     function NewDrawTextW(theDC: HDC; lpString: PWideChar; nCount: Integer;
     var lpRect: TRect; uFormat: UINT): Integer; stdcall;

implementation

var
     MouseHook: THandle;
     pShMem: PShareMem;
     hMappingFile: THandle;
     FirstProcess:boolean;{是否是第一个进程}
     Hook: array[fBeginPaint..fDrawTextW] of THookClass;{API HOOK类}
     i:integer;

{自定义的BeginPaint}
function NewBeginPaint(Wnd: HWND; var lpPaint: TPaintStruct): HDC; stdcall;
type
    TBeginPaint=function (Wnd: HWND; var lpPaint: TPaintStruct): HDC; stdcall;
begin
    Hook[fBeginPaint].Restore;
    result:=TBeginPaint(Hook[fBeginPaint].OldFunction)(Wnd,lpPaint);
    if Wnd=pshmem^.hHookWnd then{如果是当前鼠标的窗口句柄}
    begin
       pshmem^.DCMouse:=result;{记录它的返回值}
    end
    else pshmem^.DCMouse:=0;
    Hook[fBeginPaint].Change;
end;

{自定义的GetWindowDC}
function NewGetWindowDC(Wnd: HWND): HDC; stdcall;
type
    TGetWindowDC=function (Wnd: HWND): HDC; stdcall;
begin
    Hook[fGetWindowDC].Restore;
    result:=TGetWindowDC(Hook[fGetWindowDC].OldFunction)(Wnd);
    if Wnd=pshmem^.hHookWnd then{如果是当前鼠标的窗口句柄}
    begin
       pshmem^.DCMouse:=result;{记录它的返回值}
    end
    else pshmem^.DCMouse:=0;
    Hook[fGetWindowDC].Change;
end;


{自定义的GetDC}
function NewGetDC(Wnd: HWND): HDC; stdcall;
type
    TGetDC=function (Wnd: HWND): HDC; stdcall;
begin
    Hook[fGetDC].Restore;
    result:=TGetDC(Hook[fGetDC].OldFunction)(Wnd);
    if Wnd=pshmem^.hHookWnd then{如果是当前鼠标的窗口句柄}
    begin
       pshmem^.DCMouse:=result;{记录它的返回值}
    end
    else pshmem^.DCMouse:=0;
    Hook[fGetDC].Change;
end;


{自定义的CreateCompatibleDC}
function NewCreateCompatibleDC(DC: HDC): HDC; stdcall;
type
    TCreateCompatibleDC=function (DC: HDC): HDC; stdcall;
begin
    Hook[fCreateCompatibleDC].Restore;
    result:=TCreateCompatibleDC(Hook[fCreateCompatibleDC].OldFunction)(DC);
    if DC=pshmem^.DCMouse then{如果是当前鼠标的窗口HDC}
    begin
       pshmem^.DCCompatible:=result;{记录它的返回值}
    end
    else pshmem^.DCCompatible:=0;
    Hook[fCreateCompatibleDC].Change;
end;
//-------------------------------------------------------

function NewTextOutA(theDC: HDC; nXStart, nYStart: integer; str: pchar; count: integer): bool;
     stdcall;
type
   TTextOutA=function (theDC: HDC; nXStart, nYStart: integer; str: pchar; count: integer): bool;stdcall;
var
     dwBytes: DWORD;
     poOri, poDC, poText, poMouse: TPoint;
     Size: TSize;
     Rec:TRect;
     faint:boolean;
begin
     Hook[fTextOutA].Restore;{暂停截取API，恢复被截的函数}
     try
         if pShMem^.bCanSpyNow then{是否开始取词}
         begin
            GetDCOrgEx(theDC, poOri);{HDC的坐标}//用屏幕坐标定义窗口客户区起点位置
            poDC.x := nXStart;{显示的相对坐标}
            poDC.y := nYStart;
            if(poOri.X=0)and(poOri.Y=0)then{如果HDC的坐标为(0,0)}
            begin
               if (theDC=pShmem^.DCCompatible)then
                  faint:=false{精确匹配，就是指定的内存HDC}
               else faint:=true;{模糊匹配，"可能"是内存HDC}
               {取鼠标当前处的窗口（等效于Delphi的控件）坐标}
               GetWindowRect(pShMem^.hHookWnd,Rec);
               poOri.X:=Rec.Left;{把窗口坐标作为HDC的坐标}
               poOri.Y:=Rec.Top;
            end
            else begin{如果是普通HDC}
               {局部逻辑坐标转化为设备相关坐标}
               LPToDP(theDC, poDC, 1);
               faint:=false;{精确匹配，是普通HDC}
            end;
            {计算显示文字的屏幕坐标}
            poText.x := poDC.x + poOri.x;
            poText.y := poDC.y + poOri.y;
            {获取当前鼠标的坐标}
            GetCursorPos(poMouse);
            {如果对齐属性是居中}
            if (GetTextAlign(theDC) and TA_UPDATECP) <> 0 then
            begin
                GetCurrentPositionEx(theDC, @poOri);
                poText.x := poText.x + poOri.x;
                poText.y := poText.y + poOri.y;
            end;
            {显示文字的长和宽}
            GetTextExtentPoint(theDC, Str, Count, Size);
            {鼠标是否在文本的范围内}
            if (poMouse.x >= poText.x) and (poMouse.x <= poText.x + Size.cx)
                and (poMouse.y >= poText.y) and (poMouse.y <= poText.y + Size.cy)
                then
            begin
                {最多取MaxStringLen个字节}
                dwBytes := min(Count, MaxStringLen);
                {拷贝字符串}
                CopyMemory(@(pShMem^.Text), Str, dwBytes);//截获的字符在这里了...
                {以空字符结束}
                pShMem^.Text[dwBytes] := Chr(0);
                {发送WM_MOUSEPT成功取词的消息给主程序}
                postMessage(pShMem^.hProcWnd, WM_MOUSEPT, fTextOutA, 2);
                {如果输出的不是Tab键，而且是精确匹配的}
                if (string(pShMem^.Text)<>#3)and(not faint) then
                   pShMem^.bCanSpyNow := False;{取词结束}
            end;
         end;
     finally
         {调用被截的函数}
         result := TTextOutA(Hook[fTextOutA].OldFunction)(theDC, nXStart,
             nYStart, str, count);
     end;
     Hook[fTextOutA].Change;{重新截取API}
end;


function NewTextOutW(theDC: HDC; nXStart, nYStart: integer; str: pWidechar; count: integer): bool; stdcall;
type
    TTextOutW=function (theDC: HDC; nXStart, nYStart: integer; str: pWidechar; count: integer): bool; stdcall;
var
     dwBytes: DWORD;
     poOri, poDC, poText, poMouse: TPoint;
     Size: TSize;
     Rec:TRect;
     faint:boolean;
begin
     Hook[fTextOutW].Restore;{暂停截取API，恢复被截的函数}
//     SetTextColor(thedc,RGB(COLOR1,COLOR2,COLOR3));
     try
         if pShMem^.bCanSpyNow then{是否开始取词}
         begin
            GetDCOrgEx(theDC, poOri);{HDC的坐标}
            poDC.x := nXStart;{显示的相对坐标}
            poDC.y := nYStart;
            if(poOri.X=0)and(poOri.Y=0)then{如果HDC的坐标为(0,0)}
            begin
               if (theDC=pShmem^.DCCompatible)then
                  faint:=false{精确匹配，就是指定的内存HDC}
               else faint:=true;{模糊匹配，"可能"是内存HDC}
               {取鼠标当前处的窗口（等效于Delphi的控件）坐标}
               GetWindowRect(pShMem^.hHookWnd,Rec);
               poOri.X:=Rec.Left;{把窗口坐标作为HDC的坐标}
               poOri.Y:=Rec.Top;
            end
            else begin{如果是普通HDC}
               {局部逻辑坐标转化为设备相关坐标}
               LPToDP(theDC, poDC, 1);
               faint:=false;{精确匹配，是普通HDC}
            end;
            {计算显示文字的屏幕坐标}
            poText.x := poDC.x + poOri.x;
            poText.y := poDC.y + poOri.y;
            {获取当前鼠标的坐标}
            GetCursorPos(poMouse);
            {如果对齐属性是居中}
            if (GetTextAlign(theDC) and TA_UPDATECP) <> 0 then
            begin
                GetCurrentPositionEx(theDC, @poOri);
                poText.x := poText.x + poOri.x;
                poText.y := poText.y + poOri.y;
            end;
            {显示文字的长和宽}
            GetTextExtentPointW(theDC, Str, Count, Size);
            {鼠标是否在文本的范围内}
            if (poMouse.x >= poText.x) and (poMouse.x <= poText.x + Size.cx)
                and (poMouse.y >= poText.y) and (poMouse.y <= poText.y + Size.cy)
                then
            begin
                {最多取MaxStringLen个字节}
                dwBytes := min(Count*2, MaxStringLen);
                {拷贝字符串}
                CopyMemory(@(pShMem^.Text), Pchar(WideCharToString(Str)), dwBytes);//截获的字符在这里了...
                {以空字符结束}
                pShMem^.Text[dwBytes] := Chr(0);
                {发送WM_MOUSEPT成功取词的消息给主程序}
                postMessage(pShMem^.hProcWnd, WM_MOUSEPT, fTextOutW, 2);
                {如果输出的不是Tab键，而且是精确匹配的}
                if (string(pShMem^.Text)<>#3)and(not faint) then
                   pShMem^.bCanSpyNow := False;{取词结束}
            end;
         end;
     finally
         {调用被截的函数}
         result := TTextOutW(Hook[fTextOutW].OldFunction)(theDC, nXStart, nYStart, str, Count);
     end;
     Hook[fTextOutW].Change;{重新截取API}
end;


function NewExtTextOutA(theDC: HDC; nXStart, nYStart: integer; toOptions:Longint;
     rect: PRect; Str: PAnsiChar; Count: Longint; Dx: PInteger): BOOL; stdcall;
type
   TExtTextOutA=function (theDC: HDC; nXStart, nYStart: integer; toOptions:Longint;
     rect: PRect; Str: PAnsiChar; Count: Longint; Dx: PInteger): BOOL; stdcall;
var
     dwBytes: DWORD;
     poOri, poDC, poText, poMouse: TPoint;
     Size: TSize;
     Rec:TRect;
     faint:boolean;
begin
     Hook[fExtTextOutA].Restore;{暂停截取API，恢复被截的函数}
//     SetTextColor(thedc,RGB(COLOR1,COLOR2,COLOR3));
     try
         if pShMem^.bCanSpyNow then{是否开始取词}
         begin
            GetDCOrgEx(theDC, poOri);{HDC的坐标}
            poDC.x := nXStart;{显示的相对坐标}
            poDC.y := nYStart;
            if(poOri.X=0)and(poOri.Y=0)then{如果HDC的坐标为(0,0)}
            begin
               if (theDC=pShmem^.DCCompatible)then
                  faint:=false{精确匹配，就是指定的内存HDC}
               else faint:=true;{模糊匹配，"可能"是内存HDC}
               {取鼠标当前处的窗口（等效于Delphi的控件）坐标}
               GetWindowRect(pShMem^.hHookWnd,Rec);
               poOri.X:=Rec.Left;{把窗口坐标作为HDC的坐标}
               poOri.Y:=Rec.Top;
            end
            else begin{如果是普通HDC}
               {局部逻辑坐标转化为设备相关坐标}
               LPToDP(theDC, poDC, 1);
               faint:=false;{精确匹配，是普通HDC}
            end;
            {计算显示文字的屏幕坐标}
            poText.x := poDC.x + poOri.x;
            poText.y := poDC.y + poOri.y;
            {获取当前鼠标的坐标}
            GetCursorPos(poMouse);
            {如果对齐属性是居中}
            if (GetTextAlign(theDC) and TA_UPDATECP) <> 0 then
            begin
                GetCurrentPositionEx(theDC, @poOri);
                poText.x := poText.x + poOri.x;
                poText.y := poText.y + poOri.y;
            end;
            {显示文字的长和宽}
            GetTextExtentPoint(theDC, Str, Count, Size);
            {鼠标是否在文本的范围内}
            if (poMouse.x >= poText.x) and (poMouse.x <= poText.x + Size.cx)
                and (poMouse.y >= poText.y) and (poMouse.y <= poText.y + Size.cy)
                then
            begin
                {最多取MaxStringLen个字节}
                dwBytes := min(Count, MaxStringLen);
                {拷贝字符串}
                CopyMemory(@(pShMem^.Text), Str, dwBytes);
                {以空字符结束}
                pShMem^.Text[dwBytes] := Chr(0);
                {发送WM_MOUSEPT成功取词的消息给主程序}
                postMessage(pShMem^.hProcWnd, WM_MOUSEPT, fExtTextOutA, 2);
                {如果输出的不是Tab键，而且是精确匹配的}
                if (string(pShMem^.Text)<>#3)and(not faint) then
                   pShMem^.bCanSpyNow := False;{取词结束}
            end;
         end;
     finally
         {调用被截的函数}
         result := TExtTextOutA(Hook[fExtTextOutA].OldFunction)(theDC, nXStart, nYStart, toOptions, rect, Str,
             Count, Dx);
     end;
     Hook[fExtTextOutA].Change;{重新截取API}
end;

Dll工程(续2)

UnitHookDll.pas (2)

//-----------------------------------------------------------------------------------

主窗体单元UnitMain.pas

unit UnitMain;

interface

uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   StdCtrls,UnitHookType, ExtCtrls;

type
   TForm1 = class(TForm)
     Button1: TButton;
     Label1: TLabel;
     Label2: TLabel;
     Label3: TLabel;
     Edit1: TEdit;
     Edit2: TEdit;
     Edit3: TEdit;
     procedure Button1Click(Sender: TObject);
     procedure FormClose(Sender: TObject; var Action: TCloseAction);
     procedure FormCreate(Sender: TObject);
   private
     procedure getMouseInfo(var theMess:TMessage); message WM_MOUSEPT;{处理WM_MOUSEPT}
   private
     hMapObj : THandle;
     pShMem : PShareMem;
     fWndClosed:boolean;{是否正在退出主程序}
     { Private declarations }
   public
     { Public declarations }
   end;
//   {未公开的函数，实现隐浮窗口}
//   procedure SwitchToThisWindow(wnd:Hwnd;Switch:BOOL);stdcall;external 'user32.dll';
   procedure StartHook; stdcall; external 'GetWordDll.DLL';
   procedure StopHook; stdcall; external 'GetWordDll.DLL';

var
   Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
begin
   if button1.caption='取词' then
   begin
      StartHook;
      button1.caption:='停止';
   end
   else begin
      StopHook;
      button1.caption:='取词';
   end;
end;

const
   StrProcNames : array[fTextOutA..fDrawTextW] of String =
     ('来自TextOutA',
      '来自TextOutW',
      '来自ExtTextOutA',
      '来自ExtTextOutW',
      '来自DrawTextA',
      '来自菜单(来自DrawTextW)'
      );

procedure TForm1.getMouseInfo(var theMess : TMessage);
begin
   if fWndClosed then
     Exit;

    //if theMess.Msg=WM_MOUSEPT then   showmessage('fff');

   if theMess.LParam = 1 then{显示鼠标位置}
     edit1.Text := 'X:' + IntToStr(pShMem^.pMouse.x) + ' ' +
                         'Y:' + IntToStr(pShMem^.pMouse.y) + ' ' +
                         'HWND:0x' + IntToHex(pShMem^.hHookWnd, 8) + ' ' +
                         pShMem^.fStrMouseQueue
   else if theMess.LParam = 2 then
   begin
     edit2.Text := pShMem^.Text;
     if (theMess.WParam>=4)and(theMess.WParam<=9) then
         edit3.Text :=StrProcNames[theMess.Wparam-4];
   end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
   fWndClosed := True;{正在退出主程序}
   if button1.caption<>'取词' then
     Button1Click(sender);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
   SetForegroundWindow(self.Handle);{实现隐浮窗口}
   hMapObj := OpenFileMapping(FILE_MAP_WRITE,{获取完全访问映射文件}
                              False,{不可继承的}
                              LPCTSTR(MappingFileName));{映射文件名字}
   if hMapObj = 0 then
   begin
     ShowMessage('不能定位内存映射文件块!');
     Halt;
   end;

   pShMem := MapViewOfFile(hMapObj,FILE_MAP_WRITE,0,0,0);
   if pShMem = nil then
   begin
     ShowMessage('映射文件错误'+ IntToStr(GetLastError));
     CloseHandle(hMapObj);
     Halt;
   end;

   FillChar(pShMem^, SizeOf(TShareMem), 0);
   pShMem^.hProcWnd := Self.Handle;
   fWndClosed:=false;
end;

end.



推荐分享
最新信息 delphi13 多线程优化 TThreade... delphi 如何 FastMM配置 delphi13 FireDAC增强 并行备份... delphi12 Embarcadero ld... delphi 查看 cpu 核心数
热门信息 delphi 动态数组的使用 delphi多线程TThread详解 delphi try except语句 和 try finally语... delphi中常用字符串处理函数 delphi Inc函数和Dec函数的用法
推荐区 txt文本处理 查询128 说一段 简搜 短笑话 IP查询 正则大全 在线加密解密工具 在线文本筛选工具 1234828网址导航 windows库
图文皆来源于网络，内容仅做公益性分享，版权归原作者所有，如有侵权请告知删除！
  1. 关于我们
  2. 联系我们
 

Copyright © 2014 DelphiW.com 开发 源码 文档 技巧 All Rights Reserved
晋ICP备14006235号-8 晋公网安备 14108102000087号

执行时间: 0.050587177276611 seconds