Советы по Delphi. Версия 1.4.3 от 1.1.2001 - [7]

Следующий код демонстрирует как можно воспользоваться данным событием.

Демонстрационный код

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
 {Спрашиваем пользователя, если инициировано завершение работы.}
 if MessageDlg('Вы уверены?', mtConfirmation, mbYesNoCancel, 0) = mrYes then CanClose := true    {Разрешаем завершение работы.}
 else CanClose := false; {Не разрешаем завершение работы.}
end;

Как консольное приложение может узнать, что Винды завершаются?

Nomadic рекомендует следующий код:

Все процессы получают сигналы 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(Ctrl: 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