I need to mute/un-mute the sound card at startup and shutdown.
I have found some code to do the work, but often Windows slams through the shutdown and the sound never gets muted.
Can someone please tell me how to pause the shutdown long enough for my app to mute the sound? I can use a simple TTimer to pause the app long enough for it to run the muting and then let Windows get on with shutting down.
How do I tell Windows to wait though?
I notice that if I leave Firefox running and try to shutdown, Windows stops with a message, "These programs are preventing windows closing..." and needs a click to force Firefox to close. I need to find that.
Since Windows Vista, if you register a shutdown reason string with the OS or if your application has a top level window, the OS will wait indefinitely for your program to return from WM_QUERYENDSESSION while displaying the blocking applications screen - or until the user chooses to forcefully end the program of course.
The below sample code simulates a 45 seconds wait with Sleep. In the first five seconds of the wait the OS waits patiently, only then it displays the full screen UI. The only way to show the screen immediately is to immediately return false from WM_QUERYENDSESSION. But in this case you won't be able to resume shutdown.
For details on shutdown behavior of the OS for Vista and later, see documentation.
type
TForm1 = class(TForm)
..
protected
procedure WMQueryEndSession(var Message: TWMQueryEndSession);
message WM_QUERYENDSESSION;
..
...
function ShutdownBlockReasonCreate(hWnd: HWND; Reason: LPCWSTR): Bool;
stdcall; external user32;
function ShutdownBlockReasonDestroy(hWnd: HWND): Bool; stdcall; external user32;
procedure TForm1.WMQueryEndSession(var Message: TWMQueryEndSession);
const
ENDSESSION_CRITICAL = $40000000;
begin
Message.Result := LRESULT(True);
if ((Message.Unused and ENDSESSION_CRITICAL) = 0) then begin
ShutdownBlockReasonCreate(Handle, 'please wait while muting...');
Sleep(45000); // do your work here
ShutdownBlockReasonDestroy(Handle);
end;
end;
You need to handle the WM_QUERYENDSESSION messsage. It's sent to each application before Windows starts the shutdown process. Do what you need quickly, because failure to respond rapidly enough causes the behavior you're observing in FireFox, which is usually a sign of a badly designed app (and the user may terminate it before you get a chance to finish).
interface
...
type
TForm1 = class(TForm)
procedure WMQueryEndSession(var Msg: TWMQueryEndSession);
message WM_QUERYENDSESSION;
end;
implementation
procedure TForm1.WMQueryEndSession(var Msg: TWMQueryEndSession);
begin
// Do what you need to do (quickly!) before closing
Msg.Result := True;
end;
(Just as an aside: The enabling/disabling of sounds is a per-user setting, and you should have a very good need for interfering with the user's choice. If I were you, I'd make sure my uninstaller was well-tested, because any app that interfered with my sound preferences this way would be removed from my system very quickly.)
Related
Before thinking this is a duplicate Question, then please read this: Yes this question is around in on SO in different languages at least Delphi, C# and C++ but they all have something in common: They talk about handling a clean shut down not preventing it.
So here we go:
Form a VCL application I open a new Console Window using AllocConsole but when closing that window with the cross in the top right corner my application terminates. That I would like to prevent not handle!
Some code:
function Handler(dwCtrlType: DWORD): Boolean; cdecl;
begin
case dwCtrlType of
CTRL_CLOSE_EVENT, CTRL_C_EVENT, CTRL_BREAK_EVENT:
Exit(True);
else
Exit(false);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
AllocConsole;
SetConsoleCtrlHandler(#Handler, True);
end;
I have read the WinAPI documentation but it doesn't say anything about preventing Application termination.
I have tried adding message handlers for WM_ENDSESSION, WM_QUERYENDSESSION, WM_CLOSE and WM_QUIT on my MainForm but none of them gets called. I've also tried to add a FormCloseQuery event but it doesn't get called either.
I have read and tried out the solution found here but SetConsoleCtrlHandler(nil, True); doesn't provide the application for termination
So in short how to prevent termination.
I am trying to prevent my application from being shutdown by windows.
The application is running on windows 8 and written in XE6.
I tried following code but it seems to be completely ignored. To test it I simply send "end task" to it through the task manager.
What I need is a way to let my application finish what its doing when the application is closed by the user, by the task manager of by a windows shutdown.
Normal closing is not a problem, this is handled by the FormCloseQuery event. But the other 2 methods I can't get to work. Until windows XP this was easy by catching the wm_endsession and the wm_queryendsession, starting from vista you need the use ShutDownBlockReasonCreate, which returns true but does not seems to work anyway.
procedure WMQueryEndSession(var Msg : TWMQueryEndSession); message WM_QUERYENDSESSION;
procedure WMEndSession(var Msg: TWMEndSession); message WM_ENDSESSION;
function ShutdownBlockReasonCreate(hWnd: HWND; Reason: LPCWSTR): Bool; stdcall; external user32;
function ShutdownBlockReasonDestroy(hWnd: HWND): Bool; stdcall; external user32;
procedure TForm1.WMEndSession(var Msg: TWMEndSession);
begin
inherited;
Msg.Result := lresult(False);
ShutdownBlockReasonCreate(Handle, 'please wait while muting...');
Sleep(45000); // do your work here
ShutdownBlockReasonDestroy(Handle);
end;
procedure TForm1.WMQueryEndSession(var Msg: TWMQueryEndSession);
begin
inherited;
Msg.Result := lresult(False);
ShutdownBlockReasonCreate(Handle, 'please wait while muting...');
Sleep(45000); // do your work here
ShutdownBlockReasonDestroy(Handle);
end;
Update
Changing the message result to true and removing the sleep changes nothing.
procedure TForm1.WMEndSession(var Msg: TWMEndSession);
begin
inherited;
Msg.Result := lresult(True);
ShutdownBlockReasonDestroy(Application.MainForm.Handle);
ShutdownBlockReasonCreate(Application.MainForm.Handle, 'please wait while muting...');
end;
procedure TForm1.WMQueryEndSession(var Msg: TWMQueryEndSession);
begin
inherited;
Msg.Result := lresult(True);
ShutdownBlockReasonDestroy(Application.MainForm.Handle);
ShutdownBlockReasonCreate(Application.MainForm.Handle, 'please wait while muting...');
end;
According to the documentation to block shutdown you need to return FALSE in response to WM_QUERYENDSESSION.
What's more, you must not do work in this message handler. The work must happen elsewhere. If you don't respond to this message in a timely fashion the system won't wait for you.
Call ShutdownBlockReasonCreate before you start working.
Whilst working return FALSE from WM_QUERYENDSESSION. Don't work whilst handling this message. Return immediately.
When the work is done call ShutdownBlockReasonDestroy.
The handler for WM_QUERYENDSESSION can look like this:
procedure TMainForm.WMQueryEndSession(var Msg: TWMQueryEndSession);
begin
if Working then
Msg.Result := 0
else
inherited;
end;
And then the code that performs the work needs to call ShutdownBlockReasonCreate before the work starts, ShutdownBlockReasonDestroy when the work ends, and make sure that the Working property used above evaluates to True during work.
If your work blocks the main thread then you are in trouble. The main thread must be responsive, otherwise the system won't wait for you. Putting the work in a thread is often the way forward. If your main window is not visible then you don't get a chance to block shutdown. The details are explained here: http://msdn.microsoft.com/en-us/library/ms700677.aspx
If you get as far as being sent WM_ENDSESSION then it's too late. The system is going down come what may.
To test it I simply send "end task" to it through the task manager.
That has nothing to do with shutdown blocking. The way you test shutdown blocking is to logoff. If the user insists on killing your process there is little that you can do about it. Sertac's answer covers this in detail.
Finally, ignoring the return values of API calls is also very poor form. Don't do that.
Your code seems to be completely ignored because you're not testing it. You're sending "end task" to it through the task manager, the code you posted is only effective when the system is shutting down.
What is different with Windows 8 seems to be how task manager behaves. Before Windows 8, an end task from task manager will first try closing the app gracefully (sends a WM_CLOSE), this you're handling with OnCloseQuery. But when the application denies closing, the task manager will offer ending the process forcefully. This, you cannot handle. Same if you choose "end process" from task manager.
The Windows 8 task manager does not offer an additional dialog for forcefully closing the application, but immediately proceeds doing so when the application denies closing.
Here are some solution for some different cases tested in Delphi 11.1 Alexandria:
The Form OnCloseQuery gets called when app is being closed by user or by system shutdown, to know which one of these two events is triggered, call GetSystemMetrics and pass SM_SHUTTINGDOWN as an argument.
System metric SM_SHUTTINGDOWN is set when there is a pending system shutdown, clear otherwise.
This is all you need if you only want say suppress exit confirmation message to the user if system is shutting down:
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
if GetSystemMetrics (SM_SHUTTINGDOWN) > 0 then
Exit; // app is being closed by a system shutdown
// app being closed by user, ask user to confirm exit
if not ConfirmAppExit then
CanClose := False;
end;
Please note if the system is shutting down your Form OnCloseQuery will be called but your Form OnClose will not be called, any code you put in OnClose will not be executed. So, don't put code there if you want it to be executed on system shutdown, Instead, use the WM_EndSession handler described below.
If you want more than that and be able to block the shutdown, First write a handler for the message WM_QueryEndSession:
procedure WMQueryEndSession(var Msg: TWMQueryEndSession); message WM_QueryEndSession;
Inside this handler do not do anything except returning message result, this message is sent to your app to check if it agrees to shutdown the system or not, it does not mean the system shutdown is taking place right now, because all apps must agree to this message first, but if just one app denies this message (return False) then shutdown will not happen (When shutdown is really
taking place you will receive WM_EndSession message).
In the WM_QueryEndSession handler check if there are any critical running tasks which must be completed in one go or if interrupted will cause data loss, If there is a critical task running return False to deny system shutdown, like:
procedure TForm1.WMQueryEndSession(var Msg: TWMQueryEndSession);
begin
if CriticalTaskRunning then
Msg.Result := 0 // Deny system shutdown
else
inherited; // Agree to system shutdown, Same as Msg.Result := 1
end;
Do not return False if your task is not critical and can be interrupted, and do not interrupt your task at this point, just return True and keep your task running because some other app may deny the shutdown and you just interrupted your task for nothing!, Interrupt your task only when you receive WM_EndSession message which means all applications agreed to the shutdown and the system is really shutting down.
By returning False, shutdown is now denied, using ShutdownBlockReasonCreat at this time is redundant, but you can use that to explain to the user (in shutdown screen) why your app is blocking shutdown. If you use this be sure to call ShutdownBlockReasonDestroy after your task is finished.
When receiving WM_EndSession you know now the system is really shutting down.
If you need to do cleanup, abort any running tasks, save changes close DB/files ...etc, then you can use ShutdownBlockReasonCreate to block shutdown until you finish cleaning up, then unblock shutdown once finished, like:
procedure WMEndSession (var Msg: TWMEndSession);
begin
if CleanUpRequired then
begin
ShutdownBlockReasonCreate (Handle, 'My app is preparing to close, just a sec...');
try
DoCleanUp;
finally
ShutdownBlockReasonDestroy (Handle);
end;
end;
end;
Some other shutdown block methods suggest you create a shutdown block every time you start a task and destroy the shutdown block once your task is finished even if the system is not shutting down! my approach here is only create a shutdown block when it is necessary and only when the system is really shutting down.
I Hope it's useful for someone!
At program start, in the OnActivate event handler, I need to do something which blocks the program for a few seconds. During this time the form's client area is still not completely painted, which looks ugly for the user. (During this blocked time I don't need the program to respond to clicks or other user actions, so there is no need to put the blocking operation into a thread - I just need the form to be completely painted). So I use TForm.Update and Application-ProcessMessages to update the form before the blocking operation which works very well:
procedure TForm1.FormActivate(Sender: TObject);
begin
Form1.Update;
Application.ProcessMessages;
Sleep(7000);
end;
However, I wonder whether there is not another more elegant solution for this problem. This could be for example a OnShown event implemented in a descendant of TForm which will be fired AFTER the form has been completely painted. How could such an event be implemented?
Your real problem is that you are blocking the UI thread. Simply put, you must never do that. Move the long running task onto a different thread and thus allow the UI to remain responsive.
If you are looking for event which is fired when application finishes loading/repainting you should use TApplication.OnIdle event
http://docwiki.embarcadero.com/Libraries/XE3/en/Vcl.Forms.TApplication.OnIdle
This event is fired once application is read to recieve users input. NOTE this event will be fired every time application becomes idle so you need to implement some controll variable which will tel you when OnIdle even was fired for the first time.
But as David already pointed out it is not good to block your UI (main thread). Why? When you block your main thread the application can't normally process its messages. This could lead to OS recognizing your application as being "Hanged". And aou definitly wanna avoid this becouse it could cause the users to go and forcefully kill your application whihc would probably lead to data loss. Also if you ever wanna design your application for any other platforms than Windows your application might fail the certification proces becouse of that.
In the past a simple PostMessage did the trick.
Essentially you fire it during DoShow of the base form:
procedure TBaseForm.DoShow;
begin
inherited;
PostMessage(Handle, APP_AFTERSHOW, 0, 0);
end;
then catch the msg and create an AfterShow event for all forms inherited from this base form.
But that no longer works, well not if you are skinning and have a good number of VCL controls.
My next trick was to spawn a simple thread in DoShow and check for IsWindowVisible(Handle) and IsWindowEnabled(Handle). That really sped things up it cut 250ms from load time since db opening and other stuff was already in the AfterShow event.
Then finally I thought of madHooks, easy enough to hook the API ShowWindow for my application and fire APP_AFTERSHOW from that.
function ShowWindowCB(hWnd: HWND; nCmdShow: Integer): BOOL; stdcall;
begin
Result := ShowWindowNext(hWnd, nCmdShow);
PostMessage(hWnd, APP_AFTERSHOW, 0, 0);
end;
procedure TBaseForm.Loaded;
begin
inherited;
if not Assigned(Application.MainForm) then // Must be Mainform it gets assigned after creation completes
HookAPI(user32, 'ShowWindow', #ShowWindowCB, #ShowWindowNext);
end;
To get the whole thing to completely paint before AfterShow it still needed a ProcessPaintMessages call
procedure TBaseForm.APPAFTERSHOW(var AMessage: TMessage);
begin
ProcessPaintMessages;
AfterShow;
end;
procedure ProcessPaintMessages; // << not tested, pulled out of code
var
msg: TMsg;
begin
while PeekMessage(msg, 0, WM_PAINT, WM_PAINT, PM_REMOVE) do
DispatchMessage(msg);
end;
My final test was to add a Sleep to the AfterShow event and see the Form fully painted with empty db containers since the AfterShow events had not yet completed.
procedure TMainForm.AfterShow;
begin
inherited;
Sleep(8*1000);
......
I'm working on a small component for writing and reading AT Commands using an old Sony Ericsson phone.
Sending and writing to/from the phone is no problem at all, however I would like to be able to pause my SendATCmd function and wait for the COM Port component to notify me with a Notification Event, and then resume the SendATCmd function again.
Scenario: I want to get the count of SMS messages in the phone.
Normally I'd just tell the phone: Hey, how many SMS messages do you have?
and the phone would reply in the notification event.
Thats all good.
But what I really want to do is something like
if SendATCmd('CountSMS')>0 then
for 0 to SMSCount do
AddSMSToList;
The code for SendATCmd looks like this:
function TSE_Z1010.SendATCmd(Cmd: string): TATResult;
begin
fCOMPort.PutString(Cmd); //Sending AT command
//Here is where I would like to pause this function
//wait for the fCOMPort to notify me when data is available
//and then resume this function again.
result:=fTMPATResult;
end;
I've tried using a while-loop, pause, etc etc, but nothing's worked except for one thing, and that's when I put a ShowMessage where the pause should be.
I don't know how ShowMessage works internally but it seems that it doesn't halt the program like while-loop and pause do.
====================
Fixed it.
All I had to do was to add Forms in the uses clause, and then I added while fTMPATResult.Full=false do Application.ProcessMessages; in the part where I wanted to pause the procedure.
"fTMPATResult" is the variable where the incoming COM Port data is stored, globally within the component.
While AsyncPro does have some solutions for this (ontriggerdata), they are event based and make code difficult to read/understand.
here is SendAndWaitForResponse with AsyncPro (like Remy suggested):
TForm1 = class(TForm)
...
private
IOEvent : THandle; // used for IO events
IORx : string;
Comport : TapdComport;
...
procedure TForm1.ComportTriggerAvail(CP: TObject; Count: Word);
var i : integer;
begin
for i:=1 to Count do
IORx:=IORx+Comport.GetChar;
SetEvent(IOEvent);
end;
function TForm1.SerialSAWR(tx : string; TimeOut : integer) : boolean;
begin
Result := False;
try
IORx := ''; // your global var
ResetEvent(IOEvent);
Comport.PutString(tx);
Result := WaitForSingleObject(IOEvent, TimeOut) = WAIT_OBJECT_0;
except
on E : Exception do
// dosomething with exception
end;
end;
// constructor part
IOEvent := CreateEvent(nil, True, False, nil);
// destructor part
if IOEvent <> 0 then
CloseHandle(IOEvent);
Best solution is to create a thread with the comport so your GUI won't be blocked.
I have several applications in production with Asyncpro this way and it works like a charm...
Any time you need to call Application.ProcessMessages() manually, you need to rethink your code design. Doubly so when calling it in a loop.
I do not know how Asynch Pro works, but the Win32 API has a WaitCommEvent() function that does what you are asking for. You call that function to ask the serial port for notification of the desired event(s) and then you can use either WaitForOverlappedResult() or WaitForSingleObject() to wait for those events to actually occur, depending on whether the serial port is operating in overlapped mode or not. No message processing is needed. I would be surprised if Asynch Pro does not somehow expose that functionality.
Does the Windows API provide a way to notify a running Delphi application in a console window when the user terminates it with a click on the close button (instead of using Ctrl+C)?
Related question: How do I handle Ctrl+C in a Delphi console application?
The OS notifies console programs of various events via "control signals." Call SetConsoleCtrlHandler to configure a function for the OS to call to deliver signals. The signal for a closed window is CTRL_CLOSE_EVENT.
function ConsoleEventProc(CtrlType: DWORD): BOOL; stdcall;
begin
if (CtrlType = CTRL_CLOSE_EVENT) then
begin
// optionally run own code here
// ...
end;
Result := True;
end;
...
begin
SetConsoleCtrlHandler(#ConsoleEventProc, True);
// my application code here
// ...
end.