Onde está o erro ?
Olá
Fiz um programa para desligar meu micro ATX na hora programada. O problema é que depois que eu coloquei o XP ele não funciona corretamente sempre. Ás vezes, ele chega a desconectar, fechar todos os programas mas para com o a tela vazia mostrando apenas o papel de parede. Outras vezes ele desliga perfeitamente. Abaixo está toda a programação ... Se alguém achar algum erro por favor me avise.
PS: Qdo eu o usava no 98, ele funcionava perfeitamente.
unit unt_relogio;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, abfComponents;
type
TfrmPrincipal = class(TForm)
Label3: TLabel;
Timer1: TTimer;
edtHora: TEdit;
edtMinuto: TEdit;
Label1: TLabel;
Label2: TLabel;
rdgDespertar: TRadioGroup;
Label4: TLabel;
procedure Timer1Timer(Sender: TObject);
procedure edtHoraChange(Sender: TObject);
procedure edtMinutoChange(Sender: TObject);
private
//começa aqui
function GetWinVersion: String;
procedure ShutDown;
// termina aqui
public
{ Public declarations }
end;
var
frmPrincipal: TfrmPrincipal;
implementation
{$R *.DFM}
//começa aqui
function TfrmPrincipal.GetWinVersion: String;
var
VersionInfo : TOSVersionInfo;
OSName : String;
begin
// set the size of the record
VersionInfo.dwOSVersionInfoSize := SizeOf( TOSVersionInfo );
if Windows.GetVersionEx( VersionInfo ) then
begin
with VersionInfo do
begin
case dwPlatformId of
VER_PLATFORM_WIN32s : OSName := ´Win32s´;
VER_PLATFORM_WIN32_WINDOWS : OSName := ´Windows 95´;
VER_PLATFORM_WIN32_NT : OSName := ´Windows NT´;
end; // case dwPlatformId
Result := OSName + ´ Version ´ + IntToStr( dwMajorVersion ) + ´.´ + IntToStr( dwMinorVersion ) +
#1310´ (Build ´ + IntToStr( dwBuildNumber ) + ´: ´ + szCSDVersion + ´)´;
end; // with VersionInfo
end // if GetVersionEx
else
Result := ´´;
end;
procedure TfrmPrincipal.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 // we´ve got to do a whole buch of things
begin
zero := 0;
if not OpenProcessToken( GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) then
begin
MessageBox( 0, ´Exit Error´, ´OpenProcessToken() Failed´, MB_OK );
Exit;
end; // if not OpenProcessToken( GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken)
if not OpenProcessToken( GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) then
begin
MessageBox( 0, ´Exit Error´, ´OpenProcessToken() Failed´, MB_OK );
Exit;
end; // if not OpenProcessToken( GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken)
// SE_SHUTDOWN_NAME
if not LookupPrivilegeValue( nil, ´SeShutdownPrivilege´ , tkp.Privileges[ 0 ].Luid ) then
begin
MessageBox( 0, ´Exit Error´, ´LookupPrivilegeValue() Failed´, MB_OK );
Exit;
end; // if not LookupPrivilegeValue( nil, ´SeShutdownPrivilege´ , tkp.Privileges[0].Luid )
tkp.PrivilegeCount := 1;
tkp.Privileges[ 0 ].Attributes := SE_PRIVILEGE_ENABLED;
AdjustTokenPrivileges( hToken, False, tkp, SizeOf( TTokenPrivileges ), tkpo, zero );
if Boolean( GetLastError() ) then
begin
MessageBox( 0, ´Exit Error´, ´AdjustTokenPrivileges() Failed´, MB_OK );
Exit;
end // if Boolean( GetLastError() )
else
ExitWindowsEx( EWX_FORCE or EWX_POWEROFF, 0 );
end // if OSVersion = ´Windows NT´
else
begin // just shut the machine down
ExitWindowsEx( EWX_FORCE or EWX_POWEROFF, 0 );
end; // else
end;
//termina aqui
procedure TfrmPrincipal.Timer1Timer(Sender: TObject);
var
Present: TDateTime;
Hour, Min, Sec, MSec: Word;
Hora,Minuto: Integer;
begin
Present:= Now;
DecodeTime(Present, Hour, Min, Sec, MSec);
Label3.Caption :=inttostr(Hour)+´ hora(s), ´+inttostr(Min)+´ minuto(s) e ´+inttostr(Sec)+´ segundo(s)´;
Hora:=strtoint(edtHora.text);
Minuto:=strtoint(edtMinuto.text);
if rdgDespertar.itemindex=0 then
begin
if (Hour=Hora) and (Min=Minuto) then
ShutDown;
end;
end;
procedure TfrmPrincipal.edtHoraChange(Sender: TObject);
begin
if edtHora.text=´´ then edtHora.text:=´0´
end;
procedure TfrmPrincipal.edtMinutoChange(Sender: TObject);
begin
if edtMinuto.text=´´ then edtMinuto.text:=´0´
end;
end.
Fiz um programa para desligar meu micro ATX na hora programada. O problema é que depois que eu coloquei o XP ele não funciona corretamente sempre. Ás vezes, ele chega a desconectar, fechar todos os programas mas para com o a tela vazia mostrando apenas o papel de parede. Outras vezes ele desliga perfeitamente. Abaixo está toda a programação ... Se alguém achar algum erro por favor me avise.
PS: Qdo eu o usava no 98, ele funcionava perfeitamente.
unit unt_relogio;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, abfComponents;
type
TfrmPrincipal = class(TForm)
Label3: TLabel;
Timer1: TTimer;
edtHora: TEdit;
edtMinuto: TEdit;
Label1: TLabel;
Label2: TLabel;
rdgDespertar: TRadioGroup;
Label4: TLabel;
procedure Timer1Timer(Sender: TObject);
procedure edtHoraChange(Sender: TObject);
procedure edtMinutoChange(Sender: TObject);
private
//começa aqui
function GetWinVersion: String;
procedure ShutDown;
// termina aqui
public
{ Public declarations }
end;
var
frmPrincipal: TfrmPrincipal;
implementation
{$R *.DFM}
//começa aqui
function TfrmPrincipal.GetWinVersion: String;
var
VersionInfo : TOSVersionInfo;
OSName : String;
begin
// set the size of the record
VersionInfo.dwOSVersionInfoSize := SizeOf( TOSVersionInfo );
if Windows.GetVersionEx( VersionInfo ) then
begin
with VersionInfo do
begin
case dwPlatformId of
VER_PLATFORM_WIN32s : OSName := ´Win32s´;
VER_PLATFORM_WIN32_WINDOWS : OSName := ´Windows 95´;
VER_PLATFORM_WIN32_NT : OSName := ´Windows NT´;
end; // case dwPlatformId
Result := OSName + ´ Version ´ + IntToStr( dwMajorVersion ) + ´.´ + IntToStr( dwMinorVersion ) +
#1310´ (Build ´ + IntToStr( dwBuildNumber ) + ´: ´ + szCSDVersion + ´)´;
end; // with VersionInfo
end // if GetVersionEx
else
Result := ´´;
end;
procedure TfrmPrincipal.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 // we´ve got to do a whole buch of things
begin
zero := 0;
if not OpenProcessToken( GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) then
begin
MessageBox( 0, ´Exit Error´, ´OpenProcessToken() Failed´, MB_OK );
Exit;
end; // if not OpenProcessToken( GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken)
if not OpenProcessToken( GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) then
begin
MessageBox( 0, ´Exit Error´, ´OpenProcessToken() Failed´, MB_OK );
Exit;
end; // if not OpenProcessToken( GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken)
// SE_SHUTDOWN_NAME
if not LookupPrivilegeValue( nil, ´SeShutdownPrivilege´ , tkp.Privileges[ 0 ].Luid ) then
begin
MessageBox( 0, ´Exit Error´, ´LookupPrivilegeValue() Failed´, MB_OK );
Exit;
end; // if not LookupPrivilegeValue( nil, ´SeShutdownPrivilege´ , tkp.Privileges[0].Luid )
tkp.PrivilegeCount := 1;
tkp.Privileges[ 0 ].Attributes := SE_PRIVILEGE_ENABLED;
AdjustTokenPrivileges( hToken, False, tkp, SizeOf( TTokenPrivileges ), tkpo, zero );
if Boolean( GetLastError() ) then
begin
MessageBox( 0, ´Exit Error´, ´AdjustTokenPrivileges() Failed´, MB_OK );
Exit;
end // if Boolean( GetLastError() )
else
ExitWindowsEx( EWX_FORCE or EWX_POWEROFF, 0 );
end // if OSVersion = ´Windows NT´
else
begin // just shut the machine down
ExitWindowsEx( EWX_FORCE or EWX_POWEROFF, 0 );
end; // else
end;
//termina aqui
procedure TfrmPrincipal.Timer1Timer(Sender: TObject);
var
Present: TDateTime;
Hour, Min, Sec, MSec: Word;
Hora,Minuto: Integer;
begin
Present:= Now;
DecodeTime(Present, Hour, Min, Sec, MSec);
Label3.Caption :=inttostr(Hour)+´ hora(s), ´+inttostr(Min)+´ minuto(s) e ´+inttostr(Sec)+´ segundo(s)´;
Hora:=strtoint(edtHora.text);
Minuto:=strtoint(edtMinuto.text);
if rdgDespertar.itemindex=0 then
begin
if (Hour=Hora) and (Min=Minuto) then
ShutDown;
end;
end;
procedure TfrmPrincipal.edtHoraChange(Sender: TObject);
begin
if edtHora.text=´´ then edtHora.text:=´0´
end;
procedure TfrmPrincipal.edtMinutoChange(Sender: TObject);
begin
if edtMinuto.text=´´ then edtMinuto.text:=´0´
end;
end.
Glaubergs
Curtidas 0
Respostas
Mmtoor
27/09/2003
Veja bem.
mantenha a funçã para forçar o fechamento dos programas abertos.
Defina a hora e chame C:\WINDOWS\RUNDLL.EXE user.exe,exitwindows
pela API.
MMTOOR2003
mantenha a funçã para forçar o fechamento dos programas abertos.
Defina a hora e chame C:\WINDOWS\RUNDLL.EXE user.exe,exitwindows
pela API.
MMTOOR2003
GOSTEI 0
Glaubergs
27/09/2003
Perdão, mas como eu faço isso ?
GOSTEI 0