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.
Related
I have a program that uses SetCursorPos to position the cursor. The program operates as it is supposed to when running on real hardware but, when running in a VM (VMware workstation 10.0.7) it doesn't work. The cursor does not move. I tried using SendInput instead (the syscall it makes is different, because of that, I thought it might work), the result is the same as with SetCursorPos, it works on real hardware, does not work when running in a VM.
The question is: does anyone know if either SetCursorPos or SendInput can be made to work in a VM and if yes, how ? Any other way to position the cursor at a specific place that works in a VM would be welcome as well.
Thank you for your help.
For anyone who cares to try, here is some of the code I've tried.
{$APPTYPE CONSOLE}
program ConsoleSetCursorPos;
uses
Windows
;
function GetConsoleWindow : HWND; stdcall; external kernel32;
procedure DoIt;
var
ConsoleWindow : HWND;
ClientRect : TRECT;
CursorPosRetVal : BOOL;
LastError : dword;
Desktop : HDESK;
begin
// the code below is not normally necessary - for testing only
Desktop := OpenInputDesktop(0, false, WINSTA_WRITEATTRIBUTES);
LastError := GetLastError;
writeln;
writeln('From OpenInputDesktop');
writeln('Last error (decimal) : ', LastError);
if Desktop = 0 then
begin
writeln('Program terminated due to OpenInputDesktop failure');
halt(255);
end;
if not SetThreadDesktop(Desktop) then
begin
writeln('Program terminated due to SetThreadDesktop failure');
halt(255);
end;
writeln;
// end of normally unnecessary code
SetLastError(0);
ConsoleWindow := GetConsoleWindow;
GetClientRect(ConsoleWindow, ClientRect);
ClientToScreen(ConsoleWindow, ClientRect.TopLeft);
CursorPosRetVal := SetCursorPos(ClientRect.Left, ClientRect.Top);
LastError := GetLastError;
if not CursorPosRetVal
then writeln('SetCursorPos returned false (failed)')
else writeln('SetCursorPos returned true (succeeded)');
writeln('Last error (decimal) : ', LastError);
if Desktop <> 0 then CloseDesktop(Desktop);
end;
begin
DoIt;
end.
As the remarks on SetCursorPos doc:
The cursor is a shared resource. A window should move the cursor only
when the cursor is in the window's client area.
The calling process must have WINSTA_WRITEATTRIBUTES access to the
window station.
The input desktop must be the current desktop when you call
SetCursorPos. Call OpenInputDesktop to determine whether the current
desktop is the input desktop. If it is not, call SetThreadDesktop with
the HDESK returned by OpenInputDesktop to switch to that desktop.
Or you can take the same try to un-installed the mouse driver from the VM as this answer.
Is it possible to remove NotifyIcon from the notification area (system tray) when an app terminates abruptly?
if no, how can I remove it when the app runs for the next time?
Abruptly? No. Your program has ceased to exist, so there's no opportunity to run any code to tell the shell that it should remove the icon.
To remove the icon, move your mouse over it. The shell will try to notify your program, realize there's nothing there anymore, and remove the icon by itself.
On Windows 7 and later, notify icons can be identified by a user-defined GUID. On earlier versions, they are identified by a combination of HWND and ID number instead. Since your app is not guaranteed to get the same HWND value the next time it runs, the only way you can do anything to an old icon that is identified by HWND is if you remembered the previous HWND value so you can use it to remove the old icon, before then using a new HWND to add a new icon. But with a GUID-identified icon, the GUID needs to be persistent (as it is stored in the Registry to store app settings associated with the icon), so you should be able to simply keep updating the existing icon as needed, or remove it if desired.
FWIW, since code doesn't exist so far, I thought I'd throw this in. I don't know if it will help or not for the OP, but it should be good guidance in the right direction.
unit csystray;
{ removes dead system tray icons, by Glenn1234 # stackoverflow.com
since this uses "less than supported by Microsoft" means, it may
not work on all operating system. It was tested on Windows XP }
interface
uses commCtrl, shellapi, windows;
type
TTrayInfo = packed record
hWnd: HWnd;
uID: UINT;
uCallBackMessage: UINT;
Reserved1: array[0..1] of longint;
Reserved2: array[0..2] of longint;
hIcon: HICON;
end;
PTBButton = ^TTBButton;
_TBBUTTON = packed record
iBitmap: Integer;
idCommand: Integer;
fsState: Byte;
fsStyle: Byte;
bReserved: array[1..2] of Byte;
dwData: Longint;
iString: Integer;
end;
TTBButton = _TBBUTTON;
procedure RemoveStaleTrayIcons;
implementation
procedure RemoveStaleTrayIcons;
const
VMFLAGS = PROCESS_VM_OPERATION or PROCESS_VM_READ OR PROCESS_VM_WRITE;
var
ProcessID: THandle;
ProcessHandle: THandle;
trayhandle: HWnd;
ExplorerButtonInfo: Pointer;
i: integer;
ButtonCount: Longint;
BytesRead: Longint;
ButtonInfo: TTBButton;
TrayInfo: TTrayInfo;
ClassNameA: Array[0..255] of char;
outlen: integer;
TrayIconData: TNotifyIconData;
begin
// walk down the window hierarchy to find the notification area window
trayhandle := FindWindow('Shell_TrayWnd', '');
trayhandle := FindWindowEx(trayhandle, 0, 'TrayNotifyWnd', nil);
trayhandle := FindWindowEx(trayhandle, 0, 'SysPager', nil);
trayhandle := FindWindowEx(trayhandle, 0, 'ToolbarWindow32', nil);
if trayhandle = 0 then exit;
// find the notification area process and open it up for reading.
GetWindowThreadProcessId(trayhandle, #ProcessID);
ProcessHandle := OpenProcess(VMFLAGS, false, ProcessID);
ExplorerButtonInfo := VirtualAllocEx(ProcessHandle, nil, Sizeof(TTBButton),
MEM_RESERVE or MEM_COMMIT, PAGE_READWRITE);
// the notification area is a tool bar. Get the number of buttons.
ButtonCount := SendMessage(trayhandle, TB_BUTTONCOUNT, 0, 0);
if ExplorerButtonInfo <> nil then
try
// iterate the buttons & check.
for i := (ButtonCount - 1) downto 0 do
begin
// get button information.
SendMessage(trayhandle, TB_GETBUTTON, i, LParam(ExplorerButtonInfo));
ReadProcessMemory(ProcessHandle, ExplorerButtonInfo, #ButtonInfo,
Sizeof(TTBButton), BytesRead);
// if there's tray data, read and process
if Buttoninfo.dwData <> 0 then
begin
ReadProcessMemory(ProcessHandle, PChar(ButtonInfo.dwData),
#TrayInfo, Sizeof(TTrayInfo), BytesRead);
// here's the validation test, this fails if the master window is invalid
outlen := GetClassName(TrayInfo.hWnd, ClassNameA, 256);
if outlen < 1 then
begin
// duplicate the shell icon removal, i.e. my component's DeleteTray
TrayIconData.cbSize := sizeof(TrayIconData);
TrayIconData.Wnd := TrayInfo.hWnd;
TrayiconData.uID := TrayInfo.uID;
TrayIconData.uCallbackMessage := TrayInfo.uCallBackMessage;
Shell_NotifyIcon(NIM_DELETE, #TrayIconData);
end;
end;
end;
finally
VirtualFreeEx(ProcessID, ExplorerButtonInfo, Sizeof(TTBButton), MEM_RELEASE);
end;
end;
end.
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 implementing my own named pipe Client/Server class, but I'm getting too much troubles and no much information about on internet.
I already found a lot of implementation with pipes but with vlc application but I'm working with service applications.
I accept hints about how to work with pipes too.
My actual problem is:
While server the app just receive one message from the client, after this my server can't use PeekNamedPipe() any more.
My error message that I get from GetLastError is "there is a process on other end of the pipe", but.... I don't know what to solve do with this.
If I close the client app, the message I get is "The pipe is being closed", and I can't establish a client communication after this.
tks
Oooo I found the problem.
I was reading some windows articles and I found out that I must connect to the named pipe using after peek and after disconnect. It make sense.
ConnectNamedPipe(FPipeHandle, nil) and after PeekNamedPipe(FPipeHandle, nil, 0, nil, #LBytesSize, nil)
And after doing my operation I must call DisconnectNamedPipe(FPipeHandle);
To free the process.
tks
I think you'll get some troubles when running your application in Vista or Seven.
Under XP, no problem of communication between a service and a client application.
But "thanks" to the new UAC and security policy introduced with Vista and Seven, you need to set some security parameters.
See what I found out during implementation and testing of our Open Source framework.
You have a working example of Named Pipe client and server communication, also tested with the server running as a service, in our source code repository.
hier you have some sample code, notice the GUI components you will need to create on your form:
Sender unit:
procedure TForm1.FormCreate(Sender: TObject);
var
FSA : SECURITY_ATTRIBUTES;
FSD : SECURITY_DESCRIPTOR;
pch1: shortstring;
begin
InitializeSecurityDescriptor(#FSD, SECURITY_DESCRIPTOR_REVISION);
SetSecurityDescriptorDacl(#FSD, True, nil, False);
FSA.lpSecurityDescriptor := #FSD;
FSA.nLength := sizeof(SECURITY_ATTRIBUTES);
FSA.bInheritHandle := True;
Pipe:= CreateNamedPipe(PChar('\\.\pipe\<test>'),
PIPE_ACCESS_DUPLEX or FILE_FLAG_WRITE_THROUGH,
PIPE_TYPE_MESSAGE or PIPE_READMODE_MESSAGE or PIPE_NOWAIT,
PIPE_UNLIMITED_INSTANCES,
1024,
1024,
50,
#FSA);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
buffer: shortstring;
dw : dword;
b1 : boolean;
begin
buffer:= Edit2.Text;
WriteFile(Pipe, buffer, sizeof(buffer), dw, nil);
end;
Receiver unit:
procedure TForm1.FormCreate(Sender: TObject);
var
FSA : SECURITY_ATTRIBUTES;
FSD : SECURITY_DESCRIPTOR;
begin
InitializeSecurityDescriptor(#FSD, SECURITY_DESCRIPTOR_REVISION);
SetSecurityDescriptorDacl(#FSD, True, nil, False);
FSA.lpSecurityDescriptor := #FSD;
FSA.nLength := sizeof(SECURITY_ATTRIBUTES);
FSA.bInheritHandle := True;
Pipe:= CreateFile(PChar('\\.\pipe\<test>'),
GENERIC_READ or GENERIC_WRITE,
0,
#FSA,
OPEN_EXISTING,
0,
0);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
buffer: shortstring;
dw : dword;
begin
ReadFile(Pipe, buffer, sizeof(buffer), dw, nil);
edit1.Text := buffer;
end;
hope this helps.
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