type
TArg<T> = reference to procedure(const Arg: T);
.
.
.
procedure TMainFrm.CaptureConsoleOutput(const ACommand: String; CallBack: TArg<PAnsiChar>);
const
CReadBufferREAD_BUFFER_SIZE = 2400;
var
saSecurity Security: TSecurityAttributes;
piEncoder: TProcessInformation;
hReadreadableEndOfPipe, writeableEndOfPipe: THandle;
hWritestart: THandleTStartUpInfo;
suiStartup Buffer: TStartupInfoPAnsiChar;
piProcess BytesRead: TProcessInformationDWORD;
pBuffer: array [0 .. CReadBuffer] of AnsiChar;
dBuffer: array [0 .. CReadBuffer] of AnsiChar;
dRead: DWORD;
dRunning: DWORD;
dAvailable: DWORD;
begin
saSecurity AppRunning: DWORD;
tmpSL:TStringList;
tmpS:string;
begin
tmpS := GetEnvironmentVariable('TEMP') + '\' + 'CKJUNPA.BAT';
tmpSL := TStringList.Create;
tmpSL.Add(ACommand);
// tmpSL.SaveToFile(tmpS, TEncoding.UTF8); - bat file seems correct, but does not work
// tmpSL.SaveToFile(tmpS, TEncoding.ANSI); - multibyte character is incorrectly written on batch file
tmpSL.SaveToFile(tmpS, TEncoding.ANSI);
Security.nLength := SizeOf(TSecurityAttributes);
saSecuritySecurity.bInheritHandle := trueTrue;
saSecuritySecurity.lpSecurityDescriptor := nil;
if CreatePipe(hRead{var}readableEndOfPipe, hWrite{var}writeableEndOfPipe, @saSecurity@Security, 0) then
begin
try
Buffer := AllocMem(READ_BUFFER_SIZE+1);
FillChar(suiStartupStart, SizeOfSizeof(TStartupInfoStart), #0);
suiStartup start.cb := SizeOf(TStartupInfo)(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;
suiStartup start.hStdInput := hRead; GetStdHandle(STD_INPUT_HANDLE); //we're not redirecting stdInput; but we still have to give it a valid handle
suiStartup start.hStdOutput := hWrite; writeableEndOfPipe; //we give the writeable end of the pipe to the child process; we read from the readable end
suiStartup start.hStdError := hWrite;writeableEndOfPipe;
//We can also choose to say that the wShowWindow member contains a value.
suiStartup //In our case we want to force the console window to be hidden.
start.dwFlags := STARTF_USESTDHANDLES orstart.dwFlags + STARTF_USESHOWWINDOW;
suiStartup start.wShowWindow := SW_HIDE;
// Don't forget to set up members of the PROCESS_INFORMATION structure.
piEncoder := 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
if CreateProcess(nil, PChar(ACommandtmpS), @saSecuritynil, @saSecuritynil, trueTrue, NORMAL_PRIORITY_CLASS, nil, nil, start, suiStartup,
piProcess) then
try
{var}piEncoder) 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
dRunning Apprunning := WaitForSingleObject(piProcesspiEncoder.hProcess, 100);
Application.ProcessMessages;
PeekNamedPipe(hRead, nil, 0, nil, @dAvailable, nil); //Read the contents of the pipe out of the readable end
//WARNING: if (dAvailable > 0) then
the console app never writes anything to the StdOutput, then ReadFile will block and never return
repeat
dReadBytesRead := 0;
ReadFile(hReadreadableEndOfPipe, pBufferBuffer[0], CReadBufferREAD_BUFFER_SIZE, dRead{var}BytesRead, nil);
if BytesRead>0 then
pBuffer[dRead] begin
Buffer[BytesRead]:= #0;
OemToCharA(pBuffer, dBuffer);
OemToAnsi(Buffer,Buffer);
// added for debugging -----------------------------------------
KDEBUG( string(Buffer));
// end of debugging --------------------------------------------
CallBack(dBufferBuffer);
until (dRead < CReadBuffer)end;
Application.ProcessMessagesuntil BytesRead<READ_BUFFER_SIZE;
until (dRunningApprunning <> WAIT_TIMEOUT);
finallyend;
FreeMem(Buffer);
CloseHandle(piProcesspiEncoder.hProcess);
CloseHandle(piProcesspiEncoder.hThread);
endCloseHandle(readableEndOfPipe);
finally
CloseHandle(hReadwriteableEndOfPipe);
CloseHandle(hWrite)end;
endtmpSL.Destroy;
end;
|