unit2.pas

delphi 读取屏幕的源码

unit unit2;

interface

uses
  SysUtils, WinTypes,WINPROCS, Messages, Classes, Graphics, Controls,
  StdCtrls, Dialogs;

  function TextHookCreate:boolean;export;
  function TextHookFree:boolean;export;
  procedure install(num:integer);
  procedure uninstall(num:integer);

const
   MAXFUN=2;
var
    OldData,NewData:array[0..MAXFUN-1]of array[0..4] of byte;
    FunBeenSpy:array[0..MAXFUN-1]of pointer;
    already:array[0..MAXFUN-1]of boolean;

implementation

function  MyTextOut( hdc:HDC;  nxStart:integer;  nyStart:integer;  lpszString:PChar; cbstring:integer):boolean;far;
begin
   asm
      push es
      push ds
      pusha
      push ax
      mov ax,seg OldData
      mov ds,ax
      mov es,ax
      pop ax
   end;
   SetTextColor(hDC,RGB(255,0,0));
   uninstall(0);
   Result := TextOut(hDC, nXStart, nYStart,lpszString,cbString);
   install(0);
   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;
begin
   asm
      push es
      push ds
      pusha
      push ax
      mov ax,seg OldData
      mov ds,ax
      mov es,ax
      pop ax
   end;
   SetTextColor(hDC,RGB(255,0,0));
   uninstall(1);
   Result := ExtTextOut(hDC,x,y,Options,Rect,Str,Count,Dx);
   install(1);
   asm
      popa
      pop ds
      pop es
   end;
end;

{function MyDrawText(hdc: HDC; text: PChar; len: Integer;var rect: TRect;
                        Format: WORD): Integer; far;
begin
   asm
      push es
      push ds
      pusha
      push ax
      mov ax,seg OldData
      mov ds,ax
      mov es,ax
      pop ax
   end;
   SetTextColor(hDC,RGB(255,0,0));
   uninstall(2);
   Result := DrawText(hDC,text,len,rect,Format);
   install(2);
   asm
      popa
      pop ds
      pop es
   end;
end;

function MyTabbedTextOut(HC: HDC; X, Y: Integer; Str: PChar; Count: Integer; TabPositions: Integer;
  var TabStopPositions; TabOrigin: Integer): LongInt;
begin
   asm
      push es
      push ds
      pusha
      push ax
      mov ax,seg OldData
      mov ds,ax
      mov es,ax
      pop ax
   end;
   SetTextColor(HC,RGB(255,0,0));
   uninstall(3);
   Result := TabbedTextOut(HC,x,y,str,count,TabPositions,TabStopPositions,TabOrigin);
   install(3);
   asm
      popa
      pop ds
      pop es
   end;
end; }

procedure install(num:integer);
var
   segment,offset,DsSegment:Word;
   Entry:TFarProc;
begin
   asm
      push es
      push ds
      pusha
      push ax
      mov ax,seg OldData
      mov ds,ax
      mov es,ax
      pop ax
   end;
   if not already[num] then
   begin
      Segment:=Seg(FunBeenSpy[num]^);
      Offset:=Ofs(FunBeenSpy[num]^);
      DsSegment:=AllocCStoDSAlias(Segment);
      { GlobalLock(DsSegment); }
      OldData[num][0]:=PByte(Ptr(DsSegment,Offset+0))^;
      PLongint(@OldData[num][1])^:=PLongint(Ptr(DsSegment,Offset+1))^;

      PByte(Ptr(DsSegment,Offset))^:=NewData[num][0];
      PLongint(Ptr(DsSegment,Offset+1))^:=PLongint(@NewData[num][1])^;
      { GlobalUnLock(DsSegment); }
      FreeSelector(DsSegment);
      already[num]:=true;
   end;
   asm
      popa
      pop ds
      pop es
   end;
end;

procedure uninstall(num:integer);
var
   segment,offset,DsSegment:Word;
   Entry:TFarProc;
begin
   asm
      push es
      push ds
      pusha
      push ax
      mov ax,seg OldData
      mov ds,ax
      mov es,ax
      pop ax
   end;
   if already[num] then
   begin
      Segment:=Seg(FunBeenSpy[num]^);
      Offset:=Ofs(FunBeenSpy[num]^);
      DsSegment:=AllocCStoDSAlias(Segment);
      { GlobalLock(DsSegment);  }
      PByte(Ptr(DsSegment,Offset))^:=OldData[num][0];
      PLongint(Ptr(DsSegment,Offset+1))^:=PLongint(@OldData[num][1])^;
      { GlobalUnLock(DsSegment); }
      FreeSelector(DsSegment);
      already[num]:=false;
   end;
   asm
      popa
      pop ds
      pop es
   end;
end;

function TextHookCreate:boolean;
var
   i:integer;
begin
   NewData[0][0]:=$EA;
   PLongint(@NewData[0][1])^:=Longint(@MyTextOut);
   FunBeenSpy[0]:=@TextOut;

   NewData[1][0]:=$EA;
   PLongint(@NewData[1][1])^:=Longint(@MyExtTextOut);
   FunBeenSpy[1]:=@ExtTextOut;

{   NewData[2][0]:=$EA;
   PLongint(@NewData[2][1])^:=Longint(@MyDrawText);
   FunBeenSpy[2]:=@DrawText;

   NewData[3][0]:=$EA;
   PLongint(@NewData[3][1])^:=Longint(@MyTabbedTextOut);
   FunBeenSpy[3]:=@TabbedTextOut; }

   for i:=0 to MAXFUN-1 do
   begin
     already[i]:=false;
     install(i);
   end;
   result:=true;
end;

function TextHookFree:boolean;
var
   i:integer;
begin
   for i:=0 to MAXFUN-1 do
     uninstall(i);
   result:=true;
end;

end.