Валентин Озеров - Советы по Delphi. Версия 1.4.3 от 1.1.2001

Nomadicсоветует:

Используй вызов

ExpandEnvironmentStrings(LPCTSTR lpSrc, LPTSTR lpDst, DWORD nSize);

Можно. Попробуйте следующий код:

Proceduresettime(hour, min, sec, hundreths : byte); assembler;

asm

mov ch, hour

mov cl, min

mov dh, sec

mov dl, hundreths

mov ah, $2d

int $21

end;

Proceduresetdate(year : word; month, day : byte); assembler;

asm

mov cx, year

mov dh, month

mov dl, day

mov ah, $2b

int $21

end;

Существует ли возможность определения завершения работы Windows для нормального завершения работы работающего приложения Delphi?

Самым простым решением является создание обработчика события главной формы OnCloseQuery. Данное событие возникает как результат сообщения WM_QUERYENDSESSION, которое посылается всем работающим приложениям Windows в момент инициализации процесса окончания работы Windows. Логическая переменная CanClose, передаваемая обработчику как var-параметр, может позволить программе (и Windows) завершить свою работу, если имеет значение True, значение же False не позволит программе завершить свою работу.

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

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

procedureTForm1.FormCloseQuery(Sender: TObject; varCanClose: Boolean);

begin

{Спрашиваем пользователя, если инициировано завершение работы.}

ifMessageDlg('Вы уверены?', mtConfirmation, mbYesNoCancel, 0) = mrYes thenCanClose := true {Разрешаем завершение работы.}

elseCanClose := 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;

}

functionCtrl_Handler(Ctrl: Longint): LongBool;

begin

ifCtrl 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

Пример:

procedureTForm1.Button1Click(Sender: TObject);

begin

PowerControl1.Action:=actCDEject;// Или...

actLogOFF, actShutDown...

PowerControl1.Execute;

end

Component Code:

unit

PowerControl;

interface

usesWinTypes, 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;

procedureSetAction(Value : TAction); protected

public

functionExecute :Boolean;

published

propertyAction :TAction readFAction writeSetAction;

end;

procedure Register;

implementation

procedure Register;

begin

RegisterComponents('K2',[TPowerControl]);

end;

procedureTPowerControl.SetAction(Value : TAction);

begin

FAction := Value;

end;

functionTPowerControl.Execute : Boolean;

begin

with(Owner asTForm) do caseFAction 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.

Игорь Пролисрекомендует следующий код:

{*******************************************************}

{ }

{ HTMLCoolEdit }

{ }

{ Copyright (c) 1999-2000 PROFOX }

{ }

{*******************************************************}

unitmultinst;

interface

usesForms, Windows, Dialogs, SysUtils;

const

MI_NO_ERROR = 0;

MI_FAIL_SUBCLASS = 1;

MI_FAIL_CREATE_MUTEX = 2;

functionGetMIError: Integer;

functionInitInstance : Boolean;

implementation

usesRegWork, FileWork;

var

UniqueAppStr : PChar;

MessageId: Integer;

WProc: TFNWndProc = Nil;

MutHandle: THandle = 0;

MIError: Integer = 0;

functionGetMIError: Integer;

begin

Result := MIError;

end;

functionNewWndProc(Handle: HWND; Msg: Integer; wParam, lParam: Longint): Longint; StdCall;

begin

Result := 1;

ifMsg = MessageID then begin

ifIsIconic(Application.Handle) thenOpenIcon(Application.Handle)

elseSetForegroundWindow(Application.Handle);