自动关机,在delphi里面可以做出来么? (50分)

  • 主题发起人 主题发起人 lwzl99
  • 开始时间 开始时间
L

lwzl99

Unregistered / Unconfirmed
GUEST, unregistred user!
自动关机,在delphi里面可以做出来么? 最好有代码
 
可以啊,用定时嚣判断时间,时间一到则关机即可。
我现在在外面上的,没有代码,回去再给你。
或者给个邮箱也行。
 
luckhacker:也给个例子给我吧!firedrong@163.com
 
用个winapi函数ExitWindowsEx就可以了。
 
ExitWindowsEx(EWX_SHUTDOWN, 0);
 
exitwindowsex(ewx_reboot,0);
exitwindowsex(ewx_shutdown,0);
不过关机命令要主板支持才能实现。
 
在win2000下,比较复杂。。。
查以前资料。。。
 
萧西风,接收!
lwzl99,找萧西风要吧!
 
用函数ExitWindowsEx(EWX_SHUTDOWN or EWX_POWEROFF,0);
 
加上一个timer,然后在它的ontimer事件中写下:
if time>strtotime ('12:00:00') then
exitwindowsex(ewx_force,0);
这样,到了十二点,就会强行关机的!
 
xjzdy@cnnb.net也想要一份,waitting.....
 
【声明】
Function ExitWindowsEx Lib "user32" Alias "ExitWindowsEx"
(ByVal uFlags As Long, ByVal dwReserved As Long) As Long

【说明】
退出windows,并用特定的选项重新启动

【返回值】
Long,非零表示成功,零表示失败。会设置GetLastError

【备注】
这个函数调用后会立刻返回,系统关闭过程是在后台进行的。注意先中止自己的应用程序,使关闭过程更显平顺。当然,您的进程必须有足够的优先权,否则也不能执行这种操作

【参数】
uFlags --------- Long,指定下述一个或多个标志(用OR运算符合并到一起)
EWX_FORCE
强迫中止没有响应的进程
EWX_LOGOFF
中止进程,然后注销
EWX_SHUTDOWN
关掉系统电源(如果可能的话,ATX电源就可以)
EWX_REBOOT
重新引导系统
EWX_SHUTDOWN
关闭系统

dwReserved ----- Long,保留,设为零
 
给你源码,不过我要200分:
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+'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.




 
这个肯定没有问题,我一直这么用
procedure ShutDown;
const
SE_SHUTDOWN_NAME = 'SeShutdownPrivilege'; // Borland forgot this declaration
var
hToken: THandle;
tkp: TTokenPrivileges;
tkpo: TTokenPrivileges;
zero: DWORD;
begin
if Pos('Windows NT', GetWinVersion) = 1 then
begin
zero := 0;
if not OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) then
begin
ShowMsg('OpenProcessToken() Failed', 1);
Exit;
end;
if not LookupPrivilegeValue(nil, 'SeShutdownPrivilege', tkp.Privileges[0].Luid) then
begin
ShowMsg('LookupPrivilegeValue() Failed', 1);
Exit;
end;
tkp.PrivilegeCount := 1;
tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;

AdjustTokenPrivileges(hToken, False, tkp, SizeOf(TTokenPrivileges), tkpo, zero);
if Boolean(GetLastError()) then
begin
ShowMsg('AdjustTokenPrivileges() Failed', 1);
Exit;
end
else
ExitWindowsEx(EWX_FORCE or EWX_SHUTDOWN or EWX_POWEROFF, 0);
end
else
ExitWindowsEx(EWX_FORCE or EWX_SHUTDOWN or EWX_POWEROFF, 0);
end;
 
TO :desertsmoke
你写的东东是哪儿来的,是电子书上的吗,这样的书在什么地方有下的,
或是你发一个来给我好吗,我给你300分,怎么样!!

不好意思,借个地方问一下。
 
是我自己做的一个工具,讲述Win32 API的。
bambooheart@vip.sina.com
 
2000版本,绝对没问题:
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, ExtCtrls, StdCtrls;

type
TForm1 = class(TForm)
GroupBox1: TGroupBox;
Label1: TLabel;
Label2: TLabel;
Edit1: TEdit;
Edit2: TEdit;
Button1: TButton;
Button2: TButton;
Bevel1: TBevel;
Label3: TLabel;
PageControl1: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
Label4: TLabel;
Edit3: TEdit;
Button3: TButton;
Button4: TButton;
Button5: TButton;
Button6: TButton;
Button7: TButton;
Label5: TLabel;
Timer1: TTimer;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure Button7Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
procedure AdjustToken;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.AdjustToken();
var
hdlProcessHandle : Cardinal;
hdlTokenHandle : Cardinal;
tmpLuid : Int64;
tkpPrivilegeCount : Int64;
tkp : TOKEN_PRIVILEGES;
tkpNewButIgnored : TOKEN_PRIVILEGES;
lBufferNeeded : Cardinal;
Privilege : array[0..0] of _LUID_AND_ATTRIBUTES;
begin
hdlProcessHandle := GetCurrentProcess;
OpenProcessToken(hdlProcessHandle,
(TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY),
hdlTokenHandle);

// Get the LUID for shutdown privilege.
LookupPrivilegeValue('', 'SeShutdownPrivilege', tmpLuid);
Privilege[0].Luid := tmpLuid;
Privilege[0].Attributes := SE_PRIVILEGE_ENABLED;
tkp.PrivilegeCount := 1; // One privilege to set
tkp.Privileges[0] := Privilege[0];
// Enable the shutdown privilege in the access token of this
// process.
AdjustTokenPrivileges(hdlTokenHandle,
False,
tkp,
Sizeof(tkpNewButIgnored),
tkpNewButIgnored,
lBufferNeeded);

end;




procedure TForm1.Button1Click(Sender: TObject);
begin
edit1.Clear ;
edit2.Clear ;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
if (edit1.Text='') then
begin
showmessage('对不起,帐号不能为空!') ;
edit1.Focused ;
end
else if (edit2.Text ='') then
begin
showmessage('对不起,密码不能为空!') ;
edit2.Focused ;
end
else
begin
if ((edit1.Text='typein') and (edit2.Text='meguess')) then
begin
groupbox1.Visible :=false ;
pagecontrol1.Visible :=true;
end
else
begin
showmessage('对不起,您无权使用本系统');
end

end;

end;

procedure TForm1.Button5Click(Sender: TObject);
begin
AdjustToken;
ExitWindowsEx(( EWX_FORCE ), $FFFF);
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
AdjustToken;
ExitWindowsEx(( EWX_REBOOT ), $FFFF);
end;

procedure TForm1.Button7Click(Sender: TObject);
begin
AdjustToken;
ExitWindowsEx(( EWX_SHUTDOWN ), $FFFF);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var shuttime: TDateTime;
begin
shuttime:=Now;
if (TimeToStr(shuttime)='23:49:11') or (TimeToStr(shuttime)='23:49:12')then
begin
AdjustToken;
ExitWindowsEx(( EWX_FORCE ), $FFFF);
end
end;

end.
 
ExitWindowsEx(( EWX_FORCE ), $FFFF);
根本就不好用
弄的昨天晚上一个晚上都没有睡好
靠,无论是ewx_force 还是 ewx_reboot都是注销了事,马马D
 
后退
顶部