不能正常关机(100分)

  • 主题发起人 主题发起人 boyuanus
  • 开始时间 开始时间
B

boyuanus

Unregistered / Unconfirmed
GUEST, unregistred user!
自己的一个软件,最小化后变为托盘图标。
不能正常关机。
可否重载关机消息?如何去做?
100分奉上。请各位大虾不吝赐教
 
截获 WM_QUERYENDSESSION 将 Result 置 True,代表同意系统关机。

 
Beta,
不行呀
我的系统 Win2k Server, Eng, 如果截获消息,没问题,可以截获到。
但是置为True后系统就没动静了。不能够关机。

还有没有其他的方法?或者是我的问题?
最好是Win98/WinME/WinXP/Win2k都可以用的。
谢谢
 
没有
怎么设定让win2000在一定时间后自己关机
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.
 
你的程序是否使用了网络控件?例如NMUDP?
 

Similar threads

D
回复
0
查看
1K
DelphiTeacher的专栏
D
D
回复
0
查看
902
DelphiTeacher的专栏
D
D
回复
0
查看
1K
DelphiTeacher的专栏
D
S
回复
0
查看
1K
SUNSTONE的Delphi笔记
S
后退
顶部