liwutian06 发表于 2015-7-11 22:26:06

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
TForm1 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
private
    { Private declarations }
public
    { Public declarations }
end;
    function GetOperatingSystem(): string;
    procedure ShutDownComputer();
    procedure Get_Shutdown_Privilege();
var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
ShutDownComputer();
end;

procedure ShutDownComputer();
begin
if GetOperatingSystem() = 'Windows NT/2000/XP' then
begin
    Get_Shutdown_Privilege();
    //调用此函数会出现系统关机提示窗口,并允许用户取消关机动作
    InitiateSystemShutDown(nil, '关机提示:讨厌你所以关了你!', 3, True, False);
    // InitiateSystemShutDown去掉的话就不显示提示窗口
    ExitWindowsEx(EWX_SHUTDOWN+EWX_FORCE+EWX_POWEROFF+EWX_FORCEIFHUNG,0);
end
else
begin
    ExitWindowsEx(EWX_SHUTDOWN+EWX_FORCE+EWX_POWEROFF+EWX_FORCEIFHUNG,0);
end;
end;

function GetOperatingSystem(): string; //获取操作系统信息
var
osVerInfo: TOSVersionInfo;

begin
Result:= '';
osVerInfo.dwOSVersionInfoSize:= SizeOf(TOSVersionInfo);

if GetVersionEx(osVerInfo) then
    case osVerInfo.dwPlatformId of
    VER_PLATFORM_WIN32_NT:
      begin
      Result:= 'Windows NT/2000/XP'
      end;
    VER_PLATFORM_WIN32_WINDOWS:
      begin
      Result := 'Windows 95/98/98SE/Me';
      end;
end;
end;

procedure Get_Shutdown_Privilege(); //获得用户关机特权,仅对Windows NT/2000/XP
var   
rl: Cardinal;
hToken: Cardinal;
tkp: TOKEN_PRIVILEGES;   
begin
OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken);

if LookupPrivilegeValue(nil, 'SeShutdownPrivilege', tkp.Privileges.Luid) then
begin
    tkp.Privileges.Attributes:= SE_PRIVILEGE_ENABLED;
    tkp.PrivilegeCount:= 1;
    AdjustTokenPrivileges(hToken, False, tkp, 0, nil, rl);
end;
end;

end.

love562 发表于 2015-12-29 14:56:50

222222222222

zeronev 发表于 2016-4-6 11:48:04

运行环境

lsx116 发表于 2016-12-8 22:00:33

时代发生地方

小人鱼 发表于 2016-12-9 10:52:14

呵呵,这个好

大海来了哈 发表于 2016-12-16 09:49:18

11

嘻哈泥鳅 发表于 2017-1-4 16:00:49

1

鱼恨水 发表于 2017-1-21 14:56:08

欢迎回复你的关

心驰神往 发表于 2020-9-19 13:46:12

1

sy1314 发表于 2020-9-20 14:06:27

aaaaaaaaaaaaaaaaaa

心驰神往 发表于 2020-11-24 09:43:29

コ契約^ō 发表于 2013-11-14 09:15
so happy

win+d

阿里CC 发表于 2020-11-27 10:38:04

搞心态

wing2020 发表于 2020-12-9 08:41:45

谢谢分享

高山 发表于 2021-12-30 17:44:25

点赞

powerpro 发表于 2024-1-29 19:50:36

楼主,你是一个大好人!!
页: 1 2 3 4 [5]
查看完整版本: 鱼C恶搞-K.001 关不掉的屏保