main.pas

hook简单应付用,希望可以给大家一些帮助. 谢谢大家,我要下载一个东西,所以传一个源码

unit Main;

interface

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

type
  TFrmMain = class(TForm)
    Label2: TLabel;
    Label3: TLabel;
    Memo1: TMemo;
    EdtRow: TEdit;
    EdtCol: TEdit;
    BtnHook: TButton;
    BtnUnhook: TButton;
    BtnQueryRC: TButton;
    BtnHookCell: TButton;
    BtnRow: TButton;
    BtnCol: TButton;
    procedure BtnHookClick(Sender: TObject);
    procedure BtnUnhookClick(Sender: TObject);
    procedure BtnQueryRCClick(Sender: TObject);
    procedure BtnHookCellClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure BtnRowClick(Sender: TObject);
    procedure BtnColClick(Sender: TObject);
  private
    { Private declarations }
    procedure CMMsgWndCreated(var Message: TMessage); message CM_MSGWNDCREATED;
  public
    { Public declarations }
  end;

var
  FrmMain: TFrmMain;

implementation

{$R *.dfm}

var
  hLib: THandle;
  InstallHook: procedure (MainWnd, DestWnd: HWND); stdcall;
  UninstallHook: procedure ; stdcall;
  GetHookedCell: function : PChar; stdcall;

var
  MsgWnd, DestMain, DestWnd: HWND;

procedure TFrmMain.BtnHookClick(Sender: TObject);
begin
  if hLib = 0 then hLib := LoadLibrary('HookSG.dll');
  @InstallHook := GetProcAddress(hLib, 'InstallHook');
  @UninstallHook := GetProcAddress(hLib, 'UninstallHook');
  @GetHookedCell := GetProcAddress(hLib, 'GetHookedCell');

  DestMain := FindWindow('TFrmSGHooked', 'StringGrid to be hooked');
  DestWnd := FindWindowEx(DestMain, 0, 'TStringGrid', nil);
  if DestWnd = 0 then
  begin
    ShowMessage('被Hook的程序可能还没有启动，StringGrid没有找到！');
    Exit;
  end;
  MsgWnd := 0;
  InstallHook(Handle, DestWnd);
  SendMessage(HWND_BROADCAST, WM_SETTINGCHANGE, 0, 0);
  PostMessage(DestMain, WM_NULL, 0, 0);
  BtnHook.Enabled := False;
  BtnUnhook.Enabled := True;
end;

procedure TFrmMain.BtnUnhookClick(Sender: TObject);
begin
  UninstallHook;
  SendMessage(HWND_BROADCAST, WM_SETTINGCHANGE, 0, 0);
  BtnHook.Enabled := True;
  BtnUnhook.Enabled := False;
  BtnQueryRC.Enabled := False;
  BtnHookCell.Enabled := False;
  BtnRow.Enabled := False;
  BtnCol.Enabled := False;
end;

procedure TFrmMain.CMMsgWndCreated(var Message: TMessage);
begin
  MsgWnd := Message.WParam;
  if Message.LParam = 1 then
    Memo1.Lines.Add(Format('隐形消息窗口已经被创建(句柄：%.8x)', [MsgWnd]))
  else
    Memo1.Lines.Add(Format('隐形消息窗口已经被销毁(句柄：%.8x)', [MsgWnd]));
  BtnQueryRC.Enabled := Message.LParam = 1;
  BtnHookCell.Enabled := Message.LParam = 1;
  BtnRow.Enabled := Message.LParam = 1;
  BtnCol.Enabled := Message.LParam = 1;
end;

procedure TFrmMain.BtnQueryRCClick(Sender: TObject);
var
  R, C: Integer;
begin
  R := SendMessage(MsgWnd, CM_QUERYROW, 0, 0);
  C := SendMessage(MsgWnd, CM_QUERYCOL, 0, 0);
  Memo1.Lines.Add(Format('行数：%d；列数：%d', [R, C]));
end;

procedure TFrmMain.BtnHookCellClick(Sender: TObject);
var
  R, C, Len: Integer;
begin
  if not TryStrToInt(EdtCol.Text, C) or not TryStrToInt(EdtRow.Text, R) then
  begin
    ShowMessage('行/列输入不合法！');
    Exit;
  end;
  Len := SendMessage(MsgWnd, CM_HOOKCELL, C, R);
  if Len < 0 then
  begin
    Memo1.Lines.Add(Format('行列(%d，%d)索引超界！', [R, C]));
    Exit;
  end;
  Memo1.Lines.Add('');
  Memo1.Lines.Add(Format('Cell[%2d,%2d]内容：%s (长度：%d)', [C, R, GetHookedCell, Len]));
end;

procedure TFrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if BtnUnhook.Enabled then BtnUnhookClick(nil);
  if hLib <> 0 then FreeLibrary(hLib);
end;

procedure TFrmMain.BtnRowClick(Sender: TObject);
var
  R, C, RY, X, Len: Integer;
begin
  if not TryStrToInt(EdtRow.Text, RY) then
  begin
    ShowMessage('行输入不合法！');
    Exit;
  end;
  R := SendMessage(MsgWnd, CM_QUERYROW, 0, 0);
  C := SendMessage(MsgWnd, CM_QUERYCOL, 0, 0);
  if (RY < 0) or (RY >= R) then
  begin
    Memo1.Lines.Add(Format('行索引(%d)超界！', [RY]));
    Exit;
  end;
  Memo1.Lines.Add('');
  for X := 0 to C - 1 do
  begin
    Len := SendMessage(MsgWnd, CM_HOOKCELL, X, RY);
    Memo1.Lines.Add(Format('Cell[%2d,%2d]内容：%s (长度：%d)', [X, RY, GetHookedCell, Len]));
  end;
end;

procedure TFrmMain.BtnColClick(Sender: TObject);
var
  R, C, CX, Y, Len: Integer;
begin
  if not TryStrToInt(EdtCol.Text, CX) then
  begin
    ShowMessage('列输入不合法！');
    Exit;
  end;
  R := SendMessage(MsgWnd, CM_QUERYROW, 0, 0);
  C := SendMessage(MsgWnd, CM_QUERYCOL, 0, 0);
  if (CX < 0) or (CX >= C) then
  begin
    Memo1.Lines.Add(Format('列索引(%d)超界！', [CX]));
    Exit;
  end;
  Memo1.Lines.Add('');
  for Y := 0 to R - 1 do
  begin
    Len := SendMessage(MsgWnd, CM_HOOKCELL, CX, Y);
    Memo1.Lines.Add(Format('Cell[%2d,%2d]内容：%s (长度：%d)', [CX, Y, GetHookedCell, Len]));
  end;
end;

end.