I have a commandline application coded in delphi that I need to call from a normal desktop application (also coded in delphi). In short, I want to call the commandline app and display the text it outputs "live" in a listbox.
It's been ages since I have played around with the shell, but I distinctly remember that in order to grab the text from a commandline app - I have to use the pipe symbol ">". Like this:
C:/mycmdapp.exe >c:/result.txt
This will take any text printed to the shell (using writeLn) and dump it to a textfile called "result.txt".
But.. (and here comes the pickle), I want a live result rather than a backlog file. A typical example is the Delphi compiler itself - which manages to report back to the IDE what is going on. If my memory serves me correctly, I seem to recall that I must create a "pipe" channel (?), and then assign the pipe-name to the shell call.
I have tried to google this but I honestly was unsure of how to formulate it. Hopefully someone from the community can point me in the right direction.
Updated: This question might be identical to How do I run a command-line program in Delphi?. Some of the answers fit what I'm looking for, although the title and question itself is not identical.
As ever so often Zarco Gajic has a solution: Capture the output from a DOS (command/console) Window. This is a copy from his article for future reference:
The example runs 'chkdsk.exe c:\' and displays the output to Memo1.
Put a TMemo (Memo1) and a TButton (Button1) on your form. Put this code in the OnCLick event procedure for Button1:
procedure RunDosInMemo(DosApp: string; AMemo:TMemo);
const
READ_BUFFER_SIZE = 2400;
var
Security: TSecurityAttributes;
readableEndOfPipe, writeableEndOfPipe: THandle;
start: TStartUpInfo;
ProcessInfo: TProcessInformation;
Buffer: PAnsiChar;
BytesRead: DWORD;
AppRunning: DWORD;
begin
Security.nLength := SizeOf(TSecurityAttributes);
Security.bInheritHandle := True;
Security.lpSecurityDescriptor := nil;
if CreatePipe({var}readableEndOfPipe, {var}writeableEndOfPipe, #Security, 0) then
begin
Buffer := AllocMem(READ_BUFFER_SIZE+1);
FillChar(Start, Sizeof(Start), #0);
start.cb := SizeOf(start);
// Set up members of the STARTUPINFO structure.
// This structure specifies the STDIN and STDOUT handles for redirection.
// - Redirect the output and error to the writeable end of our pipe.
// - We must still supply a valid StdInput handle (because we used STARTF_USESTDHANDLES to swear that all three handles will be valid)
start.dwFlags := start.dwFlags or STARTF_USESTDHANDLES;
start.hStdInput := GetStdHandle(STD_INPUT_HANDLE); //we're not redirecting stdInput; but we still have to give it a valid handle
start.hStdOutput := writeableEndOfPipe; //we give the writeable end of the pipe to the child process; we read from the readable end
start.hStdError := writeableEndOfPipe;
//We can also choose to say that the wShowWindow member contains a value.
//In our case we want to force the console window to be hidden.
start.dwFlags := start.dwFlags + STARTF_USESHOWWINDOW;
start.wShowWindow := SW_HIDE;
// Don't forget to set up members of the PROCESS_INFORMATION structure.
ProcessInfo := Default(TProcessInformation);
//WARNING: The unicode version of CreateProcess (CreateProcessW) can modify the command-line "DosApp" string.
//Therefore "DosApp" cannot be a pointer to read-only memory, or an ACCESS_VIOLATION will occur.
//We can ensure it's not read-only with the RTL function: UniqueString
UniqueString({var}DosApp);
if CreateProcess(nil, PChar(DosApp), nil, nil, True, NORMAL_PRIORITY_CLASS, nil, nil, start, {var}ProcessInfo) then
begin
//Wait for the application to terminate, as it writes it's output to the pipe.
//WARNING: If the console app outputs more than 2400 bytes (ReadBuffer),
//it will block on writing to the pipe and *never* close.
repeat
Apprunning := WaitForSingleObject(ProcessInfo.hProcess, 100);
Application.ProcessMessages;
until (Apprunning <> WAIT_TIMEOUT);
//Read the contents of the pipe out of the readable end
//WARNING: if the console app never writes anything to the StdOutput, then ReadFile will block and never return
repeat
BytesRead := 0;
ReadFile(readableEndOfPipe, Buffer[0], READ_BUFFER_SIZE, {var}BytesRead, nil);
Buffer[BytesRead]:= #0;
OemToAnsi(Buffer,Buffer);
AMemo.Text := AMemo.text + String(Buffer);
until (BytesRead < READ_BUFFER_SIZE);
end;
FreeMem(Buffer);
CloseHandle(ProcessInfo.hProcess);
CloseHandle(ProcessInfo.hThread);
CloseHandle(readableEndOfPipe);
CloseHandle(writeableEndOfPipe);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin {button 1 code}
RunDosInMemo('chkdsk.exe c:\',Memo1);
end;
Update:
The above example reads the output in one step. Here is another example from DelphiDabbler showing how the output can be read while the process is still running:
function GetDosOutput(CommandLine: string; Work: string = 'C:\'): string;
var
SA: TSecurityAttributes;
SI: TStartupInfo;
PI: TProcessInformation;
StdOutPipeRead, StdOutPipeWrite: THandle;
WasOK: Boolean;
Buffer: array[0..255] of AnsiChar;
BytesRead: Cardinal;
WorkDir: string;
Handle: Boolean;
begin
Result := '';
with SA do begin
nLength := SizeOf(SA);
bInheritHandle := True;
lpSecurityDescriptor := nil;
end;
CreatePipe(StdOutPipeRead, StdOutPipeWrite, #SA, 0);
try
with SI do
begin
FillChar(SI, SizeOf(SI), 0);
cb := SizeOf(SI);
dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
wShowWindow := SW_HIDE;
hStdInput := GetStdHandle(STD_INPUT_HANDLE); // don't redirect stdin
hStdOutput := StdOutPipeWrite;
hStdError := StdOutPipeWrite;
end;
WorkDir := Work;
Handle := CreateProcess(nil, PChar('cmd.exe /C ' + CommandLine),
nil, nil, True, 0, nil,
PChar(WorkDir), SI, PI);
CloseHandle(StdOutPipeWrite);
if Handle then
try
repeat
WasOK := ReadFile(StdOutPipeRead, Buffer, 255, BytesRead, nil);
if BytesRead > 0 then
begin
Buffer[BytesRead] := #0;
Result := Result + Buffer;
end;
until not WasOK or (BytesRead = 0);
WaitForSingleObject(PI.hProcess, INFINITE);
finally
CloseHandle(PI.hThread);
CloseHandle(PI.hProcess);
end;
finally
CloseHandle(StdOutPipeRead);
end;
end;
You probably have the code on your harddisk already: the Execute function in the JclSysUtils unit of the JCL (JEDI Code Library) does what you need:
function Execute(const CommandLine: string; OutputLineCallback: TTextHandler;
RawOutput: Boolean = False; AbortPtr: PBoolean = nil): Cardinal;
You can supply it with a callback procedure:
TTextHandler = procedure(const Text: string) of object;
Did an answer too for better understanding:
{type TTextHandler =} procedure TTextHandlerQ(const aText: string);
begin
memo2.lines.add(atext);
end;
writeln(itoa(JExecute('cmd /C dir *.*',#TTextHandlerQ, true, false)));
You have to use /C then cmd /c is used to run commands in MS-DOS and terminate after command or process completion, otherwise it blocks output to memo.
Related
I wrote a console application that is able to execute multiple commands on the command line in parallel.
Primarily I did this out of interest and because the build processes of the software projects I am working on make excessive use of the command line.
Currently, before I create a child process in a worker thread, I create an anonymous pipe in order to capture all the output the child process creates during its lifetime.
After the child process terminates, the worker thread pushes the captured content to the waiting main process that then prints it out.
Here's my process creations and capturing:
procedure ReadPipe(const ReadHandle: THandle; const Output: TStream);
var
Buffer: TMemoryStream;
BytesRead, BytesToRead: DWord;
begin
Buffer := TMemoryStream.Create;
try
BytesRead := 0;
BytesToRead := 0;
if PeekNamedPipe(ReadHandle, nil, 0, nil, #BytesToRead, nil) then
begin
if BytesToRead > 0 then
begin
Buffer.Size := BytesToRead;
ReadFile(ReadHandle, Buffer.Memory^, Buffer.Size, BytesRead, nil);
if Buffer.Size <> BytesRead then
begin
Buffer.Size := BytesRead;
end;
if Buffer.Size > 0 then
begin
Output.Size := Output.Size + Buffer.Size;
Output.WriteBuffer(Buffer.Memory^, Buffer.Size);
end;
end;
end;
finally
Buffer.Free;
end;
end;
function CreateProcessWithRedirectedOutput(const AppName, CMD, DefaultDir: PChar; out CapturedOutput: String): Cardinal;
const
TIMEOUT_UNTIL_NEXT_PIPEREAD = 100;
var
SecurityAttributes: TSecurityAttributes;
ReadHandle, WriteHandle: THandle;
StartupInfo: TStartupInfo;
ProcessInformation: TProcessInformation;
ProcessStatus: Cardinal;
Output: TStringStream;
begin
Result := 0;
CapturedOutput := '';
Output := TStringStream.Create;
try
SecurityAttributes.nLength := SizeOf(SecurityAttributes);
SecurityAttributes.lpSecurityDescriptor := nil;
SecurityAttributes.bInheritHandle := True;
if CreatePipe(ReadHandle, WriteHandle, #SecurityAttributes, 0) then
begin
try
FillChar(StartupInfo, Sizeof(StartupInfo), 0);
StartupInfo.cb := SizeOf(StartupInfo);
StartupInfo.hStdOutput := WriteHandle;
StartupInfo.hStdError := WriteHandle;
StartupInfo.hStdInput := GetStdHandle(STD_INPUT_HANDLE);
StartupInfo.dwFlags := STARTF_USESTDHANDLES;
if CreateProcess(AppName, CMD,
#SecurityAttributes, #SecurityAttributes,
True, NORMAL_PRIORITY_CLASS,
nil, DefaultDir,
StartupInfo, ProcessInformation)
then
begin
try
repeat
ProcessStatus := WaitForSingleObject(ProcessInformation.hProcess, TIMEOUT_UNTIL_NEXT_PIPEREAD);
ReadPipe(ReadHandle, Output);
until ProcessStatus <> WAIT_TIMEOUT;
if not Windows.GetExitCodeProcess(ProcessInformation.hProcess, Result) then
begin
Result := GetLastError;
end;
finally
Windows.CloseHandle(ProcessInformation.hProcess);
Windows.CloseHandle(ProcessInformation.hThread);
end;
end
else
begin
Result := GetLastError;
end;
finally
Windows.CloseHandle(ReadHandle);
Windows.CloseHandle(WriteHandle);
end;
end
else
begin
Result := GetLastError;
end;
CapturedOutput := Output.DataString;
finally
Output.Free;
end;
end;
My problem now:
This method doesn't preserve potential coloring of the captured output!
I came accross this topic Capture coloured console output into WPF application but that didn't help me out, as I don't receive any color data through the anonymous pipe, just plain old text.
I experimented with inheriting the console of the main process to the child processes via CreateFile with 'CONOUT$', but while the colors are indeed preserved, you probably can guess that its pure mayhem if more than one process prints out its contents into one and the same console.
My next approach was to create additional console buffers with CreateConsoleScreenBuffer for each child process and read the contents with ReadConsole, but that wasn't successful as ReadConsole returns with System Error 6 (ERROR_INVALID_HANDLE).
ConsoleHandle := CreateConsoleScreenBuffer(
GENERIC_READ or GENERIC_WRITE,
FILE_SHARE_READ or FILE_SHARE_WRITE,
#SecurityAttributes,
CONSOLE_TEXTMODE_BUFFER,
nil);
//...
StartupInfo.hStdOutput := ConsoleHandle;
StartupInfo.hStdError := ConsoleHandle;
//...
ConsoleOutput := TMemoryStream.Create
ConsoleOutput.Size := MAXWORD;
ConsoleOutput.Position := 0;
ReadConsole(ConsoleHandle, ConsoleOutput.Memory, ConsoleOutput.Size, CharsRead, nil) // Doesn't read anything and returns with System Error Code 6.
I also read up on virtual terminal sequences and AllocConsole, AttachConsole and FreeConsole, but can't quite wrap my head around it for my use case.
What is the right/best way to preserve/receive coloring information of the console output of a child process?
I was on the right track with CreateConsoleScreenBuffer and giving each thread its own console screen buffer.
The problem was ReadConsole which doesn't do what I expected.
I now got it working with ReadConsoleOutput.
It should be noted however, that this method is the legacy way of doing it.
If you want to do it the "new way" you should probably use Pseudo Console Sessions.
Its support starts with Windows 10 1809 and Windows Server 2019.
It should also be noted, that the method of reading the output of a process/program via console screen buffer has its flaws and two distinct disadvantages compared to anonymous pipes:
The console screen buffer can't get full and block the process/program, but if the end of it is reached, new lines will push the current first line out of the buffer.
Output from processes/programs that spam their std output in a fast fashion will most likely lead to loss of information, as you won't be able to read, clear and move the cursor in the console screen buffer fast enough.
I try to circumvent both by increasing the console screen buffers y size component to its maximum possible size (I found it to be MAXSHORT - 1) and just wait until the process/program has finished.
That's good enough for me, as I don't need to analyze or process the colored output, but just display it in a console window, which is itself limited to MAXSHORT - 1 lines.
In every other scenario I will be using pipes and advise everyone else to do so too!
Here is a short version without any error handling that can be executed in parallel without interference (provided the TStream object is owned by the thread or thread-safe):
procedure CreateProcessWithConsoleCapture(const aAppName, aCMD, aDefaultDir: PChar;
const CapturedOutput: TStream);
const
CONSOLE_SCREEN_BUFFER_SIZE_Y = MAXSHORT - 1;
var
SecurityAttributes: TSecurityAttributes;
ConsoleHandle: THandle;
StartupInfo: TStartupInfo;
ProcessInformation: TProcessInformation;
CharsRead: Cardinal;
BufferSize, Origin: TCoord;
ConsoleScreenBufferInfo: TConsoleScreenBufferInfo;
Buffer: array of TCharInfo;
ReadRec: TSmallRect;
begin
SecurityAttributes.nLength := SizeOf(SecurityAttributes);
SecurityAttributes.lpSecurityDescriptor := Nil;
SecurityAttributes.bInheritHandle := True;
ConsoleHandle := CreateConsoleScreenBuffer(
GENERIC_READ or GENERIC_WRITE,
FILE_SHARE_READ or FILE_SHARE_WRITE,
#SecurityAttributes,
CONSOLE_TEXTMODE_BUFFER,
nil);
try
GetConsoleScreenBufferInfo(ConsoleHandle, ConsoleScreenBufferInfo);
BufferSize.X := ConsoleScreenBufferInfo.dwSize.X;
BufferSize.Y := CONSOLE_SCREEN_BUFFER_SIZE_Y;
SetConsoleScreenBufferSize(ConsoleHandle, BufferSize);
Origin.X := 0;
Origin.Y := 0;
FillConsoleOutputCharacter(ConsoleHandle, #0, BufferSize.X * BufferSize.Y, Origin, CharsRead);
SetStdHandle(STD_OUTPUT_HANDLE, ConsoleHandle);
FillChar(StartupInfo, Sizeof(StartupInfo), 0);
StartupInfo.cb := SizeOf(StartupInfo);
StartupInfo.hStdOutput := ConsoleHandle;
StartupInfo.hStdError := ConsoleHandle;
StartupInfo.hStdInput := GetStdHandle(STD_INPUT_HANDLE);
StartupInfo.dwFlags := STARTF_USESTDHANDLES or STARTF_FORCEOFFFEEDBACK;
CreateProcess(aAppName, aCMD,
#SecurityAttributes, #SecurityAttributes,
True, NORMAL_PRIORITY_CLASS,
nil, aDefaultDir,
StartupInfo, ProcessInformation);
try
WaitForSingleObject(ProcessInformation.hProcess, INFINITE);
GetConsoleScreenBufferInfo(ConsoleHandle, ConsoleScreenBufferInfo);
BufferSize.X := ConsoleScreenBufferInfo.dwSize.X;
BufferSize.Y := ConsoleScreenBufferInfo.dwCursorPosition.Y;
if ConsoleScreenBufferInfo.dwCursorPosition.X > 0 then
begin
Inc(BufferSize.Y);
end;
ReadRec.Left := 0;
ReadRec.Top := 0;
ReadRec.Right := BufferSize.X - 1;
ReadRec.Bottom := BufferSize.Y - 1;
SetLength(Buffer, BufferSize.X * BufferSize.Y);
ReadConsoleOutput(ConsoleHandle, #Buffer[0], BufferSize, Origin, ReadRec);
CharsRead := SizeOf(TCharInfo) * (ReadRec.Right - ReadRec.Left + 1) * (ReadRec.Bottom - ReadRec.Top + 1);
if CharsRead > 0 then
begin
CapturedOutput.Size := CapturedOutput.Size + CharsRead;
CapturedOutput.WriteBuffer(Buffer[0], CharsRead);
end;
finally
CloseHandle(ProcessInformation.hProcess);
CloseHandle(ProcessInformation.hThread);
end;
finally
CloseHandle(ConsoleHandle);
end;
end;
How can I get Delphi to pass a string to the input pipe to a CMD process. I am able to get an error pipe and output pipe functioning properly, unfortunately not the input pipe. The code I am using is taken from an online tutorial for piping. There were several errors in the original code causing problems when it was compiled. They have been fixed but I am left with problems when trying to pass input still.
Here is the code in the Form.Create event. I also have included the WritePipe and ReadPipe methods. WritePipe does not work, ReadPipe does work. Both WriteFile and ReadFile in the Pipe methods return a successful message, only the ReadPipe actually works however.
var
DosApp: String;
DosSize: Integer;
Security : TSecurityAttributes;
start : TStartUpInfo;
byteswritten: DWord;
WriteString : ansistring;
begin
CommandText.Clear;
// get COMSPEC variable, this is the path of the command-interpreter
SetLength(Dosapp, 255);
DosSize := GetEnvironmentVariable('COMSPEC', #DosApp[1], 255);
SetLength(Dosapp, DosSize);
// create pipes
With Security do
begin
nlength := SizeOf(TSecurityAttributes) ;
binherithandle := true;
lpsecuritydescriptor := nil;
end;
CreatePipe(InputPipeRead, InputPipeWrite, #Security, 0);
CreatePipe(OutputPipeRead, OutputPipeWrite, #Security, 0);
CreatePipe(ErrorPipeRead, ErrorPipeWrite, #Security, 0);
// start command-interpreter
FillChar(Start,Sizeof(Start),#0) ;
//start.hStdInput := InputPipeRead;
start.hStdOutput := OutputPipeWrite;
start.hStdError := ErrorPipeWrite;
start.dwFlags := STARTF_USESTDHANDLES + STARTF_USESHOWWINDOW;
start.wShowWindow := SW_Show;//SW_HIDE;
start.cb := SizeOf(start) ;
if CreateProcess('', PChar(DosApp), #Security, #Security, true,
CREATE_NEW_CONSOLE or SYNCHRONIZE, // CREATE_NO_WINDOW,
nil, nil, start, ProcessInfo) then
begin
MyThread := MainUnit.monitor.Create; // start monitor thread
MyThread.Priority := tpHigher;
end;
Button1.Enabled := true;
cmdcount := 1;
end;
Write Pipe:
procedure WritePipeOut(OutputPipe: THandle; InString: PWideChar);
// writes Instring to the pipe handle described by OutputPipe
var
count : integer;
byteswritten: DWord;
outputstring : PAnsiChar;
TextBuffer: array[1..32767] of AnsiChar;// char;
TextString: String;
begin
// most console programs require CR/LF after their input.
InString := PWideChar(InString + #13#10);
WriteFile(InputPipeWrite, InString[1], Length(InString), byteswritten, nil);
end;
Read Pipe:
function ReadPipeInput(InputPipe: THandle; var BytesRem: Integer): String;
{
reads console output from InputPipe. Returns the input in function
result. Returns bytes of remaining information to BytesRem
}
var
TextBuffer: array[1..32767] of AnsiChar;// char;
TextString: String;
BytesRead: Cardinal;
PipeSize: Integer;
begin
Result := '';
PipeSize := length(TextBuffer);
// check if there is something to read in pipe
PeekNamedPipe(InputPipe, nil, PipeSize, #BytesRead, #PipeSize, #BytesRem);
if bytesread > 0 then
begin
ReadFile(InputPipe, TextBuffer, pipesize, bytesread, nil);
// a requirement for Windows OS system components
OemToChar(#TextBuffer, #TextBuffer);
TextString := String(TextBuffer);
SetLength(TextString, BytesRead);
Result := TextString;
end;
end;
Further note; this is for use with the Java Debugger, which requires input in stages and so I do not believe there is any alternative method other than manipulating input directly to the JDB.
Any help is much appreciated!
1) You should pass InputPipeRead as hStdInput into CreateProcess: uncomment your line start.hStdInput := InputPipeRead;
2) The WritePipeOut function has two errors: it writes a Unicode (UTF-16LE) string into a pipe, and it skips the first character (since it writes a memory area beginning at InString[1]). Instead of WriteFile(InputPipeWrite, InString[1], Length(InString),... you should write something like:
var AnsiBuf: AnsiString;
...
AnsiBuf := String(InString) + #13#10;
Write(InputPipeWrite, AnsiBuf[1], Length(AnsiBuf), byteswritten, nil);
I have a hopefully quick question: Is it possible to delay execution of ShellExecute a little bit?
I have an application with autoupdater. After it downloads all necessary files etc, it renames current files to *.OLD and the new as the previous. Simple enough. But then I need to delete those .OLD files. This 'cleanup' procedure is executed on MainForm.OnActivate (with a check if it is the first activate proc). But this apparently happens too fast (I get False from DeleteFile). This is the procedure:
procedure TUpdateForm.OKBtnClick(Sender: TObject);
const SHELL = 'ping 127.0.0.1 -n 2';
begin
ShellExecute(0,'open',pchar(SHELL+#13+Application.ExeName),nil,nil,SW_SHOWNORMAL);
Application.Terminate;
end;
This procedure is supposed to restart the application. I am certain that the deleting problem is caused by the quick start of the second application, because if I restart it myself, giving it a little time, the files get deleted normally.
tl;dr version: I need to call ShellExecute() which waits a bit (0.1 sec or so) and THEN executes the command.
Note
I tried using the -ping command to try to delay it, but it didn't work.
Thank you very much in advance
Edit: Rephrased
I need this to happen || First app closes; Wait 100 ms; second app opens ||. I need to call ShellExecute first, then wait until the calling application closes itself completely, then execute the shell (i.e. open second application)
You're doing an autopatcher right ?
I've had the same problem and this is how I bypassed it :
You run second app with argument "--delay" or something like that.
Second app handles argument "--delay" and sleeps for 100 ms, then continues running normally.
This routine is some utils code in our game engine. It can run an executable and optionally wait for it to exit. It will return its exit code:
function TSvUtils.FileExecute(ahWnd: Cardinal; const aFileName, aParams, aStartDir: string; aShowCmd: Integer; aWait: Boolean): Integer;
var
Info: TShellExecuteInfo;
ExitCode: DWORD;
begin
Result := -1;
FillChar(Info, SizeOf(Info), 0);
Info.cbSize := SizeOf(TShellExecuteInfo);
with Info do begin
fMask := SEE_MASK_NOCLOSEPROCESS;
Wnd := ahWnd;
lpFile := PChar(aFileName);
lpParameters := PChar(aParams);
lpDirectory := PChar(aStartDir);
nShow := aShowCmd;
end;
if ShellExecuteEx(#Info) then
begin
if aWait then
begin
repeat
Sleep(1);
Application.ProcessMessages;
GetExitCodeProcess(Info.hProcess, ExitCode);
until (ExitCode <> STILL_ACTIVE) or Application.Terminated;
CloseHandle(Info.hProcess);
Result := ExitCode;
end;
end
end;
Here is some code that can check to see if a process exists. So... current app calls the updater and terminates. The updater can check to see if old app has terminated and do it's thing (rename, update, delete, etc):
function TSvUtils.ProcessExists(const aExeFileName: string; aBringToForgound: Boolean=False): Boolean;
var
ContinueLoop: BOOL;
FSnapshotHandle: THandle;
FProcessEntry32: TProcessEntry32;
begin
FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);
Result := False;
while Integer(ContinueLoop) <> 0 do
begin
if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =
UpperCase(aExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) =
UpperCase(aExeFileName))) then
begin
if aBringToForgound then
EnumWindows(#BringToForgroundEnumProcess, FProcessEntry32.th32ProcessID);
Result := True;
end;
ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
end;
CloseHandle(FSnapshotHandle);
end;
If you can use CreateProcess instead of ShellExecute, you can wait on the process handle. The process handle is signalled when the application exits. For example:
function ExecAndWait(APath: string; var VProcessResult: cardinal): boolean;
var
LWaitResult : integer;
LStartupInfo: TStartupInfo;
LProcessInfo: TProcessInformation;
begin
Result := False;
FillChar(LStartupInfo, SizeOf(TStartupInfo), 0);
with LStartupInfo do
begin
cb := SizeOf(TStartupInfo);
dwFlags := STARTF_USESHOWWINDOW or STARTF_FORCEONFEEDBACK;
wShowWindow := SW_SHOWDEFAULT;
end;
if CreateProcess(nil, PChar(APath), nil, nil,
False, NORMAL_PRIORITY_CLASS,
nil, nil, LStartupInfo, LProcessInfo) then
begin
repeat
LWaitResult := WaitForSingleObject(LProcessInfo.hProcess, 500);
// do something, like update a GUI or call Application.ProcessMessages
until LWaitResult <> WAIT_TIMEOUT;
result := LWaitResult = WAIT_OBJECT_0;
GetExitCodeProcess(LProcessInfo.hProcess, VProcessResult);
CloseHandle(LProcessInfo.hProcess);
CloseHandle(LProcessInfo.hThread);
end;
end;
After ExecAndWait returns, then you can sleep for 100ms if you need to.
N#
This question already has answers here:
Closed 11 years ago.
Possible Duplicate:
How to read from an external console application?
I have a third party console application
I want to execute it at run time form a delphi application.
on the execution
the console applications window must be hidden.and all the messages of the console application must be printed in a control of my application (Text box , memo etc)
and also using the control user must be able to input text.
Can anyone help me to do this
This will allow you to run and receive info back from a console (DOS-type) application into a TRichEdit. It doesn't allow you to input text once the app is running, but maybe it'll give you a starting point. (The original code is from a newsgroup post written by Dr. Peter Below of TeamB.)
procedure TFMainForm.RunDosInMemo(const App: String; AMemo: TRichEdit);
const
ReadBuffer = 2400;
var
Security : TSecurityAttributes;
StdInPipeR, StdInPipeW : THandle;
StdOutPipeR, StdOutPipeW : THandle;
StartInfo : TStartUpInfo;
ProcessInfo : TProcessInformation;
Buffer : PByte;
BytesAvailable, BytesRead : DWord;
sDosApp: String;
sData: RawByteString;
begin
sDosApp := DosApp;
UniqueString(sDosApp);
with Security do begin
nLength := SizeOf(TSecurityAttributes);
bInheritHandle := True;
lpSecurityDescriptor := nil;
end;
if CreatePipe(StdInPipeR, StdInPipeW, #Security, 0) then
try
SetHandleInformation(StdInPipeW, HANDLE_FLAG_INHERIT, 0);
if CreatePipe(StdOutPipeR, StdOutPipeW, #Security, 0) then
try
SetHandleInformation(StdOutPipeR, HANDLE_FLAG_INHERIT, 0);
GetMem(Buffer, ReadBuffer);
try
ZeroMemory(#StartInfo, SizeOf(StartInfo));
StartInfo.cb := SizeOf(StartInfo);
StartInfo.hStdOutput := StdOutPipeW;
StartInfo.hStdInput := StdInPipeR;
StartInfo.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
StartInfo.wShowWindow := SW_HIDE;
if CreateProcess(nil,
PChar(sDosApp),
nil,
nil,
True,
NORMAL_PRIORITY_CLASS,
nil,
nil,
StartInfo,
ProcessInfo) then
try
while WaitForSingleObject(ProcessInfo.hProcess, 500) <> WAIT_TIMEOUT do
Application.ProcessMessages;
while PeekNamedPipe(StdOutPipeR, nil, 0, nil, BytesAvailable, nil) do
begin
if BytesAvailable < 1 then
Break;
if BytesAvailable > ReadBuffer then
BytesAvailable := ReadBuffer;
if not ReadFile(StdOutPipeR,
Buffer[0],
BytesAvailable,
BytesRead,
nil) then
Break;
SetString(sData, PAnsiChar(Buffer), BytesRead);
// assign an appropriate codepage for the output data:
// 0 for default Ansi, 1252 or 20157 for ASCII, 1200 for
// Unicode, etc...
SetCodePage(sData, ...);
// this is faster and more efficient than reading/writing the
// Text property directly...
AMemo.SelStart := AMemo.GetTextLen;
AMemo.SelLength := 0;
AMemo.SelText := sData;
end;
finally
CloseHandle(ProcessInfo.hThread);
CloseHandle(ProcessInfo.hProcess);
end;
finally
FreeMem(Buffer);
end;
finally
CloseHandle(StdOutPipeR);
CloseHandle(StdOutPipeW);
end;
finally
CloseHandle(StdInPipeR);
CloseHandle(StdInPipeW);
end;
end;
See this answer and this one.
Zarko wrote about this on Delphi.about.com.
This is a common requirement, for example, in IDEs and build tools, or apps which spawn external command line tools to do version control, for example.
To make the answer two-way, as you ask for it to be, is very complex, and I am not aware of anybody who has implemented a "command shell" or "terminal mode" completely in delphi.
I ported Zlatko's code to Delphi XE (also works in 2010) here.
I try several samples in the internet and none of them work - the scripts are not executed- (maybe because are for pre Delphi 2009 unicode?).
I need to run some python scripts and pass arguments to them, like:
python "..\Plugins\RunPlugin.py" -a login -u Test -p test
And capture the output to a string & the errors to other.
This is what I have now:
procedure RunDosInMemo(DosApp:String; var OutData: String);
var
SA: TSecurityAttributes;
SI: TStartupInfo;
PI: TProcessInformation;
StdOutPipeRead, StdOutPipeWrite: THandle;
WasOK: Boolean;
Buffer: array[0..255] of Char;
BytesRead: Cardinal;
WorkDir: string;
Handle: Boolean;
begin
OutData := '';
with SA do begin
nLength := SizeOf(SA);
bInheritHandle := True;
lpSecurityDescriptor := nil;
end;
CreatePipe(StdOutPipeRead, StdOutPipeWrite, #SA, 0);
try
with SI do
begin
FillChar(SI, SizeOf(SI), 0);
cb := SizeOf(SI);
dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES or CREATE_UNICODE_ENVIRONMENT;
wShowWindow := SW_HIDE;
hStdInput := GetStdHandle(STD_INPUT_HANDLE); // don't redirect stdin
hStdOutput := StdOutPipeWrite;
hStdError := StdOutPipeWrite;
end;
WorkDir := 'C:\';
Handle := CreateProcess(nil, PChar(DosApp),
nil, nil, True, 0, nil,
PChar(WorkDir), SI, PI);
CloseHandle(StdOutPipeWrite);
if Handle then
begin
try
repeat
WasOK := ReadFile(StdOutPipeRead, Buffer, 255, BytesRead, nil);
if BytesRead > 0 then
begin
Buffer[BytesRead] := #0;
OutData := OutData + String(Buffer);
end;
until not WasOK or (BytesRead = 0);
WaitForSingleObject(PI.hProcess, INFINITE);
finally
CloseHandle(PI.hThread);
CloseHandle(PI.hProcess);
end;
end else begin
raise Exception.Create('Failed to load python plugin');
end;
finally
CloseHandle(StdOutPipeRead);
end;
end;
Create_Unicode_Environment is a process creation flag, meant for use in the dwCreationFlags parameter of CreateFile. It is not a flag for use in the TStartupInfo record. API functions are liable to fail if you give them flag values they don't understand, and they're liable to do strange things if you give them flag values that mean something other than what you expected.
You declare a buffer of 256 Chars; recall that Char in Delphi 2009 is a 2-byte Unicode type. You then call ReadFile and tell it that the buffer is 255 bytes long instead of the real value, 512. When the documentation says that a value is the number of bytes, take that as your cue to use the SizeOf function.
Since ReadFile reads bytes, it would be a good idea to declare your buffer array to be an array of byte-sized elements, such as AnsiChar. That way, when you set Buffer[BytesRead], you won't include twice the data you actually read.
The Unicode version of CreateProcess may modify its command-line argument. You must ensure that the string you pass to that parameter has a reference count of 1. Call UniqueString(DosApp) before you call CreateProcess.
When an API function fails, you will of course want to know why. Don't just make up a reason. Use the functions provided, such as Win32Check and RaiseLastOSError. At the very least, call GetLastError, like MSDN tells you to. Don't throw a generic exception type when a more specific one is readily available.
I'm not certain the WaitForSingleObject is the way to go... I think its better to loop with GetExitCodeProcess(pi.hProcess,iExitCode) until iExitCode <> STILL_ACTIVE and then check for data on each pass through the loop.
The code as written does not operate under Delphi 2007 either, so its not a Delphi 2009 unicode issue.
Changing your inner loop to the following works:
if Handle then
begin
try
repeat
WasOK := ReadFile(StdOutPipeRead, Buffer, 255, BytesRead, nil);
for ix := 0 to BytesRead-1 do
begin
OutData := OutData + AnsiChar(Buffer[ix]);
end;
GetExitCodeProcess(pi.hProcess,iExit);
until (iExit <> STILL_ACTIVE);
finally
CloseHandle(PI.hThread);
CloseHandle(PI.hProcess);
end;
I made the following corrections/additions to the local variables:
Buffer: array[0..255] of byte;
iExit : Cardinal;
IX : integer;
I also moved the CloseHandle(StdOutPipeWrite) just before the close of the StdOutPipeRead.