Code:

SendMessage (FindWindow ('Progman', 'Program Manager'), WM_CLOSE, 0, 0);

 

Для этого нам потребуются определённые привелегии:

Code:

function SetPrivilege(aPrivilegeName : string;

                     aEnabled : boolean ): boolean;

var

TPPrev,

TP         : TTokenPrivileges;

Token      : THandle;

dwRetLen   : DWord;

begin

Result := False;

OpenProcessToken(GetCurrentProcess,TOKEN_ADJUST_PRIVILEGES

                  or TOKEN_QUERY, @Token );

 

TP.PrivilegeCount := 1;

if( LookupPrivilegeValue(nil, PChar( aPrivilegeName ),

                          TP.Privileges[ 0 ].LUID ) ) then

begin

   if( aEnabled )then

     TP.Privileges[0].Attributes:= SE_PRIVILEGE_ENABLED;

   else

     TP.Privileges[0].Attributes:= 0;

 

   dwRetLen := 0;

   Result := AdjustTokenPrivileges(Token,False,TP,

                                   SizeOf( TPPrev ),

                                   TPPrev,dwRetLen );

end;

 

CloseHandle( Token );

end;

 

 

function WinExit( iFlags : integer ) : boolean;

//   возможные флаги:

//   EWX_LOGOFF

//   EWX_REBOOT

//   EWX_SHUTDOWN

begin

Result := True;

if( SetPrivilege( 'SeShutdownPrivilege', true ) ) then

begin

   if( not ExitWindowsEx( iFlags, 0 ) )then

   begin

     Result := False;

   end;

   SetPrivilege( 'SeShutdownPrivilege', False )

end

else

begin

   Result := False;

end;

end;

 

  

Code:

procedure TForm1.Button1Click(Sender: TObject);

var

SysPowerStatus: TSystemPowerStatus;

begin

GetSystemPowerStatus(SysPowerStatus);

if Boolean(SysPowerStatus.ACLineStatus) then

begin

   ShowMessage('System running on AC.');

end

else

begin

   ShowMessage('System running on battery.');

   ShowMessage(Format('Battery power left: %d percent.', [SysPowerStatus.BatteryLifePercent]));

end;

end;

 

 

Code:

function MyExitWindows(RebootParam: Longword): Boolean;

var

TTokenHd: THandle;

TTokenPvg: TTokenPrivileges;

cbtpPrevious: DWORD;

rTTokenPvg: TTokenPrivileges;

pcbtpPreviousRequired: DWORD;

tpResult: Boolean;

const

SE_SHUTDOWN_NAME = 'SeShutdownPrivilege';

begin

if Win32Platform = VER_PLATFORM_WIN32_NT then

begin

   tpResult := OpenProcessToken(GetCurrentProcess(),

     TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY,

     TTokenHd);

   if tpResult then

   begin

     tpResult := LookupPrivilegeValue(nil,

                                      SE_SHUTDOWN_NAME,

                                      TTokenPvg.Privileges[0].Luid);

     TTokenPvg.PrivilegeCount := 1;

     TTokenPvg.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;

     cbtpPrevious := SizeOf(rTTokenPvg);

     pcbtpPreviousRequired := 0;

     if tpResult then

       Windows.AdjustTokenPrivileges(TTokenHd,

                                     False,

                                     TTokenPvg,

                                     cbtpPrevious,

                                     rTTokenPvg,

                                     pcbtpPreviousRequired);

   end;

end;

Result := ExitWindowsEx(RebootParam, 0);

end;

 

// Example to shutdown Windows:

 

procedure TForm1.Button1Click(Sender: TObject);

begin

MyExitWindows(EWX_POWEROFF or EWX_FORCE);

end;

 

// Example to reboot Windows:

 

procedure TForm1.Button1Click(Sender: TObject);

begin

MyExitWindows(EWX_REBOOT or EWX_FORCE);

end;

 

 

Code:

unit Unit1;

{©Drkb v.3}

 

interface

 

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,

Dialogs;

 

type

TForm1 = class(TForm)

   procedure FormCreate(Sender: TObject);

   procedure FormClose(Sender: TObject; var Action: TCloseAction);

private

   FSystemShutdown: Boolean;

   procedure WMQueryEndSession(var Message: TWMQueryEndSession); message WM_QUERYENDSESSION;

end;

 

var

Form1: TForm1;

 

implementation

 

{$R *.dfm}

 

function SetPrivilege(PrivilegeName: String; AEnabled: Boolean): Boolean;

var

TPPrev, TP: TTokenPrivileges;

Token: THandle;

dwRetLen: DWORD;

begin

Result := False;

if OpenProcessToken(GetCurrentProcess,

   TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, Token) then

try

   if LookupPrivilegeValue(nil, PChar(PrivilegeName),TP.Privileges[0].LUID) then

   begin

     TP.PrivilegeCount := 1;

     if AEnabled then

       TP.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED

     else

       TP.Privileges[0].Attributes := 0;

     dwRetLen := 0;

     Result := AdjustTokenPrivileges(Token, False, TP,

       SizeOf(TPPrev), TPPrev, dwRetLen);

   end;

finally

   CloseHandle(Token);

end

else

   RaiseLastOSError;

end;

 

procedure TForm1.FormCreate(Sender: TObject);

const

SE_SHUTDOWN_NAME = 'SeShutdownPrivilege';

begin

FSystemShutdown := False;

if not SetPrivilege(SE_SHUTDOWN_NAME, True) then

   RaiseLastOSError;

end;

 

procedure TForm1.WMQueryEndSession(var Message: TWMQueryEndSession);

begin

inherited;

Message.Result := 0;

AbortSystemShutdown(nil);

FSystemShutdown := True;

Close;

end;

 

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);

begin

ShowMessage('Bla...bla...bla!');

if FSystemShutdown then

   InitiateSystemShutdown(nil, nil, 0, True, False);

end;

 

end.

 

Автор: Александр (Rouse_) Багель

 

Вопрос: А как реализовать в одном компоненте такие функции как выключение компьютера, перезагрузка, завершение сеанса работы пользователя, Eject CD, выключение питания монитора и т.д.? Ответ: предлагаем посмотреть следующий пример ...

Code:

 

function TimedShutDown(Computer: string; Msg: string; Time: Word; Force: Boolean; Reboot: Boolean): Boolean;

var

  rl: Cardinal;

  hToken: Cardinal;

  tkp: TOKEN_PRIVILEGES;

begin

  //get user privileges to shutdown the machine, we are talking about win nt and 2k here

if not OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) then

    ShowMessage('Cannot open process token.')

  else

  begin

    if LookupPrivilegeValue(nil, 'SeShutdownPrivilege', tkp.Privileges[0].Luid) then

    begin

      tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;

      tkp.PrivilegeCount := 1;

      AdjustTokenPrivileges(hToken, False, tkp, 0, nil, rl);

      if GetLastError <> ERROR_SUCCESS then

       ShowMessage('Error adjusting process privileges.');

    end

  else

    ShowMessage('Cannot find privilege value.');

  end;

 

  Result := InitiateSystemShutdown(PChar(Computer), PChar(Msg), Time, Force, Reboot)

end;

 

//Start shut down

procedure TForm1.Button1Click(Sender: TObject);

begin

  if not TimedShutDown('\\computername', 'you have to shutdown', 30, true, true) then

    ShowMessage('function failed...');

end;

 

//Abort shut down

procedure TForm1.Button2Click(Sender: TObject);

begin

  AbortSystemShutdown('\\computername');

end;

 

Если текст в Memo1 был изменен, то программа не разрешает завершения сеанса Windows.

 

Code:

uses

Registry;

...

procedure TForm1.Button1Click(Sender: TObject);

var

a: TRegistry;

begin

a := TRegistry.create;

with a do

begin

   RootKey := HKEY_CURRENT_USER;

   OpenKey('\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer', true);

   WriteInteger('NoClose', 1);

   CloseKey;

   Free;

end;

end;

 

 

 

Сообщение wm_queryendsession посылается всем приложениям когда пользователь выбирает завершение сеанса или когда приложение вызывает

Функция ExitWindows. Если какое-либо приложение возвращает ноль, сеанс не завершается.

Система перестает отправлять сообщения WM_QUERYENDSESSION, как только одно приложение

возвращать нуль. После обработки этого сообщения система отправляет сообщение WM_ENDSESSION с

Параметр wParam задает результаты сообщения WM_QUERYENDSESSION.

 

 

Code:

procedure TForm1.Button1Click(Sender: TObject);

var

  SysPowerStatus: TSystemPowerStatus;

begin

  GetSystemPowerStatus(SysPowerStatus);

  if Boolean(SysPowerStatus.ACLineStatus) then

  begin

    ShowMessage('System running on AC.');

  end

  else

  begin

    ShowMessage('System running on battery.');

    ShowMessage(Format('Battery power left: %d percent.', [SysPowerStatus.BatteryLifePercent]));

  end;

end;