HanDs
管理员

[Delphi文章] 外部程序控制技术 



最近做一个项目,需要从外部控制挰序,好比做一个外挂,要获取游戏里各个控件的句柄,然后对它进行操作。在网上查了查,这方面的例子无一例外都是C++的,找不到Delphi的,在几个网站上问了,回答的人都说不知道,并且推荐我用C++进行开发,难道Delphi真的不能对外部程序操作?

经过一天的努力,我证明了Delphi也是可以做到的,并且比C++做起来更方便,我把它做成一个控件,以便随时拖出来就用。

unit RaOuterControls;

interface

uses
SysUtils, Classes, Windows, TlHelp32;

type
TProcessInfo = record
    pHandle: Cardinal;
    pClassName: string;
    pText: string;
end;

type
TOnSendMessage = procedure(Sender: TObject; SndMsgResult: Cardinal) of object;
TOnWindowChange = procedure(Sender: TObject) of object;

type
TRaOuterControls = class(TComponent)
private
    fProcessHandle: THandle;
    fTextList: TStringList;
    fHandleList: TStringList;
    fClassList: TStringList;
    fWindowCaption: string;
    fSM: Cardinal;
    fSLP: Cardinal;
    fSWP: Cardinal;
    fSMH: THandle;
    fOnSendMessage: TOnSendMessage;
    fOnWindowChange: TOnWindowChange;
    procedure SetProcessHandle(const Value: THandle);
    procedure SetWindowCaption(const Value: string);
protected
    //function FindExeHandle(AExeName: string): THandle;
public
    constructor Create(AOwner: TComponent); override;
    function GetProcessControlInfo(index: Integer): TProcessInfo;
    procedure SendMessageToControl; overload;
    procedure SendMessageToControl(hWnd: THandle; Msg: Cardinal; WParam: Cardinal; LParam: Cardinal); overload;
published
    property OnSendMessage: TOnSendMessage read fOnSendMessage write fOnSendMessage;
    property OnWindowChange: TOnWindowChange read fOnWindowChange write fOnWindowChange;
    property SndMsgHandle: THandle read fSMH write fSMH;
    property SndMessage: Cardinal read fSM write fSM;
    property SndLParam: Cardinal read fSLP write fSLP;
    property SndWParam: Cardinal read fSWP write fSWP;
    property ProcessHandle: THandle read fProcessHandle write SetProcessHandle;
    property HandleList: TStringList read fHandleList;
    property ClassList: TStringList read fClassList;
    property TextList: TStringList read fTextList;
    property WindowCaption: string read fWindowCaption write SetWindowCaption;
end;

var
IHandleList: TStringList;
IClassList: TStringList;
ITextList: TStringList;

function EnumChildWndProc(AhWnd: LongInt; AlParam: LParam): boolean; stdcall;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('Rarnu Components', [TRaOuterControls]);
end;

function EnumChildWndProc(AhWnd: LongInt;
AlParam: LParam): boolean; stdcall;
var
WndClassName: array[0..511] of Char;
WndCaption: array[0..511] of Char;
begin
GetClassName(AhWnd, WndClassName, 512); //获取控件名称
GetWindowText(AhWnd, WndCaption, 512); //获取控件标题
IHandleList.Add(IntToStr(AhWnd));
IClassList.Add(string(WndClassName));
ITextList.Add(string(WndCaption));
result := true;
end;

{ TRaOuterControls }

constructor TRaOuterControls.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
fTextList := TStringList.Create;
fTextList.Clear;
fHandleList := TStringList.Create;
fHandleList.Clear;
fClassList := TStringList.Create;
fClassList.Clear;
IHandleList := TStringList.Create;
IHandleList.Clear;
IClassList := TStringList.Create;
IClassList.Clear;
ITextList := TStringList.Create;
ITextList.Clear;
end;

function TRaOuterControls.GetProcessControlInfo(
index: Integer): TProcessInfo;
var
piInfo: TProcessInfo;
begin
piInfo.pHandle := 0;
piInfo.pClassName := '';
piInfo.pText := '';
if fHandleList.Count - 1 < index then
begin
    result := piInfo;
    Exit;
end;
piInfo.pHandle := StrToInt(fHandleList.Strings[index]);
piInfo.pClassName := fClassList.Strings[index];
piInfo.pText := fTextList.Strings[index];
result := piInfo;
end;

procedure TRaOuterControls.SendMessageToControl;
var
SndResult: Cardinal;
begin
SndResult := SendMessage(fSMH, fSM, fSWP, fSLP);
if Assigned(OnSendMessage) then
    OnSendMessage(self, SndResult);
end;

procedure TRaOuterControls.SendMessageToControl(hWnd: THandle; Msg, WParam,
LParam: Cardinal);
var
SndResult: Cardinal;
begin
SndResult := SendMessage(hWnd, Msg, WParam, LParam);
if Assigned(OnSendMessage) then
    OnSendMessage(self, SndResult);
end;

procedure TRaOuterControls.SetProcessHandle(const Value: THandle);
begin
fProcessHandle := Value;
IHandleList.Clear;
IClassList.Clear;
ITextList.Clear;
if fProcessHandle <> 0 then EnumChildWindows(fProcessHandle, @EnumChildWndProc, 0);
fTextList := ITextList;
fHandleList := IHandleList;
fClassList := IClassList;
if Assigned(OnWindowChange) then
    OnWindowChange(self);
end;

procedure TRaOuterControls.SetWindowCaption(const Value: string);
begin
fWindowCaption := Value;
ProcessHandle := FindWindow(nil, PChar(fWindowCaption));
end;

end.
 
   
 
--------------------------------------------------------------------------------
 
  
   
  相信你一定看明白了,EnumChildWndProc其实是一个回调函数,它本身就拥有递归的性质,result:=true表明它可以继续回调,直到条件不成立为止。利用内置API可以方便的完成类名和控件标题的获取,而用C++的话,此时必须先对记录进行声明,这个声明将花费大量的代码。

控件做完后,就开始做一个实例,很简单,我想把我输入在Memo里面的文本直接移动到记事本里,实现代码如下:

unit Unit1;

interface

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

type
TForm1 = class(TForm)
    RaOuterControls1: TRaOuterControls;
    Label1: TLabel;
    Timer1: TTimer;
    Label2: TLabel;
    Memo1: TMemo;
    Button1: TButton;
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
private
    { Private declarations }
public
    { Public declarations }
end;

var
Form1: TForm1;
NotePadHandle:THandle;

implementation

{$R *.dfm}

procedure TForm1.Timer1Timer(Sender: TObject);
begin
NotePadHandle:=FindWindow(nil,'无标题 - 记事本');
if NotePadHandle<>0 then
    self.Label1.Caption:='新记事本已打开'
else
    self.Label1.Caption:='请打开一个空的记事本';
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
self.Timer1Timer(self);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
i:integer;
begin
if NotePadHandle=0 then
begin
    ShowMessage('请打开一个新的记事本');
    Exit;
end;
self.RaOuterControls1.ProcessHandle:=NotePadHandle;
//self.ListBox1.Items:=self.RaOuterControls1.ClassList;
for i:=0 to self.RaOuterControls1.ClassList.Count-1 do
begin
    if self.RaOuterControls1.ClassList.Strings[i]='Edit' then
    begin
      self.RaOuterControls1.SendMessageToControl
      (StrToInt(RaOuterControls1.HandleList.Strings[i]),WM_SETTEXT,
      0,Cardinal(PChar(memo1.Lines.Text)));
      Exit;
    end;
end;
end;

end.

除去大部分系统生成的代码外,几乎都是对控件的操作,这里提一下,虽然PCHAR保留过程返回的值是AnsiString,但是却可以用数值形转换,这里用Cardinal进行了转换,但是实际用中,个人认为还是用LongInt转换比较好,LongInt可以与其他开发平台兼容,而Cardinal仅局限于delphi中。它的原理是把文本转成整型数组的形式存到内存中,然后通过SendMessage函数进行发送。

在遍历中,由于事先知道控件的名称,所以直接用了判断,如果不知道的话还需进一步判断。我在这个控件中封装了GetProcessControlInfo函数,它返回选中的一个记录,使用起来会更加的方便。

测试一下做好的程序,果然,原来在窗体上的文本已经跑到记事本里面去了。

源码下载:http://rarnu.ys168.com/

Delphi技术目录内->外部程序操作.rar


学习中请遵守法律法规,本网站内容均来自于互联网,本网站不负担法律责任
外部 程序 控制 技术
#1楼
发帖时间:2016-7-9   |   查看数:0   |   回复数:0
游客组
快速回复