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

Каким образом запустить процесс завершения работы операционной системы (функция ExitWindows) из кода моей программы? Мне необходимо перезапустить операционную систему без перезапуска компьютера.

Ok, приводим обе функции для перезапуска операционной системы:

procedure TMainForm.RestartWindowsBtnClick(Sender: TObject);

begin

if not ExitWindows(EW_RestartWindows, 0) then ShowMessage('Приложение не может завершить работу');

end;

procedure TMainForm.RebootSystemBtnClick(Sender: TObject);

begin

if not ExitWindows(EW_RebootSystem, 0) then ShowMessage('Приложение не может завершить работу');

end;

Функция ExitWindows не была правильно задокументирована Microsoft'ом и не содержит описания возвращаемого значения. Более того, информация о этой функции практически не встречается в других источниках. Вот правильное определение этой функции:

function ExitWindows(dwReturnCode: Longint; Reserved: Word): Bool;

Выключить монитор:

SendMessage(Application.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, 0);

Включить монитор:

SendMessage(Application.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, –1);

Алгоритм, применяемый мною:

В блоке begin..end модуля .dpr:

begin

if HPrevInst <>0 then begin

ActivatePreviousInstance;

Halt;

end;

end;

Реализация в модуле:

unit PrevInst;

interface

uses WinProcs, WinTypes, SysUtils;

type

PHWnd = ^HWnd;

function EnumApps(Wnd: HWnd; TargetWindow: PHWnd): bool; export;

procedure ActivatePreviousInstance;

implementation

function EnumApps(Wnd: HWnd; TargetWindow: PHWnd): bool;

var

ClassName : array[0..30] of char;

begin

Result := true;

if GetWindowWord(Wnd, GWW_HINSTANCE) = HPrevInst then begin

GetClassName(Wnd, ClassName, 30);

if STRIComp(ClassName,'TApplication')=0 then begin

TargetWindow^:= Wnd;

Result := false;

end;

end;

end;

procedure ActivatePreviousInstance;

var

PrevInstWnd: HWnd;

begin

PrevInstWnd:= 0;

EnumWindows(@EnumApps,LongInt(@PrevInstWnd));

if PrevInstWnd <> 0 then if IsIconic(PrevInstWnd) then

ShowWindow(PrevInstWnd,SW_Restore)

else

BringWindowToTop(PrevInstWnd);

end;

end.

Предоставленное разработчиками Delphi 2 Пачекой (Pacheco) и Тайхайрой (Teixeira) и значительно переработанное.

unit multinst;

{Применение:

Необходимый код в исходном проекте

if InitInstance then begin

Application.Initialize;

Application.CreateForm(TFrmSelProject, FrmSelProject);

Application.Run;

end;

Это все понятно (я надеюсь)}

interface

uses Forms, Windows, Dialogs, SysUtils;

const

MI_NO_ERROR = 0;

MI_FAIL_SUBCLASS = 1;

MI_FAIL_CREATE_MUTEX = 2;

{ Проверка правильности запуска приложения с помощью описанных ниже функций. }

{ Количество флагов ошибок MI_* может быть более одного. }

function GetMIError: Integer;

Function InitInstance : Boolean;

implementation

const

UniqueAppStr : PChar; {Различное для каждого приложения}

var

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

{ Если это – сообщение о регистрации… }

if Msg = MessageID then begin

{ если основная форма минимизирована, восстанавливаем ее }

{ передаем фокус приложению }

if IsIconic(Application.Handle) then begin

Application.MainForm.WindowState:= wsNormal;

ShowWindow(Application.Mainform.Handle, sw_restore);

end;

SetForegroundWindow(Application.MainForm.Handle);

end

{ В противном случае посылаем сообщение предыдущему окну }

else Result:= CallWindowProc(WProc, Handle, Msg, wParam, lParam);

end;

procedure SubClassApplication;

begin

{ Обязательная процедура. Необходима, чтобы обработчик }

{ Application.OnMessage был доступен для использования. }

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;

{ Процедура вызывается, если уже имеется запущенная копия Вашей программы. }

var

BSMRecipients: DWORD;