Mam's WebSite

Mamの覚書Q&A検索


大項目:「 Delphi 」 - 中項目:「 API 」

「 OSの強制終了 」

OSの強制終了


回答


以下の内容のファイルを
○○(実行ファイル名).exe.manifest
の名前で保存します。
 
<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">
   <assemblyIdentity version="1.0.0.0" processorArchitecture="X86" name="WindowsApplication1" type="win32"/>
      <trustInfo xmlns="urn:schemas-microsoft-com:asm.v3">
      <security>
         <requestedPrivileges>
            <requestedExecutionLevel level="requireAdministrator"/> 
         </requestedPrivileges>
      </security>
   </trustInfo>
</assembly>
 
次にリソースファイルを作成します。
ファイル名はMyRC.rc
とします。
 
#define CREATEPROCESS_MANIFEST_RESOURCE_ID 1
#define CONTROL_PANEL_RESOURCE_ID 123
#define RT_MANIFEST 24
CREATEPROCESS_MANIFEST_RESOURCE_ID RT_MANIFEST "○○(実行ファイル名).exe.manifest"
 
「プロジェクト」-「プロジェクトに追加」で上記の作成したrcファイルを
プロジェクトに追加します。

ソース

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;
 
function WinExit(flags: integer): boolean;
 

var
  Form1: TForm1;
 

implementation
 
{$R *.dfm}
 
function WinExit(flags: integer): boolean;
  function SetPrivilege(privilegeName: string; enable: 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(privilegeName), tp.Privileges[0].LUID) then
    begin
      if enable 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;
begin
  result:=false;
  if SetPrivilege('SeShutdownPrivilege', true) then begin
    ExitWindowsEx(flags, 0);
    SetPrivilege('SeShutdownPrivilege', False);
    result:=true;
  end;
end;
 

procedure TForm1.Button1Click(Sender: TObject);
var flags:integer;
begin
//  EWX_LOGOFF
//      ログオフ
//  EWX_POWEROFF
//      Windowsを終了した後パソコンの電源を切る
//  EWX_REBOOT
//      再起動
//  EWX_SHUTDOWN
//      Windowsを終了し、パソコンの電源を切っても大丈夫な状況にします。
//  EWX_FORCE
//      Windowsの強制終了(終了しないアプリケーションがあっても保存せず強制終了)
//      EWX_SHUTDOWNと一緒に使う
 
  flags:=EWX_SHUTDOWN or EWX_FORCE;
  WinExit(flags);
 
end;
 
end.

Copyright 2019 Mam