获取鼠标停留位置文字

时间:2021-03-25 10:19:52
如何实现:
当鼠标停留在网页上时,读取鼠标停留位置的文字,例如网页显示的表格,停留在某个单元格,显示该单元格的数值。

13 个解决方案

#1


如果是软件,应该可以用API HOOK实现屏幕取词,Delphi下深入windows核心编程这本书提到过

#2


用api函数

#3


引用 1 楼 gyk120 的回复:
如果是软件,应该可以用API HOOK实现屏幕取词,Delphi下深入windows核心编程这本书提到过


是用软件,请教?

#4


要取的是浏览器中表格里面显示的数字串,以前做过是取的类似textbox控件里面的文字,不知道浏览器表格里面文字,和控件文字是不是一回事?

#5


原理就是 
hook  textout ,exttextout 这类函数
根据鼠标指向窗口的位置,使那个位置invalid,
当窗口重绘调用textout这些函数的时候,就可知道那个位置的内容

#6


该回复于2010-08-20 15:07:33被版主删除

#7


做过类似的东东。
比较好的处理方式是使用OleAcc

#8


我贴段我程序中的代码,你可以参考下。


unit yAccUtils;

interface

uses
  SysUtils, Classes, Windows, oleacc;

const
  csOleAccLibraryName = 'OleAcc.dll';

function AccessibleObjectFromPoint(Pt: TPoint;
  var Acc: IAccessible; var Child: Variant): HRESULT; stdcall;
function WindowFromAccessibleObject(pAcc:IACCESSIBLE;
  var phwnd:HWND): HRESULT; stdcall;

implementation

var
  FOleAccLibrary: Integer = 0;
  FAccPresent: Boolean = False;

type
  TyaAccessibleObjectFromPoint = function(Pt: TPoint;
    var Acc: IAccessible; var Child: Variant): HRESULT; stdcall;
  TyaWindowFromAccessibleObject = function(pAcc:IACCESSIBLE;
    var phwnd:HWND):HRESULT; stdcall;

procedure AccLibLoad;
begin
  if FAccPresent then
    Exit;
  FOleAccLibrary := SafeLoadLibrary(csOleAccLibraryName);
  FAccPresent := FOleAccLibrary <> 0;
end;

procedure AccLibUnLoad;
begin
  if FOleAccLibrary <> 0 then
    FreeLibrary(FOleAccLibrary);
  FAccPresent := False;
end;

procedure CheckAccLib;
begin
  if not FAccPresent then
    AccLibLoad;
end;

function AccessibleObjectFromPoint(Pt: TPoint;
  var Acc: IAccessible; var Child: Variant): HRESULT; stdcall;
var
  AProc: TyaAccessibleObjectFromPoint;
begin
  CheckAccLib;
  if FOleAccLibrary <> 0 then
  begin
    @AProc := Windows.GetProcAddress(FOleAccLibrary, 'AccessibleObjectFromPoint');
    if @AProc <> nil then
    begin
      Result := AProc(Pt, Acc, Child);
      Exit;
    end;
  end;

  Result := E_FAIL;
end;

function WindowFromAccessibleObject(pAcc: IACCESSIBLE;
  var phwnd: HWND): HRESULT; stdcall;
var
  AProc: TyaWindowFromAccessibleObject;
begin
  CheckAccLib;
  if FOleAccLibrary <> 0 then
  begin
    @AProc := Windows.GetProcAddress(FOleAccLibrary, 'WindowFromAccessibleObject');
    if @AProc <> nil then
    begin
      Result := AProc(pAcc, phwnd);
      Exit;
    end;
  end;

  Result := E_FAIL;
end;

initialization
finalization
  AccLibUnLoad;



#9


调用:


var
 P: TPoint;
 A: IAccessible;
 V: Variant;
 pszName: WideString;
 pszValue: WideString;
begin
  if GetCursorPos(P) then
  begin
    FOldPoint := P;
    if Succeeded(AccessibleObjectFromPoint(P, A, V)) then
    begin
      A.Get_accName(V, pszName);
      A.Get_accValue(V, pszValue);
    end;
。。。


pszValue即你所要的网页上的文字

#10


類似屏幕取詞的程序,直接用AIP HOOK;必要時會用到勾子,以下是示例代碼。。。

“ 螢幕取詞”的實現:
//-----------------------------------------------------------------
1 用SetWindowsHookEx()安裝滑鼠鉤子MouseProc; 
2 在螢幕上移動滑鼠時,系統就會調用滑鼠鉤子MouseProc; 
3 進入MouseProc,獲得滑鼠的座標(x,y), 
設置對TextOut()、ExtTextOut()等的跟蹤程式, 
用invalidateRect()告訴系統該點(x,y)“失效”; 
4 
系統發出WM_PAINT消息,指示該點(x,y)處的應用程式重繪“失效”的區域。 
5 負責繪製該點()的應用程式在受到 WM_PAINT 消息後, 就有機會調用
TextOut()、 ExtTextOut()等函數。 
6 調用的函數被攔截進入跟蹤程式:設置好了的跟蹤程式截獲了該次調用, 
從應用程式的堆疊中取出 該點(x,y)“文字”的指標; 
7 從應用程式的資料段中將“文字”指標的內容取出,即完成了一次“螢幕 
抓字”; 
8 退出跟蹤程式,返回到滑鼠鉤子MouseProc; 
9 在MouseProc中解除對TextOut() ExtTextOut()的跟蹤; 
10 退出MouseProc滑鼠鉤副程式,控制權交給系統。 
11 在螢幕上移動滑鼠,開始下一次“螢幕抓字”,返回步驟2。
//-----------------------------------------------------------------
Dll工程.
GetWordDll.dpr
//-----------------------------------------------------------------------------------
library GetWordDll;
uses
    Windows,
    SysUtils,
    Classes,
    UnitHookDll in 'UnitHookDll.pas',
    UnitNt2000Hook in 'UnitNt2000Hook.pas',
    UnitHookType in 'UnitHookType.pas';
exports
      StartHook,
      StopHook,
//      MouseWndProc,
      {以下匯出列表都是必須的,
      不能少,因為程式要取其位址}
      NewBeginPaint,
      NewCreateCompatibleDC,
      NewTextOutA,
      NewTextOutW,
      NewExtTextOutA,
      NewExtTextOutW,
      NewDrawTextA,
      NewDrawTextW; 
begin
end.
UnitHookType.pas
unit UnitHookType;
interface
uses windows, messages;
const
      MaxStringLen = 100;
      WM_MOUSEPT = WM_USER + 1138;
      MappingFileName = 'GetWord32 for 9x NT 2000';
      fBeginPaint=0;
      fGetWindowDC=1;
      fGetDC=2;
      fCreateCompatibleDC=3;
      fTextOutA=4;
      fTextOutW=5;
      fExtTextOutA=6;
      fExtTextOutW=7;
      fDrawTextA=8;
      fDrawTextW=9;
type
      PPointer = ^Pointer;
      TShareMem = packed record
          hProcWnd: HWND; {主應用視窗控制碼}
          hHookWnd: HWND; {滑鼠所在視窗}
          pMouse: TPoint; {滑鼠資訊}
          DCMouse,DCCompatible: HDC;
          fTimerID: integer;
          fStrMouseQueue: array[0..MaxStringLen] of Char; {滑鼠資訊串}
          nTimePassed: integer; {滑鼠停留的時間}
          bCanSpyNow: Boolean; {開始取詞}
          Text: array[0..MaxStringLen] of Char; {字串}
      end;
      PShareMem = ^TShareMem;
implementation
end.
UnitNt2000Hook.pas
//-----------------------------------------------------------------------------------
unit UnitNt2000Hook;
interface
uses classes, Windows,SysUtils, messages,dialogs;
type
    TImportCode = packed record
       JumpInstruction: Word;
       AddressOfPointerToFunction: PPointer;
    end;
    PImportCode = ^TImportCode;
    PImage_Import_Entry = ^Image_Import_Entry;
    Image_Import_Entry = record
      Characteristics: DWORD;
      TimeDateStamp: DWORD;
      MajorVersion: Word;
      MinorVersion: Word;
      Name: DWORD;
      LookupTable: DWORD;
    end;
    TLongJmp = packed record
       JmpCode: ShortInt; {指令,用$E9來代替系統的指令}
       FuncAddr: DWORD; {函數位址}
    end;
    THookClass = class
    private
       Trap:boolean; {調用方式:True陷阱式,False改引入表式}
       hProcess: Cardinal; {進程控制碼,只用於陷阱式}
       AlreadyHook:boolean; {是否已安裝Hook,只用於陷阱式}
       AllowChange:boolean; {是否允許安裝、卸載Hook,只用於改引入表式}
       Oldcode: array[0..4]of byte; {系統函數原來的前5個位元組}
       Newcode: TLongJmp; {將要寫在系統函數的前5個位元組}
    private
    public
       OldFunction,NewFunction:Pointer;{被截函數、自訂函數}
       constructor Create(IsTrap:boolean;OldFun,NewFun:pointer);
       constructor Destroy;
       procedure Restore;
       procedure Change;
    published
    end;
implementation
{取函數的實際位址。如果函數的第一個指令是Jmp,則取出它的跳轉位址(實際位址),這往往是由於程式中含有Debug調試資訊引起的}
function FinalFunctionAddress(Code: Pointer): Pointer;
Var
    func: PImportCode;
begin
    Result:=Code;
    if Code=nil then exit;
    try
      func:=code;
      if (func.JumpInstruction=$25FF) then
        {指令二進位碼FF 25    彙編指令jmp [...]}
        Func:=func.AddressOfPointerToFunction^;
      result:=Func;
    except
      Result:=nil;
    end;
end;

{更改引入表中指定函數的位址,只用於改引入表式}
function PatchAddressInModule(BeenDone:Tlist;hModule: THandle; OldFunc,NewFunc: Pointer):integer;
const
     SIZE=4;
Var
     Dos: PImageDosHeader; //DOS頭
     NT: PImageNTHeaders;    //PE頭
     ImportDesc: PImage_Import_Entry;//輸入表
     rva: DWORD;     //RVA
     Func: PPointer;    //
     DLL: String;
     f: Pointer;
     written: DWORD;
     mbi_thunk:TMemoryBasicInformation;
     dwOldProtect:DWORD;
begin
    Result:=0;
    if hModule=0 then exit;
    Dos:=Pointer(hModule);
    {如果這個DLL模組已經處理過,則退出。BeenDone包含已處理的DLL模組}
    if BeenDone.IndexOf(Dos)>=0 then exit;
    BeenDone.Add(Dos);{把DLL模組名加入BeenDone}
    OldFunc:=FinalFunctionAddress(OldFunc);{取函數的實際位址}
    {如果這個DLL模組的位址不能訪問,則退出}
    if IsBadReadPtr(Dos,SizeOf(TImageDosHeader)) then exit;
    {如果這個模組不是以'MZ'開頭,表明不是DLL,則退出}
    if Dos.e_magic<>IMAGE_DOS_SIGNATURE then exit;{IMAGE_DOS_SIGNATURE='MZ'}//檢查數位簽章,最好再檢查一下PE
    {定位至NT Header}
    NT :=Pointer(Integer(Dos) + dos._lfanew);
    {定位至引入函數表}
    RVA:=NT^.OptionalHeader.
       DataDirectory[IMAGE_DIRECTORY_ENTRY_IMPORT].VirtualAddress;//導入表
    if RVA=0 then exit;{如果引入函數表為空,則退出}
    {把函數引入表的相對位址RVA轉換為絕對位址}
    ImportDesc := pointer(DWORD(Dos)+RVA);{Dos是此DLL模組的首位址}//RVA->VA
    {遍歷所有被引入的下級DLL模組}
    While (ImportDesc^.Name<>0) do
    begin
      {被引入的下級DLL模組名字}
      DLL:=PChar(DWORD(Dos)+ImportDesc^.Name);
      {把被導入的下級DLL模組當做當前模組,進行遞迴呼叫}
      PatchAddressInModule(BeenDone,GetModuleHandle(PChar(DLL)),OldFunc,NewFunc);
      {定位至被引入的下級DLL模組的函數表}
      Func:=Pointer(DWORD(DOS)+ImportDesc.LookupTable);
      {遍歷被引入的下級DLL模組的所有函數}
      While Func^<>nil do
      begin
        f:=FinalFunctionAddress(Func^);{取實際地址}
        if f=OldFunc then {如果函數實際位址就是所要找的地址}
        begin
           VirtualQuery(Func,mbi_thunk, sizeof(TMemoryBasicInformation));
           VirtualProtect(Func,SIZE,PAGE_EXECUTE_WRITECOPY,mbi_thunk.Protect);{更改記憶體屬性}
           WriteProcessMemory(GetCurrentProcess,Func,@NewFunc,SIZE,written);{把新函數位址覆蓋它}
           VirtualProtect(Func, SIZE, mbi_thunk.Protect,dwOldProtect);{恢復記憶體屬性}
        end;
        If Written=4 then Inc(Result);
//        else showmessagefmt('error:%d',[Written]);
        Inc(Func);{下一個功能函數}
      end;
      Inc(ImportDesc);{下一個被引入的下級DLL模組}
    end;
end;

{HOOK的入口,其中IsTrap表示是否採用陷阱式}
constructor THookClass.Create(IsTrap:boolean;OldFun,NewFun:pointer);
begin
     {求被截函數、自訂函數的實際位址}
     OldFunction:=FinalFunctionAddress(OldFun);
     NewFunction:=FinalFunctionAddress(NewFun);
     Trap:=IsTrap;
     if Trap then{如果是陷阱式}
     begin
        {以特權的方式來打開當前進程}
        hProcess := OpenProcess(PROCESS_ALL_ACCESS,FALSE, GetCurrentProcessID);
        {生成jmp xxxx的代碼,共5位元組}
        Newcode.JmpCode := ShortInt($E9); {jmp指令的十六進位代碼是E9}
        NewCode.FuncAddr := DWORD(NewFunction) - DWORD(OldFunction) - 5;
        {保存被截函數的前5個位元組}
        move(OldFunction^,OldCode,5);
        {設置為還沒有開始HOOK}
        AlreadyHook:=false;
     end;
     {如果是改引入表式,將允許HOOK}
     if not Trap then AllowChange:=true;
     Change; {開始HOOK}
     {如果是改引入表式,將暫時不允許HOOK}
     if not Trap then AllowChange:=false;
end;
{HOOK的出口}
constructor THookClass.Destroy;
begin
     {如果是改引入表式,將允許HOOK}
     if not Trap then AllowChange:=true;
     Restore; {停止HOOK}
     if Trap then{如果是陷阱式}
        CloseHandle(hProcess);
end;
{開始HOOK}
procedure THookClass.Change;
var
     nCount: DWORD;
     BeenDone: TList;
begin
    if Trap then{如果是陷阱式}
    begin
      if (AlreadyHook)or (hProcess = 0) or (OldFunction = nil) or (NewFunction = nil) then
          exit;
      AlreadyHook:=true;{表示已經HOOK}
      WriteProcessMemory(hProcess, OldFunction, @(Newcode), 5, nCount);
    end
    else begin{如果是改引入表式}
         if (not AllowChange)or(OldFunction=nil)or(NewFunction=nil)then exit;
         BeenDone:=TList.Create; {用於存放當前進程所有DLL模組的名字}
         try
           PatchAddressInModule(BeenDone,GetModuleHandle(nil),OldFunction,NewFunction);
         finally
           BeenDone.Free;
         end;
    end;
end;
{恢復系統函數的調用}
procedure THookClass.Restore;
var
     nCount: DWORD;
     BeenDone: TList;
begin
    if Trap then{如果是陷阱式}
    begin
      if (not AlreadyHook) or (hProcess = 0) or (OldFunction = nil) or (NewFunction = nil) then
          exit;
      WriteProcessMemory(hProcess, OldFunction, @(Oldcode), 5, nCount);
      AlreadyHook:=false;{表示退出HOOK}
    end
    else begin{如果是改引入表式}
      if (not AllowChange)or(OldFunction=nil)or(NewFunction=nil)then exit;
      BeenDone:=TList.Create;{用於存放當前進程所有DLL模組的名字}
      try
        PatchAddressInModule(BeenDone,GetModuleHandle(nil),NewFunction,OldFunction);
      finally
        BeenDone.Free;
      end;
    end;
end;
end.

#11


楼上的代码怎么用?yAccUtils.pas并不是以“End.”结尾的,而且uses里不存在oleacc也没法编译来验证。

我知道的方法代码不超过三行,哪有你这么麻烦啊。你这到底是什么代码?你QQ多少?

#12


我少拷贝了一个End. 自己加上啊:-)

olecc.pas单元Delphi 2010中有这个文件,所以我直接使用了,
如果是Delphi 7或者更早版本好像没有这个单元,其他版本不大清楚。

如果要在Delphi 7 中使用,加上IAccessible的定义就好了,具体如下:

  
  {$EXTERNALSYM IAccessible}
  IAccessible = interface(IDispatch)
    ['{618736E0-3C3D-11CF-810C-00AA00389B71}']
    function Get_accParent(out ppdispParent: IDispatch): HResult; stdcall;
    function Get_accChildCount(out pcountChildren: Integer): HResult; stdcall;
    function Get_accChild(varChild: OleVariant; out ppdispChild: IDispatch): HResult; stdcall;
    function Get_accName(varChild: OleVariant; out pszName: WideString): HResult; stdcall;
    function Get_accValue(varChild: OleVariant; out pszValue: WideString): HResult; stdcall;
    function Get_accDescription(varChild: OleVariant; out pszDescription: WideString): HResult; stdcall;
    function Get_accRole(varChild: OleVariant; out pvarRole: OleVariant): HResult; stdcall;
    function Get_accState(varChild: OleVariant; out pvarState: OleVariant): HResult; stdcall;
    function Get_accHelp(varChild: OleVariant; out pszHelp: WideString): HResult; stdcall;
    function Get_accHelpTopic(out pszHelpFile: WideString; varChild: OleVariant;
                              out pidTopic: Integer): HResult; stdcall;
    function Get_accKeyboardShortcut(varChild: OleVariant; out pszKeyboardShortcut: WideString): HResult; stdcall;
    function Get_accFocus(out pvarChild: OleVariant): HResult; stdcall;
    function Get_accSelection(out pvarChildren: OleVariant): HResult; stdcall;
    function Get_accDefaultAction(varChild: OleVariant; out pszDefaultAction: WideString): HResult; stdcall;
    function accSelect(flagsSelect: Integer; varChild: OleVariant): HResult; stdcall;
    function accLocation(out pxLeft: Integer; out pyTop: Integer; out pcxWidth: Integer;
                         out pcyHeight: Integer; varChild: OleVariant): HResult; stdcall;
    function accNavigate(navDir: Integer; varStart: OleVariant; out pvarEndUpAt: OleVariant): HResult; stdcall;
    function accHitTest(xLeft: Integer; yTop: Integer; out pvarChild: OleVariant): HResult; stdcall;
    function accDoDefaultAction(varChild: OleVariant): HResult; stdcall;
    function Set_accName(varChild: OleVariant; const pszName: WideString): HResult; stdcall;
    function Set_accValue(varChild: OleVariant; const pszValue: WideString): HResult; stdcall;
  end;

#13


另外你说的三行代码实现是什么?不会是GetWindowText吧。。
要注意看楼主要的是取得网页上的某些文本。

#1


如果是软件,应该可以用API HOOK实现屏幕取词,Delphi下深入windows核心编程这本书提到过

#2


用api函数

#3


引用 1 楼 gyk120 的回复:
如果是软件,应该可以用API HOOK实现屏幕取词,Delphi下深入windows核心编程这本书提到过


是用软件,请教?

#4


要取的是浏览器中表格里面显示的数字串,以前做过是取的类似textbox控件里面的文字,不知道浏览器表格里面文字,和控件文字是不是一回事?

#5


原理就是 
hook  textout ,exttextout 这类函数
根据鼠标指向窗口的位置,使那个位置invalid,
当窗口重绘调用textout这些函数的时候,就可知道那个位置的内容

#6


该回复于2010-08-20 15:07:33被版主删除

#7


做过类似的东东。
比较好的处理方式是使用OleAcc

#8


我贴段我程序中的代码,你可以参考下。


unit yAccUtils;

interface

uses
  SysUtils, Classes, Windows, oleacc;

const
  csOleAccLibraryName = 'OleAcc.dll';

function AccessibleObjectFromPoint(Pt: TPoint;
  var Acc: IAccessible; var Child: Variant): HRESULT; stdcall;
function WindowFromAccessibleObject(pAcc:IACCESSIBLE;
  var phwnd:HWND): HRESULT; stdcall;

implementation

var
  FOleAccLibrary: Integer = 0;
  FAccPresent: Boolean = False;

type
  TyaAccessibleObjectFromPoint = function(Pt: TPoint;
    var Acc: IAccessible; var Child: Variant): HRESULT; stdcall;
  TyaWindowFromAccessibleObject = function(pAcc:IACCESSIBLE;
    var phwnd:HWND):HRESULT; stdcall;

procedure AccLibLoad;
begin
  if FAccPresent then
    Exit;
  FOleAccLibrary := SafeLoadLibrary(csOleAccLibraryName);
  FAccPresent := FOleAccLibrary <> 0;
end;

procedure AccLibUnLoad;
begin
  if FOleAccLibrary <> 0 then
    FreeLibrary(FOleAccLibrary);
  FAccPresent := False;
end;

procedure CheckAccLib;
begin
  if not FAccPresent then
    AccLibLoad;
end;

function AccessibleObjectFromPoint(Pt: TPoint;
  var Acc: IAccessible; var Child: Variant): HRESULT; stdcall;
var
  AProc: TyaAccessibleObjectFromPoint;
begin
  CheckAccLib;
  if FOleAccLibrary <> 0 then
  begin
    @AProc := Windows.GetProcAddress(FOleAccLibrary, 'AccessibleObjectFromPoint');
    if @AProc <> nil then
    begin
      Result := AProc(Pt, Acc, Child);
      Exit;
    end;
  end;

  Result := E_FAIL;
end;

function WindowFromAccessibleObject(pAcc: IACCESSIBLE;
  var phwnd: HWND): HRESULT; stdcall;
var
  AProc: TyaWindowFromAccessibleObject;
begin
  CheckAccLib;
  if FOleAccLibrary <> 0 then
  begin
    @AProc := Windows.GetProcAddress(FOleAccLibrary, 'WindowFromAccessibleObject');
    if @AProc <> nil then
    begin
      Result := AProc(pAcc, phwnd);
      Exit;
    end;
  end;

  Result := E_FAIL;
end;

initialization
finalization
  AccLibUnLoad;



#9


调用:


var
 P: TPoint;
 A: IAccessible;
 V: Variant;
 pszName: WideString;
 pszValue: WideString;
begin
  if GetCursorPos(P) then
  begin
    FOldPoint := P;
    if Succeeded(AccessibleObjectFromPoint(P, A, V)) then
    begin
      A.Get_accName(V, pszName);
      A.Get_accValue(V, pszValue);
    end;
。。。


pszValue即你所要的网页上的文字

#10


類似屏幕取詞的程序,直接用AIP HOOK;必要時會用到勾子,以下是示例代碼。。。

“ 螢幕取詞”的實現:
//-----------------------------------------------------------------
1 用SetWindowsHookEx()安裝滑鼠鉤子MouseProc; 
2 在螢幕上移動滑鼠時,系統就會調用滑鼠鉤子MouseProc; 
3 進入MouseProc,獲得滑鼠的座標(x,y), 
設置對TextOut()、ExtTextOut()等的跟蹤程式, 
用invalidateRect()告訴系統該點(x,y)“失效”; 
4 
系統發出WM_PAINT消息,指示該點(x,y)處的應用程式重繪“失效”的區域。 
5 負責繪製該點()的應用程式在受到 WM_PAINT 消息後, 就有機會調用
TextOut()、 ExtTextOut()等函數。 
6 調用的函數被攔截進入跟蹤程式:設置好了的跟蹤程式截獲了該次調用, 
從應用程式的堆疊中取出 該點(x,y)“文字”的指標; 
7 從應用程式的資料段中將“文字”指標的內容取出,即完成了一次“螢幕 
抓字”; 
8 退出跟蹤程式,返回到滑鼠鉤子MouseProc; 
9 在MouseProc中解除對TextOut() ExtTextOut()的跟蹤; 
10 退出MouseProc滑鼠鉤副程式,控制權交給系統。 
11 在螢幕上移動滑鼠,開始下一次“螢幕抓字”,返回步驟2。
//-----------------------------------------------------------------
Dll工程.
GetWordDll.dpr
//-----------------------------------------------------------------------------------
library GetWordDll;
uses
    Windows,
    SysUtils,
    Classes,
    UnitHookDll in 'UnitHookDll.pas',
    UnitNt2000Hook in 'UnitNt2000Hook.pas',
    UnitHookType in 'UnitHookType.pas';
exports
      StartHook,
      StopHook,
//      MouseWndProc,
      {以下匯出列表都是必須的,
      不能少,因為程式要取其位址}
      NewBeginPaint,
      NewCreateCompatibleDC,
      NewTextOutA,
      NewTextOutW,
      NewExtTextOutA,
      NewExtTextOutW,
      NewDrawTextA,
      NewDrawTextW; 
begin
end.
UnitHookType.pas
unit UnitHookType;
interface
uses windows, messages;
const
      MaxStringLen = 100;
      WM_MOUSEPT = WM_USER + 1138;
      MappingFileName = 'GetWord32 for 9x NT 2000';
      fBeginPaint=0;
      fGetWindowDC=1;
      fGetDC=2;
      fCreateCompatibleDC=3;
      fTextOutA=4;
      fTextOutW=5;
      fExtTextOutA=6;
      fExtTextOutW=7;
      fDrawTextA=8;
      fDrawTextW=9;
type
      PPointer = ^Pointer;
      TShareMem = packed record
          hProcWnd: HWND; {主應用視窗控制碼}
          hHookWnd: HWND; {滑鼠所在視窗}
          pMouse: TPoint; {滑鼠資訊}
          DCMouse,DCCompatible: HDC;
          fTimerID: integer;
          fStrMouseQueue: array[0..MaxStringLen] of Char; {滑鼠資訊串}
          nTimePassed: integer; {滑鼠停留的時間}
          bCanSpyNow: Boolean; {開始取詞}
          Text: array[0..MaxStringLen] of Char; {字串}
      end;
      PShareMem = ^TShareMem;
implementation
end.
UnitNt2000Hook.pas
//-----------------------------------------------------------------------------------
unit UnitNt2000Hook;
interface
uses classes, Windows,SysUtils, messages,dialogs;
type
    TImportCode = packed record
       JumpInstruction: Word;
       AddressOfPointerToFunction: PPointer;
    end;
    PImportCode = ^TImportCode;
    PImage_Import_Entry = ^Image_Import_Entry;
    Image_Import_Entry = record
      Characteristics: DWORD;
      TimeDateStamp: DWORD;
      MajorVersion: Word;
      MinorVersion: Word;
      Name: DWORD;
      LookupTable: DWORD;
    end;
    TLongJmp = packed record
       JmpCode: ShortInt; {指令,用$E9來代替系統的指令}
       FuncAddr: DWORD; {函數位址}
    end;
    THookClass = class
    private
       Trap:boolean; {調用方式:True陷阱式,False改引入表式}
       hProcess: Cardinal; {進程控制碼,只用於陷阱式}
       AlreadyHook:boolean; {是否已安裝Hook,只用於陷阱式}
       AllowChange:boolean; {是否允許安裝、卸載Hook,只用於改引入表式}
       Oldcode: array[0..4]of byte; {系統函數原來的前5個位元組}
       Newcode: TLongJmp; {將要寫在系統函數的前5個位元組}
    private
    public
       OldFunction,NewFunction:Pointer;{被截函數、自訂函數}
       constructor Create(IsTrap:boolean;OldFun,NewFun:pointer);
       constructor Destroy;
       procedure Restore;
       procedure Change;
    published
    end;
implementation
{取函數的實際位址。如果函數的第一個指令是Jmp,則取出它的跳轉位址(實際位址),這往往是由於程式中含有Debug調試資訊引起的}
function FinalFunctionAddress(Code: Pointer): Pointer;
Var
    func: PImportCode;
begin
    Result:=Code;
    if Code=nil then exit;
    try
      func:=code;
      if (func.JumpInstruction=$25FF) then
        {指令二進位碼FF 25    彙編指令jmp [...]}
        Func:=func.AddressOfPointerToFunction^;
      result:=Func;
    except
      Result:=nil;
    end;
end;

{更改引入表中指定函數的位址,只用於改引入表式}
function PatchAddressInModule(BeenDone:Tlist;hModule: THandle; OldFunc,NewFunc: Pointer):integer;
const
     SIZE=4;
Var
     Dos: PImageDosHeader; //DOS頭
     NT: PImageNTHeaders;    //PE頭
     ImportDesc: PImage_Import_Entry;//輸入表
     rva: DWORD;     //RVA
     Func: PPointer;    //
     DLL: String;
     f: Pointer;
     written: DWORD;
     mbi_thunk:TMemoryBasicInformation;
     dwOldProtect:DWORD;
begin
    Result:=0;
    if hModule=0 then exit;
    Dos:=Pointer(hModule);
    {如果這個DLL模組已經處理過,則退出。BeenDone包含已處理的DLL模組}
    if BeenDone.IndexOf(Dos)>=0 then exit;
    BeenDone.Add(Dos);{把DLL模組名加入BeenDone}
    OldFunc:=FinalFunctionAddress(OldFunc);{取函數的實際位址}
    {如果這個DLL模組的位址不能訪問,則退出}
    if IsBadReadPtr(Dos,SizeOf(TImageDosHeader)) then exit;
    {如果這個模組不是以'MZ'開頭,表明不是DLL,則退出}
    if Dos.e_magic<>IMAGE_DOS_SIGNATURE then exit;{IMAGE_DOS_SIGNATURE='MZ'}//檢查數位簽章,最好再檢查一下PE
    {定位至NT Header}
    NT :=Pointer(Integer(Dos) + dos._lfanew);
    {定位至引入函數表}
    RVA:=NT^.OptionalHeader.
       DataDirectory[IMAGE_DIRECTORY_ENTRY_IMPORT].VirtualAddress;//導入表
    if RVA=0 then exit;{如果引入函數表為空,則退出}
    {把函數引入表的相對位址RVA轉換為絕對位址}
    ImportDesc := pointer(DWORD(Dos)+RVA);{Dos是此DLL模組的首位址}//RVA->VA
    {遍歷所有被引入的下級DLL模組}
    While (ImportDesc^.Name<>0) do
    begin
      {被引入的下級DLL模組名字}
      DLL:=PChar(DWORD(Dos)+ImportDesc^.Name);
      {把被導入的下級DLL模組當做當前模組,進行遞迴呼叫}
      PatchAddressInModule(BeenDone,GetModuleHandle(PChar(DLL)),OldFunc,NewFunc);
      {定位至被引入的下級DLL模組的函數表}
      Func:=Pointer(DWORD(DOS)+ImportDesc.LookupTable);
      {遍歷被引入的下級DLL模組的所有函數}
      While Func^<>nil do
      begin
        f:=FinalFunctionAddress(Func^);{取實際地址}
        if f=OldFunc then {如果函數實際位址就是所要找的地址}
        begin
           VirtualQuery(Func,mbi_thunk, sizeof(TMemoryBasicInformation));
           VirtualProtect(Func,SIZE,PAGE_EXECUTE_WRITECOPY,mbi_thunk.Protect);{更改記憶體屬性}
           WriteProcessMemory(GetCurrentProcess,Func,@NewFunc,SIZE,written);{把新函數位址覆蓋它}
           VirtualProtect(Func, SIZE, mbi_thunk.Protect,dwOldProtect);{恢復記憶體屬性}
        end;
        If Written=4 then Inc(Result);
//        else showmessagefmt('error:%d',[Written]);
        Inc(Func);{下一個功能函數}
      end;
      Inc(ImportDesc);{下一個被引入的下級DLL模組}
    end;
end;

{HOOK的入口,其中IsTrap表示是否採用陷阱式}
constructor THookClass.Create(IsTrap:boolean;OldFun,NewFun:pointer);
begin
     {求被截函數、自訂函數的實際位址}
     OldFunction:=FinalFunctionAddress(OldFun);
     NewFunction:=FinalFunctionAddress(NewFun);
     Trap:=IsTrap;
     if Trap then{如果是陷阱式}
     begin
        {以特權的方式來打開當前進程}
        hProcess := OpenProcess(PROCESS_ALL_ACCESS,FALSE, GetCurrentProcessID);
        {生成jmp xxxx的代碼,共5位元組}
        Newcode.JmpCode := ShortInt($E9); {jmp指令的十六進位代碼是E9}
        NewCode.FuncAddr := DWORD(NewFunction) - DWORD(OldFunction) - 5;
        {保存被截函數的前5個位元組}
        move(OldFunction^,OldCode,5);
        {設置為還沒有開始HOOK}
        AlreadyHook:=false;
     end;
     {如果是改引入表式,將允許HOOK}
     if not Trap then AllowChange:=true;
     Change; {開始HOOK}
     {如果是改引入表式,將暫時不允許HOOK}
     if not Trap then AllowChange:=false;
end;
{HOOK的出口}
constructor THookClass.Destroy;
begin
     {如果是改引入表式,將允許HOOK}
     if not Trap then AllowChange:=true;
     Restore; {停止HOOK}
     if Trap then{如果是陷阱式}
        CloseHandle(hProcess);
end;
{開始HOOK}
procedure THookClass.Change;
var
     nCount: DWORD;
     BeenDone: TList;
begin
    if Trap then{如果是陷阱式}
    begin
      if (AlreadyHook)or (hProcess = 0) or (OldFunction = nil) or (NewFunction = nil) then
          exit;
      AlreadyHook:=true;{表示已經HOOK}
      WriteProcessMemory(hProcess, OldFunction, @(Newcode), 5, nCount);
    end
    else begin{如果是改引入表式}
         if (not AllowChange)or(OldFunction=nil)or(NewFunction=nil)then exit;
         BeenDone:=TList.Create; {用於存放當前進程所有DLL模組的名字}
         try
           PatchAddressInModule(BeenDone,GetModuleHandle(nil),OldFunction,NewFunction);
         finally
           BeenDone.Free;
         end;
    end;
end;
{恢復系統函數的調用}
procedure THookClass.Restore;
var
     nCount: DWORD;
     BeenDone: TList;
begin
    if Trap then{如果是陷阱式}
    begin
      if (not AlreadyHook) or (hProcess = 0) or (OldFunction = nil) or (NewFunction = nil) then
          exit;
      WriteProcessMemory(hProcess, OldFunction, @(Oldcode), 5, nCount);
      AlreadyHook:=false;{表示退出HOOK}
    end
    else begin{如果是改引入表式}
      if (not AllowChange)or(OldFunction=nil)or(NewFunction=nil)then exit;
      BeenDone:=TList.Create;{用於存放當前進程所有DLL模組的名字}
      try
        PatchAddressInModule(BeenDone,GetModuleHandle(nil),NewFunction,OldFunction);
      finally
        BeenDone.Free;
      end;
    end;
end;
end.

#11


楼上的代码怎么用?yAccUtils.pas并不是以“End.”结尾的,而且uses里不存在oleacc也没法编译来验证。

我知道的方法代码不超过三行,哪有你这么麻烦啊。你这到底是什么代码?你QQ多少?

#12


我少拷贝了一个End. 自己加上啊:-)

olecc.pas单元Delphi 2010中有这个文件,所以我直接使用了,
如果是Delphi 7或者更早版本好像没有这个单元,其他版本不大清楚。

如果要在Delphi 7 中使用,加上IAccessible的定义就好了,具体如下:

  
  {$EXTERNALSYM IAccessible}
  IAccessible = interface(IDispatch)
    ['{618736E0-3C3D-11CF-810C-00AA00389B71}']
    function Get_accParent(out ppdispParent: IDispatch): HResult; stdcall;
    function Get_accChildCount(out pcountChildren: Integer): HResult; stdcall;
    function Get_accChild(varChild: OleVariant; out ppdispChild: IDispatch): HResult; stdcall;
    function Get_accName(varChild: OleVariant; out pszName: WideString): HResult; stdcall;
    function Get_accValue(varChild: OleVariant; out pszValue: WideString): HResult; stdcall;
    function Get_accDescription(varChild: OleVariant; out pszDescription: WideString): HResult; stdcall;
    function Get_accRole(varChild: OleVariant; out pvarRole: OleVariant): HResult; stdcall;
    function Get_accState(varChild: OleVariant; out pvarState: OleVariant): HResult; stdcall;
    function Get_accHelp(varChild: OleVariant; out pszHelp: WideString): HResult; stdcall;
    function Get_accHelpTopic(out pszHelpFile: WideString; varChild: OleVariant;
                              out pidTopic: Integer): HResult; stdcall;
    function Get_accKeyboardShortcut(varChild: OleVariant; out pszKeyboardShortcut: WideString): HResult; stdcall;
    function Get_accFocus(out pvarChild: OleVariant): HResult; stdcall;
    function Get_accSelection(out pvarChildren: OleVariant): HResult; stdcall;
    function Get_accDefaultAction(varChild: OleVariant; out pszDefaultAction: WideString): HResult; stdcall;
    function accSelect(flagsSelect: Integer; varChild: OleVariant): HResult; stdcall;
    function accLocation(out pxLeft: Integer; out pyTop: Integer; out pcxWidth: Integer;
                         out pcyHeight: Integer; varChild: OleVariant): HResult; stdcall;
    function accNavigate(navDir: Integer; varStart: OleVariant; out pvarEndUpAt: OleVariant): HResult; stdcall;
    function accHitTest(xLeft: Integer; yTop: Integer; out pvarChild: OleVariant): HResult; stdcall;
    function accDoDefaultAction(varChild: OleVariant): HResult; stdcall;
    function Set_accName(varChild: OleVariant; const pszName: WideString): HResult; stdcall;
    function Set_accValue(varChild: OleVariant; const pszValue: WideString): HResult; stdcall;
  end;

#13


另外你说的三行代码实现是什么?不会是GetWindowText吧。。
要注意看楼主要的是取得网页上的某些文本。