Все процессы получают сигналы CTRL_CLOSE_EVENT, CTRL_LOGOFF_EVENT и CTRL_SHUTDOWN_EVENT. А делается это (грубо говоря :) так:
BOOL Ctrl_Handler(DWORD Ctrl) {
if ((Ctrl == CTRL_SHUTDOWN_EVENT) || (Ctrl == CTRL_LOGOFF_EVENT)) {
// Вау! Юзер обламывает!
} else {
// Тут что-от другое можно творить. А можно и не творить :-)
}
return TRUE;
}
function Ctrl_Handler(Ctrclass="underline" Longint): LongBool;
begin
if Ctrl in [CTRL_SHUTDOWN_EVENT, CTRL_LOGOFF_EVENT] then begin
// Вау, вау
end
else begin
// Am I creator?
end;
Result := true;
end;
А где-то в программе:
SetConsoleCtrlHandler(Ctrl_Handler, TRUE);
Таких обработчиков можно навесить кучу. Если при обработке какого-то из сообщений обработчик возвращает FALSE, то вызывается следующий обработчик. Можно настроить таких этажерок, что ого-го :-)))
Короче, смотри описание SetConsoleCtrlHandler — там всё есть.
Как корректно перехватить сигнал выгрузки операционной системы, если в моей программе нет окна?
Nomadic рекомендует следующий способ:
Используй GetMessage(), в качестве HWND окна пиши NULL (на Паскале — 0). Если в очереди сообщений следующее — WM_QUIT, то эта функция фозвращает FALSE. Если ты пишешь программу для Win32, то запихни это в отдельный поток, организующий выход из программы.
Постепенное умирание
The_Sprite пишет:
Вопрос: А как реализовать в одном компоненте такие функции как выключение компьютера, перезагрузка, завершение сеанса работы пользователя, Eject CD, выключение питания монитора и т.д.? Ответ: предлагаем посмотреть следующий пример…
Совместимость: все версии Delphi
Пример:
procedure TForm1.Button1Click(Sender: TObject);
begin
PowerControl1.Action:=actCDEject;// Или...
actLogOFF, actShutDown...
PowerControl1.Execute;
end
Component Code:
unit
PowerControl;
interface
uses WinTypes, WinProcs, Messages, SysUtils, Classes, Controls,Forms, Graphics,MMSystem;
type
TAction =(actLogOFF,actShutDown,actReBoot,actForce,actPowerOFF,
actForceIfHung,actMonitorOFF,actMonitorON,actCDEject,actCDUnEject);
type TPowerControl = class(TComponent)
private
FAction : TAction;
procedure SetAction(Value : TAction); protected
public
function Execute :Boolean;
published
property Action :TAction read FAction write SetAction;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('K2',[TPowerControl]);
end;
procedure TPowerControl.SetAction(Value : TAction);
begin
FAction := Value;
end;
function TPowerControl.Execute : Boolean;
begin
with (Owner as TForm) do case FAction of
actLogOff: ExitWindowsEx(EWX_LOGOFF, 1);
actShutDown: ExitWindowsEx(EWX_SHUTDOWN, 1);
actReBoot:ExitWindowsEx(EWX_REBOOT, 1);
actForce:ExitWindowsEx(EWX_FORCE, 1);
actPowerOff:ExitWindowsEx(EWX_POWEROFF, 1);
actForceIfHung:ExitWindowsEx(EWX_FORCEIFHUNG, 1);
actMonitorOFF:SendMessage(Application.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, 0);
actMonitorON: SendMessage(Application.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, -1);
actCDEject: mciSendstring('SET CDAUDIO DOOR OPEN WAIT', nil, 0, Handle);
actCDUnEject: mciSendstring('SET CDAUDIO DOOR CLOSED WAIT', nil, 0, Handle);
end; {Case}
Result := True;
end;
end.
Разное
Как не допустить запуск второй копии программы VIII
Игорь Пролис рекомендует следующий код:
{*******************************************************}
{ }
{ HTMLCoolEdit }
{ }
{ Copyright (c) 1999-2000 PROFOX }
{ }
{*******************************************************}
unit multinst;
interface
uses Forms, Windows, Dialogs, SysUtils;
const
MI_NO_ERROR = 0;
MI_FAIL_SUBCLASS = 1;
MI_FAIL_CREATE_MUTEX = 2;
function GetMIError: Integer;
function InitInstance : Boolean;
implementation
uses RegWork, FileWork;
var
UniqueAppStr : PChar;
MessageId: Integer;
WProc: TFNWndProc = Nil;
MutHandle: THandle = 0;
MIError: Integer = 0;
function GetMIError: Integer;
begin
Result := MIError;
end;
function NewWndProc(Handle: HWND; Msg: Integer; wParam, lParam: Longint): Longint; StdCall;
begin
Result := 1;
if Msg = MessageID then begin
if IsIconic(Application.Handle) then OpenIcon(Application.Handle)
else SetForegroundWindow(Application.Handle);
FileWork.LoadFileName(RegWork.RWGetParamStr1);
end
else Result := CallWindowProc(WProc, Handle, Msg, wParam, lParam);
end;
procedure SubClassApplication;
begin
WProc := TFNWndProc(SetWindowLong(Application.Handle, GWL_WNDPROC, Longint(@NewWndProc)));
if WProc = Nil then MIError := MIError or MI_FAIL_SUBCLASS;
end;
procedure DoFirstInstance;
begin
SubClassApplication;
MutHandle := CreateMutex(Nil, False, UniqueAppStr);
if MutHandle = 0 then MIError := MIError or MI_FAIL_CREATE_MUTEX;
end;
procedure BroadcastFocusMessage;