Onde está o erro ?

Delphi

27/09/2003

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.


Glaubergs

Glaubergs

Curtidas 0

Respostas

Mmtoor

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


GOSTEI 0
Glaubergs

Glaubergs

27/09/2003

Perdão, mas como eu faço isso ?


GOSTEI 0
POSTAR