屏幕取词(100分)

寒芳轻 · 2008-08-27

最近在研究屏幕取词，网上找到一些资料，说的是取鼠标选中的＂词＂的方法 我想做个取某个窗口中特定控件上的字，如：我想在我的程序界面上同步显示我打开的IE地址栏内的东西，首先我通过鼠标获取ie的句柄，然后在dll中做个定时器，能不能得到这个IE地址栏的内容同步显示在我的程序界面上～～～～ 　　有没有达人做过类似的东西，给点参考思路～～～～～～

zpj86 · 2008-08-27

用timer效率肯定不行的，试试hook某个消息~~~

tandxu · 2008-08-27

转个: 如有讨论者可以通过huiyugan@263.net甘化新(作者)联系。 //链接库 GFDict.dll的代码，GFDict.dpr (******************************************************************************* * Copy Right (C) Gan Huaxin 2001, 2002, huiyugan@263.net * A Free Screen Words Capture Library *   Dedicated to my GirlFriend Sunny, Happy for ever * * Version         Date           Modification *   0.1       2001-11-07~09       New, oly a test *                                 Can Get Word, Sometimes occure error *   0.2       2002-05-14~16       Some Bugs Fixed,And *******************************************************************************) library GFDict; // {$DEFINE MSG_NOT_SEND} {$DEFINE WIN_NT} {$IFNDEF WIN_NT}   {$DEFINE WIN_9X} {$ENDIF} // {$DEFINE DEBUG} uses   SysUtils,   Classes,   windows,   messages,   untTypes; const   STR_MSGNOTIFY

Char='WM_GANNOTIFY'; var   HMapFile:THandle;   CommonData:^TCommonData;   idMsg : UINT;   hwndServer : HWnd; var   hWndCover : THandle;   LastMousePos : TPoint;   LastTime : DWORD;   g_CriticalSection : TRTLCriticalSection;   m_CriticalSection : TRTLCriticalSection;   b_InCS : boolean; var   hNextHookProc: HHook;   hProc : THandle;   bFirst : boolean;   bDllInstalled : boolean;   ThunkCodeArr : array[TThunkFunc] of TThunkCode; {$IFDEF DEBUG}   procedure GanWarning;   begin     MessageBeep(0);   end; {$ELSE}   procedure GanWarning;   begin   end; {$ENDIF} {$DEFINE _NOTIFY_} {$IFDEF _NOTIFY_}   procedure GanNotify;   begin     MessageBeep(0);   end; {$ELSE}   procedure GanNotify;   begin   end; {$ENDIF} // about Memory Map file support procedure MapCommonData; var FirstCall: Boolean; begin   HMapFile:=OpenFileMapping(FILE_MAP_WRITE, False, 'GanGan_ThunkDict');   FirstCall:=(HMapFile = 0);   if FirstCall then     HMapFile:=CreateFileMapping($FFFFFFFF,nil,PAGE_READWRITE,                                 0,SizeOf(TCommonData),                                 'GanGan_ThunkDict');   CommonData:= MapViewOfFile(HMapFile, FILE_MAP_WRITE, 0, 0, 0);   if FirstCall then FillChar(CommonData^, SizeOf(TCommonData), 0); end; // ----------------------------------------------------------------------------- procedure UnInstallThunkFunc(tfType : TThunkFunc); var   nCount : DWORD; begin   if not ThunkCodeArr[tfType].bInstalled then exit;   if (hProc=0) or (ThunkCodeArr[tfType].addr_sys=nil) then exit;   WriteProcessMemory(hProc,                      ThunkCodeArr[tfType].addr_sys,                      @(ThunkCodeArr[tfType].codeBak),                      5,                      nCount);   ThunkCodeArr[tfType].bInstalled := false; end; procedure InstallThunkFunc(tfType : TThunkFunc); var   nCount : DWORD; begin   if ThunkCodeArr[tfType].bInstalled then exit;   if (hProc=0) or (ThunkCodeArr[tfType].addr_sys=nil) then exit;   WriteProcessMemory(hProc,                      ThunkCodeArr[tfType].addr_sys,                      @(ThunkCodeArr[tfType].codeThunk),                      5,                      nCount);   ThunkCodeArr[tfType].bInstalled := True; end; procedure UnInstallGanFilter; forward; {===================  TextOut   ==============================================} function GanTextOutA(DC: HDC; X, Y: Integer; Str: PAnsiChar; Count: Integer): BOOL; stdcall; var   tm : TTextMetric;   rect : TRect;   size : TSize;   i, j : integer;   posDcOrg : TPoint;   posDcOff : TPoint; begin //  EnterCriticalSection(g_CriticalSection);   result := FALSE;   UnInstallThunkFunc(tfTextOutA); {$IFNDEF MSG_NOT_SEND} try   if (CommonData<>nil) then begin     GetDcOrgEx(dc, posDcOrg); // Get The DC offset     posDcOff := Point(x,y);     LPtoDP(dc, posDcOff, 1);     Rect.Left := posDcOrg.x + posDcOff.x;     Rect.Top := posDcOrg.y + posDcOff.y;     if BOOL(GetTextAlign(dc) and  TA_UPDATECP) then begin       GetCurrentPositionEx(dc, @posDcOff);       Inc(Rect.Left, posDcOff.x);       Inc(Rect.Top, posDcOff.y);     end;     GetTextExtentPointA(DC, Str, Count, size);     Rect.Right :=  Rect.Left + size.cx;     Rect.Bottom := Rect.Top + size.cy;     if PtInRect(rect, CommonData.MousePos) then begin // in total area!       if StrPos(Str, ' ')<>nil then begin         i := 0;         while (Str = Char(' ')) and (i<Count) do Inc(i);         j := i;         while (i<Count) do begin           if Str=Char(' ') then begin             Str := Char(0);             GetTextExtentPointA(DC, Str, i-1, size);             rect.Right := rect.Left + size.cx;             if PtInRect(rect, CommonData.MousePos) then begin               // SendMessage(CommonData.CallBackHandle, idMsg, i, 3);               StrCopy(CommonData.BufferA, PChar(@(Str[j])));               CommonData^.Rect := Rect;               SendMessage(CommonData^.CallBackHandle, idMsg, Integer(tfTextOutA), 0);               Str := Char(' ');               break;             end;             Str := Char(' ');             while (Str = Char(' ')) and (i < Count) do Inc(i);             if i=Count then break;             j := i;             Dec(i);             // break;           end;           inc(i);         end;         if (i=Count) then begin           StrCopy(CommonData.BufferA, PChar(@(Str[j])));           CommonData^.Rect := Rect;           SendMessage(CommonData^.CallBackHandle, idMsg, Integer(tfTextOutA), 0);         end;       end else       begin         StrCopy(CommonData.BufferA, Str);         CommonData^.Rect := Rect;         SendMessage(CommonData^.CallBackHandle, idMsg, Integer(tfTextOutA), 0);       end;     end;   end;   (*   StrCopy(CommonData.BufferA, Str);   CommonData^.Rect := Rect;   SendMessage(CommonData^.CallBackHandle, idMsg, Integer(tfTextOutA), 0);   *) except   GanWarning;   StrCopy(CommonData.BufferA, 'Error in TextOutA');   SendMessage(CommonData^.CallBackHandle, idMsg, Integer(tfTextOutA), 0); end; {$ENDIF}   TextOutA(DC, X, Y, Str, Count);   InstallThunkFunc(tfTextOutA); //  UnInstallGanFilter; //  LeaveCriticalSection(g_CriticalSection); end; function GanTextOutW(DC: HDC; X, Y: Integer; Str: PWideChar; Count: Integer): BOOL; stdcall; var   tm : TTextMetric;   rect : TRect;   size : TSize;   i, j : integer;   wChar : WideChar;   posDcOrg, posDcOff : TPoint; begin //  EnterCriticalSection(g_CriticalSection);   result := FALSE;   UnInstallThunkFunc(tfTextOutW); {$IFNDEF MSG_NOT_SEND} try   if (CommonData<>nil) then begin     GetDcOrgEx(dc, posDcOrg);     posDcOff := Point(x,y);     LPtoDP(dc, posDcOff, 1);     Rect.Left := posDcOrg.x + posDcOff.x;     Rect.Top := posDcOrg.y + posDcOff.y;     if BOOL(GetTextAlign(dc) and  TA_UPDATECP) then begin       GetCurrentPositionEx(dc, @posDcOff);       Inc(Rect.Left, posDcOff.x);       Inc(Rect.Top, posDcOff.y);     end;     GetTextExtentPointW(DC, Str, Count, size);     rect.Right := rect.Left + size.cx;     rect.Bottom := rect.Top + size.cy;     if PtInRect(rect, CommonData.MousePos) then begin       if StrPos(PChar(WideCharToString(Str)), ' ')<>nil then begin         i := 0;         while (Str = WideChar(' ')) and (i<Count) do Inc(i);         j := i;         while (i<Count) do begin           if Str=WideChar(' ') then begin             Str := WideChar(0);             GetTextExtentPoint32W(DC, Str, i-1, size);             rect.Right := rect.Left + size.cx;             if PtInRect(rect, CommonData.MousePos) then begin               // SendMessage(CommonData.CallBackHandle, idMsg, i, 3);               StrCopy(CommonData.BufferA,PChar(WideCharToString(@(Str[j]))));               CommonData^.Rect := Rect;               SendMessage(CommonData^.CallBackHandle, idMsg, Integer(tfTextOutW), 0);               Str := WideChar(' ');               break;             end;             Str := WideChar(' ');             while (Str = WideChar(' ')) and (i < Count) do Inc(i);             if i=Count then break;             j := i;             Dec(i);             // break;           end;           inc(i);         end;         if (i=Count) then begin           StrCopy(CommonData.BufferA, PChar(WideCharToString(@(Str[j]))));           CommonData^.Rect := Rect;           SendMessage(CommonData^.CallBackHandle, idMsg, Integer(tfTextOutW), 0);         end;       end else       begin         StrCopy(CommonData.BufferA,PChar(WideCharToString(Str)));         CommonData^.Rect := Rect;         SendMessage(CommonData^.CallBackHandle, idMsg, Integer(tfTextOutW), 0);       end;     end;   end; except   GanWarning;   StrCopy(CommonData.BufferA, 'Error in TextOutW');   SendMessage(CommonData^.CallBackHandle, idMsg, Integer(tfTextOutW), 0); end; {$ENDIF}   result := TextOutW(DC, X, Y, Str, Count);   InstallThunkFunc(tfTextOutW); //  UnInstallGanFilter; //  LeaveCriticalSection(g_CriticalSection); end; {===================  ExtTextOut  ============================================} (*   这个函数在UltraEdit里会出错，加上异常处理就没有关系。   Bug Fixed 2002-05-13 *) function GanExtTextOutA(DC: HDC; X, Y: Integer; Options: Longint;   Rect: PRect; Str: PAnsiChar; Count: Longint; Dx: PInteger): BOOL; stdcall; var   posDcOrg : TPoint;   posDc : TPoint;   RectText : TRect;   size : TSize; begin //  EnterCriticalSection(g_CriticalSection);   result := FALSE;   UnInstallThunkFunc(tfExtTextOutA); {$IFNDEF MSG_NOT_SEND}   GetDcOrgEx(dc, posDcOrg);   posDc := Point(x,y);   LPtoDP(dc, posDc, 1);   RectText.Left := posDc.x + posDcOrg.x;   RectText.Top := posDc.y + posDcOrg.y;   if BOOL(GetTextAlign(dc) and TA_UPDATECP) then begin     GetCurrentPositionEx(dc, @posDc);     Inc(RectText.Left, posDc.x);     Inc(RectText.Top, posDc.y);   end;   GetTextExtentPointA(dc, Str, Count, size); {Get The Length and Height of str}   with RectText do begin     Right := Left + size.cx;     Bottom := Top + Size.cy;   end;     if (CommonData<>nil) {and false} and PtInRect(RectText, CommonData.MousePos) then begin     try       StrCopy(CommonData.BufferA, Str);       CommonData^.Rect := RectText;     except       GanWarning;       StrCopy(CommonData.BufferA, 'ERROR in ExtTextOutA');     end;     SendMessage(CommonData^.CallBackHandle, idMsg, Integer(tfExtTextOutA), 0);   end; {$ENDIF}   result := ExtTextOutA(DC, X, Y, Options, Rect, Str, Count, Dx);   InstallThunkFunc(tfExtTextOutA); //  UnInstallGanFilter; //  LeaveCriticalSection(g_CriticalSection); end; function GanExtTextOutW(DC: HDC; X, Y: Integer; Options: Longint;   Rect: PRect; Str: PWideChar; Count: Longint; Dx: PInteger): BOOL; stdcall; var   posDcOrg : TPoint;   posDc : TPoint;   RectText : TRect;   size : TSize; label last; begin //  EnterCriticalSection(g_CriticalSection);   result := FALSE;   UnInstallThunkFunc(tfExtTextOutW); {$IFNDEF MSG_NOT_SEND}   if CommonData^.bInSpec then begin     (*if (Options and ETO_CLIPPED)=0 then goto last;*)     try         StrCopy(CommonData.BufferA,PChar(WideCharToString(Str)));         CommonData^.Rect := RectText;     except         GanWarning;         StrCopy(CommonData.BufferA, 'ERROR in ExtTextOutW');     end;     SendMessage(CommonData^.CallBackHandle, idMsg, Integer(tfExtTextOutW), 0);     goto last;   end;   GetDcOrgEx(dc, posDcOrg);   posDc.x := x;   posDc.y := y;   LPtoDP(dc, posDc, 1);   RectText.Left := posDc.x + posDcOrg.x;   RectText.Top := posDc.y + posDcOrg.y;   if BOOL(GetTextAlign(dc) and TA_UPDATECP) then begin     GetCurrentPositionEx(dc, @posDc);     Inc(RectText.Left, posDc.x);     Inc(RectText.Top, posDc.y);   end;   GetTextExtentPointW(dc, Str, Count, size); {Get The Length and Height of str}   with RectText do begin     Right := Left + size.cx;     Bottom := Top + Size.cy;   end;   if (CommonData<>nil) {and false} and PtInRect(RectText, CommonData.MousePos) then begin     {Bug Find 2002-05-13}     try         StrCopy(CommonData.BufferA,PChar(WideCharToString(Str)));         CommonData^.Rect := RectText;     except         GanWarning;         StrCopy(CommonData.BufferA, 'ERROR in ExtTextOutW');     end;     SendMessage(CommonData^.CallBackHandle, idMsg, Integer(tfExtTextOutW), 0);   end; {$ENDIF} last:   result := ExtTextOutW(DC, X, Y, Options, Rect, Str, Count, Dx);   InstallThunkFunc(tfExtTextOutW); //  UnInstallGanFilter; //  LeaveCriticalSection(g_CriticalSection); end; {===================  DrawText  ==============================================} function GanDrawTextA(hDC: HDC; lpString: PAnsiChar; nCount: Integer;   var lpRect: TRect; uFormat: UINT): Integer; stdcall; var   RectSave : TRect;   posDcOrg : TPoint; begin //  EnterCriticalSection(g_CriticalSection);   UnInstallThunkFunc(tfDrawTextA); {$IFNDEF MSG_NOT_SEND}   if (CommonData<>nil) {and false} then begin     GetDcOrgEx(hDc, posDcOrg);     RectSave := lpRect;     OffsetRect(RectSave, posDcOrg.x, posDcOrg.y);     if PtInRect(RectSave, CommonData^.MousePos) then begin       try         StrCopy(CommonData.BufferA, lpString);         CommonData^.Rect := lpRect;       except         GanWarning;       end;       SendMessage(CommonData^.CallBackHandle, idMsg, Integer(tfDrawTextA), 0);     end;   end; {$ENDIF}   result := DrawTextA(hDC, lpString, nCount, lpRect, uFormat);   InstallThunkFunc(tfDrawTextA); //  UnInstallGanFilter; //  LeaveCriticalSection(g_CriticalSection); end; function GanDrawTextW(hDC: HDC; lpString: PWideChar; nCount: Integer;   var lpRect: TRect; uFormat: UINT): Integer; stdcall; var   RectSave : TRect;   posDcOrg : TPoint; begin //  EnterCriticalSection(g_CriticalSection);   UnInstallThunkFunc(tfDrawTextW); {$IFNDEF MSG_NOT_SEND}   if (CommonData<>nil) {and false} then begin     GetDcOrgEx(hDc, posDcOrg);     RectSave := lpRect;     OffsetRect(RectSave, posDcOrg.x, posDcOrg.y);     if PtInRect(RectSave, CommonData^.MousePos) then begin       try         StrCopy(CommonData.BufferA,PChar(WideCharToString(lpString)));         CommonData^.Rect := lpRect;       except         GanWarning;       end;     end;     SendMessage(CommonData^.CallBackHandle, idMsg, Integer(tfDrawTextW), 0);   end; {$ENDIF}   result := DrawTextW(hDC, lpString, nCount, lpRect, uFormat);   InstallThunkFunc(tfDrawTextW); //  UnInstallGanFilter; //  LeaveCriticalSection(g_CriticalSection); end; procedure InstallGanFilter; var   tfType : TThunkFunc; begin   if bDllInstalled then exit;   for tfType := tfTextOutA to {tfExtTextOutW}tfDrawTextW do   // for tfType := LOW(TThunkFunc) to TThunkFunc(Ord(HIGH(TThunkFunc))-2) do     InstallThunkFunc(tfType);   bDllInstalled := true; end; procedure UnInstallGanFilter; var   tfType : TThunkFunc; begin   if not bDllInstalled then exit;   for tfType := tfTextOutA to {tfExtTextOutW}tfDrawTextW do   // for tfType := LOW(TThunkFunc) to TThunkFunc(Ord(HIGH(TThunkFunc))-2) do     UnInstallThunkFunc(tfType);   bDllInstalled := false; end; {==================  =========================================================} function WMCoverGetMinMaxInfo(                 hWnd    : THandle;                 Msg     : LongWord;                 wParam  : WPARAM;                 lParam  : LPARAM):BOOL;stdcall; var   info : ^MINMAXINFO; begin   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. (******************************************************************************* * Copy Right (C) Gan Huaxin 2001, 2002, huiyugan@263.net * A Free Screen Words Capture Library *   Dedicated to my GirlFriend Sunny, Happy for ever * * Version         Date           Modification *   0.1       2001-11-07~09       New, oly a test *                                 Can Get Word, Sometimes occure error *   0.2       2002-05-14~16       Some Bugs Fixed,And *******************************************************************************) unit untTypes; interface uses   Windows; type   TCommonData = record     bCapture : BOOL;     bInSpec : BOOL;     CallBackHandle:HWnd;     CallBackProcID : DWORD;     hWndFloat : HWnd; (*浮动窗口的句柄*)     hWndMouse : HWnd; (*鼠标所在窗口server的句柄*)     hWndCapture : HWnd; (*当前鼠标所在的窗口*)     MousePos  : TPoint; (*当前鼠标屏幕坐标*)     MousePClient : TPoint; (*鼠标所在窗口的坐标*)     Rect : TRect;     case integer of       0 : (BufferA : array [0..1023] of Char);       1 : (BufferW : array [0..511] of WideChar);   end;   PCommonData = ^TCommonData;   TCode5 = packed record     siJmp : ShortInt;     dwAddr : DWORD;   end;   TThunkFunc = (tfTextOutA,       tfTextOutW,                 tfExtTextOutA,    tfExtTextOutW,                 tfDrawTextA,      tfDrawTextW);   TThunkFuncName = packed record     strMod        : string;  // 系统模块名称     strSysProc    : string;  // 系统DLL中的名字     strThunkProc  : string;  // 你替换的函数的名字，必须在DLL的引出表中   end;   TThunkCode = packed record     codeBak       : TCode5;  // 系统函数的代码的前5个字节     codeThunk     : TCode5;  // 跳转到你的代码的5个字节     addr_sys      : Pointer; // 系统函数的地址     addr_thunk    : Pointer; // 替换函数的地址     bInstalled    : boolean; // 安装了吗?   end; const   G_DELAY_TIME = 100; const   ThunkFuncNameArr : array[TThunkFunc] of TThunkFuncName = (     (strMod : 'gdi32.dll';  strSysProc : 'TextOutA';    strThunkProc : 'GanTextOutA'),     (strMod : 'gdi32.dll';  strSysProc : 'TextOutW';    strThunkProc : 'GanTextOutW'),     (strMod : 'gdi32.dll';  strSysProc : 'ExtTextOutA'; strThunkProc : 'GanExtTextOutA'),     (strMod : 'gdi32.dll';  strSysProc : 'ExtTextOutW'; strThunkProc : 'GanExtTextOutW'),     (strMod : 'user32.dll'; strSysProc : 'DrawTextA';   strThunkProc : 'GanDrawTextA'),     (strMod : 'user32.dll'; strSysProc : 'DrawTextW';   strThunkProc : 'GanDrawTextW')   ); implementation end. //单元untMain.pas的代码，窗体设置见下 (******************************************************************************* * Copy Right (C) Gan Huaxin 2001, 2002, huiyugan@263.net * A Free Screen Words Capture Library *   Dedicated to my GirlFriend Sunny, Happy for ever * * Version         Date           Modification *   0.1       2001-11-07~09       New, oly a test *                                 Can Get Word, Sometimes occure error *   0.2       2002-05-14~16       Some Bugs Fixed,And *******************************************************************************) unit untMain; interface uses   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,   StdCtrls, untTypes; type   TfrmGanDict = class(TForm)     btnLoad: TButton;     btnUnLoad: TButton;     lblHwnd: TLabel;     btnAbout: TButton;     lblMousePos: TLabel;     memoThunk: TMemo;     lblFontWidth: TLabel;     lblRect: TLabel;     procedure btnLoadClick(Sender: TObject);     procedure btnUnLoadClick(Sender: TObject);     procedure FormDestroy(Sender: TObject);     procedure FormCreate(Sender: TObject);   private     { Private declarations }   public     { Public declarations }     procedure WndProc(var Mess: TMessage); override;   end; var   frmGanDict: TfrmGanDict; implementation uses untAbout; {$R *.DFM} var   HMapFile:THandle;   CommonData:^TCommonData; const   STR_MSGNOTIFYchar='WM_GANNOTIFY'; var   idMsg : UINT; function EnableMouseHook(hld:hwnd; ProcessID : DWORD; hInst : THandle): BOOL; external 'GFDict.dll'; function DisableMouseHook: BOOL; external 'GFDict.dll'; function SetCaptureFlag(bFlag:BOOL): BOOL; external 'GFDict.dll'; procedure MapCommonData; var FirstCall: Boolean; begin   HMapFile:=OpenFileMapping(FILE_MAP_WRITE, False, 'GanGan_ThunkDict');   FirstCall:=(HMapFile = 0);   if FirstCall then     HMapFile:=CreateFileMapping($FFFFFFFF,nil,PAGE_READWRITE,                                 0,SizeOf(TCommonData),                                 'GanGan_ThunkDict');   CommonData:= MapViewOfFile(HMapFile, FILE_MAP_WRITE, 0, 0, 0);   if FirstCall then FillChar(CommonData^, SizeOf(TCommonData), 0); end; procedure TfrmGanDict.btnLoadClick(Sender: TObject); begin   if not EnableMouseHook(handle, GetCurrentProcessID, Application.Handle) then     ShowMessage('ERROR')   else     SetCaptureFlag(TRUE); end; procedure TfrmGanDict.btnUnLoadClick(Sender: TObject); begin   DisableMouseHook; end; procedure TfrmGanDict.FormDestroy(Sender: TObject); begin   DisableMouseHook;   if CommonData<>nil then begin     UnMapViewOfFile(CommonData);     CommonData := nil;     CloseHandle(HMapFile);     HMapFile := 0;   end; end; procedure TfrmGanDict.FormCreate(Sender: TObject); begin   idMsg := RegisterWindowMessage(STR_MSGNOTIFY);   CommonData := nil;   MapCommonData;   SetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0,                SWP_NOSIZE or SWP_NOMOVE); end; const   StrProcNames : array[0..5] of String =     ('TextOutA',      'TextOutW',      'ExtTextOutA',      'ExtTextOutW',      'DrawTextA',      'DrawTextW'); procedure TfrmGanDict.WndProc(var Mess: TMessage); begin   case Mess.LParam of     0:       begin         if (mess.msg = idMsg) then begin           if (Mess.wParam >=0) and (Mess.WParam <= 5) then begin             lblHwnd.Caption := StrProcNames[mess.wParam]; //Format('Handle : 0x%X', [mess.wParam]);             if CommonData <> nil then with CommonData^ do begin               memoThunk.Text := CommonData.BufferA;               lblRect.Caption := Format('Client X:%d, Y:%d, Rect[%d,%d,%d,%d]',                 [MousePClient.x, MousePClient.y,                  Rect.Left, Rect.Top, Rect.Right, Rect.Bottom]);               // lblThunkText.Caption := CommonData.BufferA;             end           end else             lblHwnd.Caption := 'UnKnow Message';         end;       end;     1:       begin         if CommonData<>nil then with CommonData^ do           lblMousePos.Caption := Format('Mouse Pos X : %d, Y : %d',                                         [MousePos.X,                                          MousePos.Y]);       end;     2:       begin         memoThunk.Text := '---';       end;     3:       begin         lblFontWidth.Caption := Format('Font Width : %d', [mess.wParam]);       end;   end;   inherited; end; end.

寒芳轻 · 2008-08-28

谢谢tandxu:你贴出来的这个是鼠标屏幕取词的代码吧........   我想处理的是.....开始设置的时候设置下要取的对象,,,,之后不用鼠标停留在上面也能同步显示

屏幕取词(100分)

寒芳轻

Unregistered / Unconfirmed

zpj86

Unregistered / Unconfirmed

tandxu

Unregistered / Unconfirmed

寒芳轻

Unregistered / Unconfirmed

Similar threads