定时关机的例子

program AutoShutDown;

uses
Windows,
ShellAPI,
Sysutils,
Messages;

{$R *.RES}
var
WinClass: TWndClassA;
Handle: hwnd;
Inst, Button1, Label1, Edit1: Integer;
Msg: TMsg;
tid: TNotifyIconDataA;
sdt: tdatetime;
timerid: integer;
hFont: Integer;
const
AppName = 'AutoShutDown';
st = '定时关机';
About = st + ' 1.0, Keyes.chen@263.net, Keyes 1999.10.23';
gjs = '设定关机时间';

procedure SetShutdownTime;
var
Textlength: Integer;
Text: PChar; i: tdatetime;
begin
TextLength := GetWindowTextLength(Edit1);
GetMem(Text, TextLength + 1);
GetWindowText(Edit1, Text, TextLength + 1);
try
i := Strtodatetime(Text);
if i <= now then
begin
MessageBox(handle, '不对吧!太早了.', '错误', mb_ok or MB_ICONERROR);
exit;
end;
sdt := i;
timerid := Settimer(handle, 1000, 1000, nil);
Showwindow(handle, sw_hide);
lstrcpy(tid.szTip, pchar(st + ' 关机时间:' + Datetimetostr(sdt)));
Shell_NotifyIcon(nim_modify, @tid);
except
Killtimer(handle, timerid);
Messagebox(handle, pchar('关机时间设定错误'#13#10#13#10 + '格式因该是:' + Datetimetostr(now)), AppName, Mb_ok or MB_ICONINFORMATION);
end;
FreeMem(Text, TextLength + 1);
end;

function WindowProc(hWnd, uMsg, wParam, lParam: Integer): Integer; stdcall;
var pt: tpoint; pm: Hmenu;
begin
result := 0;
case uMsg of
wm_timer:
begin
if now >= sdt then
begin
Killtimer(handle, timerid);
ExitWindowsEx(EWX_SHUTDOWN or EWX_Force, 0);
// PostMessage(handle,wm_Destroy,0,0);
end;
end;
wm_User:
begin
case lparam of
WM_LBUTTONDBLCLK:
begin
showwindow(handle, sw_restore);
setforegroundwindow(handle);
end;
wm_LButtonDown, wm_RButtonDown:
begin
GetCursorPos(pt);
pm := CreatePopupMenu;
AppendMenu(pm, 0, Ord('S'), gjs);
AppendMenu(pm, 0, Ord('A'), '关于...');
AppendMenu(pm, mf_Separator, 0, nil);
AppendMenu(pm, 0, Ord('E'), '退出');
SetForegroundWindow(handle);
if TrackPopupMenu(pm, tpm_BottomAlign or tpm_RightAlign, pt.x, {GetDeviceCaps(dc,Vertres)} pt.y, 0, handle, nil) then
SetForegroundWindow(handle);
DestroyMenu(pm)
end;
end;
end;
wm_Destroy:
begin
Shell_NotifyIcon(nim_Delete, @tid);
Killtimer(handle, timerid);
halt;
end;
wm_Command:
begin
if (lParam = Button1) then begin SetshutdownTime; exit end;
case Loword(wParam) of
Ord('A'): MessageBox(0, About, AppName, mb_ok or MB_ICONINFORMATION);
Ord('E'): PostMessage(handle, wm_Close, 0, 0);
Ord('S'):
begin
Showwindow(handle, sw_restore);
end;
end;
end;
end;
Result := DefWindowProc(hWnd, uMsg, wParam, lParam);
end;

begin
{ ** Register Custom WndClass ** }
if FindWindow(AppName, nil) <> 0 then begin
Messagebox(handle, '已经有一个AutoShutDown运行了', AppName, mb_ok or MB_ICONWARNING);
halt(0);
end;
Inst := hInstance;
with WinClass do
begin
style := CS_CLASSDC or CS_PARENTDC;
lpfnWndProc := @WindowProc;
hInstance := Inst;
hbrBackground := color_btnface + 1;
lpszClassname := AppName;
hCursor := LoadCursor(0, IDC_ARROW);
end;
RegisterClass(WinClass);
Handle := CreateWindowEx(WS_EX_WINDOWEDGE, AppName, 'AutoShutDown 1.00',
WS_VISIBLE {or WS_SIZEBOX} or WS_CAPTION or WS_SYSMENU,
283, 238, 325, 65, 0, 0, Inst, nil);
Button1 := CreateWindow('Button', 'OK', WS_VISIBLE or WS_CHILD or BS_PUSHLIKE or BS_TEXT,
236, 8, 75, 20, handle, 0, Inst, nil);
Label1 := Createwindow('Static', '', WS_VISIBLE or WS_CHILD or SS_LEFT,
8, 12, 80, 13, Handle, 0, Inst, nil);
Edit1 := CreateWindowEx(WS_EX_CLIENTEDGE, 'Edit', Pchar(Datetimetostr(now)), WS_CHILD or WS_VISIBLE or
WS_BORDER {or ES_PASSWORD}, 88, 8, 141, 21, Handle, 0, Inst, nil);
hFont := CreateFont(-12, 0, 0, 0, 500, 0, 0, 0, GB2312_CHARSET,
OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY,
DEFAULT_PITCH or FF_DONTCARE, '宋体');
if hFont <> 0 then
begin
SendMessage(Button1, WM_SETFONT, hFont, 0);
SendMessage(Label1, WM_SETFONT, hFont, 0);
SendMessage(Edit1, WM_SETFONT, hFont, 0);
end;
SetWindowText(Label1, pchar(gjs + ':'));
SetFocus(Edit1);
UpdateWindow(Handle);
tid.cbSize := sizeof(tid);
tid.Wnd := handle;
tid.uID := 1;
tid.uFlags := nif_Message or nif_Icon or nif_Tip;
tid.uCallBackMessage := wm_User;
tid.hIcon := LoadIcon(hInstance, 'MAINICON');
lstrcpy(tid.szTip, st);
Shell_NotifyIcon(nim_Add, @tid);
while (GetMessage(Msg, Handle, 0, 0)) do
begin
TranslateMessage(msg);
DispatchMessage(msg);
end;
end.