⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 unit2.pas

📁 Delphi写的屏幕取词程序
💻 PAS
字号:
unit unit2;
interface
uses
  SysUtils, WinTypes,WINPROCS, Messages, Classes, Graphics, Controls,
  StdCtrls, Dialogs;
const
  MAXBUF=100;
  MAXFUN=2;
  function TextHookCreate:boolean;export;
  function TextHookFree:boolean;export;
  function checkbuf(buf:pchar):boolean;export;
  procedure HookTextOut;
  procedure unHookTextOut;
  procedure HookExTextOut;
  procedure unHookExTextOut;
 var
    OldAddr,NewAddr:array[0..MAXFUN-1,0..4] of byte;
    already:array[0..MAXFUN-1]of boolean;
    s:array[0..MAXBUF] of char;

implementation

function min(a,b:integer):integer;
begin
   if a>=b then result:=a
   else result:=b;
end;
function max(a,b:integer):integer;
begin
   if a<=b then result:=a
   else result:=b;
end;

function checkbuf(buf:pchar):boolean;
var
  A:array[0..50] of char;
  r:boolean;
begin

 asm
 {保存段、寄存器的值}
      push es
      push ds
      pusha
      push ax
      mov ax,seg oldaddr[0]
      mov ds,ax
      mov es,ax
      pop ax
 end;
 {拷贝缓冲区数据到输出缓冲区中}
 strlcopy(buf,@s[0],MAXBUF);
 {非空数据}
 r:=s[0]<>#0;
 asm
   popa
   pop ds
   pop es
 end;
 result:=r;
end;

function  MyTextOut( hdc:HDC;  x:integer;  y:integer;  Str:PChar; count:integer):boolean;far;
var
  poOri:longint;
  size:TSize;
  poDC, poText, poMouse: TPoint;
begin
   asm
   {保存段、寄存器}
      push es
      push ds
      pusha
      push ax
      mov ax,seg oldaddr[0]
      mov ds,ax
      mov es,ax
      pop ax
   end;
   {设置文件颜色}
{   SetTextColor(hDC,RGB(255,0,0)); }
   {恢复函数入口}
   unHookTextOut;
   {调用默认的显示函数}
   Result := TextOut(hDC, X, Y,Str,count);
   {修改函数入口}
   HookTextOut;

   {取HDC坐标}
   poOri:=GetDCOrg(hDC);
   poDC.x := X;
   poDC.y := Y;
   {局部逻辑坐标转化为设备相关坐标}
   LPToDP(hDC, poDC, 1);
   {获取当前鼠标的坐标}
   GetCursorPos(poMouse);
   poText.x := poDC.x + LoWord(poOri);
   poText.y := poDC.y + HiWord(poOri);
   {获取对齐属性}
   if (GetTextAlign(hDC) and TA_UPDATECP) <> 0 then
   begin
     GetCurrentPositionEx(hDC, @poOri);
     poText.x := poText.x + LoWord(poOri);
     poText.y := poText.y + HiWord(poOri);
   end;
   {取得要输出的字符串的实际显示大小}
   GetTextExtentPoint(hDC, Str, Count, Size);
   {鼠标是否在文本的范围内}
   if (count<>0)and (poMouse.x >= poText.x) and (poMouse.x <= poText.x + Size.cx) and
     (poMouse.y >= poText.y) and (poMouse.y <= poText.y + Size.cy) then
   begin
      strlcopy(@s[0],str,count);
   end;
   asm
      popa
      pop ds
      pop es
   end;
end;

function  MyExtTextOut(hDC: HDC; X, Y: Integer; Options: Word; Rect: PRect; Str: PChar; Count: Word; Dx: PInteger):
  Boolean;far;
var
  poOri:longint;
  size:TSize;
  poDC, poText, poMouse: TPoint;
begin
   asm
      push es
      push ds
      pusha
      push ax
      mov ax,seg oldaddr[1]
      mov ds,ax
      mov es,ax
      pop ax
   end;
{   SetTextColor(hDC,RGB(255,0,0));   }
   {恢复函数入口}
   UnHookExTextOut;
   {调用默认的输出显示函数}
   Result := ExtTextOut(hDC,x,y,Options,Rect,str,count,Dx);
   HookExTextOut;

   {取HDC坐标}
   poOri:=GetDCOrg(hDC);
   poDC.x := X;
   poDC.y := Y;
   {局部逻辑坐标转化为设备相关坐标}
   LPToDP(hDC, poDC, 1);
   {获取当前鼠标的坐标}
   GetCursorPos(poMouse);
   poText.x := poDC.x + LoWord(poOri);
   poText.y := poDC.y + HiWord(poOri);
   {获取对齐属性}
   if (GetTextAlign(hDC) and TA_UPDATECP) <> 0 then
   begin
     GetCurrentPositionEx(hDC, @poOri);
     poText.x := poText.x + LoWord(poOri);
     poText.y := poText.y + HiWord(poOri);
   end;
   {取得要输出的字符串的实际显示大小}
   GetTextExtentPoint(hDC, Str, Count, Size);
   {鼠标是否在文本的范围内}
   if (count<>0)and (poMouse.x >= poText.x) and (poMouse.x <= poText.x + Size.cx) and
     (poMouse.y >= poText.y) and (poMouse.y <= poText.y + Size.cy) then
   begin
      strlcopy(@s[0],str,count);
   end;

   asm
      popa
      pop ds
      pop es
   end;
end;


procedure HookTextOut;
var
   segment,offset, DsSegment, NewSegment,NewOffset:Word;
begin
   asm
      push es
      push ds
      pusha
      push ax
      mov ax,seg oldaddr[0]
      mov ds,ax
      mov es,ax
      pop ax
   end;
   if not already[0] then
   begin
      Segment:=Seg(TextOut);
      Offset:=Ofs(TextOut);
      DsSegment:=AllocCStoDSAlias(Segment);


      OldAddr[0][0]:=PByte(Ptr(DsSegment,Offset+0))^;
      OldAddr[0][1]:=PByte(Ptr(DsSegment,Offset+1))^;
      OldAddr[0][2]:=PByte(Ptr(DsSegment,Offset+2))^;
      OldAddr[0][3]:=PByte(Ptr(DsSegment,Offset+3))^;
      OldAddr[0][4]:=PByte(Ptr(DsSegment,Offset+4))^;

      NewSegment:=Seg(MyTextOut);
      NewOffset:=Ofs(MyTextOut);
      {修改入口为跳转到新的函数入口}
      NewAddr[0][0]:=$EA;
      NewAddr[0][1]:=Lo(NewOffset);
      NewAddr[0][2]:=Hi(NewOffset);
      NewAddr[0][3]:=Lo(NewSegment);
      NewAddr[0][4]:=Hi(NewSegment);

      PByte(Ptr(DsSegment,Offset))^:=NewAddr[0][0];
      PByte(Ptr(DsSegment,Offset+1))^:=NewAddr[0][1];
      PByte(Ptr(DsSegment,Offset+2))^:=NewAddr[0][2];
      PByte(Ptr(DsSegment,Offset+3))^:=NewAddr[0][3];
      PByte(Ptr(DsSegment,Offset+4))^:=NewAddr[0][4];

      already[0]:=true;
      FreeSelector(DsSegment);
   end;
end;

procedure HookExTextOut;
var
   segment,Exoffset,ExDsSegment,ExNewSegment,ExNewOffset:Word;
begin
  asm
     push es
     push ds
     pusha
     push ax
     mov ax,seg oldaddr[1]
     mov ds,ax
     mov es,ax
     pop ax
 end;
 if not already[1] then
 begin
     {获取段基地址}
     Segment:=Seg(EXTTextOut);
     {段偏移量}
     ExOffset:=Ofs(EXTTextOut);
     {取与代码段有相同基址的可写数据段别名}
     ExDsSegment:=AllocCStoDSAlias(Segment);

     {保存原函数要替换的头几个字节}
     OldAddr[1][0]:=PByte(Ptr(ExDsSegment,ExOffset+0))^;
     OldAddr[1][1]:=PByte(Ptr(ExDsSegment,ExOffset+1))^;
     OldAddr[1][2]:=PByte(Ptr(ExDsSegment,ExOffset+2))^;
     OldAddr[1][3]:=PByte(Ptr(ExDsSegment,ExOffset+3))^;
     OldAddr[1][4]:=PByte(Ptr(ExDsSegment,ExOffset+4))^;

     {获取段基地址}
     ExNewSegment:=Seg(MyExtTextOut);
     {段偏移量}
     ExNewOffset:=Ofs(MyExtTextOut);
     {取自定义函数的地址}
     NewAddr[1][0]:=$EA;
     NewAddr[1][1]:=Lo(ExNewOffset);
     NewAddr[1][2]:=Hi(ExNewOffset);
     NewAddr[1][3]:=Lo(ExNewSegment);
     NewAddr[1][4]:=Hi(ExNewSegment);

     {修改指定Windows函数的前几个字节}
     PByte(Ptr(ExDsSegment,ExOffset))^:=NewAddr[1][0];
     PByte(Ptr(ExDsSegment,ExOffset+1))^:=NewAddr[1][1];
     PByte(Ptr(ExDsSegment,ExOffset+2))^:=NewAddr[1][2];
     PByte(Ptr(ExDsSegment,ExOffset+3))^:=NewAddr[1][3];
     PByte(Ptr(ExDsSegment,ExOffset+4))^:=NewAddr[1][4];
     already[1]:=true;
     {释放段}
     FreeSelector(ExDsSegment);
    end;
   asm
      popa
      pop ds
      pop es
   end;
end;

procedure unHookTextOut;
var
   segment,offset,Exoffset,DsSegment,ExDsSegment:word;
begin
   asm
     {保存段寄存器和段的内容}
      push es
      push ds
      pusha
      push ax
      mov ax,seg oldaddr[0]
      mov ds,ax
      mov es,ax
      pop ax
   end;
   {处于取词状态}
   if already[0] then
   begin
      {函数的段基址}
      Segment:=Seg(TextOut);
      {函数的偏移}
      Offset:=Ofs(TextOut);
      {取与代码段有相同基址的可写数据段别名}
      DsSegment:=AllocCStoDSAlias(Segment);

      {改回原windows函数}
      PByte(Ptr(DsSegment,Offset))^:=OldAddr[0][0];
      PByte(Ptr(DsSegment,Offset+1))^:=OldAddr[0][1];
      PByte(Ptr(DsSegment,Offset+2))^:=OldAddr[0][2];
      PByte(Ptr(DsSegment,Offset+3))^:=OldAddr[0][3];
      PByte(Ptr(DsSegment,Offset+4))^:=OldAddr[0][4];

      FreeSelector(DsSegment);
      already[0]:=false;
   end;
   asm
      popa
      pop ds
      pop es
   end;
end;

procedure unHookExTextOut;
var
   segment,offset,Exoffset,
   DsSegment,ExDsSegment:word;
begin
   asm
      push es
      push ds
      pusha
      push ax
      mov ax,seg oldaddr[1]
      mov ds,ax
      mov es,ax
      pop ax
   end;
   if already[1] then
   begin
     {取函数段基址}
      Segment:=Seg(EXTTextOut);
      {取函数偏移}
      ExOffset:=Ofs(EXTTextOut);
      {取与代码段有相同基址的可写数据段别名}
      ExDsSegment:=AllocCStoDSAlias(Segment);
      {恢复原函数}
      PByte(Ptr(ExDsSegment,ExOffset+0))^:=OldAddr[1][0];
      PByte(Ptr(ExDsSegment,ExOffset+1))^:=OldAddr[1][1];
      PByte(Ptr(ExDsSegment,ExOffset+2))^:=OldAddr[1][2];
      PByte(Ptr(ExDsSegment,ExOffset+3))^:=OldAddr[1][3];
      PByte(Ptr(ExDsSegment,ExOffset+4))^:=OldAddr[1][4];


      FreeSelector(ExDsSegment);
      already[1]:=false;
   end;
   asm
      popa
      pop ds
      pop es
   end;
end;

{修改Windows系统函数地址}
function TextHookCreate:boolean;
begin
   s[0]:=#0;
   HookTextOut;
   HookExTextOut;
   result:=true;
end;

{恢复Windows系统函数地址}
function TextHookFree:boolean;
begin
   unHookTextOut;
   unHookExTextOut;
   result:=true;
end;


end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -