gfdict.dpr

如何用delphi在windows 2000 windows xp下实现获取屏幕的汉字

    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.