delphi7 求自动关机源码
发布网友
发布时间：2022-04-20 05:08
共1个回答
热心网友
时间：2023-07-17 09:08
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, Buttons;type
TFrm_AutoShutWindows = class(TForm)
Timer: TTimer;
P_Tip: TPanel;
L1: TLabel;
LB_Hint: TLabel;
IMG_TIP: TImage;
procere FormClose(Sender: TObject; var Action: TCloseAction);
procere TimerTimer(Sender: TObject);
procere FormShow(Sender: TObject);
procere FormCreate(Sender: TObject);
procere FormResize(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;var
Frm_AutoShutWindows: TFrm_AutoShutWindows;
Check_AutoT:Integer=3;implementation{$R *.dfm}Function System_Ver:String;
var VersionInfo: TOSVersionInfo;
begin
VersionInfo.dwOSVersionInfoSize := Sizeof(TOSVersionInfo);
GetVersionEx(VersionInfo);
Case VersionInfo.dwPlatformID of
VER_PLATFORM_WIN32S: Result:='';
VER_PLATFORM_WIN32_WINDOWS: Result:='WINDOWS9X';
VER_PLATFORM_WIN32_NT: Result :='WINDOWSNT';
End;
end;procere ADJUST_;
var
hToken : THandle;
Tkp : TTokenPrivileges;
Zero:DWORD;
begin
OpenProcessToken(GetCurrentProcess(),TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY,hToken);
LookupPrivilegeValue(nil,'SeShutdownPrivilege',tkp.Privileges[0].Luid);
Tkp.PrivilegeCount :=1;
Tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
AdjustTokenPrivileges(hToken,False,Tkp,SizeOf(TTokenPrivileges),nil,Zero);
end;procere TFrm_AutoShutWindows.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
Action:=Cafree;
Self:=nil;
end;procere TFrm_AutoShutWindows.TimerTimer(Sender: TObject);
Var
I:Integer;
ProcessWnd,ExitCode:Cardinal;
Mem_List:TStringList;
function GetCurrentRun:Integer;
var
aryCaption: array[0..255] of Char;
hFound: THandle;
nProcId: DWord;
IsCanOpen : THandle;
begin
Result := 0;
hFound := FindWindowEx(0, 0, nil, nil);
MEM_List.Clear;
while hFound <> 0 do
begin
if GetWindow(hFound, GW_OWNER) = 0 then
if IsWindowVisible(hFound) then
if GetWindowText(hFound, aryCaption, 255) > 0 then
if (AnsiCompareText(StrPas(aryCaption), 'Program Manager') <> 0) then
begin
GetWindowThreadProcessId(hFound, @nProcId);
If (nProcId<>windows.GetCurrentProcessId()) then
Begin
IsCanOpen:=OpenProcess(PROCESS_VM_OPERATION or PROCESS_VM_READ
or PROCESS_VM_WRITE or PROCESS_QUERY_INFORMATION,true,nProcId);
if (IsCanOpen<>0) Then //能打开
begin
windows.CloseHandle(IsCanOpen);
MEM_List.Add(FloatToStr(nProcID));
Result:=Result+1;
end; //end if
end; //end if
end;
hFound := FindWindowEx(0, hFound, nil, nil);
end;
end;
begin
Dec(Check_AutoT);
LB_Hint.Caption:=Inttostr(Check_AutoT)+' 秒 ';
If Check_AutoT<=0 then
begin
Timer.Enabled:=false;
Mem_List:=TStringList.Create ;
If GetCurrentRun>0 then
Begin
For I:=0 to Mem_list.Count-1 do
Begin
ProcessWnd := OpenProcess(PROCESS_ALL_ACCESS, True, StrToInt(Mem_List.Strings[I]));
GetExitCodeProcess(ProcessWnd,ExitCode);
TerminateProcess(ProcessWnd, ExitCode);
END;
End;
If System_Ver<>'WINDOWS9X' then
Begin
ADJUST_;
ExitWindowsEx(EWX_POWEROFF,EWX_SHUTDOWN+EWX_FORCE+EWX_POWEROFF); //关闭系统并关闭电源
End else
begin
Winexec(pchar('Net use * /del /yes'),SW_HIDE);
ExitWindowsEx(EWX_SHUTDOWN,1);
end;
Application.Terminate;
end;
end;procere TFrm_AutoShutWindows.FormShow(Sender: TObject);
begin
WindowState:=wsMinimized;
WindowState:=wsNormal;
Timer.Enabled:=True;
end;procere TFrm_AutoShutWindows.FormCreate(Sender: TObject);
begin
Width:=Screen.Width;
Height:=Screen.Height;
Application.BringToFront;
end;procere TFrm_AutoShutWindows.FormResize(Sender: TObject);
begin
P_Tip.Top:=(Height div 2)-115;
P_Tip.Left:=(Width Div 2)-280;
end;end.
DFM代码： object Frm_AutoShutWindows: TFrm_AutoShutWindows
Left = 52
Top = 53
BorderIcons = [biMinimize, biMaximize]
BorderStyle = bsNone
Caption = '自动关机提示'
ClientHeight = 615
ClientWidth = 880
Color = clWindow
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = '宋体'
Font.Style = []
FormStyle = fsStayOnTop
OldCreateOrder = False
Position = poScreenCenter
Scaled = False
OnClose = FormClose
OnCreate = FormCreate
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 12
object Shape1: TShape
Left = 0
Top = 0
Width = 880
Height = 615
Align = alClient
end
object Label1: TLabel
Left = 86
Top = 106
Width = 697
Height = 87
Caption = '30秒后将自动关机'
Font.Charset = ANSI_CHARSET
Font.Color = clNavy
Font.Height = -87
Font.Name = '宋体'
Font.Style = []
ParentFont = False
Transparent = True
end
object Label2: TLabel
Left = 81
Top = 280
Width = 785
Height = 87
Caption = '还剩下 秒 ...'
Font.Charset = ANSI_CHARSET
Font.Color = clNavy
Font.Height = -87
Font.Name = '宋体'
Font.Style = []
ParentFont = False
Transparent = True
end
object LB_Hint: TLabel
Left = 357
Top = 216
Width = 222
Height = 223
Alignment = taCenter
AutoSize = False
Caption = '30'
Font.Charset = ANSI_CHARSET
Font.Color = clNavy
Font.Height = -200
Font.Name = 'Arial'
Font.Style = []
ParentFont = False
Transparent = True
end
object Label3: TLabel
Left = 536
Top = 568
Width = 296
Height = 16
Caption = '点击取消,可暂时将关机时间延迟10分钟。'
Font.Charset = ANSI_CHARSET
Font.Color = clRed
Font.Height = -16
Font.Name = '宋体'
Font.Style = []
ParentFont = False
end
object Btn_CloseWindows: TBitBtn
Left = 240
Top = 432
Width = 161
Height = 121
Caption = '立即关机'
Font.Charset = ANSI_CHARSET
Font.Color = clMaroon
Font.Height = -27
Font.Name = '宋体'
Font.Style = []
ParentFont = False
TabOrder = 0
OnClick = Btn_CloseWindowsClick
end
object Btn_CanCel: TBitBtn
Left = 496
Top = 432
Width = 153
Height = 121
Caption = '取消'
Font.Charset = ANSI_CHARSET
Font.Color = clMaroon
Font.Height = -27
Font.Name = '宋体'
Font.Style = []
ParentFont = False
TabOrder = 1
OnClick = Btn_CanCelClick
end
object MEM_List: TMemo
Left = 72
Top = 56
Width = 185
Height = 89
TabOrder = 2
Visible = False
end
object Timer: TTimer
Enabled = False
OnTimer = TimerTimer
Left = 240
Top = 48
end
end
