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;
Related
I would like to start one cmd process and keep feeding it some different commands. I would like to get every text cmd output as soon as text is out. So far I have this:
function GetDosOutput(const ACommandLine: string;
AWorkDir: string = 'C:\'): string;
var
_SA: TSecurityAttributes;
_SI: TStartupInfo;
_PI: TProcessInformation;
_StdOutPipeRead, StdOutPipeWrite: THandle;
_WasOK: boolean;
_Buffer: array [0 .. 255] of AnsiChar;
_BytesRead: Cardinal;
_Handle: boolean;
begin
Result := '';
_SA.nLength := SizeOf(_SA);
_SA.bInheritHandle := True;
_SA.lpSecurityDescriptor := nil;
CreatePipe(_StdOutPipeRead, StdOutPipeWrite, #_SA, 0);
try
FillChar(_SI, SizeOf(_SI), 0);
_SI.cb := SizeOf(_SI);
_SI.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
_SI.wShowWindow := SW_HIDE;
_SI.hStdInput := GetStdHandle(STD_INPUT_HANDLE);
_SI.hStdOutput := StdOutPipeWrite;
_SI.hStdError := StdOutPipeWrite;
_Handle := CreateProcess(nil, PChar('cmd.exe /C ' + ACommandLine), nil, nil,
True, 0, nil, PChar(AWorkDir), _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 + string(_Buffer);
Application.ProcessMessages;
end;
until not _WasOK or (_BytesRead = 0);
WaitForSingleObject(_PI.hProcess, INFINITE);
finally
CloseHandle(_PI.hThread);
CloseHandle(_PI.hProcess);
end;
finally
CloseHandle(_StdOutPipeRead);
end;
end;
How do I keep same cmd.exe process and give it different commands, e.g.
1) ping stackoverflow.com, see its content as soon as one line is printed
2) ipconfig /all ?
the code i use is as below:
begin
saSecurity.nLength := SizeOf(TSecurityAttributes);
saSecurity.bInheritHandle := True;
saSecurity.lpSecurityDescriptor := nil;
FillChar(suiStartup, SizeOf(TStartupInfo), #0);
suiStartup.cb := SizeOf(TStartupInfo);
suiStartup.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
suiStartup.wShowWindow := SW_HIDE;
ccOk:=CreateProcess(nil, PChar(ExecutableFirst+' '+CommandsFirst),#saSecurity,#saSecurity, True, NORMAL_PRIORITY_CLASS, nil, nil, suiStartup, piProcess);
if ccOk then
begin
CreateProcess(nil, PChar(ExecutableSecond + ' ' + CommandsSecond), #saSecurity,#saSecurity, True, NORMAL_PRIORITY_CLASS, nil, nil, suiStartup, piProcess);
try
repeat Running:=MsgWaitForMultipleObjects(2,piProcess.hProcess,True,100,QS_ALLINPUT);
Application.ProcessMessages;
until Running <> WAIT_TIMEOUT
finally
CloseHandle(piProcess.hProcess);
CloseHandle(piProcess.hThread);
if (Running=WAIT_OBJECT_0) then BidsConversion; //run this when both process has finished
end;
end else
begin
raise.Exception(GetLastError.toString);
Exit
end;
end;
The Code working but sometimes it is firing BidsConversion however the First Process is still not completed hence it Exception raised.
Why the app is not waiting for both processes to finish then fire the procedure ?
You are not checking the return value of the 2nd CreateProcess() to see if it failed, but more importantly you are completely misusing MsgWaitForMultipleObjects():
you are not passing both process handles to MsgWaitForMultipleObjects() even though you are setting its nCount parameter to 2.
you are calling ProcessMessages() unconditionally, even when MsgWaitForMultipleObjects() does not tell you that messages are waiting to be processed.
your loop's until clause is checking for the wrong termination value, so your loop will break prematurely on ANY condition that is not a timeout, eg: when either process finishes, or when a message is pending in the queue.
there is an important caveat with setting the bWaitAll parameter to True that you need to be aware of - see MsgWaitForMultipleObjects is a very tricky API on MSDN for details about that.
With that said, try something more like this:
var
...
arrHandles: array[0..1] of THandle;
numHandles, i: Integer;
begin
...
ccOk := CreateProcess(nil, PChar(ExecutableFirst + ' ' + CommandsFirst), #saSecurity, #saSecurity, True, NORMAL_PRIORITY_CLASS, nil, nil, suiStartup, piProcess);
if not ccOk then
RaiseLastOSError;
CloseHandle(piProcess.hThread);
arrHandles[0] := piProcess.hProcess;
numHandles := 1;
try
ccOk := CreateProcess(nil, PChar(ExecutableSecond + ' ' + CommandsSecond), #saSecurity, #saSecurity, True, NORMAL_PRIORITY_CLASS, nil, nil, suiStartup, piProcess);
if not ccOk then
RaiseLastOSError;
CloseHandle(piProcess.hThread);
arrHandles[1] := piProcess.hProcess;
numHandles := 2;
// there is a caveat when setting bWaitAll=True that the wait will not be
// completely satisfied until both handles are signaled AND the calling thread
// receives an input event! That last caveat is not desirable, so setting
// bWaitAll=False instead to avoid that so the loop can break immediately when
// both handles are signaled...
repeat
Running := MsgWaitForMultipleObjects(numHandles, arrHandles, False, INFINTE, QS_ALLINPUT);
if {(Running >= WAIT_OBJECT_0) and} (Running < (WAIT_OBJECT_0 + DWORD(numHandles))) then
begin
i := Integer(Running - WAIT_OBJECT_0);
CloseHandle(arrHandles[i]);
if i = 0 then arrHandles[0] := arrHandles[1];
Dec(numHandles);
end
else if Running = (WAIT_OBJECT_0 + DWORD(numHandles)) then begin
Application.ProcessMessages;
end
else if Running = WAIT_FAILED then begin
RaiseLastOSError;
end;
until numHandles = 0;
except
for i := 0 to numHandles-1 do begin
TerminateProcess(arrHandles[i], 0);
CloseHandle(arrHandles[i]);
end;
raise;
end;
BidsConversion; //run this when both processes have finished without error
...
end;
That being said, consider doing the wait asynchronously in a separate worker thread so you are not blocking the main UI thread anymore. You can create your own thread that calls WaitForMultipleObjects() (not MsgWaitForMultipleObjects() since you would not need to wait on the message queue anymore), or you can use RegisterWaitForSingleObject() on each process handle individually. Either way, let the worker thread(s) notify the main UI thread when waiting is finished, and just don't call BidsConversion() until you have received notification that both processes have finished.
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
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);
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;