I have a project that was adding some specific flags (command lines) to Chrome browser, the problem is that I was doing this by creating a new Chrome shortcut, with the flags I want to execute.
In the last days this solution became too superficial, and I was requested to do something more 'deeper'. Looking on Windows Registry, I didn't found any good solution to always add this flags when someone run Chrome, so I started thinking to hook CreateProcess into explorer, and check if the process that is about to run is Chrome, then I add the flags in the lpCommandLine attribute.
I know hook into explorer is a pretty 'intrusive' solution, but this became helpful because I have some other achieves I was putting off on this project, and hooking will help me to get all them done.
I got the hook working, I tried by many ways to add the command lines when chrome is found, but no success... Right now (and I tried at least 8 different solutions) my detour function is:
function InterceptCreateProcess(lpApplicationName: PChar;
lpCommandLine: PChar;
lpProcessAttributes, lpThreadAttributes: PSecurityAttributes;
bInheritHandles: BOOL;
dwCreationFlags: DWORD;
lpEnvironment: Pointer;
lpCurrentDirectory: PChar;
const lpStartupInfo: STARTUPINFO;
var lpProcessInformation: PROCESS_INFORMATION): BOOL; stdcall;
var
Cmd: string;
begin
Result:= CreateProcessNext(lpApplicationName,
lpCommandLine,
lpProcessAttributes,
lpThreadAttributes,
bInheritHandles,
dwCreationFlags,
lpEnvironment,
lpCurrentDirectory,
lpStartupInfo,
lpProcessInformation);
if (POS(Chrome, UpperCase(String(lpApplicationName))) > 0) then
begin
Cmd:= ' --show-fps-counter';
lpCommandLine:= PChar(WideString(lpCommandLine + Cmd));
ShowMessage(lpCommandLine);
end;
end;
The "--show-fps-counter" is the command line I'm trying to add without success.
My Delphi version is XE4.
Ok, this is a pretty obvious thing... I need to add the parameter BEFORE calling the CreateProcessNext (original function)!
So, simply doing:
if (POS(Chrome, UpperCase(String(lpApplicationName))) > 0) then
begin
lpCommandLine:= PChar(lpCommandLine + ' --show-fps-counter');
end;
Result:= CreateProcessNext(lpApplicationName,
lpCommandLine,
lpProcessAttributes,
lpThreadAttributes,
bInheritHandles,
dwCreationFlags,
lpEnvironment,
lpCurrentDirectory,
lpStartupInfo,
lpProcessInformation);
works... note that I just inverted the order to change the lpCommandLine. Thank's for all participants and I'll still consider what was said here.
Related
I have a simple Delphi application that creates a desktop shortcut for a URL. It makes a two-line text file with a .url filename extension in the user's Desktop folder:
[InternetShortcut]
URL=http://127.0.0.1/admin
That works fine. When I need to update the file with a new URL, I overwrite the old file. But Windows will not recognize the change until I restart Explorer or reboot. So I learned about SHChangeNotify() and called it after overwriting the file:
SHChangeNotify(SHCNE_UPDATEITEM, SHCNF_PATH or SHCNF_FLUSH, PChar(Path), nil);
But it has no effect:
I tried with and without the SHCNF_FLUSH flag;
also the SHCNF_FLUSHNOWAIT flag makes no difference.
I also tried deleting the file first and then using the SHCNE_DELETE event and then re-creating the file. That doesn't work either, it just keeps using the old URL.
How do I force Explorer to reload the URL from the file without a restart?
While the file's content can be treated like any INI file I yet have not found a direct way to control manipulations to it:
When creating a file its content is read as expected: the system's default application for the URL='s protocol is started (i.e. for http it is most likely the internet browser).
Modifying the file per file systems has no effect - either MSIE itself maintains a cache or the COM's magic.
Indirectly manipulation is possible in the following way:
Empty the file's existing content. Why? Because the later step will just add the same INI section with an URL= value again, but the first section's URL= value remains the one that is taken into account.
Access the file per COM and change its properties. Sadly this writes more into the file - in my case the outcome/file's content was:
[{000214A0-0000-0000-C000-000000000046}]
Prop3=19,2
[InternetShortcut]
URL=http://127.0.0.1/index.php
IDList=
However, it "works" as in: the change (speak: a different URL) is recognized. Putting it all together my following code for Delphi 7 on Windows 7 should also work for you - just call the function:
uses
ShlObj, ActiveX, ComObj;
const
SID_IUniformResourceLocatorA= '{FBF23B80-E3F0-101B-8488-00AA003E56F8}';
SID_IUniformResourceLocatorW= '{CABB0DA0-DA57-11CF-9974-0020AFD79762}';
SID_InternetShortcut= '{FBF23B40-E3F0-101B-8488-00AA003E56F8}';
type
PUrlInvokeCommandInfoA= ^TUrlInvokeCommandInfoA;
TUrlInvokeCommandInfoA= record
dwcbSize,
dwFlags: DWORD; // Bit field of IURL_INVOKECOMMAND_FLAGS
hwndParent: HWND; // Parent window. Valid only if IURL_INVOKECOMMAND_FL_ALLOW_UI is set.
pcszVerb: LPCSTR; // Verb to invoke. Ignored if IURL_INVOKECOMMAND_FL_USE_DEFAULT_VERB is set.
end;
PUrlInvokeCommandInfoW= ^TUrlInvokeCommandInfoW;
TUrlInvokeCommandInfoW= record
dwcbSize,
dwFlags: DWORD;
hwndParent: HWND;
pcszVerb: LPCWSTR;
end;
IUniformResourceLocatorA= interface( IUnknown )
[SID_IUniformResourceLocatorA]
function SetURL( pcszURL: LPCSTR; dwInFlags: DWORD ): HRESULT; stdcall;
function GetURL( ppszURL: LPSTR ): HRESULT; stdcall;
function InvokeCommand( purlici: PUrlInvokeCommandInfoA ): HRESULT; stdcall;
end;
IUniformResourceLocatorW= interface( IUnknown )
[SID_IUniformResourceLocatorW]
function SetURL( pcszURL: LPCWSTR; dwInFlags: DWORD ): HRESULT; stdcall;
function GetURL( ppszURL: LPWSTR ): HRESULT; stdcall;
function InvokeCommand(purlici: PUrlInvokeCommandInfoW ): HRESULT; stdcall;
end;
function SetURL( sFile, sUrl: Widestring ): Integer;
const
CLSID_InternetShortCut: TGUID= SID_InternetShortcut;
var
oUrl: IUniformResourceLocatorW;
oFile: IPersistFile;
hFile: THandle;
begin
// First, the existing file's content should be emptied
hFile:= CreateFileW( PWideChar(sFile), GENERIC_WRITE, 0, nil, OPEN_EXISTING, 0, 0 );
if hFile= INVALID_HANDLE_VALUE then begin
result:= 1; // File might not exist, sharing violation, etc.
exit;
end;
// Initial file pointer is at position 0
if not SetEndOfFile( hFile ) then begin
result:= 2; // Missing permissions, etc.
CloseHandle( hFile );
exit;
end;
// Gracefully end accessing the file
if not CloseHandle( hFile ) then begin
result:= 3; // File system crashed, etc.
exit;
end;
// Using COM to access properties
result:= 0;
try
oUrl:= CreateComObject( CLSID_InternetShortCut ) as IUniformResourceLocatorW;
except
result:= 4; // CLSID unsupported, COM not available, etc.
end;
if result<> 0 then exit;
// Opening the file again
oFile:= oUrl as IPersistFile;
if oFile.Load( PWideChar(sFile), STGM_READWRITE )<> S_OK then begin
result:= 5; // Sharing violations, access permissions, etc.
exit;
end;
// Set the property as per interface - only saving the file is not enough
if oUrl.SetURL( PWideChar(sUrl), 0 )<> S_OK then begin
result:= 6;
exit;
end;
// Storing the file's new content - setting only the property is not enough
if oFile.Save( PWideChar(sFile), TRUE )<> S_OK then begin
result:= 7;
exit;
end;
// Success!
result:= 0;
end;
As per my desktop firewall the executing process modifies the memory of explorer.exe upon IPersistFile.Save() - after that executing the URL file should reflect its new content, while any attempt before that should still act upon the old file's content.
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.
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.
MY application has had a mode for years where the customer can 'disable access to the OS'. Obviously this feature goes against the grain (at least as far as Windows is concerned) but there are installations where my App is the only program that should ever be visibile to a machine operator amd in this case such a feature is useful.
The technigue I used was built from several 'layers':
Hide the taskbar and button.
Disable task-switching.
Disable my main form system icons.
To disable the taskbar I used:
// Get a handle to the taskbar and its button..
Taskbar := FindWindow('Shell_TrayWnd', Nil);
StartButton := FindWindow('Button', Nil);
// Hide the taskbar and button
if Taskbar <> 0 then
ShowWindow( Taskbar, SW_HIDE );
if StartButton <> 0 then
ShowWindow( StartButton, SW_HIDE );
// Set the work area to the whole screen
R := Rect( 0,0,Screen.Width,Screen.Height );
SystemParametersInfo(
SPI_SETWORKAREA,
0,
#R,
0 );
This worked well and still seems fine on W7.
Researching how to disable task-switching some years ago turned up the only technique of 'pretending' that your App is a screen saver (other than terrible things like renaming your app to 'explorer.exe' and booting into it etc):
procedure EnableTaskSwitching( AState : boolean );
// Enables / disables task switching
begin
SystemParametersInfo(
SPI_SCREENSAVERRUNNING,
Cardinal( not AState),
nil,
0 );
end;
Not surprisingly this seems to have no effect in W7 (I think it works in XP etc).
Does anyone know of another, better, way of enabling / disabling Alt-Tab (and other special windows keys) from working?
If found a solution:
function LowLevelKeyboardProc(nCode: integer; wParam: WPARAM; lParam: LPARAM):
LRESULT; stdcall;
type
PKBDLLHOOKSTRUCT = ^TKBDLLHOOKSTRUCT;
TKBDLLHOOKSTRUCT = record
vkCode: cardinal;
scanCode: cardinal;
flags: cardinal;
time: cardinal;
dwExtraInfo: Cardinal;
end;
PKeyboardLowLevelHookStruct = ^TKeyboardLowLevelHookStruct;
TKeyboardLowLevelHookStruct = TKBDLLHOOKSTRUCT;
const
LLKHF_ALTDOWN = $20;
var
hs: PKeyboardLowLevelHookStruct;
ctrlDown: boolean;
begin
if nCode = HC_ACTION then
begin
hs := PKeyboardLowLevelHookStruct(lParam);
ctrlDown := GetAsyncKeyState(VK_CONTROL) and $8000 <> 0;
if (hs^.vkCode = VK_ESCAPE) and ctrlDown then
Exit(1);
if (hs^.vkCode = VK_TAB) and ((hs^.flags and LLKHF_ALTDOWN) <> 0) then
Exit(1);
if (hs^.vkCode = VK_ESCAPE) and ((hs^.flags and LLKHF_ALTDOWN) <> 0) then
Exit(1);
if (hs^.vkCode = VK_LWIN) or (hs^.vkCode = VK_RWIN) then
Exit(1);
end;
result := CallNextHookEx(0, nCode, wParam, lParam);
end;
procedure TForm1.FormShow(Sender: TObject);
begin
SetWindowsHookEx(WH_KEYBOARD_LL, #LowLevelKeyboardProc, 0, 0);
end;
This disables (as you can see!)
Ctrl+Esc (show start menu)
Alt+Tab (task switch)
Alt+Esc (task switch)
Win (show start menu)
Win+Tab (3D task switch)
Win+D, Win+M, Win+Space, Win+Arrows, Win+P, Win+U, Win+E, Win+F, Win+Digit, ...
Almost any combination including the Windows key (but not all, e.g. Win+L)
As David has pointed out, this is called "Kiosk Mode". A couple of good articles (part 1 and part 2) can be found on About.com.
There is Windows Embedded Standard 7 that you can package in a way that has a true kiosk mode.
dWinLock also provides a solution. IIRC, they install a service that can stop Ctrl+Alt+Del.
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