首页
社区
课程
招聘
[求助]勾 DrawTextA 成功, 但 UnHook 时出错了。。。
发表于: 2007-9-29 23:48 5045

[求助]勾 DrawTextA 成功, 但 UnHook 时出错了。。。

2007-9-29 23:48
5045
我想勾用 DELPHI 开发的程序的 控件的“TLabel”的标题,(DrawTextA ),现在可以成功勾到我想要的信息了, 但在UnHook 时会导致要勾的程序出错了。。。
工程的附件也给上, 大家帮看看,我错在什么地方,谢谢。。。。

//-----------------------------------------------------------------------------------------------
library Hook;
uses
  SysUtils,
  windows,
  Messages,
  APIHook in 'APIHook.pas';

var
  MyHook : HHOOK;
  Hooked : Boolean;

{------------------------------------}
{过程名:HookProc
{过程功能:HOOK过程
{过程参数:nCode, wParam, lParam消息的相
{         关参数
{------------------------------------}
procedure HookProc(nCode, wParam, lParam: LongWORD);stdcall;
begin
  if not Hooked then
  begin
    HookAPI;
    Hooked := True;
  end;
  //调用下一个Hook
  CallNextHookEx(MyHook, nCode, wParam, lParam);
end;

{------------------------------------}
{函数名:InstallHook
{函数功能:在指定窗口上安装HOOK
{函数参数:sWindow:要安装HOOK的窗口
{返回值:成功返回TRUE,失败返回FALSE
{------------------------------------}
function InstallHook(SWindow: LongWORD):Boolean;stdcall;
var
  ThreadID: LongWORD;
begin
  Result := False;
  MyHook := 0;
  ThreadID := GetWindowThreadProcessId(sWindow, nil);
  //给指定窗口挂上钩子
  MyHook := SetWindowsHookEx(WH_GETMESSAGE, @HookProc, Hinstance, ThreadID);
  if MyHook > 0 then
    Result := True  //是否成功HOOK
  else
    exit;
end;
{------------------------------------}
{过程名:UnHook
{过程功能:卸载HOOK
{过程参数:无
{------------------------------------}
procedure UnHook;stdcall;
begin
  UnHookAPI;
  //卸载Hook
  UnhookWindowsHookEx(MyHook);
end;
{------------------------------------}
{过程名:DLL入口函数
{过程功能:进行DLL初始化,释放等
{过程参数:DLL状态
{------------------------------------}
procedure MyDLLHandler(Reason: Integer);
var
  FHandle: LongWORD;
begin
  case Reason of
    DLL_PROCESS_ATTACH:
    begin
    //InstallHook;
    end;
    DLL_PROCESS_DETACH:
    begin
      if MyHook > 0 then UnHook;
    end;
  end;
end;
{$R *.res}
exports
  InstallHook, UnHook, HookProc;
begin
  MyHook:=0;
  Hooked:=False;
  DLLProc := @MyDLLHandler;
  MyDLLhandler(DLL_PROCESS_ATTACH);

end.

//--------------------------------------------------------------------------------------
unit APIHook;
interface
uses
  SysUtils,
  Windows,  IniFiles;

  //--------------------函数声明---------------------------
  procedure HookAPI;
  procedure UnHookAPI;
var
  DrawTextABaseAddress :  Pointer;
  DrawTextAOldProc: array [0..7] of Byte;
  DrawTextANewPorc: array [0..7] of Byte;

  ProcessHandle: THandle;
implementation

function MyDrawTextA(hDC: HDC; lpString: PAnsiChar; nCount: Integer; var lpRect: TRect; uFormat: UINT): Integer; stdcall;
var
  dwSize: cardinal;
  Ini : TIniFile;
begin
  if nCount > 180 then // 我想要的 lpString 是 nCount > 180
  begin
  Ini:=TIniFile.Create('C:\Documents and Settings\Administrator\桌面\VIP.ini');
  Ini.WriteString(lpString, lpString, IntTostr(nCount));
  Ini.Free;
  end;

  WriteProcessMemory(ProcessHandle, DrawTextABaseAddress, @DrawTextAOldProc, 8, dwSize);
  Result := DrawTextA(hDC, lpString, nCount, lpRect, uFormat);
  WriteProcessMemory(ProcessHandle, DrawTextABaseAddress, @DrawTextANewPorc, 8, dwSize);
end;
{------------------------------------}
{过程功能:HookAPI
{过程参数:无
{------------------------------------}
procedure HookAPI;
var
  DLLModule: THandle;
  nSize: cardinal;
  Dat: DWORD;
  Tmp : array [0..3] of Byte;
begin
  ProcessHandle := GetCurrentProcess;
  DLLModule := LoadLibrary('user32.dll');
  DrawTextABaseAddress := GetProcAddress(DLLModule, 'DrawTextA');

  Dat := DWORD(@MyDrawTextA);
  Move(Dat, Tmp, 4);
  DrawTextANewPorc[0] := $B8; { 汇编跳转指令 }
  DrawTextANewPorc[1] := Tmp[0]; { 跳转到自身的函数 }
  DrawTextANewPorc[2] := Tmp[1];
  DrawTextANewPorc[3] := Tmp[2];
  DrawTextANewPorc[4] := Tmp[3];
  DrawTextANewPorc[5] := $FF;
  DrawTextANewPorc[6] := $E0;
  DrawTextANewPorc[7] := 0;
  { 读取系统函数内存地址 }
  ReadProcessMemory(ProcessHandle, DrawTextABaseAddress, @DrawTextAOldProc, 8, nSize);
  { 用自己的函数地址覆盖系统的函数地址 }
  WriteProcessMemory(ProcessHandle, DrawTextABaseAddress, @DrawTextANewPorc, 8, nSize);
end;
{------------------------------------}
{过程功能:取消HOOKAPI
{过程参数:无
{------------------------------------}
procedure UnHookAPI;
var
  dwSize: Cardinal;
begin
  WriteProcessMemory(ProcessHandle, DrawTextABaseAddress, @DrawTextAOldProc, 8, dwSize);
end;
end.
//-----------------------------------------------------------------------------------------------------

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Memory_Hss;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  InstallHook: function (SWindow: THandle):Boolean;stdcall;
  UnHook: procedure;stdcall;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  PID : Integer; //窗口的进程和线程ID
  hProcess : THandle;  //用OpenProcess函数游戏进程的句柄
  MyHandle : THandle;
  ModuleHandle: THandle;
begin

  //YB_Handle := FindWindow('TfrmMSNPopForm', 'frmMSNPopForm');
  MyHandle := FindWindow(Pchar(Edit1.Text), Pchar(Edit2.Text));
  if not isWindow(MyHandle) then
  begin
    MessageBox(self.Handle, '没有找到窗口', '!!!', MB_OK);
    exit;
  end;
  ModuleHandle := LoadLibrary('Hook.dll');
  @InstallHook := GetProcAddress(ModuleHandle, 'InstallHook');
  @UnHook := GetProcAddress(ModuleHandle, 'UnHook');
  if InstallHook(MyHandle) then
    ShowMessage('Hook OK');
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  UnHook;
end;

end.

[培训]内核驱动高级班,冲击BAT一流互联网大厂工作,每周日13:00-18:00直播授课

上传的附件:
收藏
免费 0
支持
分享
最新回复 (2)
雪    币: 1205
活跃值: (5094)
能力值: ( LV3,RANK:20 )
在线值:
发帖
回帖
粉丝
2
急急急,提前一下!!!!!!!!!!!
2007-9-30 16:52
0
雪    币: 1205
活跃值: (5094)
能力值: ( LV3,RANK:20 )
在线值:
发帖
回帖
粉丝
3
急急急,提前一下!!!!!!!!!!!

现在再加个用于“挂勾”的目标程序,方便大家调试。

改变文本标题.rar (2007-10-03 22:56, 159.5 KB, 0 次下载)
上传的附件:
2007-10-2 22:44
0
游客
登录 | 注册 方可回帖
返回
//