The Win app is a form with a button and a memo. If you press the button a
thread will be created and executed. The thread starts a command-line app
(with CreateProcess) and reads the output of that app (via anonymous pipe /
redirected stdout) until the command-line app has finished. Each time the
thread gets an output line it sends that string to the main app using
PostMessage. The event handler of the main app outputs each string received
to the memo (with Memo.Lines.Add).
All steps described above work fine but it lasts nearly to *end* of
execution of the command-line app before there's any output displayed in the
main app's memo. I lowered the priority of the command-line process, I
inserted a short Sleep to the secondary thread, I tried Memo.Update, but
nothing changed that "non real time behaviour".
Any help would really appreciated.
Tom
> All steps described above work fine but it lasts nearly to *end*
> of execution of the command-line app before there's any output
> displayed in the main app's memo.
Then you are doing something to block the main thread from displaying
updates properly. Please show your actual code.
Gamibt
>> All steps described above work fine but it lasts nearly to *end*
>> of execution of the command-line app before there's any output
>> displayed in the main app's memo.
>
> Then you are doing something to block the main thread from displaying
> updates properly. Please show your actual code.
This isn't necessarily the case. Problem is that redirected STDOUT is often
subject to a 128 (?) byte buffer. You might be successful with playing
around with TTextRec fields, but I'm not sure.
--
Ben
> This isn't necessarily the case. Problem is that redirected STDOUT is
> often subject to a 128 (?) byte buffer.
That would not prevent the code from updating the UI properly. Especially
since the reading of the STDOUT is happening in a separate thread to begin
with. ReadFile() would return the outputted data when STDOUT's buffer is
full. Also, the code could use PeekNamedPipe() to determine the amount of
data actually in the STDOUT buffer and then read it all regardless of its
actual size.
Gambit
Here's my actual code. Main app:
procedure TfrmMain.WMNewLine (var Msg:TMessage);
var
NewLine: PChar;
begin
NewLine:=PChar(Msg.WParam);
Memo.Lines.Add(StrPas(NewLine));
StrDispose(NewLine);
Msg.Result:=0;
end;
procedure TfrmMain.btnExecDosAppClick (Sender:TObject);
begin
FDosThread:=TDosThread.Create(True);
FDosThread.FormHandle:=Handle;
FDosThread.Resume;
end;
And the worker thread:
type
TDosThread = class(TThread)
private
FFormHandle: HWND;
protected
procedure Execute; override;
published
property FormHandle: HWND write FFormHandle;
end;
implementation
const
sCmdLine = 'C:\MyCmdLineApp.exe "param1" "param2"';
procedure TDosThread.Execute;
const
ReadBufferSize = 128;
var
sa: PSECURITYATTRIBUTES;
read_stdout, newstdout: THandle;
si: STARTUPINFO;
pi: PROCESS_INFORMATION;
ReadBuffer: array[0..ReadBufferSize-1] of Char;
ExitCode: Cardinal;
BytesRead, BytesAvail: Cardinal;
PostMsgBuffer: PChar;
begin
GetMem(sa, SizeOf(SECURITY_ATTRIBUTES));
sa.lpSecurityDescriptor := nil;
sa.nLength := SizeOf(SECURITY_ATTRIBUTES);
sa.bInheritHandle := true;
CreatePipe(read_stdout, newstdout, sa, 0);
GetStartupInfo(si);
si.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
si.wShowWindow := SW_HIDE;
si.hStdOutput := newstdout;
si.hStdError := newstdout;
si.hStdInput := GetStdHandle(STD_INPUT_HANDLE);
CreateProcess(nil, PChar(sCmdLine), nil, nil, TRUE,CREATE_NEW_CONSOLE or
NORMAL_PRIORITY_CLASS, nil, nil, si, pi);
FillChar(ReadBuffer, ReadBufferSize, #0);
while true do begin
GetExitCodeProcess(pi.hProcess, ExitCode);
if ExitCode<>STILL_ACTIVE then
Break;
PeekNamedPipe(read_stdout, @ReadBuffer[0], ReadBufferSize-1, @BytesRead,
@BytesAvail, nil);
if BytesRead<>0 then begin
if BytesAvail>ReadBufferSize-1 then
while BytesRead>=ReadBufferSize-1 do begin
FillChar(ReadBuffer, ReadBufferSize, #0);
ReadFile(read_stdout, ReadBuffer, ReadBufferSize-1, BytesRead,
nil);
PostMsgBuffer:=StrAlloc(ReadBufferSize);
StrCopy(PostMsgBuffer,ReadBuffer);
PostMessage(FFormHandle, WM_NEWLINE, WParam(PostMsgBuffer), 0);
end
else begin
FillChar(ReadBuffer, ReadBufferSize, #0);
ReadFile(read_stdout, ReadBuffer, ReadBufferSize-1, BytesRead, nil);
PostMsgBuffer:=StrAlloc(ReadBufferSize);
StrCopy(PostMsgBuffer,ReadBuffer);
PostMessage(FFormHandle, WM_NEWLINE, WParam(PostMsgBuffer), 0);
end;
end;
end;
FreeMem(sa);
CloseHandle(pi.hThread);
CloseHandle(pi.hProcess);
CloseHandle(newstdout);
CloseHandle(read_stdout);
end;
Tom
if Assigned(fOnWorking) then
fOnWorking(Self);
Sleep(10); // <--------------------------
It's been a few years since I wrote this but I think that the Sleep
statement allows pending messages to be processed (I can't think why it's
there otherwise) ... and the only active process that will be demanding CPU
resources will be our own DOS routine and related pipe function.
Andrew
Be aware of the fact that a TMemo has a finite limit to the number of lines
that it can contain and our application had to process thousands of lines
from an Interbase GBAK command ... so we used a TRichEdit.
This is our event handler for our DOS execute ... we wanted it to show that
last line added :
procedure TfrmBackupRestore.DatabaseToolsNewLine(Sender : TObject; aLine :
string);
begin
if (fRichEditCurrent <> nil) then begin
with fRichEditCurrent do begin
SelStart := GetTextLen;
SelText := aLine + #13#10;
Perform(EM_SCROLLCARET, 0, 0);
end; {with}
end; {if}
ShowWorking;
end; {DatabaseToolsNewLine}
Anyway ... good luck ...
Andrew
{-----------------------------}
unit CJDosExecute;
interface
uses
Windows, Classes;
type
TTextLineEvent = procedure(Sender : TObject; aLine : string) of object;
type
TCJDosExecute = class(TObject)
private
fCommandLine : string;
fAbort : boolean;
fOnLineEvent : TTextLineEvent;
fOnWorking : TNotifyEvent;
public
constructor Create;
function Execute : DWORD;
property CommandLine : string read fCommandLine write
fCommandLine;
procedure Abort;
property OnWorking : TNotifyEvent read fOnWorking write
fOnWorking;
property OnNewLine : TTextLineEvent read fOnLineEvent write
fOnLineEvent;
property Aborted : boolean read fAbort;
end;
implementation
uses
SysUtils;
{--------------------------------------------------------------------------------------------------}
constructor TCJDosExecute.Create;
begin
inherited;
fCommandLine := '';
end; {constructor}
{--------------------------------------------------------------------------------------------------}
procedure TCJDosExecute.Abort;
begin
fAbort := true;
end; {Abort}
{--------------------------------------------------------------------------------------------------}
function TCJDosExecute.Execute : DWORD;
const
cBadExitCode = 9999;
var
SecurityAttributes : TSecurityAttributes;
StartupInfo : TStartupInfo;
ProcessInfo : TProcessInformation;
StdOutPipeRead : THandle;
StdOutPipeWrite : THandle;
CreateProcOK : boolean;
Buffer : array[0..255] of Char;
BytesRead : DWORD;
Text : string;
aLine : string;
lp1 : integer;
begin
fAbort := false;
Result := cBadExitCode;
if (fCommandLine <> '') then begin
with SecurityAttributes do begin
nLength := SizeOf(SecurityAttributes);
bInheritHandle := true;
lpSecurityDescriptor := nil;
end; {with}
CreatePipe(StdOutPipeRead, StdOutPipeWrite, @SecurityAttributes, 0);//
Create pipe for standard output redirection
try
with StartupInfo do begin //
Make child process use StdOutPipeWrite as standard out
FillChar(StartupInfo, SizeOf(StartupInfo), 0); //
and make sure it does not show on screen.
cb := SizeOf(StartupInfo);
dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
wShowWindow := SW_HIDE;
hStdInput := GetStdHandle(STD_INPUT_HANDLE); //
don't redirect std input
hStdOutput := StdOutPipeWrite;
hStdError := StdOutPipeWrite;
end; {with}
CreateProcOK := CreateProcess(nil, PChar(fCommandLine), nil, nil,
true, NORMAL_PRIORITY_CLASS, nil, nil, StartupInfo, ProcessInfo);
CloseHandle(StdOutPipeWrite); //
Now that the handle has been inherited, close write to be safe.
//
We don't want to read or write to it accidentally.
if not CreateProcOK then //
if process could be created then handle its output
raise Exception.Create('¡ No podía ejecutar la línea de comando !')
else begin
try
Text := ''; //
get all output until dos app finishes
repeat
if Assigned(fOnWorking) then
fOnWorking(Self);
Sleep(10);
if ReadFile(StdOutPipeRead, Buffer, 255, BytesRead, nil) then
begin
if (BytesRead > 0) then begin //
has anything been read?
Buffer[BytesRead] := #0; //
finish buffer to PChar
Text := Text + Buffer; //
combine the buffer with the rest of the last run
lp1 := 1;
while (lp1 < Length(Text)) do begin
if (Text[lp1] = #13) and (Text[succ(lp1)] = #10) then
begin
aLine := Copy(Text, 1, pred(lp1));
if Assigned(fOnLineEvent) then
fOnLineEvent(Self, aLine);
Delete(Text, 1, succ(lp1));
lp1 := 1;
end else
inc(lp1);
end; {while}
end; {if}
end else
break;
if fAbort then begin //
The user has decided to stop the process.
TerminateProcess(ProcessInfo.hProcess, 0);
break;
end; {if}
until (BytesRead = 0);
WaitForSingleObject(ProcessInfo.hProcess, INFINITE); //
Wait for console app to finish (should be already at this point)
GetExitCodeProcess(ProcessInfo.hProcess, Result);
finally
CloseHandle(ProcessInfo.hThread);
CloseHandle(ProcessInfo.hProcess);
end; {try}
end; {if}
finally
CloseHandle(StdOutPipeRead);
end; {try}
end; {if}
end; {Execute}
{--------------------------------------------------------------------------------------------------}
{CJDosExecute}
end.
> That would not prevent the code from updating the UI properly.
> Especially since the reading of the STDOUT is happening in a separate
> thread to begin with. ReadFile() would return the outputted data when
> STDOUT's buffer is full. Also, the code could use PeekNamedPipe() to
> determine the amount of data actually in the STDOUT buffer and then
> read it all regardless of its actual size.
The problem is that when you have a console application writing eg a "." to
STDOUT every second, you might not see the first redirected stuff after
about two minutes. ReadFile() won't do any good because it would return
nothing even if the console application has written some dots in the
meantime.
Of course all this should run in a thread of its own etc etc - I was merely
commenting on the STDOUT buffer issue.
--
Ben
thanks very much for your detailed answer. But I think that all the things
you pointed out are *not* the reason for my problem. In contrast to your
source code I took the CreateProcess-And-Get-Output part out to a secondary
thread. So the main thread has nothing to do but to respond to incoming
messages. Each thread gets it own piece of the "time cake" by Windows OS, so
imho there must be enough time for the main thread to respond to incoming
messages. For example, minimizing/maximizing the Win app when the
command-line app is running works without any noticable delay.
Tom
"Andrew Jameson" <softspots...@SPAMgmail.com> schrieb im Newsbeitrag
news:457b...@newsgroups.borland.com...
Andrew
> The problem is that when you have a console application writing eg a "."
> to STDOUT every second, you might not see the first redirected stuff
> after about two minutes. ReadFile() won't do any good because it would
> return nothing even if the console application has written some dots in
> the meantime.
Yes, ReadFile() will return whatever is currently in STDOUT. I tested it to
make sure, and it worked fine for me. The reading code grabbed the data in
real-time, even when the console app was outputting data very slowly.
Gambit
> Here's my actual code. Main app:
You are running a tight unyielding loop in your thread, so the main thread
is likely starving for CPU time. Try this thread code instead:
procedure TfrmMain.WMNewLine (var Msg:TMessage);
var
NewLine: PChar;
S: String;
begin
NewLine := PChar(Msg.LParam);
try
SetString(S, NewLine, Msg.WParam);
Memo.Lines.Add(S);
finally
StrDispose(NewLine);
end;
end;
procedure TDosThread.Execute;
const
ReadBufferSize = 128;
var
sa: SECURITY_ATTRIBUTES;
read_stdout, write_stdout: THandle;
si: STARTUPINFO;
pi: PROCESS_INFORMATION;
function CheckStdOut: Boolean;
var
BytesAvail, BytesToRead, BytesRead: DWORD;
ReadBuffer: array[0..ReadBufferSize-1] of Char;
PostMsgBuffer: PChar;
begin
Result := False;
BytesAvail := 0;
if not PeekNamedPipe(read_stdout, nil, 0, nil, @BytesAvail, nil)
then Exit;
while BytesAvail > 0 do
begin
BytesToRead = ReadBufferSize;
if BytesToRead > BytesAvail then BytesToRead := BytesAvail;
BytesRead := 0;
if not ReadFile(read_stdout, ReadBuffer, BytesToRead,
BytesRead, nil) then Exit;
PostMsgBuffer := StrAlloc(BytesRead);
StrLCopy(PostMsgBuffer, ReadBuffer, BytesRead);
PostMessage(FFormHandle, WM_NEWLINE, WParam(BytesRead),
LParam(PostMsgBuffer));
Dec(BytesAvail, BytesRead);
end;
Result := True;
end;
begin
sa.nLength := SizeOf(SECURITY_ATTRIBUTES);
sa.lpSecurityDescriptor := nil;
sa.bInheritHandle := TRUE;
if not CreatePipe(read_stdout, write_stdout, @sa, 0) then Exit;
GetStartupInfo(si);
si.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
si.wShowWindow := SW_HIDE;
si.hStdOutput := write_stdout;
si.hStdError := write_stdout;
si.hStdInput := GetStdHandle(STD_INPUT_HANDLE);
if CreateProcess(nil, PChar(sCmdLine), nil, nil,
TRUE,CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, nil, nil, si, pi) then
begin
CloseHandle(pi.hThread);
while WaitForSingleObject(pi.hProcess, 10) = WAIT_TIMEOUT then
begin
if not CheckStdOut then Break;
end;
CheckStdOut;
CloseHandle(pi.hProcess);
end;
CloseHandle(write_stdout);
CloseHandle(read_stdout);
end;
Gambit
> Yes, ReadFile() will return whatever is currently in STDOUT. I tested
> it to make sure, and it worked fine for me. The reading code grabbed
> the data in real-time, even when the console app was outputting data
> very slowly.
Strange - in my code, PeekNamedPipe() always returns either 0 or multiples
of 128 bytes. (Apart from the chunky output, everything's working fine - no
missing data, no unresponsive behaviour...)
--
Ben
> Strange - in my code, PeekNamedPipe() always returns either 0
> or multiples of 128 bytes.
Not for me. I get whatever is actually available at that moment in time.
That is what PeekNamedPipe() is supposed to do, afterall.
Gambit
> Strange - in my code, PeekNamedPipe() always returns either 0 or
> multiples of 128 bytes.
Make sure that your console application is not actually buffering the data
in 128-byte blocks before then flushing them to STDOUT.
Gambit
> Make sure that your console application is not actually buffering the
> data in 128-byte blocks before then flushing them to STDOUT.
It's a Delphi application...just plain old boring write() and writeln()
calls...
--
Ben
> Not for me. I get whatever is actually available at that moment in time.
> That is what PeekNamedPipe() is supposed to do, afterall.
I'm suspecting a pipe stream buffer of some kind.
--
Ben
Then your application is buffering data in 128-byte blocks before
flushing them to stdout. You can use the Flush function to send the
buffer's contents to the output before the buffer fills.
--
Rob
> Then your application is buffering data in 128-byte blocks before
> flushing them to stdout. You can use the Flush function to send the
> buffer's contents to the output before the buffer fills.
I don't want to change my console application - there are hundreds of other
console application that behave the same...
I was just wondering whether there was a way to get rid of the buffer in
the hosting/redirecting application.
--
Ben
There isn't. Delphi's default I/O functions don't tell the OS anything
until the buffer fills up. Before that, they just copy the data into a
buffer and return to the caller. (Delphi isn't alone in that regard.
Most programming environments do some amount of internal buffering.)
If the OS doesn't know anything about the intended output, then it can't
possibly give any other programs access to that output in advance.
Nonetheless, if the program is producing more than 128 bytes of output
in a typical run, then your other program should be able to capture some
of the output before the program finishes writing everything.
--
Rob
> Nonetheless, if the program is producing more than 128 bytes of output
> in a typical run, then your other program should be able to capture some
> of the output before the program finishes writing everything.
Sure - it does. That wasn't my initial problem. I just wasn't sure whether
it was the console applet that uses that buffer or whether the O/S did
something too.
One more question: why do we see the stuff on the screen without delay,
only when redirected?
--
Ben
> I don't want to change my console application - there are
> hundreds of other console application that behave the same...
Only those that are using buffered output. Many console applications do not
actually do that.
> I was just wondering whether there was a way to get rid of the
> buffer in the hosting/redirecting application.
You are missing the point. There is no buffer in the hosting application.
Your own console code is buffering the data separately. The redirection
code in the hosting application can only read what is actually flushed to
STDOUT. Your code is using Delphi's I/O functions, which buffer the data in
memory and only flush them to STDOUT when the buffer is full. The hosting
application cannot read what has not been flushed yet. So you have to
either stop using the I/O functions altogether and write to STDOUT directly,
or else call Flush() periodically in order to actually flush the buffered
data to STDOUT. That is all you can do.
Gambit
But we don't. This is apparent when a program is writing to both stdout
and stderr, or writing with multiple threads. The interleaving of output
statements in the code is not necessarily reflected in the way the
output text appears on the screen.
Also, calling ReadLn will usually force a flush -- to make sure a prompt
has been printed to the screen before pausing to wait for input.
And finally, if you're debugging a console program, you will probably
notice that when you pause at a breakpoint, not all the output will
appear on the console window yet.
--
Rob
> You are missing the point. There is no buffer in the hosting
> application. Your own console code is buffering the data separately.
> The redirection code in the hosting application can only read what is
> actually flushed to STDOUT. Your code is using Delphi's I/O
> functions, which buffer the data in memory and only flush them to
> STDOUT when the buffer is full. The hosting application cannot read
> what has not been flushed yet. So you have to either stop using the
> I/O functions altogether and write to STDOUT directly, or else call
> Flush() periodically in order to actually flush the buffered data to
> STDOUT. That is all you can do.
Okay. IOW, if I didn't write the to-be-redirected console application, I'm
out of luck.
--
Ben
> Then your application is buffering data in 128-byte blocks before
> flushing them to stdout. You can use the Flush function to send the
> buffer's contents to the output before the buffer fills.
Alternatively you can use your own buffer instead of the default.
Otherwise you'd have to call flush in a bunch of places. Normally this
was done to *increase* from the small 128 byte default but I don't see
why you couldn't decrease it using the same technique. There is a
predefined TextFile called 'output' which is really stdout:
var ch : char;
begin
SettextBuf(Output, Ch); // Force standard out to use a single-byte
buffer
Writeln('This is written one character at a time');
--
-Mike (TeamB)
> IOW, if I didn't write the to-be-redirected console application, I'm out
of luck.
Pretty much. Sure, you will eventually receive all of the data, but it may
not be as fast as you would like, if the console app is not writing to
STDOUT right away.
Gambit
Hi, Tom
Did you ever get this solved? I ran into it a few years back
and I did work out a solution. I've gotta dig up some old
files, then I can share it with you if you still need it.
Drop me a line at: digloo2 (at) gmail (dot-com) and I'll send
you some code.
-David