Delphi implements a universal timed automatic shutdown Program

Source: Internet
Author: User

I. Question: The computer running a task, especially the server, will automatically shut down when it reaches the specified time if it is under no duty, this will greatly reduce the burden on the system administrator and bring great convenience to our daily work.

The timed automatic shutdown program developed by Delphi is applicable to two types of Windows operating systems: Windows 95/98/me to Windows NT/2000/XP.

2. Functions of the program include:

1. You can set the shutdown time and use the custom function isvalidtime () to determine whether the time entered by the user is valid.

2. timed force automatic shutdown: for Windows 95/98/Me, directly call the API function exitwindowsex () to shut down. For NT/2000/XP, You need to obtain the computer name and get the shutdown privilege before shutdown: First call the openprocesstoken () function to obtain the access token handle, and then call adjusttokenprivileges () function to enable this privilege. WIN32API defines a set of string constants to identify different privileges. For example, the shutdown privilege is 'seshutdownprivilege '.

3. When the preset shutdown time is reached, the delay is 30 seconds for the user to save the file or cancel shutdown. For Windows 95/98/me, only the program interface is displayed. for NT/2000/XP, the system countdown interface is displayed.

4. In order not to occupy the space of the taskbar, the program is displayed in the tray. Right-click the icon in the tray to display the shortcut menu.

5. If the specified shutdown time is not reached, the system will shut down. The program can intercept the shutdown message, and the user will choose whether to shut down. The principle is: when a user disables Windows, the system will send a message wm_queryendsession to each application, telling the application to shut down. If the returned message value is 0, you cannot shut down. Therefore, it is done to intercept wm_queryendsession and return 0.

6. Only one instance of the program is running in the memory. The principle is to use Windows global atomic table information to implement this function. Windows global atomic table can be accessed by all current applications. It can contain 37 items in total. When running the program, first check whether there is information about the program in the table. If so, the system prompts and exits. If not, add the program information to the table. When the program finally exits, it should remove information from the table so that the program can run again.

4. source program:
Unit autoshut1;
Interface

Uses
Windows, messages, sysutils, variants, classes, graphics, controls, forms,
Dialogs, stdctrls, extctrls, menus, appevets, shellapi;
Type
Tform1 = Class (tform)
Timer1: ttimer;
Timer2: ttimer;
Applicationevents1: tapplicationevents;
Popupmenu1: tpopupmenu;
Edit1: tedit;
Edit2: tedit;
Label1: tlabel;
Label2: tlabel;
Label3: tlabel;
Btn_ OK: tbutton;
Btn_abort: tbutton;
Procedure timer1timer (Sender: tobject );
Procedure traymenu (var msg: tmessage); message wm_user;
Procedure timesetclick (Sender: tobject );
Procedure exitclick (Sender: tobject );
Procedure btn_okclick (Sender: tobject );
Procedure btn_abortclick (Sender: tobject );
Procedure timer2timer (Sender: tobject );
Procedure edit2keypress (Sender: tobject; var key: Char );
Procedure wmqueryendsession (var msg: twmqueryendsession );
Message wm_queryendsession;
Procedure formcreate (Sender: tobject );
Procedure formdestroy (Sender: tobject );
Procedure formclosequery (Sender: tobject; var canclose: Boolean );
Private
{Private Declarations}
Tray: policyicondata;
Procedure showintray ();
Public
{Public declarations}
End;

VaR
Form1: tform1;
P, ti1: pchar;
Flags: longint;
I: integer;
{Shutdown delay time}
Timedelay: integer;
Atom: integer;
Implementation
{$ R *. DFM}

{If the automatic shutdown time is not reached, the shutdown message is intercepted when the system is to be shut down.

Wm_queryendsession, let the user decide whether to shut down}
Procedure tform1.wmqueryendsession (var msg: twmqueryendsession );
Begin
If messagedlg ('Do you really want to disable windows? ', Mtconfirmation, [mbyes, mbno], 0) = mrno then
MSG. Result: = 0
Else
MSG. Result: = 1;
End;

{Determine whether the time s format is valid}

Function isvalidtime (S: string): bool;
Begin
If length (s) <> 5 then isvalidtime: = false
Else
Begin
If (s [1] <'0') or (s [1]> '2') or (s [2] <'0') or
(S [2]> '9') or (s [3] <> ':') or
(S [4] <'0') or (s [4]> '5') or
(S [5] <'0') or (s [5]> '9') Then isvalidtime: = false
Else
Isvalidtime: = true;
End;
End;

{Determine the operating system to determine the shutdown mode}

Function getoperatingsystem: string;
VaR osverinfo: tosversioninfo;
Begin
Result: = '';
Osverinfo. dwosversioninfosize: = sizeof (tosversioninfo );
If getversionex (osverinfo) then
Case osverinfo. dwplatformid
Ver_platform_win32_nt:
Begin
Result: = 'windows NT/2000/XXX'
End;
Ver_platform_win32_windows:
Begin
Result: = 'windows 95/98/98SE/Me ';
End;
End;
End;

{Obtain computer name}

Function getcomputername: string;
VaR
Buffer: array [0 .. max_computername_length + 1] of char;
Size: Cardinal;
Begin
Size: = max_computername_length + 1;
Windows. getcomputername (@ buffer, size );
Result: = strpas (buffer );
End;

  
{Timed Shutdown function. The meanings of parameters are as follows:

COMPUTER: computer name; MSG: displays prompt information;
Time: Time delay; force: whether to force shutdown;
Reboot: restart or not}
Function timedshutdown (COMPUTER: string; MSG: string;
Time: word; force: Boolean; reboot: Boolean): Boolean;
VaR
RL: Cardinal;
Htoken: Cardinal;
Tkp: token_privileges;
Begin
{Get the user shutdown privilege, only for Windows NT/2000/XP}
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;
Result: = initiatesystemshutdown (pchar (Computer), pchar (MSG), time, force, reboot)
End;

{When the form is minimized, it is displayed in the tray}

Procedure tform1.showintray;
Begin
Tray. cbsize: = sizeof (tray );
Tray. WND: = self. Handle;
Tray. uflags: = nif_icon + nif_message + nif_tip;
Tray. ucallbackmessage: = wm_user;
Tray. hicon: = application. Icon. Handle;
Tray. sztip: = 'timed shutdown ';
Shell_policyicon (nim_add, @ tray );
End;

{Right-click the icon in the tray to display the shortcut menu}

Procedure tform1.traymenu (var msg: tmessage );
VaR
X, Y: tpoint;
J, K: integer;
Begin
Getcursorpos (X );
Getcursorpos (y );
J: = x. x;
K: = y.y;
If msg. lparam = wm_rbuttondown then popupmenu1.popup (j, k );
End;
  
Procedure tform1.timer1timer (Sender: tobject );
Begin
Edit1.text: = formatdatetime ('hh: mm', now );
{Two equal times, the computer will be forced to shut down within timedelay seconds}
If edit1.text = edit2.text then
Begin
Timedelay: = 30;
Timer1.enabled: = false;
If getoperatingsystem = 'windows NT/2000/XXX' then
Begin
{The shutdown Prompt window of the calling system is limited to Windows NT/2000/XP .}
Timedshutdown (getcomputername, 'the system is about to shut down! ',
Timedelay, true, false );
Btn_abort.enabled: = true;
Timer2.enabled: = true;
End;
If getoperatingsystem = 'windows 95/98/98SE/me' then
Begin
Timer2.enabled: = true;
{Display the window of this program on the top layer and time countdown}
Application. Restore;
Setwindowpos (handle, hwnd_topmost, left, top, width, height,
Swp_noactivate );
End;
End;
End;

Procedure tform1.timer2timer (Sender: tobject );
Begin
Btn_abort.enabled: = true;
Label3.caption: = 'Seconds before the shutdown time '+ inttostr (timedelay) +. ';
If timedelay> 0 then timedelay: = timedelay-1
Else
Begin
Timer2.enabled: = false;
{Force Windows 95/98/98SE/me to shut down}
Exitwindowsex (ewx_shutdown + ewx_force, 0 );
End;
End;

{Shortcut menu defined by the control popupmenu1, including "set shutdown time" and "exit ".

Autopopup of popupmenu1 is false. The following Code sets the shutdown time}
Procedure tform1.timesetclick (Sender: tobject );
Begin
{Set the current program window to the top level}
Setwindowpos (handle, hwnd_topmost, left, top, width, height,
Swp_noactivate );
Showwindow (application. Handle, sw_normal );
Edit2.setfocus;
Edit2.selectall;
End;

{Exit code in the shortcut menu}

Procedure tform1.exitclick (Sender: tobject );
Begin
{If you have started the countdown, you are not allowed to exit, but the program window is displayed}
If timer2.enabled = false then
Begin
Application. Terminate;
End
Else showwindow (application. Handle, sw_normal );
End;

{OK button}

Procedure tform1.btn _ okclick (Sender: tobject );
Begin
Btn_abort.enabled: = false;
Label3.caption: = 'prompt: shutdown time format hh: mm ';
If timer1.enabled = false then timer1.enabled: = true;
{The shutdown time setting is valid. The program is displayed in the tray. If the shutdown time is invalid, a message is displayed .}
If isvalidtime (edit2.text) then
Begin
Showwindow (application. Handle, sw_minimize );
Showwindow (application. Handle, sw_hide );
Showintray;
End
Else
Showmessage ('prompt: Time Format error, '+ CHR (13) +
'Enter the correct shutdown time hh: Mm. ');
End;

{Cancel Shutdown Button}

Procedure tform1.btn _ abortclick (Sender: tobject );
Begin
If getoperatingsystem = 'windows NT/2000/XXX' then
{Cancel shutdown for Windows NT/2000/XP}
Begin
Abortsystemshutdown (pchar (getcomputername ));
End;
{Stop countdown}
If timer2.enabled = true then timer2.enabled: = false;
Btn_abort.enabled: = false;
End;

{Enter the shutdown time and press Enter}

Procedure tform1.edit2keypress (Sender: tobject; var key: Char );
Begin
If (Key = #13) Then btn_ OK .click;
End;

{Search for the system atomic table to see if the program is running}

Procedure tform1.formcreate (Sender: tobject );
Begin
{Add information to the table if it is not running}
If globalfindatom ('program _ running') = 0 then
Atom: = globaladdatom ('program _ running ')
Else begin
{If the program is running, the system displays information and exits}
Messagedlg ('The program is already running! ', Mtwarning, [mbok], 0 );
Halt;
End;
End;

Procedure tform1.formdestroy (Sender: tobject );
Begin
{Remove information from the atomic table when the program exits}
Globaldeleteatom (atom );
{Delete icons in the tray}
Shell_policyicon (nim_delete, @ tray );
End;

Procedure tform1.formclosequery (Sender: tobject; var canclose: Boolean );
Begin
{If you have started the countdown, disable the program window}
If timer2.enabled = true then canclose: = false;
End;
End.

5. Description: The program is developed in Delphi 6.0 in Windows XP and runs successfully in Windows 95/98/me and Windows NT/2000/XP.

Contact Us

The content source of this page is from Internet, which doesn't represent Alibaba Cloud's opinion; products and services mentioned on that page don't have any relationship with Alibaba Cloud. If the content of the page makes you feel confusing, please write us an email, we will handle the problem within 5 days after receiving your email.

If you find any instances of plagiarism from the community, please send an email to: info-contact@alibabacloud.com and provide relevant evidence. A staff member will contact you within 5 working days.

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.