I want to make a program that will do piping between two programs
Getting input from first, giving it to second that will do processing on it and give it back to me which I will give back to first
if Input <> '-' then
InS := TFileStream.Create(Input, fmOpenRead or fmShareDenyWrite)
else
InS := THandleStream.Create(GetStdHandle(STD_INPUT_HANDLE));
if Output <> '-' then
OutS := TFileStream.Create(Output, fmCreate or fmShareExclusive)
else
OutS := THandleStream.Create(GetStdHandle(STD_OUTPUT_HANDLE));
FillChar(StartupInfo, sizeof(StartupInfo), 0);
FillChar(ProcessInfo, sizeof(ProcessInfo), 0);
SecurityAttributes.nLength := sizeof(SecurityAttributes);
SecurityAttributes.bInheritHandle := True;
SecurityAttributes.lpSecurityDescriptor := Nil;
CreatePipe(OutPipe, InPipe, #SecurityAttributes, 0);
StartupInfo.cb := sizeof(StartupInfo);
StartupInfo.wShowWindow := SW_HIDE;
StartupInfo.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
StartupInfo.hStdInput := InPipe;
StartupInfo.hStdOutput := OutPipe;
Handle := CreateProcess(PChar(CLSAppInfo.CLSExeName),
PChar(Format('a - -', [])), nil, nil, True, 0, nil, PChar(GetCurrentDir),
StartupInfo, ProcessInfo);
if Handle then
begin
GetMem(Buffer, BLOCK_SIZE);
repeat
ReadByte := InS.Read(Buffer^, BLOCK_SIZE);
isOK := WriteFile(InPipe, Buffer^, ReadByte, WroteByte, nil);
WriteLn(ReadByte.ToString);
WriteLn(isOK.ToString());
if (not isOK) or (ReadByte = 0) then
break;
repeat
isOK := ReadFile(OutPipe, Buffer^, 255, ReadByte, nil);
if not isOK then
break;
if ReadByte = 0 then
break;
OutS.Write(Buffer, ReadByte);
until 0 = 1;
until 0 = 1;
FreeMem(Buffer);
CloseHandle(ProcessInfo.hThread);
CloseHandle(ProcessInfo.hProcess);
end;
CloseHandle(InPipe);
CloseHandle(OutPipe);
OutS.Free;
InS.Free;
But this just starts the programs and the programs ends without doing anything
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;
I have a problem with MapiSendMail function of MAPI32.dll. Everything seems fine, message is completed, then I send it by winapi function, and i get an Access violation error, it happend in MAPISendMail. Here's the fragment of the code:
MAPIModule := LoadLibrary(PWideChar(MAPIDLL));
if MAPIModule = 0 then
Result := -1
else
try
#SM := GetProcAddress(MAPIModule, 'MAPISendMail');
if #SM <> nil then
begin
Result := SM(0, application.Handle, Msg, MAPI_DIALOG {or MAPI_LOGON_UI}, 0);
end
else
Result := 1;
finally
end;
Also I was trying to change GetProcAddres to MAPISendMailW or MAPISendMailHelper, but then #SM was nil.
#Edit1
function TMail._SendMAPIEmail(const aTo, aAtts: array of AnsiString; const body, subject, SenderName, SenderEmail: string; ShowError: Boolean = true): Integer;
var
SM: TFNMapiSendMail;
Msg: MapiMessage;
lpSender: MapiRecipDesc;
Recips: array of MapiRecipDesc;
Att: array of MapiFileDesc;
TempAttNames: array of pAnsiChar;
TempAttNamesAnsi: array of AnsiString;
TempAttPaths: array of pAnsiChar;
TempRecip: array of pAnsiChar;
p1, LenTo, LenAtts: Integer;
MAPIModule: HModule;
sError: String;
i: integer;
begin
try
FillChar(Msg, SizeOf(Msg), 0);
{ get the length of all arrays passed to this function }
LenTo := length(aTo);
if Trim(aAtts[0]) <> '' then
LenAtts := length(aAtts)
else
LenAtts := 0;
{ ... }
SetLength(Recips, LenTo);
SetLength(TempRecip, LenTo);
Setlength(Att, LenAtts);
SetLength(TempAttNames, LenAtts);
SetLength(TempAttPaths, LenAtts);
SetLength(TempAttNamesAnsi, LenAtts);
{ to }
for p1 := 0 to LenTo - 1 do
begin
FillChar(Recips[p1], SizeOf(Recips[p1]), 0);
Recips[p1].ulReserved := 0;
Recips[p1].ulRecipClass := MAPI_TO;
{ Upgrade }
Recips[p1].lpszName := '';
TempRecip[p1] := pAnsichar(aTo[p1]);
Recips[p1].lpszAddress := TempRecip[p1];
end;
{ atts }
for p1 := 0 to LenAtts - 1 do
begin
FillChar(Att[p1], SizeOf(Att[p1]), 0);
FillChar(TempAttPaths[p1], SizeOf(pAnsiChar), 0);
FillChar(TempAttNames[p1], SizeOf(pAnsiChar), 0);
FillChar(TempAttNamesAnsi[01], SizeOf(AnsiChar), 0);
Att[p1].ulReserved := 0;
Att[p1].flFlags := 0;
Att[p1].nPosition := Cardinal($FFFFFFFF);
{ Upgrade }
TempAttPaths[p1] := pAnsichar(aAtts[p1]);
Att[p1].lpszPathName := TempAttPaths[p1];
TempAttNamesAnsi[p1] := AnsiString((ExtractFileName(string(aAtts[p1]))));
TempAttNames[p1] := pAnsiChar(TempAttNamesAnsi[p1]);
Att[p1].lpszFileName := TempAttNames[p1];
end;
{ fill the message }
with Msg do
begin
ulReserved := 0;
if subject <> '' then
{ Upgrade }
lpszSubject := pAnsichar(AnsiString(subject));
if body <> '' then
{ Upgrade }
lpszNoteText := pAnsichar(AnsiString(body));
if SenderEmail <> '' then
begin
lpSender.ulRecipClass := MAPI_ORIG;
if SenderName = '' then
lpSender.lpszName := pAnsichar(AnsiString(SenderEmail))
else
lpSender.lpszName := pAnsichar(AnsiString(SenderName));
lpSender.lpszAddress := pAnsichar(AnsiString(SenderEmail));
lpSender.ulEIDSize := 0;
lpSender.lpEntryID := nil;
lpOriginator := #lpSender;
end
else
Msg.lpOriginator := nil;
Msg.lpszMessageType := nil;
Msg.lpszDateReceived := nil;
Msg.lpszConversationID := nil;
Msg.flFlags := 0;
Msg.nRecipCount := LenTo;
Msg.lpRecips := #Recips[0];
Msg.nFileCount := LenAtts;
Msg.lpFiles := #Att[0];
end;
MAPIModule := LoadLibrary(PWideChar(MAPIDLL));
if MAPIModule = 0 then
Result := -1
else
try
#SM := GetProcAddress(MAPIModule, 'MAPISendMail');
if #SM <> nil then
begin
//Result := MapiSendMail(0, application.Handle, Msg, MAPI_DIALOG, 0);
Result := SM(0, 0, Msg, MAPI_DIALOG {or MAPI_LOGON_UI}, 0);
end
else
Result := 1;
finally
if Assigned(Att) and (Msg.nFileCount > 0) then
begin
for i := 0 to Msg.nFileCount - 1 do
begin
if Assigned(Att[i].lpszPathName) then
Att[i].lpszPathName := nil;
if Assigned(Att[i].lpszFileName) then
Att[i].lpszFileName := nil;
//FreeMem(Att[i].lpszPathName);
//Dispose(Att[i].lpszPathname);
//StrDispose(Att[i].lpszPathName);
//Dispose(Att[i].lpszFileName);
//StrDispose(Att[i].lpszFileName);
end;
Att := nil;
end;
if Assigned(Recips) and (Msg.nRecipCount > 0) then
begin
for i := 0 to Msg.nRecipCount - 1 do
begin
if Assigned(Recips[i].lpszName) then
Recips[i].lpszName := nil;
if Assigned(Recips[i].lpszAddress) then
Recips[i].lpszAddress := nil;
//if Assigned(Recips[i].lpszName) then
//Dispose(Recips[i].lpszName);
//if Assigned(Recips[i].lpszAddress) then
//Dispose(Recips[i].lpszAddress);
end;
Recips := nil;
end;
end;
Under Win32
Under Win32 it should not be a problem. Just first try calling MapiSendMail with very simple MapiMessage and if it will work, add complexity little by little. Your code is just too complex to debug it visually. Did you call MapiSendMail with very simple MapiMessage, just for testing? Please try the following code, it works for sure:
procedure TestSendExA(const APath1, ACaption1, APath2, ACaption2: AnsiString);
var
R: Integer;
MSG: TMapiMessage;
F: Array [0..1] of TMapiFileDesc;
Recipients: array[0..1] of TMapiRecipDesc;
Originator : array[0..0] of TMapiRecipDesc;
begin
if not FileExists(APath1) or not FileExists(APath2) then raise Exception.Create('File not found');
FillChar(Msg, SizeOf(Msg), 0);
Msg.lpszSubject := 'testo';
Msg.lpszNoteText := 'Hi there!';
Msg.lpszDateReceived := '2015/01/25 12:34';
Msg.lpszConversationId := '1234.test#ritlabs.com';
Msg.flFlags := MAPI_RECEIPT_REQUESTED;
FillChar(Recipients, SizeOf(Recipients), 0);
with Recipients[0] do
begin
ulRecipClass := MAPI_TO;
lpszName := 'Maxim Masiutin';
lpszAddress := 'maxim.test#ritlabs.com';
end;
with Recipients[1] do
begin
ulRecipClass := MAPI_CC;
lpszName := 'Vasilii Pupkin';
lpszAddress := 'pupkin.test#ritlabs.com';
end;
FillChar(Originator, SizeOf(Originator), 0);
with Originator[0] do
begin
ulRecipClass := MAPI_TO;
lpszName := 'Maxim Masiutin';
lpszAddress := 'max#ritlabs.com';
end;
Msg.lpOriginator := #Originator;
Msg.nRecipCount := 2;
Msg.lpRecips := #Recipients;
Msg.nFileCount := 2;
Msg.lpFiles := #F;
FillChar(F, SizeOf(F), 0);
F[0].lpszPathName := PAnsiChar(APath1);
F[0].lpszFileName := PAnsiChar(ACaption1);
F[1].lpszPathName := PAnsiChar(APath2);
F[1].lpszFileName := PAnsiChar(ACaption2);
R := MAPISendMail(MapiSession, 0, Msg, 0, 0);
end;
The MapiSession in the above example is a handle to the session returned by MapiLogon.
This sample code requires that you pass two valid file paths to valid files in APath1 and APath2.
Under Win64
It is the record alignment of MapiMessage and other records that it is important when you work with Simple MAPI from Delphi: (1) make sure the records don't have "packed" prefix; and (2) make sure you have {$A8} compiler directive is explicitly specified before first record definition. This will work fine under both Win32 and Win64.
I have following code:
if (APartitionStyle = 0) then //mbr
begin
hDevice := CreateFile(
PChar(ADisk),
GENERIC_WRITE and GENERIC_READ,
FILE_SHARE_WRITE and FILE_SHARE_READ,
nil,
OPEN_EXISTING,
0,
0);
error := SysErrorMessage(GetLastError);
if (hDevice = INVALID_HANDLE_VALUE) then
begin
error := SysErrorMessage(GetLastError);
result := error;
end;
dwIoControlCode := IOCTL_DISK_CREATE_DISK;
dsk.PartitionStyle := PARTITION_STYLE_MBR;
dsk.mbr.Signature := Random(9999);
lpInBuffer := #dsk;
nInBufferSize := sizeof(CREATE_DISK);
lpOutBuffer := nil;
nOutBufferSize := 0;
lpOverlapped := nil;
bresult := DeviceIOControl(
hDevice,
dwIoControlCode,
lpInBuffer,
nInBufferSize,
lpOutBuffer,
nOutBufferSize,
lpBytesReturned,
lpOverlapped);
if not bresult then
begin
error := SysErrorMessage(GetLastError);
result := error;
end;
I have executed the code as administrator or system and as user (with admin privilegs).
I have read something like: Driver is locked. Is there something missing in the code?
The handle is successfully created. On DeviceIOControl I get an error "Access Denied".
You are passing incorrect values to CreateFile(). You are using the and operator to combine bit flags:
hDevice := CreateFile(
PChar(ADisk),
GENERIC_WRITE and GENERIC_READ, { = 0 ! }
FILE_SHARE_WRITE and FILE_SHARE_READ, { = 0 ! }
nil,
OPEN_EXISTING,
0,
0);
You need to use the or operator instead:
hDevice := CreateFile(
PChar(ADisk),
GENERIC_WRITE or GENERIC_READ, { = $C0000000 ! }
FILE_SHARE_WRITE or FILE_SHARE_READ, { = $00000003 ! }
nil,
OPEN_EXISTING,
0,
0);
In the following code, I use "commandLine" parameter to create another process, but this subprocess possibly did not write sth into pipe, so the readfile function would block.
How to let it return if there is no data?
if (CreateProcess(nil, PChar('cmd.exe /C ' + CommandLine), #saSecurity, #saSecurity, True, NORMAL_PRIORITY_CLASS, nil, nil, suiStartup, piProcess))
then
sOutputString := '';
begin
repeat
dRunning := WaitForSingleObject(piProcess.hProcess, 100);
Application.ProcessMessages();
until (dRunning <> WAIT_TIMEOUT);
CloseHandle(piProcess.hProcess);
CloseHandle(piProcess.hThread);
repeat
dRead := 0;
ReadFile(hRead, pBuffer[0], CReadBuffer, dRead, nil);
// But it is blocked......
until (dRead < CReadBuffer);
end;
You can check if the named pipe contains data before reading from it
if PeekNamedPipe(hRead, nil, 0, nil, #dwBytesAvailable, nil) then
begin
if dwBytesAvailable > 0 then
begin
ReadFile(...);
end;
end;
I have Delphi code which is used to run Java.exe from JAVA_HOME with a given set of parameters. This is achieved through CreateProcess() by passing Command Line command to it. For a particualr set of input parameters, this gives me an error which says "Could not create Java Virtual Machine". I need to get this through PeekNamedPipe() into Delphi code and display it in the application. How can I achieve this?
The Delphi code looks like this:
begin
securityAttr.nlength := SizeOf(TSecurityAttributes);
securityAttr.binherithandle := true;
securityAttr.lpsecuritydescriptor := nil;
if CreatePipe (readPipe, writePipe, #securityAttr, 0) then
begin
buffer := AllocMem(READ_BUFFER + 1);
FillChar(startInfo, Sizeof(startInfo), #0);
startInfo.cb := SizeOf(startInfo);
startInfo.hStdOutput := writePipe;
startInfo.hStdInput := readPipe;
startInfo.dwFlags := STARTF_USESTDHANDLES + STARTF_USESHOWWINDOW;
startInfo.wShowWindow := SW_HIDE;
if SearchPath(nil, PChar(consoleApp), '.exe', SizeOf(consoleAppBuf), consoleAppBuf, exeName) = 0 then
raise EInOutError.CreateFmt('Could not find file %s', [consoleApp]);
FmtStr(commandLine, '"%s" %s', [consoleAppBuf, parameters]);
if CreateProcess(nil, PChar(commandLine), nil, nil, true, CREATE_NO_WINDOW, nil, nil, startInfo, processInfo) then
begin
totalBytesRead := 0;
repeat
exitCode := WaitForSingleObject(ProcessInfo.hProcess, 100);
Application.ProcessMessages;
if (PeekNamedPipe(readPipe, #buffer[totalBytesRead],
READ_BUFFER, #bytesRead,
#totalBytesAvail, #bytesLeftThisMessage)) then
begin
if (bytesRead > 0) then
ReadFile(readPipe, buffer[totalBytesRead], bytesRead, bytesRead, nil);
totalBytesRead := totalBytesRead + bytesRead;
end;
until (exitCode <> WAIT_TIMEOUT);
GetExitCodeProcess(ProcessInfo.hProcess, result);
buffer[totalBytesRead]:= #0;
OemToChar(buffer, buffer);
output.Text := output.Text + StrPas(buffer);
FreeMem(buffer);
CloseHandle(processInfo.hProcess);
CloseHandle(processInfo.hThread);
CloseHandle(readPipe);
CloseHandle(writePipe);
end
else
RaiseLastWin32Error;
end;
How can I read the error thrown by java.exe?
It is a mistake to connect both ends of the same pipe to the input and output of the same process. You are feeding the output of the process back into its input. Leave hStdInput as NULL.
You also play fast and loose with error checking, and run the risk of leaking handles because you don't use finally blocks. And I'm not keen on the busy loop. Or the call to ProcessMessages.
Leaving that all aside, the likely reason for you not reading errors is that they go to stderr. Connect the write end of your pipe to stderr, as well as to stdout:
startInfo.hStdOutput := writePipe;
startInfo.hStdError := writePipe;