I use the folowing function to start MS Word and open a file. This is done OK but the Word app is not maximized on top of my application. Is that not possible to add to my function?
function TFiles.ExecuteAndWait(const aFile: string; aParam: string = ''; const aHidden: boolean = False): integer;
var
SEInfo: TShellExecuteInfo;
ExitCode: DWORD;
begin
FillChar(SEInfo, SizeOf(SEInfo), 0) ;
SEInfo.cbSize := SizeOf(TShellExecuteInfo) ;
with SEInfo do
begin
fMask := SEE_MASK_NOCLOSEPROCESS;
Wnd := Application.Handle;
lpFile := PChar(aFile) ;
lpParameters := PChar(aParam) ;
if aHidden = True then
nShow := SW_HIDE
else
nShow := SW_SHOWNORMAL;
end;
if ShellExecuteEx(#SEInfo) then
begin
repeat
Application.ProcessMessages;
GetExitCodeProcess(SEInfo.hProcess, ExitCode) ;
until (ExitCode <> STILL_ACTIVE) Or Application.Terminated;
Result := ExitCode;
end
else
Result := -1;
end;
There are a few problems here:
Pass SW_MAXIMIZE if you want the window to be maximized.
You leak the process handle. Call CloseHandle when you have finished with the process handle.
The busy loop works, but is clumsy. You should use a wait function. Either in a separate thread use WaitForSingleObject. Or if you must wait in the main thread, and must use ProcessMessages, use MsgWaitForMultipleObjects.
Related
I am a Delphi developer in our company. We need a function which launches a command-line executable and get its return value.
The code I wrote, and all the examples I found on the Internet, do this via CreateProcess(), but my boss rejected this and told me that there MUST be a solution doing this via ShellExecute(). I can't find any example on the Internet doing this with ShellExecute(). All of them use CreateProcess().
Below are 3 methods I delivered to my boss. He did not like ShellExecute_AndGetReturnValue(). It's named "ShellExecute", but it does not use ShellExecute().
All of these 3 methods are working fine. But the first one is not using ShellExecute(). Instead it is using CreateProcess().
So, is it possible to solve/change the ShellExecute_AndGetReturnValue() method so that it will use ShellExecute() instead of CreateProcess()? All examples I found, all of them, use CreateProcess().
function ShellExecute_AndGetReturnValue(FileName : string; Params : string = ''; Show : Integer = SW_HIDE; WorkingDir : string = '') : string;
const
READ_BUFFER_SIZE = 2048;
var
Security: TSecurityAttributes;
readableEndOfPipe, writeableEndOfPipe, readableErrorEndOfPipe, writeableErrorEndOfPipe: THandle;
start: TStartUpInfo;
ProcessInfo: TProcessInformation;
Buffer: PAnsiChar;
BytesRead: DWORD;
AppRunning: DWORD;
ResultStdOutput : string;
ResultErrOutput : string;
lpDirectory : PAnsiChar;
CmdLine : string;
begin
Result := '';
Security.nLength := SizeOf(TSecurityAttributes);
Security.bInheritHandle := True;
Security.lpSecurityDescriptor := nil;
if CreatePipe(readableEndOfPipe, writeableEndOfPipe, #Security, 0) then
begin
Buffer := AllocMem(READ_BUFFER_SIZE + 1);
FillChar(Start, Sizeof(Start), #0);
FillChar(ProcessInfo, SizeOf(ProcessInfo), #0);
start.cb := SizeOf(start);
start.dwFlags := start.dwFlags or STARTF_USESTDHANDLES;
start.hStdInput := GetStdHandle(STD_INPUT_HANDLE);
start.hStdOutput := writeableEndOfPipe;
CreatePipe(readableErrorEndOfPipe, writeableErrorEndOfPipe, #Security, 0);
start.hStdError := writeableErrorEndOfPipe;
start.hStdError := writeableEndOfPipe;
start.dwFlags := start.dwFlags + STARTF_USESHOWWINDOW;
start.wShowWindow := Show;
UniqueString(FileName);
CmdLine := '"' + FileName + '" ' + Params;
if WorkingDir <> '' then
begin
lpDirectory := PAnsiChar(WorkingDir);
end else
begin
lpDirectory := PAnsiChar(ExtractFilePath(FileName));
end;
if CreateProcess(nil, PChar(CmdLine), nil, nil, True, NORMAL_PRIORITY_CLASS, nil, lpDirectory, start, ProcessInfo) then
begin
repeat
Apprunning := WaitForSingleObject(ProcessInfo.hProcess, 100);
Application.ProcessMessages;
until (Apprunning <> WAIT_TIMEOUT);
ResultStdOutput := '';
ResultErrOutput := '';
//Must Close write Handles before reading (if the console application does not output anything)
CloseHandle(writeableEndOfPipe);
CloseHandle(writeableErrorEndOfPipe);
repeat
BytesRead := 0;
ReadFile(readableEndOfPipe, Buffer[0], READ_BUFFER_SIZE, BytesRead, nil);
Buffer[BytesRead]:= #0;
OemToAnsi(Buffer,Buffer);
ResultStdOutput := ResultStdOutput + String(Buffer);
until (BytesRead < READ_BUFFER_SIZE);
if start.hStdOutput <> start.hStdError then
begin
BytesRead := 0;
ReadFile(readableErrorEndOfPipe, Buffer[0], READ_BUFFER_SIZE, BytesRead, nil);
Buffer[BytesRead]:= #0;
OemToAnsi(Buffer,Buffer);
ResultErrOutput := ResultErrOutput + String(Buffer);
end;
end;
Result := ResultStdOutput;
FreeMem(Buffer);
CloseHandle(ProcessInfo.hProcess);
CloseHandle(ProcessInfo.hThread);
CloseHandle(readableEndOfPipe);
CloseHandle(readableErrorEndOfPipe);
end;
end;
procedure ShellExecute_NoWait(FileName : string; Params : string = ''; Action : string = 'open'; Show : Integer = SW_SHOWNORMAL; WorkingDir : string = '');
var
exInfo: TShellExecuteInfo;
Ph: DWORD;
begin
FillChar(exInfo, SizeOf(exInfo), 0);
with exInfo do
begin
cbSize := SizeOf(exInfo);
fMask := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_FLAG_DDEWAIT;
Wnd := GetActiveWindow();
lpVerb := PAnsiChar(Action);
lpParameters := PChar(Params);
lpFile := PChar(FileName);
nShow := Show;
if WorkingDir <> '' then
begin
lpDirectory := PAnsiChar(WorkingDir);
end else
begin
lpDirectory := PAnsiChar(ExtractFilePath(FileName));
end;
end;
if ShellExecuteEx(#exInfo) then
begin
Ph := exInfo.HProcess;
CloseHandle(Ph);
end;
end;
procedure ShellExecute_AndWait(FileName : string; Params : string = ''; Action : string = 'open'; Show : Integer = SW_SHOWNORMAL; WorkingDir : string = '');
var
exInfo: TShellExecuteInfo;
Ph: DWORD;
begin
FillChar(exInfo, SizeOf(exInfo), 0);
with exInfo do
begin
cbSize := SizeOf(exInfo);
fMask := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_FLAG_DDEWAIT;
Wnd := GetActiveWindow();
lpVerb := PAnsiChar(Action);
lpParameters := PChar(Params);
lpFile := PChar(FileName);
nShow := Show;
if WorkingDir <> '' then
begin
lpDirectory := PAnsiChar(WorkingDir);
end else
begin
lpDirectory := PAnsiChar(ExtractFilePath(FileName));
end;
end;
if ShellExecuteEx(#exInfo) then
begin
Ph := exInfo.HProcess;
while WaitForSingleObject(ExInfo.hProcess, 50) <> WAIT_OBJECT_0 do
begin
Application.ProcessMessages;
end;
CloseHandle(Ph);
end;
end;
Task from your boss is not fully correct. Problem is that the generic solution of ShellExecute – is not start cmd.exe, this command starts an application that is linked to this type of file and starts it. So, to make it work like you want – it needs a lot of work.
One more thing – do you need to get the result of work of your program or console output of your program?
Here is modified part of sources from jcl library to return return code:
function PCharOrNil(const S: string): PChar;
begin
Result := Pointer(S);
end;
// memory initialization
procedure ResetMemory(out P; Size: Longint);
begin
if Size > 0 then
begin
Byte(P) := 0;
FillChar(P, Size, 0);
end;
end;
function ShellExecAndWait(const FileName: string; const Parameters: string;
const Verb: string; CmdShow: Integer; const Directory: string): cardinal;
var
Sei: TShellExecuteInfo;
Res: LongBool;
Msg: tagMSG;
ShellResult : boolean;
begin
ResetMemory(Sei, SizeOf(Sei));
Sei.cbSize := SizeOf(Sei);
Sei.fMask := SEE_MASK_DOENVSUBST or SEE_MASK_FLAG_NO_UI or SEE_MASK_NOCLOSEPROCESS or
SEE_MASK_FLAG_DDEWAIT or SEE_MASK_NOASYNC;
Sei.lpFile := PChar(FileName);
Sei.lpParameters := PCharOrNil(Parameters);
Sei.lpVerb := PCharOrNil(Verb);
Sei.nShow := CmdShow;
Sei.lpDirectory := PCharOrNil(Directory);
{$TYPEDADDRESS ON}
ShellResult := ShellExecuteEx(#Sei);
{$IFNDEF TYPEDADDRESS_ON}
{$TYPEDADDRESS OFF}
{$ENDIF ~TYPEDADDRESS_ON}
if ShellResult then begin
WaitForInputIdle(Sei.hProcess, INFINITE);
while WaitForSingleObject(Sei.hProcess, 10) = WAIT_TIMEOUT do
repeat
Msg.hwnd := 0;
Res := PeekMessage(Msg, Sei.Wnd, 0, 0, PM_REMOVE);
if Res then
begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
until not Res;
if not GetExitCodeProcess(Sei.hProcess, Result) then
raise Exception.Create('GetExitCodeProcess fail');
CloseHandle(Sei.hProcess);
end else begin
raise Exception.Create('ShellExecuteEx fail');
end;
end;
procedure TForm2.Button1Click(Sender: TObject);
var
xResult : cardinal;
begin
xResult := ShellExecAndWait('ping.exe', '', '', 1, ''); //xResult = 1
xResult := ShellExecAndWait('ping.exe', '8.8.8.8', '', 1, ''); //xResult = 0
end;
If you need to specify input/output pipes (to control stdin and stdout of the called process) then ShellExecute cannot be used. It simply does not support specifying these. Neither does ShellExecuteEx.
So the only option you have if you must use ShellExecute is to ShellExecute the command processor (CMD.EXE) and ask it to perform the redirection of input and output. This will limit your redirection source and target to physical files on the disk, as that's the way CMD.EXE allows redirection (>StdOut <StdIn).
Othwewise, your approach with CreateProcess is the way forward. What does your boss give as reason that you must use ShellExecute?
If you don't need redirection support, you can use ShellExecuteEx and then after a successful execution, you can obtain the Handle to the running process in Info.hProcess (Info is the TShellExecuteInfo structure passed to ShellExecuteEx).
This value can then be used in GetExitCodeProcess to determine if the process is still running, or if it has terminated (and you have thus retrieved the "Return Value", if I have correctly understood your use of this expression - it's actually called an "ExitCode", or - in batch files - an "ERRORLEVEL").
Incomplete code:
FUNCTION ShellExecuteAndWait(....) : DWORD;
.
.
VAR Info : TShellExecuteInfo;
.
.
Info.fMask:=Info.fMask OR SEE_MASK_NOCLOSEPROCESS;
IF NOT ShellExecuteEx(Info) THEN EXIT($FFFF8000);
IF Info.hProcess=0 THEN EXIT($FFFF0000);
REPEAT
IF NOT GetExitCodeProcess(Info.hProcess,Result) THEN EXIT($FFFFFFFF)
UNTIL Result<>STILL_ACTIVE
.
.
The above code should demonstrate how to do this...
I am executing an executable written in Go from Delphi (which downloads files from a URL list) and am capturing its console output in a TMemo on a Delphi form.
The last two lines in Go's main function are:
fmt.Println(fmt.Sprintf("Requested %d URLs in %f seconds", uc-1, duration))
os.Exit(0)
This line does appear in Delphi's memo, so I assume that the Go executable cleanly exits with a code of 0. I need to resolve two issues with my code:
After Go has issued a few thousand HTTP GETs (it outputs requested URLs one by one to the console) it has to 'wait for some stragglers'. During that time, my Delphi app displays the infamous 'Not responding' in the caption bar and Task Manager.
Even though the Go executable seems to cleanly exit, my Done() procedure never gets reached - it appears that Delphi never leaves the loop..? What am I doing wrong?
As always, any form of help is greatly appreciated!
procedure Tform_Main.CaptureConsoleOutput(const ACommand, AParameters: String; AMemo: TMemo);
const
CReadBuffer = 65536;
var
saSecurity: TSecurityAttributes;
hRead: THandle;
hWrite: THandle;
suiStartup: TStartupInfo;
piProcess: TProcessInformation;
pBuffer: Array[0..CReadBuffer] of AnsiChar;
dRead: DWord;
dRunning: DWord;
begin
(*
ACommand: ex. {GoGetter.exe}
AParameters: ex. {C:\temp\downloads\ c:\temp\urls.txt 1}
*)
saSecurity.nLength := SizeOf(TSecurityAttributes);
saSecurity.bInheritHandle := True;
saSecurity.lpSecurityDescriptor := nil;
try
if CreatePipe(hRead, hWrite, #saSecurity, 0) then
begin
Screen.Cursor := crHourglass;
Application.ProcessMessages;
FillChar(suiStartup, SizeOf(TStartupInfo), #0);
suiStartup.cb := SizeOf(TStartupInfo);
suiStartup.hStdInput := hRead;
suiStartup.hStdOutput := hWrite;
suiStartup.hStdError := hWrite;
suiStartup.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
suiStartup.wShowWindow := SW_HIDE;
//
if CreateProcess(nil, PChar(ACommand + ' ' + AParameters), #saSecurity, #saSecurity, True, NORMAL_PRIORITY_CLASS,
nil, nil, suiStartup, piProcess) then
begin
repeat
dRunning := WaitForSingleObject(piProcess.hProcess, 100);
Application.ProcessMessages();
repeat
dRead := 0;
ReadFile(hRead, pBuffer[0], CReadBuffer, dRead, nil);
pBuffer[dRead] := #0;
OemToAnsi(pBuffer, pBuffer);
AMemo.Lines.Text := AMemo.Lines.Text + String(pBuffer);
SendMessage(AMemo.Handle, WM_VSCROLL, SB_BOTTOM, 0);
until (dRead < CReadBuffer);
until (dRunning <> WAIT_TIMEOUT);
end;
end;
Done(); // writes a 'finished' message to the memo, resets the screen cursor & re-enables the start button
finally
CloseHandle(piProcess.hProcess);
CloseHandle(piProcess.hThread);
CloseHandle(hRead);
CloseHandle(hWrite);
end;
end;
Don't assign your hRead handle to the child process's hStdInput. You are not sending any data to the child process. Don't let the child process inherit your hRead handle at all. Use SetHandleInformation() to remove the HANDLE_FLAG_INHERIT flag from it.
And, you need to close your hWrite handle after the child process has inherited it, otherwise the pipe will remain open after the child process has terminated. You are not writing anything to the child process, so you don't need to leave your original hWrite handle open. When the child process terminates, its inherited hWrite handle will be closed, thus breaking the pipe, allowing ReadFile() to stop waiting for further data.
See How to read output from cmd.exe using CreateProcess() and CreatePipe() for more details about the use of pipe handles during I/O redirection.
Then, you can remove the outer repeat loop altogether. Just loop on ReadFile() until it fails, then call WaitForSingleObject() on the hProcess handle before cleaning up.
And just an FYI, using AMemo.Lines.Text := AMemo.Lines.Text + String(pBuffer); is a very inefficient way to append strings to a TMemo, especially over a long time.
Try something more like this instead:
procedure Tform_Main.CaptureConsoleOutput(const ACommand, AParameters: String; AMemo: TMemo);
const
CReadBuffer = 65536;
var
saSecurity: TSecurityAttributes;
hRead: THandle;
hWrite: THandle;
suiStartup: TStartupInfo;
piProcess: TProcessInformation;
pBuffer: array[0..CReadBuffer] of AnsiChar;
dRead: DWord;
begin
(*
ACommand: ex. {GoGetter.exe}
AParameters: ex. {C:\temp\downloads\ c:\temp\urls.txt 1}
*)
saSecurity.nLength := SizeOf(TSecurityAttributes);
saSecurity.bInheritHandle := True;
saSecurity.lpSecurityDescriptor := nil;
if CreatePipe(hRead, hWrite, #saSecurity, 0) then
try
SetHandleInformation(hRead, HANDLE_FLAG_INHERIT, 0);
ZeroMemory(#suiStartup, SizeOf(suiStartup));
suiStartup.cb := SizeOf(TStartupInfo);
suiStartup.hStdInput := GetStdHandle(STD_INPUT_HANDLE);
suiStartup.hStdOutput := hWrite;
suiStartup.hStdError := hWrite;
suiStartup.dwFlags := STARTF_USESTDHANDLES;
Screen.Cursor := crHourglass;
Application.ProcessMessages;
try
if CreateProcess(nil, PChar(ACommand + ' ' + AParameters), #saSecurity, #saSecurity, True, CREATE_NO_WINDOW or NORMAL_PRIORITY_CLASS,
nil, nil, suiStartup, piProcess) then
try
CloseHandle(piProcess.hThread);
CloseHandle(hWrite);
hWrite := INVALID_HANDLE_VALUE;
repeat
Application.ProcessMessages();
if (not ReadFile(hRead, pBuffer[0], CReadBuffer, dRead, nil)) or (dRead = 0) then
Break;
pBuffer[dRead] := #0;
OemToAnsi(pBuffer, pBuffer);
AMemo.SelStart := AMemo.GetTextLen();
AMemo.SelLength := 0;
AMemo.SelText := String(pBuffer);
SendMessage(AMemo.Handle, WM_VSCROLL, SB_BOTTOM, 0);
until False;
WaitForSingleObject(piProcess.hProcess, INFINITE);
finally
CloseHandle(piProcess.hProcess);
end;
finally
Done();
end;
finally
CloseHandle(hRead);
if hWrite <> INVALID_HANDLE_VALUE then
CloseHandle(hWrite);
end;
end;
Then, consider moving this code into a separate worker thread so you don't block your main UI thread anymore. Then you won't need ProcessMessages() anymore. Otherwise, if you really want to call ProcessMessages() inside the loop, use a named pipe instead of an anonymous pipe, then you can read asynchronously using OVERLAPPED I/O (see Overlapped I/O on anonymous pipe).
So I'm trying to do a archive using delphi and ShellExecuteEx my code is :
Result := False;
DecodeDate(now,y,m,d);
NumeFisier := dir+'\Export_'+IntToStr(y)+'.'+IntToStr(m)+'.'+IntToStr(d)+'.zip';
FillChar(exInfo, SizeOf(exInfo), 0);
with exInfo do
begin
cbSize := SizeOf(exInfo);
fMask := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_FLAG_DDEWAIT;
Wnd := GetActiveWindow();
exInfo.lpVerb := nil;
exInfo.lpFile := PAnsiChar('C:\Windows\System32\cmd.exe');
exInfo.lpParameters := PAnsiChar('C:\Program Files\7-Zip\7z.exe ' +'a ' + NumeFisier + ' ' + dir);
nShow := SW_SHOWNORMAL;
end;
if ShellExecuteEx(#exInfo) then
Ph := exInfo.hProcess
else
begin
ShowMessage(SysErrorMessage(GetLastError));
Result := true;
exit;
end;
while WaitForSingleObject(exInfo.hProcess, 50) <> WAIT_OBJECT_0 do
Application.ProcessMessages;
CloseHandle(Ph);
Result := true;
For some reason this only opens the Command Prompt and doesn't execute the archiving. How can I make it execute the 7z.exe file.
I tried with ShellExecute and it works great, but I have to check then the process is finished, so I'm stuck with ShellExecuteEx
There's no need to involve cmd.exe. That's the command interpreter. You want to execute a different executable so do that directly.
You don't want to use ShellExecuteEx since that has far more generality than you need. All that ShellExecuteEx is doing here is calling CreateProcess. You should do that directly and avoid the middle man. What's more, calling CreateProcess allows you to hide the console window easily. Pass CREATE_NO_WINDOW to achieve that.
Finally, there are better ways to wait than your code. Using MsgWaitForMultipleObjects allows you to avoid polling. And putting this code into a thread would allow you to avoid calls to Application.ProcessMessages.
procedure WaitUntilSignaled(Handle: THandle; ProcessMessages: Boolean);
var
retval: DWORD;
begin
if ProcessMessages then begin
Application.ProcessMessages;//in case there are messages already in the queue
while True do begin
retval := MsgWaitForMultipleObjects(1, Handle, False, INFINITE, QS_ALLEVENTS);
case retval of
WAIT_OBJECT_0,WAIT_ABANDONED_0:
break;
WAIT_OBJECT_0+1:
Application.ProcessMessages;
WAIT_FAILED:
RaiseLastOSError;
end;
end;
end else begin
Win32Check(WaitForSingleObject(Handle, INFINITE)<>WAIT_FAILED);
end;
end;
procedure ExecuteProcess(
const ExecutablePath: string;
const Arguments: string;
const CurrentDirectory: string;
const Wait: Boolean;
const CreationFlags: DWORD
);
var
si: TStartupInfo;
pi: TProcessInformation;
MyCurrentDirectory: PChar;
begin
ZeroMemory(#si, SizeOf(si));
si.cb := SizeOf(si);
if CurrentDirectory <> '' then begin
MyCurrentDirectory := PChar(CurrentDirectory);
end else begin
MyCurrentDirectory := nil;
end;
Win32Check(CreateProcess(
nil,
PChar('"' + ExecutablePath + '" ' + Arguments),
nil,
nil,
False,
CreationFlags,
nil,
MyCurrentDirectory,
si,
pi
));
try
if Wait then begin
WaitUntilSignaled(pi.hProcess, True);
end;
finally
CloseHandle(pi.hProcess);
CloseHandle(pi.hThread);
end;
end;
I want to run a background application from my Delphi code. The application that opens is a DOS based EXE which outputs stuff to the DOS window. The program will be open indefinitely until it is closed from task manager. The current code I use to open the application is;
procedure CaptureConsoleOutput(const ACommand, AParameters: String; CallBack: TArg<PAnsiChar>);
const
CReadBuffer = 2400;
var
saSecurity: TSecurityAttributes;
hRead: THandle;
hWrite: THandle;
suiStartup: TStartupInfo;
piProcess: TProcessInformation;
pBuffer: array [0 .. CReadBuffer] of AnsiChar;
dBuffer: array [0 .. CReadBuffer] of AnsiChar;
dRead: DWord;
dRunning: DWord;
begin
saSecurity.nLength := SizeOf(TSecurityAttributes);
saSecurity.bInheritHandle := True;
saSecurity.lpSecurityDescriptor := nil;
if CreatePipe(hRead, hWrite, #saSecurity, 0) then
begin
FillChar(suiStartup, SizeOf(TStartupInfo), #0);
suiStartup.cb := SizeOf(TStartupInfo);
suiStartup.hStdInput := hRead;
suiStartup.hStdOutput := hWrite;
suiStartup.hStdError := hWrite;
suiStartup.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
suiStartup.wShowWindow := SW_HIDE;
if CreateProcess(nil, pChar(ACommand + ' ' + AParameters), #saSecurity, #saSecurity, True, NORMAL_PRIORITY_CLASS, nil, nil, suiStartup, piProcess) then
begin
repeat
dRunning := WaitForSingleObject(piProcess.hProcess, 100);
//Application.ProcessMessages();
repeat
dRead := 0;
ReadFile(hRead, pBuffer[0], CReadBuffer, dRead, nil);
if(dRead > 0) then
begin
pBuffer[dRead] := #0;
//ShowMessage(pBuffer);
//OemToAnsi(pBuffer, pBuffer);
//Unicode support by Lars Fosdal
OemToCharA(pBuffer, dBuffer);
CallBack(dBuffer);
end;
until (dRead < CReadBuffer);
until (dRunning <> WAIT_TIMEOUT);
CloseHandle(piProcess.hProcess);
CloseHandle(piProcess.hThread);
end;
CloseHandle(hRead);
CloseHandle(hWrite);
end;
end;
This is good, however because the program doesn't 'quit' and stays open forever, my application hangs, and the code never moves along.
Any help would be appreciated
If you don't need to do anything with the spawned process, you can simply close the handles that CreateProcess() returned and move on, the process will keep running. But since you appear to need to read continuously from the output of the spawned process, you can simply move that logic into a worker thread so your main code is not blocked anymore.
//You have to put your conde inside a thread. For example:
//Let's suppose you want to ping Google Server. You'll have to create a thread just like //below in your interface section inside Delphi. You'll get this done by choosing File-New-//Other-Thread Object, Then name your thread as you want.
type
TPing = class(TThread)
private
{ Private declarations }
protected
procedure Execute; override;
end;
//Copy your CaptureConsoleOutput procedure onto Thread unit.
//inside Execute procedure, call your CaptureConsoleOutput procedure.
//In my case, I just capture the output directly in the Memo component.
//That worked just fine for me !
procedure TPing.Execute;
begin
Priority := tpLower;
CaptureConsoleOutput('ping www.yahoo.com', '-t', Form1.Memo2);
end;
I am trying to register an Active X .ocx Library in a Delphi program i have tried the following code with out success no errors and the program runs through all of the code but when it has finished the Active X Library hasn't been registered. What am i doing wrong ?
procedure RegisterOCX;
type
TRegFunc = function : HResult; stdcall;
var
ARegFunc : TRegFunc;
aHandle : THandle;
ocxPath,AppPath : string;
begin
GetDir(0, AppPath);
try
ocxPath := AppPath + '\VOIP.ocx';
aHandle := LoadLibrary(PChar(ocxPath));
if aHandle <> 0 then
begin
ARegFunc := GetProcAddress(aHandle,'DllRegisterServer');
if Assigned(ARegFunc) then
begin
ExecAndWait('regsvr32','/s ' + ocxPath);
end;
FreeLibrary(aHandle);
end;
except
ShowMessage('Unable to register ');
end;
end;
function ExecAndWait(const ExecuteFile, ParamString : string): boolean;
var
SEInfo: TShellExecuteInfo;
ExitCode: DWORD;
begin
FillChar(SEInfo, SizeOf(SEInfo), 0);
SEInfo.cbSize := SizeOf(TShellExecuteInfo);
with SEInfo do begin
fMask := SEE_MASK_NOCLOSEPROCESS;
Wnd := Application.Handle;
lpFile := PChar(ExecuteFile);
lpParameters := PChar(ParamString);
nShow := SW_HIDE;
end;
if ShellExecuteEx(#SEInfo) then
begin
repeat
Application.ProcessMessages;
GetExitCodeProcess(SEInfo.hProcess, ExitCode);
until (ExitCode <> STILL_ACTIVE) or Application.Terminated;
Result:=True;
end
else Result:=False;
end;
You are making life hard for yourself by using regsvr32. You've gone 99% of the way to doing without. Instead of calling regsvr32, just call DllRegisterServer. After all, that's all that regsvr32 is going to do!
Your code becomes:
if Assigned(ARegFunc) then
OleCheck(ARegFunc());
You can then remove ExecAndWait altogether. Which is nice because it saves me discussing the busy loop, and the leaked handle!
It would make sense to me to rename the variable that you called ARegFunc as DllRegisterServer. So the code might then look like this:
aHandle := LoadLibrary(PChar(ocxPath));
if aHandle = 0 then
RaiseLastWin32Error;
try
DllRegisterServer := GetProcAddress(aHandle,'DllRegisterServer');
if Assigned(DllRegisterServer) then
OleCheck(DllRegisterServer());
finally
FreeLibrary(aHandle);
end;
The most likely failure mode for a call to DllRegisterServer will be a failure to run your registration code elevated.
As an aside, LoadLibrary returns HMODULE rather than THandle.