unithookdll.pas

Delphi写的屏幕取词程序

unit UnitHookDLL;
interface
uses Windows, Messages, Dialogs, SysUtils, UnitHookType, Math;

type
  THandle16 = Word;
function OpenGetKeyHook(sender: HWND; MessageID: WORD): BOOlean; stdcall;
function CloseGetKeyHook: BOOLean; stdcall;

var
  pShMem: PShareMem;
  hMappingFile: THandle;
  FirstProcess: boolean;
  pFuncCreate, pFuncFree, pFuncCheck: Pointer;
  hInst16: THandle;
  MessageHook: HHOOK;

{$STACKFRAMES On}
implementation

uses QTthunku;

{执行16位代码下进行取词，修改函数的入口}
function SetGDIHook: boolean; stdcall;
begin
  result := false;
  if pFuncCreate = nil then exit;
  asm
      pushad
      push ebp
      sub esp,$2c
      mov edx, pFuncCreate {函数地址}
      mov ebp,esp
      add ebp,$2c
      {利用Thunk执行16位下的函数，函数地址保存在edx中}
      call  QT_Thunk
      add esp,$2c
      pop ebp
      mov byte ptr @result,al

      popad
  end;
end;

{执行16位代码下取消取词，恢复函数入口}

function UnSetGDIHook: boolean; stdcall;
begin
  result := false;
  if pFuncFree = nil then exit;
  asm
     {保寄存器的值}
      pushad
      push ebp
      sub esp,$2c
      mov edx, pFuncFree {函数地址}
      mov ebp,esp
      add ebp,$2c
      {利用Thunk执行16位下的函数，函数地址保存在edx}
      call  QT_Thunk
      add esp,$2c
      pop ebp
      mov byte ptr @result,al

      popad
  end;
end;

function CheckBuf: boolean; stdcall;
var
  asd1, asd2: pchar;
begin
  result := false;
  if pFuncCheck = nil then exit;
  {分配固定的内存，提供与16位代码交换数据}
  asd1 := GlobalAllocPtr16(GPTR, MAXBUF);
  {16位指针转换为32位指针}
  asd2 := Ptr16To32(asd1);
  asm
     {保存寄存器的值}
      pushad
      push ebp
      sub esp,$2c
      push asd1  {第一个参数。最多支持两个参数}
                 {第二个参数}
      mov edx, pFuncCheck{函数地址}
      mov ebp,esp
      add ebp,$2c
      call  QT_Thunk
      add esp,$2c
      pop ebp
      mov byte ptr @result,al

      popad
  end;
  if result then
  begin
    {拷贝数据到共享内存中}
    strlcopy(@pShMem^.Text, asd2, MAXBUF);
  end;
  {释放16位指针}
  GlobalFreePtr16(asd1);
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,MAXBUF));
         PostMessage(pShMem^.hMainWnd, WM_MOUSEPT, 2, 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;

procedure fOnTimer(theWnd: HWND; msg, idTimer: Cardinal; dwTime: DWORD); stdcall; //CallBack Type
var
  InvalidRect: TRECT;
  hwndPtIn: HWND;
  buffer:array[0..255]of char;
  menu:Hmenu;
begin
  pShmem^.nTimePassed := pShmem^.nTimePassed + 1;
  if pShmem^.nTimePassed = 10 then
  begin
    {获取当前鼠标点的窗口句柄}
    hwndPtIn := WindowFromPoint(pshmem^.pMouse);
    {屏幕坐标转换为客户区的坐标}
    ScreenToClient(hwndPtIn, pshmem^.pMouse);
    setGDIHook;
    if(pshmem^.pMouse.x<0)or(pshmem^.pMouse.y<0) then
    begin
       Getwindowtext(hwndPtIn,buffer,sizeof(buffer)-1);
       Setwindowtext(hwndPtIn,buffer);
       ClientToScreen(hwndPtIn, pshmem^.pMouse);
       //MenuItemFromPoint(hwndPtIn,GetMenu(hwndPtIn),pshmem^.pMouse);
       menu:=GetMenu(hwndPtIn);
       IterateThroughItems(hwndPtIn,menu,pshmem^.pMouse,1);
//       BringWindowToTop(hwndPtIn);
//       DrawMenuBar(hwndPtIn);
    end
    else begin
       InvalidRect.left := pshmem^.pMouse.x;
       InvalidRect.top := pshmem^.pMouse.y;
       InvalidRect.Right := pshmem^.pMouse.x + 1;
       InvalidRect.Bottom := pshmem^.pMouse.y + 1;
       {强迫重画此点}
       InvalidateRect(hwndPtIn, @InvalidRect, false);
    end;
  end
  else if pShmem^.nTimePassed >= 11 then
  begin
    {如果鼠标定留时间超过一定值，即显示数据}
    pShmem^.nTimePassed := 11;
    {调用检查缓冲区的数据}
    if CheckBuf then  
      {消息值为2表示缓冲区有数据}
      PostMessage(pShMem^.hMainWnd, WM_MOUSEPT, 2, 2);
  end;
end;

function MouseHookProc(nCode: integer; wPar: WParam; lPar: LParam): lResult; stdcall;
var
  pMouseInf: TMouseHookStruct;
begin
  pShmem^.nTimePassed := 0;
  UnSetGDIHook; {采用stdcall，所以它里面的变量可以随意}
  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;
      {发送鼠标位置消息}
      PostMessage(pShMem^.hMainWnd, WM_MOUSEPT, 1, 1); {1表示是鼠标消息}
    end;
    pShMem^.hHookWnd := pMouseInf.hwnd;
  end;

  Result := CallNextHookEx(MessageHook, nCode, wPar, lPar);
end;

function OpenGetKeyHook(sender: HWND; MessageID: WORD): BOOLean; stdcall;
begin
  {设置定时器}
  pShmem^.fTimerID := SetTimer(0, 0, 20, @fOnTimer);
  {添加鼠标钩子}
  MessageHook := SetWindowsHookEx(WH_MOUSE, MouseHookProc, HInstance, 0); ;
  result := true;
end;

function CloseGetKeyHook: BOOLean; stdcall;
begin
  {关闭定时器}
  KillTimer(0, pShmem^.fTimerID);
  {取消钩子}
  UnhookWindowsHookEx(MessageHook);
  {取消取词}
  UnSetGDIHook;
  result := true;
end;

initialization
        {如果映射文件已经存在则打开}
        hMappingFile := OpenFileMapping(FILE_MAP_WRITE, False, MappingFileName);
        if hMappingFile = 0 then
        begin
          {创建映射文件}
          hMappingFile := CreateFileMapping($FFFFFFFF,
             nil,
             PAGE_READWRITE, {页面为可读写}
             0,
             SizeOf(TShareMem),
             PChar(MappingFileName));
          FirstProcess := true;
        end
        else FirstProcess := false;
        if hMappingFile <> 0 then
        begin
          {句柄pShMem指向映射文件地址}
          pShMem := PShareMem(MapViewOfFile(hMappingFile,
             FILE_MAP_WRITE,
             0,
             0,
             0));
          if pShMem = nil then
          begin
            CloseHandle(hMappingFile);
            ShowMessage('不能建立共享内存!');
            exit;
          end
        end;
        if FirstProcess then
        begin
          MessageHook := 0;
        end;
        pFuncFree := nil;
        pFuncCreate := nil;
        pFuncCheck := nil;
        pshmem^.nTimePassed := 0;
        {载入16位DLL，必须用LoadLibrary16}
        hInst16 := LoadLibrary16('GetWord.DLL');
        {载入成功}
        if hInst16 >= 32 then
        begin
          {取函数或过程的地址}
          pFuncCreate := GetProcAddress16(hInst16, 'TextHookCreate');
          pFuncFree := GetProcAddress16(hInst16, 'TextHookFree');
          pFuncCheck := GetProcAddress16(hInst16, 'checkbuf');
          if (pFuncCreate = nil) or (pFuncFree = nil) or (pFuncCheck = nil) then
          begin
            pFuncCreate := nil;
            pFuncFree := nil;
            pFuncCheck := nil;
          end;
        end
        else begin
          showmessage('打开16位DLL错误');
          exit;
        end;
finalization
        if hInst16 >= 32 then
           FreeLibrary16(hInst16);
        UnMapViewOfFile(pShMem);
        CloseHandle(hMappingFile);

end.