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