1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
|
WaitForSingleObject
If we ever need to run an external application and wait until it
terminates, then we would have to do without ShellExecute and resort
to more basic functions, like CreateProcess, WaitForSingleObject and
CloseHandle.
uses Forms, Windows;
procedure TForm1.Button1Click(Sender: TObject);
var
proc_info: TProcessInformation;
startinfo: TStartupInfo;
ExitCode: longword;
begin
// Initialize the structures
FillChar(proc_info, sizeof(TProcessInformation), 0);
FillChar(startinfo, sizeof(TStartupInfo), 0);
startinfo.cb := sizeof(TStartupInfo);
// Attempts to create the process
if CreateProcess('c:\windows\notepad.exe', nil, nil,
nil, false, NORMAL_PRIORITY_CLASS, nil, nil,
startinfo, proc_info) <> False then begin
// The process has been successfully created
// No let's wait till it ends...
WaitForSingleObject(proc_info.hProcess, INFINITE);
// Process has finished. Now we should close it.
GetExitCodeProcess(proc_info.hProcess, ExitCode); // Optional
CloseHandle(proc_info.hThread);
CloseHandle(proc_info.hProcess);
Application.MessageBox(
PChar(Format('Notepad finished! (Exit code=%d)', [ExitCode])),
'Info', MB_ICONINFORMATION);
end else begin
// Failure creating the process
Application.MessageBox('Couldn''t execute the '
+ 'application', 'Error', MB_ICONEXCLAMATION);
end;//if
end;
Problems
We have experienced problems with WaitForSingleObject
in combination with certain applications and we had to finish them with
the task manager. Other applications apparently fail to finish correctly
and WaitForSingleObject never returns. Appart from that, an application
does not respond to events while it waits and this means that for
example the forms won't repaint...
A possible workaround to these problems is checking the status of the
launched application (calling GetExitCodeProcess) at intervals (in a timer
event).
uses Forms, Windows, StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
btnExecute: TButton;
btnCancel: TButton;
Timer1: TTimer;
procedure FormCreate(Sender: TObject);
procedure btnExecuteClick(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure btnCancelClick(Sender: TObject);
procedure FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
private
proc_info: TProcessInformation;
startinfo: TStartupInfo;
ExitCode: LongWord;
end;
implementation
procedure TForm1.FormCreate(Sender: TObject);
begin
btnCancel.Enabled := False;
Timer1.Enabled := False;
Timer1.Interval := 200;
end;
procedure TForm1.btnExecuteClick(Sender: TObject);
begin
FillChar(proc_info, sizeof(TProcessInformation), 0);
FillChar(startinfo, sizeof(TStartupInfo), 0);
startinfo.cb := sizeof(TStartupInfo);
if CreateProcess(nil, 'c:\windows\notepad.exe', nil,
nil, false, CREATE_DEFAULT_ERROR_MODE
+ NORMAL_PRIORITY_CLASS, nil, nil, startinfo,
proc_info) then begin
btnExecute.Enabled := False;
btnCancel.Enabled := True;
Timer1.Enabled := True;
end else begin
CloseHandle(proc_info.hProcess);
Application.MessageBox('Couldn''t execute the '
+ 'application', 'Error', MB_ICONEXCLAMATION);
end;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
Timer1.Enabled := False;
if GetExitCodeProcess(proc_info.hProcess, ExitCode)
then
if ExitCode = STILL_ACTIVE then
Timer1.Enabled := True
else begin
btnCancel.Enabled := False;
btnExecute.Enabled := True;
CloseHandle(proc_info.hProcess);
end
else begin
btnCancel.Enabled := False;
btnExecute.Enabled := True;
TerminateProcess(proc_info.hProcess, 0);
CloseHandle(proc_info.hProcess);
end;
end;
procedure TForm1.btnCancelClick(Sender: TObject);
begin
Timer1.Enabled := False;
if Application.MessageBox('You should try to finish'
+ ' the application normally.'#13#13'¿Terminate it '
+ 'anyway?', 'Warning', MB_YESNO + MB_DEFBUTTON2 +
MB_ICONQUESTION + MB_TASKMODAL) = ID_YES then begin
TerminateProcess(proc_info.hProcess, 0);
CloseHandle(proc_info.hProcess);
btnCancel.Enabled := False;
btnExecute.Enabled := True;
end else begin
Timer1.Enabled := True;
end;
end;
procedure TForm1.FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
begin
if btnCancel.Enabled then begin
btnCancelClick(Sender);
if btnCancel.Enabled then CanClose := False;
end;
end;
If we ever need to run an external application and wait until it
terminates, then we would have to do without ShellExecute and resort
to more basic functions, like CreateProcess, WaitForSingleObject and
CloseHandle.
uses Forms, Windows;
procedure TForm1.Button1Click(Sender: TObject);
var
proc_info: TProcessInformation;
startinfo: TStartupInfo;
ExitCode: longword;
begin
// Initialize the structures
FillChar(proc_info, sizeof(TProcessInformation), 0);
FillChar(startinfo, sizeof(TStartupInfo), 0);
startinfo.cb := sizeof(TStartupInfo);
// Attempts to create the process
if CreateProcess('c:\windows\notepad.exe', nil, nil,
nil, false, NORMAL_PRIORITY_CLASS, nil, nil,
startinfo, proc_info) <> False then begin
// The process has been successfully created
// No let's wait till it ends...
WaitForSingleObject(proc_info.hProcess, INFINITE);
// Process has finished. Now we should close it.
GetExitCodeProcess(proc_info.hProcess, ExitCode); // Optional
CloseHandle(proc_info.hThread);
CloseHandle(proc_info.hProcess);
Application.MessageBox(
PChar(Format('Notepad finished! (Exit code=%d)', [ExitCode])),
'Info', MB_ICONINFORMATION);
end else begin
// Failure creating the process
Application.MessageBox('Couldn''t execute the '
+ 'application', 'Error', MB_ICONEXCLAMATION);
end;//if
end;
Problems
We have experienced problems with WaitForSingleObject in combination
with certain applications and we had to finish them with the task
manager. Other applications apparently fail to finish correctly and
WaitForSingleObject never returns. Appart from that, an application
does not respond to events while it waits and this means that for
example the forms won't repaint...
A possible workaround to these problems is checking the status of the
launched application (calling GetExitCodeProcess) at intervals (in a timer
event).
uses Forms, Windows, StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
btnExecute: TButton;
btnCancel: TButton;
Timer1: TTimer;
procedure FormCreate(Sender: TObject);
procedure btnExecuteClick(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure btnCancelClick(Sender: TObject);
procedure FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
private
proc_info: TProcessInformation;
startinfo: TStartupInfo;
ExitCode: LongWord;
end;
implementation
procedure TForm1.FormCreate(Sender: TObject);
begin
btnCancel.Enabled := False;
Timer1.Enabled := False;
Timer1.Interval := 200;
end;
procedure TForm1.btnExecuteClick(Sender: TObject);
begin
FillChar(proc_info, sizeof(TProcessInformation), 0);
FillChar(startinfo, sizeof(TStartupInfo), 0);
startinfo.cb := sizeof(TStartupInfo);
if CreateProcess(nil, 'c:\windows\notepad.exe', nil,
nil, false, CREATE_DEFAULT_ERROR_MODE
+ NORMAL_PRIORITY_CLASS, nil, nil, startinfo,
proc_info) then begin
btnExecute.Enabled := False;
btnCancel.Enabled := True;
Timer1.Enabled := True;
end else begin
CloseHandle(proc_info.hProcess);
Application.MessageBox('Couldn''t execute the '
+ 'application', 'Error', MB_ICONEXCLAMATION);
end;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
Timer1.Enabled := False;
if GetExitCodeProcess(proc_info.hProcess, ExitCode)
then
if ExitCode = STILL_ACTIVE then
Timer1.Enabled := True
else begin
btnCancel.Enabled := False;
btnExecute.Enabled := True;
CloseHandle(proc_info.hProcess);
end
else begin
btnCancel.Enabled := False;
btnExecute.Enabled := True;
TerminateProcess(proc_info.hProcess, 0);
CloseHandle(proc_info.hProcess);
end;
end;
procedure TForm1.btnCancelClick(Sender: TObject);
begin
Timer1.Enabled := False;
if Application.MessageBox('You should try to finish'
+ ' the application normally.'#13#13'¿Terminate it '
+ 'anyway?', 'Warning', MB_YESNO + MB_DEFBUTTON2 +
MB_ICONQUESTION + MB_TASKMODAL) = ID_YES then begin
TerminateProcess(proc_info.hProcess, 0);
CloseHandle(proc_info.hProcess);
btnCancel.Enabled := False;
btnExecute.Enabled := True;
end else begin
Timer1.Enabled := True;
end;
end;
procedure TForm1.FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
begin
if btnCancel.Enabled then begin
btnCancelClick(Sender);
if btnCancel.Enabled then CanClose := False;
end;
end; |
