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.
Related
Somewhere in my application (along with 3rd party libraries of code) is a window procedure that is preventing Windows from:
logging off
shutting down
restarting
I found one spot in my code where I made the extraordinarily common mistake of calling DefWindowProc, but calling it incorrectly:
Before:
void Grobber.BroadcastListenerWindowProc(ref TMessage msg)
{
DefWindowProc(_broadcastListenerHwnd, msg.msg, msg.wparam, msg.lparam);
}
After:
void Grobber.BroadcastListenerWindowProc(ref TMessage msg)
{
//20170207: Forgetting to set the result can, for example, prevent Windows from restarting
msg.Result = DefWindowProc(_broadcastListenerHwnd, msg.msg, msg.wparam, msg.lparam);
}
I fixed that bug, and my test program no longer halted the shutdown.
But a full application does
I'm now faced with having to tear a program down to nothing, until my computer finally reboots.
Somewhere deep inside my application is a Window procedure attached to an HWND that is returning zero to WM_QUERYENDSESSION. If only i knew the HWND, i could use the Spy++ to find the Window.
But how can i find that hwnd?
The Windows Application event log notes the process that halt a shutdown:
And there very well be a more detailed log in the more detailed Applications and Services Logs. But those are undocumented.
How can i find my problematic hwnd?
Attempts
I tried to use EnumThreadWindows to get all the windows of my "main" thread, with the idea of manually sending WM_QUERYENDSESSION to them all to see who returns false:
var
wnds: TList<HWND>;
function DoFindWindow(Window: HWnd; Param: LPARAM): Bool; stdcall;
var
wnds: TList<HWND>;
begin
wnds := TList<HWND>(Param);
wnds.Add(Window);
Result := True;
end;
wnds := TList<HWND>.Create;
enumProc := #DoFindWindow;
EnumThreadWindows(GetCurrentThreadId, EnumProc, LPARAM(wnds));
Now i have a list of twelve hwnds. Poke them:
var
window: HWND;
res: LRESULT;
for window in wnds do
begin
res := SendMessage(window, WM_QUERYENDSESSION, 0, 0);
if res = 0 then
begin
ShowMessage('Window: '+IntToHex(window, 8)+' returned false to WM_QUERYENDSESSION');
end;
end;
But nobody did return zero.
So that's one tube down the drain.
EnumThreadWindows only enumerates the windows of one particular thread. It could be that the offending window was created in a thread. So I'd suggest that you use EnumWindows to enum all top level windows in your application for your test.
It's enough to initialize COM in a thread and you'll have a window you don't know about. That way a call to WaitForSingleObject in a thread could be your culprit:
Debugging an application that would not behave with WM_QUERYENDSESSION
This might sound a bit like overkill but here goes. I would solve this using code hooks for AllocateHWnd and DeallocateHWnd. We had to solve a different issue related to handles and it worked well for us.
Your replacement routines will just be copies of the versions in System.Classes. You will also need to copy all of the dependencies (PObjectInstance, TObjectInstance, CodeBytes, PInstanceBlock, TInstanceBlock, InstBlockList, InstFreeList, StdWndProc, CalcJmpOffset, MakeObjectInstance, FreeObjectInstance, CleanupInstFreeList, GetFreeInstBlockItemCount, ReleaseObjectInstanceBlocks, UtilWindowClass) from that unit. The only difference is that you log all allocated and deallocated handles in your replacement routines. It would help to include stack traces too.
That will give you a list of all of the handles that are allocated at the time of your shutdown along with their calling stack traces.
The basic structure is something like this. I can't post full code because it's mostly VCL code with the exception of the code hooks and logging.
const
{$IF Defined(CPUX86)}
CodeBytes = 2;
{$ELSEIF Defined(CPUX64)}
CodeBytes = 8;
{$ENDIF CPU}
InstanceCount = (4096 - SizeOf(Pointer) * 2 - CodeBytes) div SizeOf(TObjectInstance) - 1;
type
PInstanceBlock = ^TInstanceBlock;
TInstanceBlock = packed record
...
end;
var
InstBlockList: PInstanceBlock;
InstFreeList: PObjectInstance;
{ Standard window procedure }
function StdWndProc(Window: HWND; Message: UINT; WParam: WPARAM; LParam: WPARAM): LRESULT; stdcall;
...
function CalcJmpOffset(Src, Dest: Pointer): Longint;
...
function MakeObjectInstance(const AMethod: TWndMethod): Pointer;
...
procedure FreeObjectInstance(ObjectInstance: Pointer);
...
procedure CleanupInstFreeList(BlockStart, BlockEnd: PByte);
...
function GetFreeInstBlockItemCount(Item: PObjectInstance; Block: PInstanceBlock): Integer;
...
procedure ReleaseObjectInstanceBlocks;
...
var
UtilWindowClass: TWndClass = (
... );
function AllocateHWnd(const AMethod: TWndMethod): HWND;
begin
< Logging/Stack trace code here >
...
end;
procedure DeallocateHWnd(Wnd: HWND);
begin
< Logging/Stack trace code here >
...
end;
It may also be necessary to hook and log SetWindowLong, SetWindowLongA and SetWindowLongW too.
I am trying to write a small program in Delphi 2007 to access files off of a portable USB drive whenever it is plugged in to a Windows 7 machine. This drive does not show up as a standard drive letter though. It appears under Portable Devices in Windows Explorer. I have written the following code to enumerate all the items under 'Computer':
Procedure TfrmMain.ComputerChanged(Var Msg: TMessage);
Var
Enum: IEnumIDList;
Fetched: Longword;
Item: PItemIDList;
Path: String;
Computer: IShellFolder;
StrRet: TSTRRET;
Begin
Status('Computer changed... Checking folders.');
fDesktop.BindToObject(fCompPidl, Nil, IID_IShellFolder, Computer);
If Assigned(Computer) And
(Computer.EnumObjects(Self.Handle, SHCONTF_FOLDERS, Enum) = NOERROR) Then
Begin
While (Enum.Next(1, Item, Fetched) = NOERROR) Do
Begin
FillChar(StrRet, SizeOf(StrRet), #0);
Computer.GetDisplayNameOf(Item, SHGDN_FORADDRESSBAR or SHGDN_NORMAL, StrRet);
Path := StrRetToStr(StrRet, Item);
Status(Path);
End;
End;
End;
(note: the Status procedure just outputs a message to a TMemo.)
This is called whenever my application is notified of a change by the Windows shell subsystem. It enumerates all of the local drives and network drives but nothing else (iCloud Photos drive is missing as well).
Does anyone know how I can access the files on these virtual drives?
You more than likely aren't initializing COM correctly. Your code will work as-is if you don't call CoInitializeEx or if you call it with a bad value, but the Portable Device drivers require apartment threading to work.
Based on your code, here's a sample app that works correctly and shows portable devices. If you comment out the CoInitializeEx/CoUninitialize calls or pass in COINIT_MULTITHREADED instead it will still work, but it only shows the drives.
program ListMyComputer;
{$APPTYPE CONSOLE}
uses
ComObj, ShlObj, ShellApi, ShLwApi, ActiveX, Windows, SysUtils;
var
Enum: IEnumIDList;
Fetched: Longword;
CompPidl, Item: PItemIDList;
Path: PWideChar;
Desktop, Computer: IShellFolder;
StrRet: TSTRRET;
begin
CoInitializeEx(nil, COINIT_APARTMENTTHREADED);
try
WriteLn('Computer changed... Checking folders.');
SHGetDesktopFolder(Desktop);
SHGetFolderLocation(0, CSIDL_DRIVES, 0, 0, CompPidl);
Desktop.BindToObject(CompPidl, Nil, IID_IShellFolder, Computer);
CoTaskMemFree(CompPidl);
If Assigned(Computer) And
(Computer.EnumObjects(0, SHCONTF_FOLDERS, Enum) = NOERROR) Then
Begin
While (Enum.Next(1, Item, Fetched) = NOERROR) Do
Begin
FillChar(StrRet, SizeOf(StrRet), #0);
Computer.GetDisplayNameOf(Item, SHGDN_FORADDRESSBAR or SHGDN_NORMAL, StrRet);
StrRetToStr(#StrRet, Item, Path);
WriteLn(Path);
CoTaskMemFree(Path);
End;
End;
WriteLn('Enumeration complete');
ReadLn;
finally
CoUninitialize
end;
end.
Thanks to #SertacAkyuz for pointing out the need to use Windows Portable Device API which lead me to this Experts Exchange question discussing the same thing. Sinisa Vuk supplied an awesome code example to answer that question which I have linked (it's too long to embed) here with permission: http://pastebin.com/0hSWv5pE
What is the best way to find whether a web-browser is running?
Using Delphi XE2 and on Windows, I need to find whether the following web-browsers are currently running:
A) Mozilla Firefox
B) Apple Safari
C) Google Chrome
If found, the process will be terminated because the home page of the web-browser needs to be changed programmatically by modifying the web-browser configuration files (which is either not possible or could result in unpredictable results if done when the web-browser is running).
Does the output from the EnumWindows API function contain sufficient information needed to handle the above task? If yes, then are the window class names for each of the above web-browsers documented anywhere? If no, then which method is most reliable?
TIA.
Terminate a process without the user permission is not good practice, instead you must ask to the user if he wants terminate the app (in this case the web browser).
Now back to your question, you can detect if a app(webbroser) is running checking for the process name (firefox.exe, chrome.exe , safari.exe) using the CreateToolhelp32Snapshot method.
uses
Windows,
tlhelp32,
SysUtils;
function IsProcessRunning(const ListProcess: Array of string): boolean;
var
hSnapshot : THandle;
lppe : TProcessEntry32;
I : Integer;
begin
result:=false;
hSnapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
if hSnapshot <> INVALID_HANDLE_VALUE then
try
lppe.dwSize := SizeOf(lppe);
if Process32First(hSnapshot, lppe) then
repeat
for I := Low(ListProcess) to High(ListProcess) do
if SameText(lppe.szExeFile, ListProcess[i]) then
Exit(True);
until not Process32Next(hSnapshot, lppe);
finally
CloseHandle(hSnapshot);
end;
end;
and use like so
IsProcessRunning(['firefox.exe','chrome.exe','safari.exe'])
Now if you want a more reliable way you can search for the class name of the Window (using the FindWindowEx method) and then the PID of the process owner of the handle (using GetWindowThreadProcessId), from here you can use the PID of the process to resolve the name of exe.
{$APPTYPE CONSOLE}
uses
Windows,
tlhelp32,
SysUtils;
function GetProcessName(const th32ProcessID: DWORD): string;
var
hSnapshot : THandle;
lppe : TProcessEntry32;
begin
result:='';
hSnapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
if hSnapshot <> INVALID_HANDLE_VALUE then
try
lppe.dwSize := SizeOf(lppe);
if Process32First(hSnapshot, lppe) then
repeat
if lppe.th32ProcessID=th32ProcessID then
Exit(lppe.szExeFile);
until not Process32Next(hSnapshot, lppe);
finally
CloseHandle(hSnapshot);
end;
end;
function IsWebBrowserRunning(const ClassName, ExeName :string) : Boolean;
var
hWindow : THandle;
dwProcessId: DWORD;
begin
result:=False;
hWindow:= FindWindowEx(0, 0, PChar(ClassName), nil);
if hWindow<>0 then
begin
dwProcessId:=0;
GetWindowThreadProcessId(hWindow, dwProcessId);
if dwProcessId>0 then
exit(Sametext(GetProcessName(dwProcessId),ExeName));
end;
end;
begin
try
if IsWebBrowserRunning('MozillaWindowClass','firefox.exe') then
Writeln('Firefox is Running');
if IsWebBrowserRunning('{1C03B488-D53B-4a81-97F8-754559640193}','safari.exe') then
Writeln('Safari is Running');
if IsWebBrowserRunning('Chrome_WidgetWin_1','chrome.exe') then
Writeln('Chrome is Running');
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
readln;
end.
Is there any way to block the Keyboard input completely ? This should also block key combos like WIN+E.
I found this Code, is there anyway to change it to block only keyboard input (Mouse needs to work)
procedure TForm1.Button1Click(Sender: TObject) ;
function FuncAvail(dllName, funcName: string; var p: pointer): boolean;
var
lib: THandle;
begin
result := false;
p := nil;
if LoadLibrary(PChar(dllName)) = 0 then exit;
lib := GetModuleHandle(PChar(dllName)) ;
if lib <> 0 then
begin
p := GetProcAddress(lib, PChar(funcName)) ;
if p <> nil then Result := true;
end;
end;
var
BlockInput : function(Block: BOOL): BOOL; stdcall;
begin
if FuncAvail('USER32.DLL', 'BlockInput', #BlockInput) then
begin
ShowMessage('Your Mouse and Keyboard will be blocked for 5 seconds!') ;
BlockInput(true) ;
Sleep(5000) ;
BlockInput(false) ;
end;
end;
end.
Would this code also work with WIN keys etc ?
Thanks!
You're thinking way too hard.
The appropriate way to set up a kiosk that can be controlled by the mouse and not the keyboard is to not have a keyboard attached. (This also makes it impossible for an unscrupulous kiosk-user to steal your keyboard.)
This also means that, if you need to perform administrative tasks, you can attach a keyboard (or remote in) and everything will work fine.
If for some reason removing the keyboard is not a feasible option, there is an unsupported way of doing this in software: remove the UpperFilters value from
HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Class\{4D36E96B-E325-11CE-BFC1-08002BE10318}
This disables input from all normal keyboard devices, but the Remote Desktop virtual keyboard will still work, so you may want to ensure that Remote Desktop is configured and working first.
For your reference, should you want to reverse the process, UpperFilters is normally a REG_MULTI_SZ containing a single string "kbdclass" (without the quote marks).
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