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.