When using pipes to read from spawned processes, is it possible to terminate said program when it asks for input?
If it doesn't terminate, the usual ReadFile loop until the pipe is closed will block forever:
tsi.cb := SizeOf(TStartupInfo);
tsi.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
tsi.hStdInput := hInputRead;
tsi.hStdOutput := hOutputWrite;
tsi.hStdError := hErrorWrite;
if not CreateProcess(nil, PAnsiChar(Cmd), #sa, #sa, true, 0, nil, PAnsiChar(WorkDir), tsi, tpi) then
exit;
// Close handles we don't need. We are only interested in its output
CloseHandle(hOutputWrite);
CloseHandle(hInputRead);
CloseHandle(hErrorWrite);
repeat
// ReadFile will never return while our programs waits for input
if not ReadFile(OutputRead, Buf, SizeOf(Buf), nRead, nil) or (nRead = 0) then
begin
if GetLastError = ERROR_BROKEN_PIPE then
Break
else
ErrFunc('Pipe read error, could not execute file');
end;
// do something with buf...
until False;
Terminating by itself is quite easy (just use TerminateProcess), but one only knows when to call TerminateProcess when its too late, i.e. when it hangs.
First, you're not using pipes in the Win32 sense, you're using redirected console output.
That being said, however, you can wait on the file handle and abort if the wait times out.
Related
I need a way to pause the execution of a function for some seconds. I know i can use the sleep method to do it, but this method 'freezes' the application while its execution. I also know i can use something like the code below to avoid freezing :
// sleeps for 5 seconds without freezing
for i := 1 to 5 do
begin
sleep(1000);
application.processmessages;
end;
There are two problems of this approach : one is the fact the freezing still occurs each one second and the second problem is the calling to 'application.processmessages' each second. My app is CPU intensive and each processmessages call do a lot of unnecessary work that uses unnecessary CPU power ; i just want to pause the workflow, nothing more.
What i really need would be a way to pause the execution just like a TTimer, in the example below :
// sleeps for 5 seconds
mytimer.interval := 5000;
mytimer.enabled := true;
// wait the timer executes
// then continue the flow
// running myfunction
myfunction;
The problem of this approach is 'myfunction' won't wait the for mytimer, it will run right after the mytimer is enabled.
Is there another approach to achieve a pause like i want ?
Thanks in advance.
As David stated, the best option is to move the work into a separate thread and stop blocking the main thread altogether. But, if you must block the main thread, then at the very least you should only call ProcessMessages() when there really are messages waiting to be processed, and let the thread sleep the rest of the time. You can use MsgWaitForMultipleObjects() to handle that, eg:
var
Start, Elapsed: DWORD;
// sleep for 5 seconds without freezing
Start := GetTickCount;
Elapsed := 0;
repeat
// (WAIT_OBJECT_0+nCount) is returned when a message is in the queue.
// WAIT_TIMEOUT is returned when the timeout elapses.
if MsgWaitForMultipleObjects(0, Pointer(nil)^, FALSE, 5000-Elapsed, QS_ALLINPUT) <> WAIT_OBJECT_0 then Break;
Application.ProcessMessages;
Elapsed := GetTickCount - Start;
until Elapsed >= 5000;
Alternatively:
var
Ret: DWORD;
WaitTime: TLargeInteger;
Timer: THandle;
// sleep for 5 seconds without freezing
Timer := CreateWaitableTimer(nil, TRUE, nil);
WaitTime := -50000000; // 5 seconds
SetWaitableTimer(Timer, WaitTime, 0, nil, nil, FALSE);
repeat
// (WAIT_OBJECT_0+0) is returned when the timer is signaled.
// (WAIT_OBJECT_0+1) is returned when a message is in the queue.
Ret := MsgWaitForMultipleObjects(1, Timer, FALSE, INFINITE, QS_ALLINPUT);
if Ret <> (WAIT_OBJECT_0+1) then Break;
Application.ProcessMessages;
until False;
if Ret <> WAIT_OBJECT_0 then
CancelWaitableTimer(Timer);
CloseHandle(Timer);
Move the task that needs to be paused into a separate thread so that it does not interfere with the UI.
It is rather doubtful, that Application.ProcessMessages will really consumpt too much processor time. You can try to store the moment of time when you start waiting and then begin a repeat Application.ProcessMessages until...; circle checking the time span between the stored and current time.
If you have not a problem with using a timer, you can do this:
(ouside the timer-event:)
mytimer.interval := 5000;
mytimer.tag:=0;
mytimer.enabled := true;
(inside the timer-event:)
mytimer.tag:=mytimer.tag+1;
if mytimer.tag=2 then begin
mytimer.enabled:=false;
myfunction;
end;
I've written a multitreaded tcp server using fpFork() call. Works fine, but after client disconnects a zombie process remains. There is an infinite loop where I wait for incoming connection, fork, pass this conenction to the child, which take care of it and then exits. However the child remains as zombie until the parent terminates.
while True do
begin
// Accept connection
ClientAddrLen := sizeof(ClientAddr);
ClientSock := fpaccept(ServerSock, #ClientAddr, #ClientAddrLen);
if ClientSock > 0 then // Success?
begin
Pid := fpFork();
// Error fork
if pid < 0 then
begin
CloseSocket(ClientSock);
continue;
end
// Child process
else if pid = 0 then
begin
CloseSocket(ServerSock);
handleClient(ClientSock);
CloseSocket(ClientSock);
Halt(0);
end
// parent process
else if pid > 0 then
begin
CloseSocket(ClientSock);
continue;
end;
end;
end;
I headr about function fpWait() or fpWaitPid() but free pascal documentation lacks examples and googling it is worthless, thus I don't even how to use it.
I'm using fpc 2.6.4 on FreeBSD.
Update 1
After some trial-and-error testing, reading manuals and discussions I tried some combinations. I put following functions in the parent part of executed code:
else if pid > 0 then
begin
CloseSocket(ClientSock);
//here
continue;
end;
a) Using WaitProcess(pid) (is equivalet with fpWaitPid(pid, #Status, 0))
With this parent process wait for the child, however as the parent was waiting it couldn't accept another connection until the child is terminated.
b) Using fpWaitPid(pid, #Status, WNOHANG)
This function does not block the program, but it doesn't bother doing anything. Like the function is not even there. It's confusing, because everywhere i read about this (it was coded in C,but it doe's not matter, these functions are only wrappers around unix calls) was suggested use of this.
At this point I have no idea what could be wrong. Thank you in advance.
When child process was ended it's bacame a zombee and system sending the SIGCHLD signal to the parent process. Parent process have will call wait (fpwait in freepascal) function when it accept the SIGCHLD signal. If parent process call wait function system send to parent process exit code of the child process and erase it's record and free it's pid.
If parent process don't react on SIGCHLD signals and (or) don't call wait function then zombee process's quantity will multiply until the parent process's termination.
procedure DoSigChld; cdecl;
var stat : longint;
begin
fpwait(stat);
end;
SignalAction.sa_handler := #DoSigChld;
fpsigaction(SIGCHLD, #SignalAction, nil);
I use the code below to prevent the user from killing my program from Task Manager (I found it somewhere):
function PreventProcessKill: Integer;
var
hProcess:Thandle;
EmptyDacl: TACL ;
pEmptyDacl: PACL ;
dwErr : DWORD ;
begin
hProcess := GetCurrentProcess();
ZeroMemory(#EmptyDacl, SizeOF(tacl));
pEmptyDacl := #EmptyDacl;
if (not InitializeAcl(EmptyDacl, sizeof(tACL), 2)) then dwErr := GetLastError()
else dwErr := SetSecurityInfo(hProcess, SE_KERNEL_OBJECT, DACL_SECURITY_INFORMATION, nil, nil,
#EmptyDacl, nil);
Result:= dwErr;
end;
It works great, but at some point in my program I need to revert the effect and allow closing from Task Manager.
Any ideas?
You are modifying the DACL when you call SetSecurityInfo. So, just before you do that call GetSecurityInfo and make a note of the original process DACL. When the time comes, call SetSecurityInfo again to restore it.
Do note that a determined user can also do this so you cannot actually stop them from killing the process. You are just making it a little awkward.
I finally found it. I can call SetSecurityInfo, passing nil instead of an empty DACL. It seems that an empty DACL means "No permissions" and a null DACL means "All permissions".
I'm developing a Windows 7 application which has to prevent WinDVD from triggering new disc availability when inserted (i.e. inserting a DVD).
Background information:
I'm working out this little application for a company which has to compare two movie players at a time playing simultaneously the same DVD, from different drives.
They're doing heuristic quality testing to determine best DVD player at the moment to bundle it into their new line of PCs.
At the moment their best choice seem to be WinDVD, so every other test has to be conducted against it. Problem is, when they insert first DVD, it's all right the default player WinDVD starts.
Then when they insert the second disc, the default player responds first, so they are forced to close the window and open the other player they're testing.
This is done for many movies that represent a reference to them to spot color rendering and image quality. It becomes tedious for users to close the additional window when it shows up, as this operation is due to be repeated hundreds of times a week.
My program is trying to inhibit default player' second response
I thought to intercept a WM_DEVICECHANGE message to somehow create a global hook for it.
Problem is, intercepting WM_DEVICECHANGE works very well, but it doesn't block WinDVD's ability to trigger new units insertion, evidently letting the message being delivered anyways. Due to this I started thinking how to prevent that message being dispatched after my interception.
In order to realize this global hook I thought of, I'm using this line of code:
CurrentHook:=setwindowshookex(WH_CALLWNDPROC,HookProcAdd,LibHandle,0);
linked to the callback contained within a DLL of mine and I can see that WM_DEVICECHANGE is correctly intercepted, but as I said the message is still dispatched to the whole system.
Any suggestion appreciated.
Updates:
#TOndrej :
I've tried what follows:
var
rlen : DWORD;
pRelen : ^DWORD;
h : THandle;
val : Boolean;
pVal: ^Boolean;
res : Boolean;
begin
rlen := 0;
val := True;
pVal := #val;
pRelen := #val;
h := CreateFile(PChar('\\.\d:'), GENERIC_READ or GENERIC_WRITE, FILE_SHARE_READ or FILE_SHARE_WRITE, nil,
OPEN_EXISTING, 0, 0);
if h <> INVALID_HANDLE_VALUE then
begin
res:= DeviceIoControl(h,
IOCTL_STORAGE_MCN_CONTROL,
pVal,
SizeOf(val),
nil,
0,
rlen,
nil);
if not res then
begin
ShowMessage('Error');
end;
CloseHandle(h);
end;
end;
but res is false every time. What am I missing?
For IOCTL_STORAGE_MCN_CONTROL control code, files must be opened with the FILE_READ_ATTRIBUTES access right:
var
rlen: DWORD;
pVal: PBOOL;
res: BOOL;
begin
rlen := 0;
GetMem(PVal,SizeOf(BOOL));
pVal^ := TRUE;
h := CreateFile(PChar('\\.\D:'),
FILE_READ_ATTRIBUTES,
FILE_SHARE_READ OR FILE_SHARE_WRITE,
nil, OPEN_EXISTING, 0, 0);
if h <> INVALID_HANDLE_VALUE then
begin
res:= DeviceIoControl(h,
IOCTL_STORAGE_MCN_CONTROL,
pVal,
SizeOf(BOOL),
nil,
0,
rlen,
nil);
if not res then
begin
ShowMessage('Error');
end else
begin
ShowMessage('Device Notification Disabled');
end;
// close file handle
CloseHandle(h);
// After CloseHandle, file notification is restored...
end;
end;
In my test, after CloseHandle, device notification is restored...
The correct, official, and documented way to handle this is to suppress AutoRun programmably. If your app is not in the foreground to receive the "QueryCancelAutoPlay" message, your global hook should be able to respond to the message without dispatching it.
Why not just disable the CD autorun capability by setting the registry key HKLM\System\CurrentControlSet\Services\CDRom and set the key Autorun to 0 instead of 1?
The customer must launch each application separately, or maybe choose an "open with..." option, but that should be perfectly suitable for benchmark testing. By your description they are testing runtime performance and playback quality, not autorun capability.
Say I have got a program that hogs the processor and/or hard disk to the point that it makes it nearly impossible to do anything else on that computer. Now I don't want to kill that program because what it does is useful (it's a batch job that really is that CPU or disk heavy, e.g. it could ZIP a few gigabytes of data files) but for a short time I need to do something else on that computer. Is there any way an external program could do to freeze that performance killer for a while?
It's like the old DOS option to switch between programs without actually having multitasking.
Assume that the hypothetical program in question is a 3rd party product for which I don't have the source code and there is no way to tell it to pause.
I know I can change the program's priority class e.g. in TaskManager but that's not enough, I want to freeze it.
I am talking about Windows XP as the OS and would like to program a solution with Delphi. I have got all rights on the machine, so I could start something as administrator, replace files and I could also install a service if that is necessary.
You can freeze it with Process Explorer: Right-click on your program and select Suspend.
Here is some sample code for programmatic freezing from http://www.c-plusplus.de/forum/viewtopic-var-p-is-1460293.html, edited and omitted error checking for brevity:
#include <windows.h>
_NtSuspendProcess NtSuspendProcess =
(_NtSuspendProcess) GetProcAddress( GetModuleHandle( "ntdll" ),
"NtSuspendProcess" );
HANDLE ProcessHandle = OpenProcess( PROCESS_ALL_ACCESS, FALSE, pid);
NtSuspendProcess( ProcessHandle );
If you want to do it programatically you can use the approach described here.
What is does, is enumerating all the threads in a process and then suspending them. There is no SuspendProcess API, so this is a simulation of such a call.
Beware that this can potentionally have some bad side effects. It depend on the process and how it is written.
I don't know of any other way to do it in the Win32/64 API world. If you go lower to the kernel land and use the NT* APIs you have "NtSuspendProcess" API available. But this is undocumented so it can change with any version of windows or even with any service pack (not very likely though).
The declaration of "NtSuspendProcess" can be found in the JEDI ports of the windows APIs.
You can use my ProcessInfo component to suspend all threads belonging to the process. The approach is similar to what Runner explained to you. The code would be something like this:
var
Process : TProcessItem;
AThread: TThreadItem;
begin
Process := ProcessInfo1.RunningProcesses.FindByName('notepad.exe');
if Assigned(Process) then
begin
for AThread in Process.Threads do
AThread.SuspendThread;
end;
end;
You can download source code of ProcessInfo form here
function OpenThread(dwDesiredAccess: DWORD; InheritHandle: Boolean; dwThreadID: DWORD): THandle; stdcall; external 'kernel32.dll';
function ResumeProcess(PID: DWORD):Boolean;
var
tid, snap: THandle;
TE32: TThreadEntry32;
begin
Result := False;
snap := CreateToolHelp32SnapShot(TH32CS_SNAPTHREAD, 0);
TE32.dwSize := SizeOf(TThreadEntry32);
Thread32First(snap, TE32);
repeat
if TE32.th32OwnerProcessID = PID then begin
tid := OpenThread($0002, FALSE, TE32.th32ThreadID);
ResumeThread(tid);
Result := TRUE;
CloseHandle(tid);
end;
until Thread32Next(snap, TE32) = false;
CloseHandle(snap);
end;
function SuspendProcess(PID: DWORD): Boolean;
var
tid, snap: THandle;
TE32: TThreadEntry32;
begin
Result := False;
snap := CreateToolHelp32SnapShot(TH32CS_SNAPTHREAD, 0);
TE32.dwSize := SizeOf(TThreadEntry32);
Thread32First(snap, TE32);
repeat
if TE32.th32OwnerProcessID = PID then begin
tid := OpenThread($0002, FALSE, TE32.th32ThreadID);
SuspendThread(tid);
Result := TRUE;
CloseHandle(tid);
end;
until Thread32Next(snap, TE32) = false;
CloseHandle(snap);
end;
Hope this helps