鱼C论坛

 找回密码
 立即注册
查看: 1107|回复: 6

[技术交流] delphi实现关机

[复制链接]
发表于 2022-9-10 09:27:43 | 显示全部楼层 |阅读模式

马上注册,结交更多好友,享用更多功能^_^

您需要 登录 才可以下载或查看,没有账号?立即注册

x
今天给各位分享一下delphi如何关机


下面直接上:
关闭Windows函数ExitWindowsEx(UINT uFlag,DWORD:dwReserved)说明:

控制WINDOWS的开关:如关闭WINDOWS,重新启动WINDOWS等, ExitWindowsEx(UINT uFlags,DWORD dwReserved);是实现这一功能的API函数。如果Complile时提示EWX_XXXX未定义,那么请手动定义这几个常数,默认情况下是无需我们手动定义的。
const
EWX_FORCE=4; //关闭所有程序并以其他用户身份登录?(!!应为“强制执行否”吧!!)
EWX_LOGOFF=0; //重新启动计算机并切换到MS-DOS方式
EWX_REBOOT=2; //重新启动计算机
EWX_SHUTDOWN=1;//关闭计算机
EWX_POWEROFF=8;//切断电源
EWX_FORCEIFHUNG=$10;//不记得了,有谁好心查下MSDN
调用方法:
ExitWindowsEx(EWX_REBOOT,0); //重启计算机
ExitWindowsEx(EWX_FORCE+EWX_SHUTDOWN,0); //强行关机

不过博主经常听到有人说这一API只在Windows 95/98/98SE/Me下有效,而在Windows NT/2000/XP下无效。
其实这是不正确的,这一API在上述平台下均是有效的,只是我们在Windows NT/2000/XP平台下执行此函数之前,必须要获取得关机特权罢了,其实就算是Windows NT/2000/XP系统自身关机也必须要走这一流程的。

  • 获取关机特权函数如下:
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[0].Luid) then  
  begin  
    tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;  
    tkp.PrivilegeCount := 1;  
    AdjustTokenPrivileges(hToken, False, tkp, 0, nil, rl);  
  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[0].Luid) then  

begin

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

 tkp.PrivilegeCount := 1; 

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

end;  

end; 

另一个关机API,InitiateSystemShutdown(PChar(Computer_Name),PChar(Hint_Msg),Time,Force,Reboot);在Windows NT/2000/XP平台下还会自动调用系统本身的关机提示窗口。
InitiateSystemShutdown(PChar(Computer_Name), PChar(Hint_Msg),Time,Force,Reboot);
                      //关机计算机名,关机提示信息,停留时长,是否强行关机,是否要重启
当我们把Computer_Name设为nil时,默认为本机,如 InitiateSystemshutdown(nil,nil,0,True,False);//强行关机


由于我们需要制作一个通用的关机程序,故要对当前的操作系统进行判断,这个比较简单,函数如下:
 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 ShutDownComputer;  
  begin  
    if GetOperatingSystem='Windows NT/2000/XP' then   
    begin   
      Get_Shutdown_Privilege;  
      //调用此函数会出现系统关机提示窗口,并允许用户取消关机动作  
      //InitiateSystemShutDown(nil,'关机提示:讨厌你所以关了你!',0,True,False);  
      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;   
=========================================================================================================================}  
  
使用:  
  
procedure TShutDownForm.btn_PowerOffClick(Sender:Object);  
begin  
  ShutDownComputer;  
end; 



至于使用windows终端强制关机
shutdown -s -t 3 #3就是几秒后关机

ok就到这里,大家点赞,评分,支持一下吧



想知道小甲鱼最近在做啥?请访问 -> ilovefishc.com
回复

使用道具 举报

 楼主| 发表于 2022-9-10 09:29:00 | 显示全部楼层
给位大佬,多给我加点荣誉,争取让我早日升到中级鱼油I
想知道小甲鱼最近在做啥?请访问 -> ilovefishc.com
回复 支持 反对

使用道具 举报

发表于 2022-9-10 11:37:50 From FishC Mobile | 显示全部楼层
现在哪还有xp用户
话说,我给你发的短信没收到吗
想知道小甲鱼最近在做啥?请访问 -> ilovefishc.com
回复 支持 反对

使用道具 举报

 楼主| 发表于 2022-9-10 11:53:13 | 显示全部楼层
wp231957 发表于 2022-9-10 11:37
现在哪还有xp用户
话说,我给你发的短信没收到吗

我给你发的问号你没收到吗
想知道小甲鱼最近在做啥?请访问 -> ilovefishc.com
回复 支持 反对

使用道具 举报

发表于 2022-9-10 11:57:13 From FishC Mobile | 显示全部楼层
编程追风梦 发表于 2022-9-10 11:53
我给你发的问号你没收到吗

收到了,我又给你回了啊
我是说你说的那些学英语的资料,要是方便就发一份
想知道小甲鱼最近在做啥?请访问 -> ilovefishc.com
回复 支持 反对

使用道具 举报

 楼主| 发表于 2022-9-10 18:25:43 | 显示全部楼层
wp231957 发表于 2022-9-10 11:57
收到了,我又给你回了啊
我是说你说的那些学英语的资料,要是方便就发一份

ok
想知道小甲鱼最近在做啥?请访问 -> ilovefishc.com
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

小黑屋|手机版|Archiver|鱼C工作室 ( 粤ICP备18085999号-1 | 粤公网安备 44051102000585号)

GMT+8, 2024-11-21 18:59

Powered by Discuz! X3.4

© 2001-2023 Discuz! Team.

快速回复 返回顶部 返回列表