gfdict.dpr

屏幕取词,一个简单的程序,希望对刚入门的朋友一点点帮助

  result := BOOL(0);
  info := Pointer(lParam);
  info^.ptMaxSize.x := GetSystemMetrics(SM_CXFULLSCREEN);
  info^.ptMaxSize.y := GetSystemMetrics(SM_CYFULLSCREEN);
  info^.ptMinTrackSize.x := 0;
  info^.ptMinTrackSize.y := 0;
  info^.ptMaxTrackSize.x := GetSystemMetrics(SM_CXFULLSCREEN);
  info^.ptMaxTrackSize.y := GetSystemMetrics(SM_CYFULLSCREEN);
end;

function CoverMainProc(
    hWnd:LongWord;
    Message:LongWord;
    wParam:WPARAM;
    lParam:LPARAM
    ):BOOL;stdcall;
begin
  case Message of
    WM_CLOSE :
            begin
               DestroyWindow(hWnd);
               // PostQuitMessage(0);
            end;
  end;
  result := BOOL(DefWindowProc(hWnd, Message, lParam, lParam));
end;


procedure GanGetWordTimer(wnd : HWND; msg, idTimer : Cardinal; dwTime : DWORD);far pascal;
begin
  SendMessage(CommonData^.hWndMouse, idMsg, 1, 0);
  if (CommonData.BufferA='') then begin
        SendMessage(CommonData.CallBackHandle, idMsg, 0, 2);
  end;
  KillTimer(CommonData^.hWndFloat, 2);
end;

procedure WndCoverTimer(wnd : HWND; msg, idTimer : Cardinal; dwTime : DWORD);far pascal; //CallBack Type
var
  mouseWnd : HWnd;
  szClass : PChar;
  strClass : string;
  iLeft, iWidth : Integer;
  rect : TRect;
begin
  if (CommonData=nil) or (not CommonData^.bCapture) then begin
    exit;
  end;

  mouseWnd := WindowFromPoint(CommonData^.MousePos);
  if (mouseWnd=CommonData^.CallBackHandle) then begin
    exit;
  end;
  szClass := StrAlloc(256);
  GetClassName(mouseWnd, szClass, 255);
  strClass := Strpas(szClass);
  StrDispose(szClass);

  CommonData^.bInSpec := FALSE;

  if (Pos('Internet Explorer_Server', strClass)>0) then begin
    GetWindowRect(mouseWnd, rect);
    iLeft := rect.Left - 4;
    iWidth := rect.Right - rect.Left + 14;
    if (CommonData^.MousePos.x - iLeft > 200) then begin
      iLeft := CommonData^.MousePos.x - 200;
      iWidth := 210;
    end;
    CommonData^.bInSpec := TRUE;
  end
  else begin
    iLeft := CommonData^.MousePos.x - 1;
    iWidth := 1;
  end;
  // InstallGanFilter;
(*
  SetWindowPos(CommonData^.hWndFloat,
               HWND_TOPMOST,
               CommonData.MousePos.x, CommonData.MousePos.y, 10, 10,
               SWP_NOACTIVATE or SWP_SHOWWINDOW);
  ShowWindow(CommonData^.hWndFloat, SW_HIDE);
*)
  CommonData^.BufferA := '';
  	SetWindowPos(CommonData^.hWndFloat,
               HWND_TOPMOST,
               iLeft{CommonData.MousePos.x-1}, CommonData.MousePos.y-1,
               iWidth, 2,
               88{SWP_NOACTIVATE or SWP_NOREDRAW});

  SendMessage(CommonData^.hWndMouse, idMsg, 0, 0);


	MoveWindow(CommonData^.hWndFloat, -1, -1, 1, 1, TRUE);

  {
  SetWindowPos(CommonData^.hWndFloat,
               HWND_TOPMOST,
               CommonData.MousePos.x, CommonData.MousePos.y,
               120, 1,
               SWP_NOACTIVATE or SWP_SHOWWINDOW);
  ShowWindow(CommonData^.hWndFloat, SW_HIDE);
  }
  SetTimer(CommonData^.hWndFloat, 2, 300, @GanGetWordTimer);
end;

procedure InitCoverWindow(hInst : LongWord);
var
  WndClass : TWndClass; //Ex;
begin
  with WndClass do begin
    style              := WS_EX_TOPMOST;
    lpfnWndProc        := @CoverMainProc;  (*消息处理函数*)
    hInstance          := hInst;
    hbrBackground      := color_btnface + 1;
    lpszClassname      := 'GanFreeDict';
    hicon              := 0;
    hCursor            := 0;
    cbClsExtra         := 0;
    cbWndExtra         := 0;
  end;

  try
    if not BOOL(RegisterClass{Ex}(WndClass)) then begin
      MessageBox(0,
                 PChar(Format('$EEEE, Can not register class CHILD %d',[GetLastError])),
                 'Register Error',
                 MB_OK);
    end;
  except
    MessageBox(0, 'EXCEPTION', 'Register Class', MB_OK);
  end;

  hWndCover := CreateWindowEx(WS_EX_TOPMOST or WS_EX_TOOLWINDOW,
                              'GanFreeDict',
                              '^_^',
                              WS_POPUP or WS_VISIBLE,
                              -1,-1,1,1,
                              0,
                              0,
                              hInst, // GetModuleHandle('dll.dll'), // 98 for this, 2000 for 0
                              nil);

  if CommonData<>nil then begin
    CommonData^.hWndFloat := hWndCover;
  end;
  SetTimer(hWndCover, 1, 450, @WndCoverTimer);

end;
(******************************************************************************)
function GanServerProc(
    hWnd:LongWord;
    Message:LongWord;
    wParam:WPARAM;
    lParam:LPARAM
    ):BOOL;stdcall;
begin
  if (Message=idMsg) then  begin
    if (wParam = 0) then begin
      InstallGanFilter;
    end
    else begin
      UnInstallGanFilter;
    end;
  end;
  case Message of
    WM_CLOSE :
            begin
               DestroyWindow(hWnd);
               // PostQuitMessage(0);
            end;
  end;
  result := BOOL(DefWindowProc(hWnd, Message, lParam, lParam));
end;


procedure InitServerWnd;
var
  WndClass : TWndClass; //Ex;
begin
 with WndClass do begin
    style              := WS_EX_TOPMOST;
    lpfnWndProc        := @GanServerProc;  (*消息处理函数*)
    hInstance          := GetModuleHandle('GFDict.dll');
    hbrBackground      := color_btnface + 1;
    lpszClassname      := 'GanServerDict';
    hicon              := 0;
    hCursor            := 0;
    cbClsExtra         := 0;
    cbWndExtra         := 0;
  end;

  try
    if not BOOL(RegisterClass{Ex}(WndClass)) then begin
      MessageBox(0,
                 PChar(Format('Can not register class server %d',[GetLastError])),
                 'Register Error',
                 MB_OK);
    end;
  except
    MessageBox(0, 'EXCEPTION', 'Register Server Class', MB_OK);
  end;

  hWndServer := CreateWindowEx(WS_EX_TOPMOST or WS_EX_TOOLWINDOW,
                              'GanServerDict',
                              'Gan Server',
                              WS_POPUP or WS_VISIBLE,
                              -1,-1,1,1,
                              0,
                              0,
                              0, //hInst, // GetModuleHandle('dll.dll'), // 98 for this, 2000 for 0
                              nil);
  if (hWndServer=0) then begin
    MessageBeep(0);
  end;

end;
(******************************************************************************)

procedure InitThunkCode;
var
  tfType : TThunkFunc;
  hMod : HMODULE;
  pSysFunc, pThunkFunc : Pointer;
begin
  for tfType := LOW(TThunkFunc) to HIGH(TThunkFunc) do begin
    // clear to zero
    FillChar(ThunkCodeArr[tfType], sizeof(TThunkCode), 0);

    // fill it by right value
    hMod := 0;
    hMod := GetModuleHandle(PChar(ThunkFuncNameArr[tfType].strMod));
    if hMod = 0 then continue;

    pSysFunc := nil;
    pSysFunc := GetProcAddress(hMod,
      PChar(ThunkFuncNameArr[tfType].strSysProc));
    if pSysFunc = nil then continue;

    pThunkFunc := nil;
    pThunkFunc := GetProcAddress(hInstance,
      PChar(ThunkFuncNameArr[tfType].strThunkProc));
    if pThunkFunc = nil then continue;

    // now fill it!
    ThunkCodeArr[tfType].addr_sys := pSysFunc;
    ThunkCodeArr[tfType].addr_thunk := pThunkFunc;

    ThunkCodeArr[tfType].codeThunk.siJmp := ShortInt($E9);  // jmp ____
    ThunkCodeArr[tfType].codeThunk.dwAddr :=
      DWORD(pThunkFunc) - DWORD(pSysFunc) - 5;

    ThunkCodeArr[tfType].codeBak.siJmp := PByte(pSysFunc)^;
    ThunkCodeArr[tfType].codeBak.dwAddr := PDWORD(DWORD(pSysFunc)+1)^;
  end;
end;

{==================  Install Mouse Hook Support ==============================}
function MousePosHookHandler(iCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
var
  pMouse : PMOUSEHOOKSTRUCT;
  mPoint : TPoint;
  rect : TRect;
  bMousePosChg : boolean;
begin
  if iCode < 0 then
  begin
    Result := CallNextHookEx(hNextHookProc, iCode, wParam, lParam);
  end
  else
  if (CommonData<>nil) and
    (CommonData^.bCapture) and
    (TryEnterCriticalSection(m_CriticalSection))
  then begin

{$IFDEF WIN_9X}
    if bFirst then begin
      bFirst := false;
      // InstallGanFilter;
      InitCoverWindow;
    end;
{$ENDIF}

    pMouse := PMOUSEHOOKSTRUCT(lParam);

    if (CommonData<>nil) then begin
      CommonData.MousePos := pMouse.pt;
      CommonData.hWndCapture := pMouse.hWnd;
      PostMessage(CommonData.CallBackHandle, idMsg, 0, 1);
    end;
    if (GetCurrentProcessID <> CommonData^.CallBackProcID) then begin
      CommonData^.hWndMouse := hWndServer;

      mPoint := pMouse^.pt;
      ScreenToClient(pMouse^.hwnd, mPoint);
      if Assigned(CommonData) then
        CommonData.MousePClient := mPoint;
    end
    else begin
      CommonData^.hWndMouse := 0;

    end;
(*
    if (pMouse.pt.x = LastMousePos.x) and (pMouse.pt.y = LastMousePos.y) then
      bMousePosChg := false
    else begin
      bMousePosChg := true;
      LastMousePos := pMouse.pt;
    end;
    if (wParam = WM_MOUSEMOVE)
      and true
{$IFDEF WIN_9X}
      and (hWndCover <> 0)
{$ENDIF}
      and bMousePosChg
      and (not b_InCS)
      and (GetTickCount - LastTime > G_DELAY_TIME) then
    begin
      LastTime := GetTickCount;

      // whether in my window
      if (CommonData<>nil) and
         (GetCurrentProcessID = CommonData^.CallBackProcID) then begin
        result := 0;
        LeaveCriticalSection(m_CriticalSection);
        result := CallNextHookEx(hNextHookProc, iCode, wParam, lParam);
        exit;
      end;
      mPoint := pMouse^.pt;
      ScreenToClient(pMouse^.hwnd, mPoint);
      if Assigned(CommonData) then
        CommonData.MousePClient := mPoint;

      rect.TopLeft := mPoint;
      rect.Right := mPoint.x + 2;
      rect.Bottom := mPoint.y + 1;
      // Work for NT 2000 XP
{$IFDEF WIN_NT}
      InstallGanFilter;

      if Assigned(CommonData) then
        CommonData.BufferA := '';

      InvalidateRect(pMouse^.hWnd, @rect, TRUE);
      if (mPoint.X<0) or (mPoint.Y<0) then
        SendMessage(pMouse.hwnd, WM_NCPAINT, 1, 0)
      else
        SendMessage(pMouse.hwnd, WM_PAINT, 0, 0);

      UninstallGanFilter;
      if Assigned(CommonData) and (CommonData.BufferA='') then begin
        SendMessage(CommonData.CallBackHandle, idMsg, 0, 2);
      end;
{$ENDIF}
      // flowing work on 98
{$IFDEF WIN_9X}
      if (hWndCover <> 0) then begin
        SetWindowPos(hWndCover, 0, pMouse.pt.X, pMouse.pt.Y, 4, 1,
          SWP_NOZORDER or SWP_NOACTIVATE);
        ShowWindow(hWndCover, SW_SHOW);

//        EnterCriticalSection(m_CriticalSection);

        InstallGanFilter;
        ShowWindow(hWndCover, SW_HIDE);

//        LeaveCriticalSection(m_CriticalSection);
      end;
{$ENDIF}
    end;
*)
    LeaveCriticalSection(m_CriticalSection);
    Result := CallNextHookEx(hNextHookProc, iCode, wParam, lParam);
  end
  else begin
    Result := CallNextHookEx(hNextHookProc, iCode, wParam, lParam);
  end;
end;

function EnableMouseHook(hld:hwnd; ProcessID : DWORD; hInst:THandle): BOOL; export;
begin
  Result := False;
  if hNextHookProc <> 0 then Exit;

  hNextHookProc := SetWindowsHookEx(WH_MOUSE, MousePosHookHandler,Hinstance, 0);
//    GetWindowThreadProcessID(hWnd, nil));

  InitCoverWindow(hInst);
  if CommonData <> nil then begin
    CommonData^.CallBackHandle := hld;
    CommonData^.CallBackProcID := ProcessID;
  end;
  Result :=hNextHookProc <> 0 ;
end;

function DisableMouseHook: BOOL; export;
begin
try
  if hNextHookProc <> 0 then
  begin
    KillTimer(CommonData^.hWndFloat, 1);
    KillTimer(CommonData^.hWndFloat, 2);
    SendMessage(CommonData^.hWndFloat, WM_CLOSE, 0, 0);
    CommonData^.hWndFloat := 0;

    UnInstallGanFilter;
    UnhookWindowshookEx(hNextHookProc);
    hNextHookProc := 0;
  end;
  Result := hNextHookProc = 0;
except
  MessageBeep(0);
end;
end;

function SetCaptureFlag(bSet:BOOL):BOOL; export;
begin
  if CommonData<>nil then begin
    result := TRUE;
    CommonData^.bCapture := bSet;
  end
  else begin
    result := FALSE;
  end;
end;

procedure DllMain(dwReason : DWORD);
begin
  case dwReason of
    DLL_PROCESS_ATTACH :
      begin
        // InstallGanFilter;
        // InitCoverWindow;
      end;
    DLL_PROCESS_DETACH :
      begin
        if (hWndServer <> 0) then begin
          SendMessage(hWndServer, WM_CLOSE, 0, 0);
          hWndServer := 0;
          try
            UnRegisterClass('GanServerDict', hInstance);
          except
            MessageBeep(0);
          end;
        end;
        UnInstallGanFilter;
        if CommonData<>nil then begin
          try
            UnMapViewOfFile(CommonData);
            CommonData := nil;
            CloseHandle(HMapFile);
            HMapFile := 0;
          except
            MessageBox(0,
                       'Error when free MapViewFile',
                       'FreeDict Error',
                       MB_OK);
          end;
        end;
(*
        if (hWndCover <> 0) then begin
          try
            DestroyWindow(hWndCover);
            hWndCover := 0;
            if (UnRegisterClass('GanFreeDict', hInstance)) then
              {MessageBox(0,
                         'Success to Unregister _GanFreeDict_ Class',
                         'Success',
                         MB_OK);}
          except
            MessageBox(0,
                       'Error when Destroy window and UnRegisterClass',
                       'FreeDict Error',
                       MB_OK);
          end;
        end;
*)

        if hProc<>0 then begin
          try
            CloseHandle(hProc);
            hProc := 0;
          except
            MessageBox(0,
                       'Error when CloseHandle',
                       'FreeDict Error',
                       MB_OK);
          end;
        end;

        DeleteCriticalSection(g_CriticalSection);
        DeleteCriticalSection(m_CriticalSection);
      end;
    DLL_THREAD_ATTACH :
      begin
      end;
    DLL_THREAD_DETACH :
      begin
      end;
  end;
end;

exports
  EnableMouseHook,
  DisableMouseHook,
  GanTextOutA,
  GanTextOutW,
  GanExtTextOutA,
  GanExtTextOutW,
  GanDrawTextA,
  GanDrawTextW,
  SetCaptureFlag;

begin
  InitializeCriticalSection(g_CriticalSection);
  InitializeCriticalSection(m_CriticalSection);
  b_InCS := false;
  hNextHookProc := 0;
  hProc := 0;
  bFirst := true;
  bDllInstalled := false;
  hWndCover := 0;
  hWndServer := 0;
  CommonData := nil;
  HMapFile := 0;
  LastTime := 0;
  FillChar(LastMousePos, sizeof(TPoint), 0);
  idMsg := RegisterWindowMessage(STR_MSGNOTIFY);

  MapCommonData;

  hProc := OpenProcess(PROCESS_ALL_ACCESS,
                       FALSE,
                       GetCurrentProcessID());
  InitThunkCode;
  InitServerWnd;
  // InitCoverWindow;

  // DisableThreadLibraryCalls(hInstance);

  DLLProc := @DLLMain;
  DLLMain(DLL_PROCESS_ATTACH);
end.