Author Jonas Bilinkevicius
I have a CD-ROM catalog Paradox application. When it is run, it checks if the BDE
is installed. If it raises an exception, I do:
1
2 ShellExecute(handle, 'open', PChar(ExtractFilePath(Application.ExeName) +
3 'BDESetup\Setup.exe), '', nil , SW_SW_SHOWMINNOACTIVE);
My problem is, that the application continues to run before the BDE is installed.
Answer:
The following unit contains two functions that might solve your problem.
The two functions defined in the unit below provide two alternative ways to allow
an application to call another application and wait for it to exit before
continuing. The called application can be a Win32 app, a Win16 app, or a DOS app.
To call a batch file or an internal command.com or cmd.exe command, use something
like: 'command.com' or 'cmd.exe' as the app, and '/c dir' as the parameter.
If you want the user to see the app's window, then pass SW_SHOW as the Visibility
parameter. If you want to hide it, pass SW_HIDE (defined in Windows.pas).
If the called application cannot be run, then the function returns false, and you
can use GetLastError to get an error code, and use SysErrorMessage to turn that
into a text error message, if necessary.
If the called application runs, then the function returns true. If the called
application runs, but signals an abnormal termination by setting its Exit Code to a
non-zero value (rare among Windows applications) but common among DOS utilities),
then this Exit Code can be seen in the final var parameter ResultingExitCode.
The wait loop includes a Windows message loop which explicitly looks out for a
wm_Quit message to allow the calling application to be closed even if the called
application hangs.
4 unit Exec;
5
6 {
7 Author: Bill Sparrow (bsparrow@cix.co.uk)
8 Revision history in reverse chronological order:-
9 13/10/1999 WFS Original version, tested only in Delphi 3 on NT4 SP3.
10
11 Acknowledgements: the code borrows heaviliy from two contributions
12 posted on the CIX Conferencing system, one of which in turn borrows
13 from a Compuserve posting:
14
15 magsys@cix.co.uk cix:borland/3delphi32:3488 29/07/1998.
16 Francis PARLANT CIS : 100113,3015.
17 jatkins@cix.co.uk cix:borland/6delphi:3540 01/11/1998
18 }
19
20 interface
21
22 uses Windows;
23
24 function ShellExecAndWait(App, Params: string; Visibility: Integer;
25 var ResultingExitCode: DWord): Boolean;
26
27 function CreateProcAndWait(App, Params: string; Visibility: Word;
28 var ResultingExitCode: DWord): Boolean;
29
30 implementation
31
32 uses
33 shellAPI, {for ShellExecuteEx, TShellExecuteInfo, etc.}
34 Messages; {for WM_QUIT}
35
36 {
37 Based on a version from jatkins@cix.co.uk cix: borland / 6 delphi: 3540
38 01 / 11 / 1998
39 }
40
41 {
42 One advantage of ShellExecuteEx is that it can find the path to the executable
43 without you having to specify it in full, so long as the app has set a registry key
44 under the appropriate App Paths branch.
45
46 Another is that instead of passing an application name plus a document filename as
47 a parameter, you can just pass the document name. So long as the document file type
48 has an association, Windows will find the appropriate application to open the
49 document.
50
51 ShellExecuteEx is presumably what gets called when you double click a file in
52 Windows Explorer to open it.
53
54 Without SEE_MASK_FLAG_NO_UI, if ShellExecuteEx encounters an error, it will display
55 an error dialog to the user before returning False. Furthermore, the text of the
56 error dialog may be an inappropriate level for the user. For instance, if you try
57 to open a document for which there is no association, the error dialog tells the
58 user to set up an association. Turning off the UI allows us to handle the error
59 ourselves and put up an error dialog if appropriate.
60 }
61
62 function ShellExecAndWait(App, Params: string; Visibility: Integer;
63 var ResultingExitCode: DWord): Boolean;
64 var
65 Msg: TMsg;
66 E: TShellExecuteInfo;
67 begin
68 FillChar(E, SizeOf(E), 0); {Superfulous, but what the heck!}
69 E.cbSize := sizeof(E);
70 E.fMask := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_FLAG_NO_UI;
71 E.wnd := 0; {Still not sure about leaving this at zero}
72 E.lpVerb := nil; {Defaults to 'open'}
73 E.lpFile := PChar(App); {Application or document to open}
74 E.lpParameters := PChar(Params); {Optional Command line parameter to pass}
75 E.lpDirectory := nil; {Defaults to current directory}
76 E.nShow := Visibility; {E.g. SW_SHOW or SW_HIDE}
77 if ShellExecuteEx(@E) then
78 begin
79 repeat
80 while PeekMessage(Msg, 0, 0, 0, pm_Remove) do
81 begin
82 if Msg.message = wm_Quit then
83 Halt(Msg.WParam);
84 TranslateMessage(Msg);
85 DispatchMessage(Msg);
86 end;
87 until
88 WaitForSingleObject(E.hProcess, 50) <> WAIT_TIMEOUT;
89 GetExitCodeProcess(E.hProcess, ResultingExitCode);
90 CloseHandle(E.hProcess); {Prevent leakage}
91 Result := True; {ShellExecuteEx succeeded}
92 end
93 else
94 begin
95 ResultingExitCode := 1; {Just so that it is not left undefined}
96 Result := False; {ShellExecuteEx failed}
97 end;
98 end;
99
100 {From the Win32 help for CreateProcess...
101
102 "The created process remains in the system until all threads within the process have
103 terminated and all handles to the process and any of its threads have been closed
104 through calls to CloseHandle.The handles for both the process and the main
105 thread must be closed through calls to CloseHandle.If these handles are not needed,
106 it is best to close them immediately after the process is created."
107
108 Testing this under NT4 shows a memory leak of 12 K if you don't close the handles.
109 }
110
111 {Based on a version from magsys@cix.co.uk cix:borland/3delphi32:3488
112 29/07/1998.}
113
114 function CreateProcAndWait(App, Params: string; Visibility: Word;
115 var ResultingExitCode: DWord): Boolean;
116 var
117 Msg: TMsg;
118 SI: TStartupInfo;
119 PI: TProcessInformation;
120 CommandLine: string;
121 begin
122 FillChar(SI, SizeOf(SI), 0);
123 SI.cb := SizeOf(SI);
124 SI.dwFlags := STARTF_USESHOWWINDOW or STARTF_FORCEONFEEDBACK;
125 SI.wShowWindow := Visibility; {E.g. SW_SHOW or SW_HIDE}
126
127 {The first whitespace-delimited 'parameter' in the lpCommandLine needs to be the
128 app's path and file name if any following 'real' parameters are to be correctly
129 seen by the called application.
130 Setting lpApplicationName is optional so long as we comply with the above. If
131 we did also set lpApplicationName, however, we would have to ensure that the copy
132 in
133 lpCommandLine was in quotes in case it contains a space. If we leave
134 lpApplicationName as nil, Windows takes care of this problem for us. Also, if the
135 called app is 16 bit, we have to do it this way! On second thoughts, relying on
136 Windows to do the quoting would leave us
137 open to an ambiguity, so do it explicitly.}
138
139 {If the app's filename contains a space, and is not already quoted, then quote
140 it...}
141 if (Pos(' ', App) <> 0) and (Pos('"', App) = 0) then
142 CommandLine := '"' + App + '"'
143 else
144 CommandLine := App;
145 {Join the App and the Params into one string with a space between them...}
146 if (App <> '') and (Params <> '') then
147 CommandLine := CommandLine + ' ';
148 CommandLine := CommandLine + Params;
149 if CreateProcess(nil, PChar(CommandLine), nil, nil, False, 0, nil, nil, SI, PI)
150 then
151 begin
152 repeat
153 while PeekMessage(Msg, 0, 0, 0, pm_Remove) do
154 begin
155 if Msg.message = wm_Quit then
156 Halt(Msg.WParam);
157 TranslateMessage(Msg);
158 DispatchMessage(Msg);
159 end;
160 until
161 WaitForSingleObject(PI.hProcess, 50) <> WAIT_TIMEOUT;
162 GetExitCodeProcess(PI.hProcess, ResultingExitCode);
163 CloseHandle(PI.hThread); {Prevent leakage}
164 CloseHandle(PI.hProcess); {Prevent leakage}
165 Result := True; {CreateProcess succeeded}
166 end
167 else
168 begin
169 ResultingExitCode := 1; {Just so that it is not left undefined}
170 Result := False; {CreateProcess failed}
171 end;
172 end;
173
174 end.
|
