copy 的旧贴,我也没试,你看看:
win2000和nt的关机机制和win98不一样
必须调用AdjustTokenPrivileges使se_shutdown_name有效
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Memo1: TMemo;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
procedure DoShutdown;
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
logoff: boolean = false;
reboot: boolean = false;
warn: boolean = false;
downQuick: boolean = false;
cancelShutdown: boolean = false;
powerOff: boolean = false;
timeDelay: integer = 0;
implementation
{$R *.DFM}
function HasParam(Opt: Char): Boolean;
var
x: integer;
begin
result := false;
for x := 1 to paramCount do
if (paramstr(x) = '-'+opt) or (paramstr(x) = '/'+opt) then result := true;
end;
function GetErrorString: String;
var
lz: Cardinal;
err: array[0..512] of Char;
begin
lz := GetLastError;
FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, nil, lz, 0, @err, 512, nil);
result := string(err);
end;
procedure Tform1.DoShutdown;
var
rl,flgs: Cardinal;
hToken: Cardinal;
tkp: TOKEN_PRIVILEGES;
begin
flgs := 0;
if downQuick then flgs := flgs or EWX_FORCE;
if not reboot then flgs := flgs or EWX_SHUTDOWN;
if reboot then flgs := flgs or EWX_REBOOT;
if poweroff and (not reboot) then flgs := flgs or EWX_POWEROFF;
if logoff then flgs := (flgs and (not (EWX_REBOOT or EWX_SHUTDOWN or EWX_POWEROFF))) or EWX_LOGOFF;
if Win32Platform = VER_PLATFORM_WIN32_NT then begin
if not OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) then
memo1.lines.add('Cannot open process token. ['+GetErrorString+']')
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
memo1.lines.add('Error adjusting process privileges.');
end else memo1.lines.add('Cannot find privilege value. ['+GetErrorString+']');
end;
if CancelShutdown then
if AbortSystemShutdown(nil) = False then
memo1.lines.add('Cannot abort. [/'+GetErrorString+'/]')
else
memo1.lines.add('Cancelled./')
else begin
if InitiateSystemShutdown(nil, nil, timeDelay, downQuick, Reboot) = False then
memo1.lines.add('Cannot go down. [/'+GetErrorString+'/]')
else
memo1.lines.add('Shutting down!/');
end;
end
else begin
ExitWindowsEx(flgs, 0);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
memo1.lines.add('Shutdown v0.3 for Win32 (similar to the Linux version)');
memo1.lines.add('(c) 2000 NeuralAbyss Software. All Rights Reserved.');
if HasParam('?') or (ParamCount=0) then begin
memo1.lines.add('Usage: shutdown [-akrhfnc] [-t secs]');
memo1.lines.add(' -k: don''t really shutdown, only warn.');
memo1.lines.add(' -r: reboot after shutdown.');
memo1.lines.add(' -h: halt after shutdown.');
memo1.lines.add(' -p: power off after shutdown');
memo1.lines.add(' -l: log off only');
memo1.lines.add(' -n: kill apps that don''t want to die.');
memo1.lines.add(' -c: cancel a running shutdown.');
end else begin
if HasParam('k') then warn := true;
if HasParam('r') then reboot := true;
if HasParam('h') and reboot then begin
memo1.lines.add('Error: Cannot specify -r and -h parameters together!');
Exit;
end;
if HasParam('h') then reboot := false;
if HasParam('n') then downQuick := true;
if HasParam('c') then cancelShutdown := true;
if HasParam('p') then powerOff := true;
if HasParam('l') then logoff := true;
DoShutdown;
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
reboot := true;
DoShutdown;
end;
end.
