外部程序控制技术

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

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

 

 

 

 

 

1. unit RaOuterControls;
3. interface
5. uses
6. SysUtils, Classes, Windows, TlHelp32;
8. type
9. TProcessInfo = record
10.     pHandle: Cardinal;
11.     pClassName: string;
12.     pText: string;
13. end;
15. type
16. TOnSendMessage = procedure(Sender: TObject; SndMsgResult: Cardinal) of object;
17. TOnWindowChange = procedure(Sender: TObject) of object;
19. type
20. TRaOuterControls = class(TComponent)
21. private
22.     fProcessHandle: THandle;
23.     fTextList: TStringList;
24.     fHandleList: TStringList;
25.     fClassList: TStringList;
26.     fWindowCaption: string;
27.     fSM: Cardinal;
28.     fSLP: Cardinal;
29.     fSWP: Cardinal;
30.     fSMH: THandle;
31.     fOnSendMessage: TOnSendMessage;
32.     fOnWindowChange: TOnWindowChange;
33.     procedure SetProcessHandle(const Value: THandle);
34.     procedure SetWindowCaption(const Value: string);
35. protected
36.     //function FindExeHandle(AExeName: string): THandle;
37. public
38.     constructor Create(AOwner: TComponent); override;
39.     function GetProcessControlInfo(index: Integer): TProcessInfo;
40.     procedure SendMessageToControl; overload;
41.     procedure SendMessageToControl(hWnd: THandle; Msg: Cardinal; WParam: Cardinal; LParam: Cardinal); overload;
42. published
43.     property OnSendMessage: TOnSendMessage read fOnSendMessage write fOnSendMessage;
44.     property OnWindowChange: TOnWindowChange read fOnWindowChange write fOnWindowChange;
45.     property SndMsgHandle: THandle read fSMH write fSMH;
46.     property SndMessage: Cardinal read fSM write fSM;
47.     property SndLParam: Cardinal read fSLP write fSLP;
48.     property SndWParam: Cardinal read fSWP write fSWP;
49.     property ProcessHandle: THandle read fProcessHandle write SetProcessHandle;
50.     property HandleList: TStringList read fHandleList;
51.     property ClassList: TStringList read fClassList;
52.     property TextList: TStringList read fTextList;
53.     property WindowCaption: string read fWindowCaption write SetWindowCaption;
54. end;
56. var
57. IHandleList: TStringList;
58. IClassList: TStringList;
59. ITextList: TStringList;
61. function EnumChildWndProc(AhWnd: LongInt; AlParam: LParam): boolean; stdcall;
63. procedure Register;
65. implementation
67. procedure Register;
68. begin
69. RegisterComponents('Rarnu Components', [TRaOuterControls]);
70. end;
72. function EnumChildWndProc(AhWnd: LongInt;
73. AlParam: LParam): boolean; stdcall;
74. var
75. WndClassName: array[0..511] of Char;
76. WndCaption: array[0..511] of Char;
77. begin
78. GetClassName(AhWnd, WndClassName, 512); //获取控件名称
79. GetWindowText(AhWnd, WndCaption, 512); //获取控件标题
80. IHandleList.Add(IntToStr(AhWnd));
81. IClassList.Add(string(WndClassName));
82. ITextList.Add(string(WndCaption));
83. result := true;
84. end;
86. { TRaOuterControls }
88. constructor TRaOuterControls.Create(AOwner: TComponent);
89. begin
90. inherited Create(AOwner);
91. fTextList := TStringList.Create;
92. fTextList.Clear;
93. fHandleList := TStringList.Create;
94. fHandleList.Clear;
95. fClassList := TStringList.Create;
96. fClassList.Clear;
97. IHandleList := TStringList.Create;
98. IHandleList.Clear;
99. IClassList := TStringList.Create;
100. IClassList.Clear;
101. ITextList := TStringList.Create;
102. ITextList.Clear;
103. end;
105. function TRaOuterControls.GetProcessControlInfo(
106. index: Integer): TProcessInfo;
107. var
108. piInfo: TProcessInfo;
109. begin
110. piInfo.pHandle := 0;
111. piInfo.pClassName := '';
112. piInfo.pText := '';
113. if fHandleList.Count - 1 < index then
114. begin
115.     result := piInfo;
116.     Exit;
117. end;
118. piInfo.pHandle := StrToInt(fHandleList.Strings[index]);
119. piInfo.pClassName := fClassList.Strings[index];
120. piInfo.pText := fTextList.Strings[index];
121. result := piInfo;
122. end;
124. procedure TRaOuterControls.SendMessageToControl;
125. var
126. SndResult: Cardinal;
127. begin
128. SndResult := SendMessage(fSMH, fSM, fSWP, fSLP);
129. if Assigned(OnSendMessage) then
130.     OnSendMessage(self, SndResult);
131. end;
133. procedure TRaOuterControls.SendMessageToControl(hWnd: THandle; Msg, WParam,
134. LParam: Cardinal);
135. var
136. SndResult: Cardinal;
137. begin
138. SndResult := SendMessage(hWnd, Msg, WParam, LParam);
139. if Assigned(OnSendMessage) then
140.     OnSendMessage(self, SndResult);
141. end;
143. procedure TRaOuterControls.SetProcessHandle(const Value: THandle);
144. begin
145. fProcessHandle := Value;
146. IHandleList.Clear;
147. IClassList.Clear;
148. ITextList.Clear;
149. if fProcessHandle <> 0 then EnumChildWindows(fProcessHandle, @EnumChildWndProc, 0);
150. fTextList := ITextList;
151. fHandleList := IHandleList;
152. fClassList := IClassList;
153. if Assigned(OnWindowChange) then
154.     OnWindowChange(self);
155. end;
157. procedure TRaOuterControls.SetWindowCaption(const Value: string);
158. begin
159. fWindowCaption := Value;
160. ProcessHandle := FindWindow(nil, PChar(fWindowCaption));
161. end;
163. end.

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

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

 

 

 

 

 

1. unit Unit1;
3. interface
5. uses
6. Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7. Dialogs, ExtCtrls, StdCtrls, RaOuterControls;
9. type
10. TForm1 = class(TForm)
11.     RaOuterControls1: TRaOuterControls;
12.     Label1: TLabel;
13.     Timer1: TTimer;
14.     Label2: TLabel;
15.     Memo1: TMemo;
16.     Button1: TButton;
17.     procedure Timer1Timer(Sender: TObject);
18.     procedure FormCreate(Sender: TObject);
19.     procedure Button1Click(Sender: TObject);
20. private
21.     { Private declarations }
22. public
23.     { Public declarations }
24. end;
26. var
27. Form1: TForm1;
28. NotePadHandle:THandle;
30. implementation
32. {$R *.dfm}
34. procedure TForm1.Timer1Timer(Sender: TObject);
35. begin
36. NotePadHandle:=FindWindow(nil,'无标题 - 记事本');
37. if NotePadHandle<>0 then
38.     self.Label1.Caption:='新记事本已打开'
39. else
40.     self.Label1.Caption:='请打开一个空的记事本';
41. end;
43. procedure TForm1.FormCreate(Sender: TObject);
44. begin
45. self.Timer1Timer(self);
46. end;
48. procedure TForm1.Button1Click(Sender: TObject);
49. var
50. i:integer;
51. begin
52. if NotePadHandle=0 then
53. begin
54.     ShowMessage('请打开一个新的记事本');
55.     Exit;
56. end;
57. self.RaOuterControls1.ProcessHandle:=NotePadHandle;
58. //self.ListBox1.Items:=self.RaOuterControls1.ClassList;
59. for i:=0 to self.RaOuterControls1.ClassList.Count-1 do
60. begin
61.     if self.RaOuterControls1.ClassList.Strings[i]='Edit' then
62.     begin
63.       self.RaOuterControls1.SendMessageToControl
64.       (StrToInt(RaOuterControls1.HandleList.Strings[i]),WM_SETTEXT,
65.       0,Cardinal(PChar(memo1.Lines.Text)));
66.       Exit;
67.     end;
68. end;
69. end;
71. end.

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

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

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