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".
Related
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.
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.
I have an NT service that calls a console program written in Delphi 7, let's call it failover.exe that in turn calls NETSH using a procedure I found:
procedure ExecConsoleApp(CommandLine: ansistring; Output, Errors: TStringList);
Note: ExecConsoleApp uses CreateProcess, see the following link for full code: http://www.delphisources.ru/pages/faq/base/createprocess_console.html
I would pass the following to CommandLine before calling ExecConsoleApp:
cmd.exe /c "C:\Windows\system32\netsh.exe interface delete address "Wireless Network Connection" 192.168.0.36"
ExecConsoleApp will return an error:
The system cannot find the file specified
But if I were to run it in Command Prompt, it runs perfectly.
The strange thing is that I remembered it working on the first attempt on that 2003 Server, but after that, it failed regardless of the number of times I tried. In one of the attempt, I've also tried assigning logon as administrator user to the service but to no avail. Neither does fiddling with file security help.
I don't have a Win 2003 server to test with in office, but I have tested it on XP and Win7 and ExecConsoleApp works perfectly, although on XP, I had to amend ExecConsoleApp to execute from system32\wbem in order for it work work:
Res := CreateProcess(nil, PChar(CommandLine), nil, nil, True,
// **** Attention: Amended by to point current directory to system32\wbem, this is to solve an error returned by netsh.exe if not done otherwise.
// CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, #env, nil, si, pi);
CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, #env, pchar(GetSystemPath(WindRoot) + 'system32\wbem'), si, pi);
I've researched for a day but no clues, hope someone can help. Thanks.
Additional remarks -
Server is 32 bit Win2k3.
Tried domain administrator, doesn't work.
Code snippets:
Procedure ExecConsoleApp(CommandLine: ansistring; Output, Errors: TStringList);
var
sa: TSECURITYATTRIBUTES;
si: TSTARTUPINFO;
pi: TPROCESSINFORMATION;
hPipeOutputRead: THANDLE;
hPipeOutputWrite: THANDLE;
hPipeErrorsRead: THANDLE;
hPipeErrorsWrite: THANDLE;
Res, bTest: boolean;
env: array[0..100] of char;
szBuffer: array[0..256] of char;
dwNumberOfBytesRead: DWORD;
Stream: TMemoryStream;
begin
sa.nLength := sizeof(sa);
sa.bInheritHandle := True;
sa.lpSecurityDescriptor := nil;
CreatePipe(hPipeOutputRead, hPipeOutputWrite, #sa, 0);
CreatePipe(hPipeErrorsRead, hPipeErrorsWrite, #sa, 0);
ZeroMemory(#env, SizeOf(env));
ZeroMemory(#si, SizeOf(si));
ZeroMemory(#pi, SizeOf(pi));
si.cb := SizeOf(si);
si.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
si.wShowWindow := SW_HIDE;
si.hStdInput := 0;
si.hStdOutput := hPipeOutputWrite;
si.hStdError := hPipeErrorsWrite;
(* Remember that if you want to execute an app with no parameters you nil the
second parameter and use the first, you can also leave it as is with no
problems. *)
Res := CreateProcess(nil, PChar(CommandLine), nil, nil, True,
CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, #env, nil, si, pi);
// Procedure will exit if CreateProcess fail
if not Res then
begin
CloseHandle(hPipeOutputRead);
CloseHandle(hPipeOutputWrite);
CloseHandle(hPipeErrorsRead);
CloseHandle(hPipeErrorsWrite);
Exit;
end;
CloseHandle(hPipeOutputWrite);
CloseHandle(hPipeErrorsWrite);
//Read output pipe
Stream := TMemoryStream.Create;
try
while True do
begin
bTest := ReadFile(hPipeOutputRead, szBuffer, 256, dwNumberOfBytesRead, nil);
if not bTest then
begin
break;
end;
OemToAnsi(szBuffer, szBuffer);
Stream.Write(szBuffer, dwNumberOfBytesRead);
end;
Stream.Position := 0;
Output.LoadFromStream(Stream);
finally
Stream.Free;
end;
//Read error pipe
Stream := TMemoryStream.Create;
try
while True do
begin
bTest := ReadFile(hPipeErrorsRead, szBuffer, 256, dwNumberOfBytesRead, nil);
if not bTest then
begin
break;
end;
OemToAnsi(szBuffer, szBuffer);
Stream.Write(szBuffer, dwNumberOfBytesRead);
end;
Stream.Position := 0;
Errors.LoadFromStream(Stream);
finally
Stream.Free;
end;
WaitForSingleObject(pi.hProcess, INFINITE);
CloseHandle(pi.hProcess);
CloseHandle(hPipeOutputRead);
CloseHandle(hPipeErrorsRead);
end;
cmdstring :=
'cmd.exe /c "' + GetSystemPath(WindRoot) + 'system32\netsh.exe interface ' +
ip + ' delete address "' + NetworkInterfaceName + '" ' + VirtualFailoverIPAddress + '"';
logstr('cmdstring: ' + cmdstring);
ExecConsoleApp(cmdstring, OutP, ErrorP);
if OutP.Text <> '' then
begin
logstr('Delete IP Result: ' + OutP.Text);
end
else
begin
logstr('Delete IP Error: ' + ErrorP.Text);
end;
Tried running netsh.exe directly instead of "cmd.exe /c C:\Windows\system32\netsh.exe...", and got the same "The system cannot find the file specified." error. I also accidentally discovered that if I were to issue a wrong netsh command, netsh will actually return an error, e.g.
netsh interface ip delete address "LocalArea Connection" 10.40.201.65
Invalid interface LocalArea Connection specified.
The following is returned if i correct the typo "LocalArea" to "Local Area".
netsh interface ip delete address "Local Area Connection" 10.40.201.65
The system cannot find the file specified.
Again, I must repeat that the same command works perfectly fine if I issue it via Command Prompt instead of from my application.
Have you tried this?
if not CreateProcess(PChar('C:\Windows\system32\netsh.exe'), PChar(Arguments), ...) then
begin
// Do somehting with `GetLastError`
end;
Of course it would be better to detect the path of C:\Windows\system32 at runtime as this could be on another driver or in another directory.
When you run it this way you can get an error message from Windows using the GetLastError call right after CreateProcess.
The ExecConsoleApp procedure is flawed, because it doesn't return the GetLastError or even any indication that CreateProcess failed.
You should fix this first. Maybe add raise EExecConsoleAppCreateProcessFailed.Create(SysErrorMessage(GetLastError)) before Exit to the code.
You shouldn't use cmd.exe /c as a prefix. It's redundant and it makes error diagnostics more difficult. GetLastError might not reflect the correct error code, because you're delegating the creation of the acutal netsh.exe process to cmd.
The "cannot find the file specified" error may also occur if an implicitly loaded DLL required by the executable is not available. In this situation, that is the most likely cause - some essential DLL is not being found when netsh.exe is being run in a non-interactive context.
Use Process Monitor (available for download from Microsoft's web site) to record the file system operations that are taking place during the attempt. Look for file not found errors either in the context of your service process or in the context of the netsh.exe process.
First , I want to thank all the persons who works for this site, very useful for a developer. This is the first I am blocked in my developement since 3 days. I have searched solutions on Internet but I find nothing which solves this issue.
So, I develop a service which have to execute an external program on vista/seven/xp when a user is logged. Some characteristics of this service :
automatic
no interactive.
detect the session ID of the user logged
To run the external GUI application as the interactive user:
To be sure a user session is opened, I list ALL the "explorer.exe" process, extract their Pid and SessionID with the msdn function ProcessIdToSessionId
if the SessionID of the logged user is equal with the session ID of this "explorer.exe" process, I am sure that the "good" desktop is running so now I can execute the external program. (I say "good" desktop because, as you know, more than one user session can be opened on the system )
after that, I run the application with this function:
function RunInteractive(prog_filename: String; sessionID: Cardinal): boolean;
var hToken: THandle;
si: _STARTUPINFOA;
pi: _PROCESS_INFORMATION;
begin
ZeroMemory(#si, SizeOf(si));
si.cb := SizeOf(si);
SI.lpDesktop := nil;
if WTSQueryUserToken(sessionID, hToken)
then begin
if CreateProcessAsUser(hToken, nil, PChar(prog_filename), nil, nil, False, 0, nil, PChar(ExtractFilePath(prog_filename)), si, pi)
then result := true
else result := false;
end
else Begin
result := false;
End;
CloseHandle(hToken);
end;
This code is ok in most of case except one: when I change User. Let me explain it with 2 simple users (Domain\user1 and Domain\user2):
To be clean, I install the service and reboot the system
I open session with user1: the external program is executed and I can see its form
I close the session and opensession with user2 : the external program is executed and I can see its the form.
If I do this X times, the result is always the same, very good...but If I do this:
I re-install the service and reboot the system
I open session with user1: the external program is executed and I can see its form
this time, I am not close the session but change user with user2 : the external program is executed but I cannot see the form and an error is occured : System error code 5: Access denied.
Something is wrong but I don't find the solution. Thanks for your answers...
You don't need to enumerate running explorer.exe processes, you can use WTSGetActiveConsoleSessionId() instead, and then pass that SessionId to WTSQueryUserToken(). Note that WTSQueryUserToken() returns an impersonation token but CreateProcessAsUser() needs a primary token, so use DuplicateTokenEx() for that conversion.
You should also use CreateEnvironmentBlock() so the spawned process has a proper environment that is suited to the user account that is being used.
Lastly, set the STARTUPINFO.lpDesktop field to 'WinSta0\Default' instead of nil so the spawned UI can be made visible correctly.
I have been using this approach for several years now and have not had any problems with it. For example:
function CreateEnvironmentBlock(var lpEnvironment: Pointer; hToken: THandle; bInherit: BOOL): BOOL; stdcall; external 'userenv.dll'
function DestroyEnvironmentBlock(lpEnvironment: Pointer): BOOL; stdcall; external 'userenv.dll';
function RunInteractive(prog_filename: String): Boolean;
var
hUserToken, hToken: THandle;
si: _STARTUPINFOA;
pi: _PROCESS_INFORMATION;
SessionId: DWORD;
Env: Pointer;
begin
Result := False;
ZeroMemory(#si, SizeOf(si));
si.cb := SizeOf(si);
si.lpDesktop := 'WinSta0\Default';
SessionId := WTSGetActiveConsoleSessionId;
if SessionId = $FFFFFFFF then Exit;
if not WTSQueryUserToken(SessionID, hToken) then Exit;
try
if not DuplicateTokenEx(hToken, MAXIMUM_ALLOWED, nil, SecurityIdentification, TokenPrimary, hUserToken) then Exit;
finally
CloseHandle(hToken);
end;
try
if not CreateEnvironmentBlock(Env, hUserToken, False) then Exit;
try
Result := CreateProcessAsUser(hUserToken, nil, PChar(prog_filename), nil, nil, False, CREATE_UNICODE_ENVIRONMENT, Env, PChar(ExtractFilePath(prog_filename)), si, pi);
if Result then
begin
CloseHandle(pi.hThread);
CloseHandle(pi.hProcess);
end;
finally
DestroyEnvironmentBlock(Env);
end;
finally
CloseHandle(hUserToken);
end;
end;
Probably your method of getting the session ID by finding the "good" explorer.exe is not working for fast user switching.
Try having your application register for Session change notifications with WTSRegisterSessionNotification. You will then get notifications when the session switches, complete with the current session ID.
Note the following:
To receive session change notifications from a service, use the
HandlerEx function.
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