定时关机的例子 - 癫狂编程

定时关机的例子

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.