鼠标取词代码 - DELPHI

unit UnitHookType;

interface

uses windows, messages;

implementation

end.
//==================================================
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; {停止取词}

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;

toOptions, rect, Str,
            Count, Dx);
    end;
    Hook[fExtTextOutA].Change;{重新截取API}
end;

toOptions,Rect, Str, Count, Dx);
end;
Hook[fExtTextOutW].Change;{重新截取API}
end;

uFormat);
end;
Hook[fDrawTextA].Change;{重新截取API}
end;

dwBytes);
                  {以空字符结束}
                  pShMem^.Text[dwBytes] := Chr(0);
               end;
               {发送WM_MOUSEPT成功取词的消息给主程序}
               postMessage(pShMem^.hProcWnd, WM_MOUSEPT, fDrawTextW, 2);
               {如果输出的不是Tab键，而且是精确匹配的}
               if (string(pShMem^.Text)<>#3)and(not faint) then
                  pShMem^.bCanSpyNow := False;{取词结束}
           end;
        end;
    finally
        {调用被截的函数}
        result := TDrawTextW(Hook[fDrawTextW].OldFunction)(theDC, lpString, nCount, lpRect,

uFormat);
end;
Hook[fDrawTextW].Change;{重新截取API}
end;

{遍历所有菜单项}
procedure IterateThroughItems(WND:HWND;menu:Hmenu;p:TPoint;Level:integer);
var
   i:integer;
   info:TMenuItemInfo;
   rec:TRect;
begin
   for i:=0 to GetMenuItemCount(menu)-1 do {遍历所有子菜单项}
   begin
      fillchar(info,sizeof(info),0);
      info.cbSize:=sizeof(info);
      info.fMask:=MIIM_TYPE or MIIM_SUBMENU;
      info.cch:=256;
      getmem(info.dwTypeData,256);
      {取菜单的文字}
      GetMenuItemInfo(menu,i,true,info);
      {取菜单的坐标}
      GetMenuItemRect(wnd,menu,i,rec);
      {如果鼠标在菜单的矩形区域内}
      if (rec.Left<=p.X)and(p.X<=rec.Right)and(rec.Top<=p.Y)and(p.Y<=rec.Bottom)then
      if (info.cch<>0) then
      begin
         {取出菜单文字}
         strlcopy(pShMem^.Text,info.dwTypeData,min(info.cch,MaxStringLen));
         pShMem^.bCanSpyNow := False;
         {发送WM_MOUSEPT成功取词的消息给主程序}
         PostMessage(pShMem^.hProcWnd, WM_MOUSEPT, fDrawTextW, 2);
      end;
//          freemem(info.dwTypeData,256);
//          info.dwTypeData:=nil;
      if info.hSubMenu<>0 then {如果它有下级子菜单，则归递调用}
      begin
         IterateThroughItems(wnd,info.hSubMenu,p,Level+1);
      end;
   end;
end;

{定时器，每10毫秒被调用一次}
procedure fOnTimer(theWnd: HWND; msg, idTimer: Cardinal; dwTime: DWORD); stdcall;
var
    InvalidRect: TRECT;
    buffer:array[0..256]of char;
    menu:Hmenu;
    MousePoint:TPoint;
begin
    pShMem^.nTimePassed := pShMem^.nTimePassed + 1;
    if pShMem^.nTimePassed = 10 then {如果鼠标停留了0.1秒}
    begin
      MousePoint:=pshmem^.pMouse;
      {获取当前鼠标所在的窗口（等效于Delphi的控件）句柄}
      pshmem^.hHookWnd := WindowFromPoint(MousePoint);
      {屏幕坐标转换为窗口（等效于Delphi的控件）客户区的坐标}
      ScreenToClient(pshmem^.hHookWnd, MousePoint);
      pShMem^.bCanSpyNow := true;{可以开始取词}
      {如果客户区的坐标为负值，则说明鼠标位于菜单或标题的上空}
      if(MousePoint.x<0)or(MousePoint.y<0) then
      begin
        {读取并设置标题，让其重绘}
        Getwindowtext(pshmem^.hHookWnd,buffer,sizeof(buffer)-1);
        Setwindowtext(pshmem^.hHookWnd,pchar(string(buffer)+' '));
        Setwindowtext(pshmem^.hHookWnd,buffer);
        {客户区的坐标恢复为屏幕坐标}
        ClientToScreen(pshmem^.hHookWnd, MousePoint);
        {取出当前的菜单}
        menu:=GetMenu(pshmem^.hHookWnd);
        if menu<>0 then
           {遍历所有菜单，判断是否位于鼠标的下方}
           IterateThroughItems(pshmem^.hHookWnd,menu,MousePoint,1);
      end
      else begin{否则，说明鼠标位于客户区}
        InvalidRect.left := MousePoint.x;
        InvalidRect.top := MousePoint.y;
        InvalidRect.Right := MousePoint.x + 1;
        InvalidRect.Bottom := MousePoint.y + 1;
        {重绘客户区}
        InvalidateRect(pshmem^.hHookWnd, @InvalidRect, false);
      end;
    end
    else if pShMem^.nTimePassed >= 11 then
    begin
       pShMem^.nTimePassed := 11;
    end;
    {清空pShmem}
end;

{鼠标钩子}
function MouseHookProc(nCode: integer; wPar: WParam; lPar: LParam): lResult;
    stdcall;
var
    pMouseInf: TMouseHookStruct;
begin
    pShMem^.nTimePassed := 0;
    if (nCode >= 0) and ((wPar = WM_MOUSEMOVE)or(wPar = WM_NCMOUSEMOVE)) then
    begin
        pMouseInf := (PMouseHookStruct(lPar))^;
        if (pShMem^.pMouse.x <> pMouseInf.pt.x) or
            (pShMem^.pMouse.y <> pMouseInf.pt.y) then
        begin
            if nCode = HC_NOREMOVE then
                pShMem^.fStrMouseQueue := 'Not removed from the queue'
            else
                pShMem^.fStrMouseQueue := 'Removed from the queue';
            {鼠标的坐标}
            pShMem^.pMouse := pMouseInf.pt;
            {鼠标所在的窗口}
            pShMem^.hHookWnd := pMouseInf.hwnd;
            {1是自定义的数值，表明这是鼠标消息}
            postMessage(pShMem^.hProcWnd, WM_MOUSEPT, 1, 1);
        end;
    end;
    Result := CallNextHookEx(MouseHook, nCode, wPar, lPar);
end;

{开始取词}
procedure StartHook; stdcall;
begin
   if MouseHook=0 then
   begin
     pShMem^.fTimerID := SetTimer(0, 0, 10, @fOnTimer);
     {注入其它进程}
     MouseHook := SetWindowsHookEx(WH_MOUSE, MouseHookProc, HInstance, 0);
   end;
end;

{停止取词}
procedure StopHook; stdcall;
begin
   if MouseHook<>0 then
   begin
      KillTimer(0, pShMem^.fTimerID);
      UnhookWindowsHookEx(MouseHook);
      MouseHook:=0;
   end;
end;

initialization
        hMappingFile := OpenFileMapping(FILE_MAP_WRITE,False,MappingFileName);
        if hMappingFile=0 then
        begin
           hMappingFile := CreateFileMapping($FFFFFFFF,nil,PAGE_READWRITE,0,SizeOf

(TShareMem),MappingFileName);
           FirstProcess:=true; {这是第一个进程，即主程序}
        end
        else FirstProcess:=false;
        if hMappingFile=0 then Exception.Create('不能建立共享内存!');

        pShMem := MapViewOfFile(hMappingFile,FILE_MAP_WRITE or FILE_MAP_READ,0,0,0);
        if pShMem = nil then
        begin
           CloseHandle(hMappingFile);
           Exception.Create('不能映射共享内存!');
        end;
        if FirstProcess then
        begin
           pShMem^.bCanSpyNow:=false;
        end;
        Hook[fBeginPaint]:=THookClass.Create(Trap,@BeginPaint,@NewBeginPaint);{Trap=True陷阱

式}
        Hook[fGetWindowDC]:=THookClass.Create(Trap,@GetWindowDC,@NewGetWindowDC);
        Hook[fGetDC]:=THookClass.Create(Trap,@GetDC,@NewGetDC);
        Hook[fCreateCompatibleDC]:=THookClass.Create

(Trap,@CreateCompatibleDC,@NewCreateCompatibleDC);
        Hook[fTextOutA]:=THookClass.Create(Trap,@TextOutA,@NewTextOutA);
        Hook[fTextOutW]:=THookClass.Create(Trap,@TextOutW,@NewTextOutW);
        Hook[fExtTextOutA]:=THookClass.Create(Trap,@ExtTextOutA,@NewExtTextOutA);
        Hook[fExtTextOutW]:=THookClass.Create(Trap,@ExtTextOutW,@NewExtTextOutW);
        Hook[fDrawTextA]:=THookClass.Create(Trap,@DrawTextA,@NewDrawTextA);
        Hook[fDrawTextW]:=THookClass.Create(Trap,@DrawTextW,@NewDrawTextW);
finalization
        for i:=Low(hook) to High(hook) do
           if Hook[i]<>nil then
              Hook[i].Destroy;
        UnMapViewOfFile(pShMem); {取消映射视图}
        CloseHandle(hMappingFile); {关闭映射文件句柄}
end.

//=================================================
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;
   NT: PImageNTHeaders;
   ImportDesc: PImage_Import_Entry;
   rva: DWORD;
   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'}

{定位至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模块的首地址}

{遍历所有被引入的下级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.

//===============主窗口=====================
unit UnitMain;

interface

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

type
TForm1 = class(TForm)
    Button1: TButton;
    Label2: TLabel;
    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+1] of String =
    ('来自TextOutA',
     '来自TextOutW',
     '来自ExtTextOutA',
     '来自ExtTextOutW',
     '来自DrawTextA',
     '来自DrawTextW',
     '来自菜单');

procedure TForm1.getMouseInfo(var theMess : TMessage);
begin
if fWndClosed then
    Exit;
if theMess.LParam = 1 then{显示鼠标位置}
{    Label1.caption := '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
    Label2.caption := pShMem^.Text;
    if (theMess.WParam>=0)and(theMess.WParam<=5) then
//        Label3.Caption :=StrProcNames[theMess.Wparam];
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;

initialization
finalization

end.
//========================================

　　屏幕上的文字大都是由gdi32.dll的以下几个函数显示的：TextOutA、TextO

utW、ExtTextOutA、
ExtTextOutW。实现屏幕抓词的关键就是截获对这些函数的调用，得到程序发给他

们的参数。

　　我的方法有以下三个步骤：

　　一、得到鼠标的当前位置

　　通过SetWindowsHookEx实现。

　　二、向鼠标下的窗口发重画消息，让它调用系统函数重画

　　通过WindowFromPoint，ScreenToClient，InvalidateRect 实现。

　　三、截获对系统函数的调用，取得参数(以TextOutA为例)

　　1.仿照TextOutA作成自己的函数MyTextOutA，与TextOutA有相同参数和返回

值，放在系统钩子所在
的DLL里。