Bilgisayarı İstenilen Saatte Kapatma
Bilgisayarı istediğiniz bir saat te kapatın.. program kapatma butonuna bastığınızda gizli hale gelip arka planda çalışacaktır.. program ikonu saatin yanında görünür ona tıklayarak tekrar programı acabilirsiniz.. programı sonlandırmak için baslata bastıktan sonra ESC ye basarsanız kapanır..
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, shellapi;
const
WM_NOTIFYICON = WM_USER+333;
type
TForm1 = class(TForm)
GroupBox2: TGroupBox;
Edit1: TEdit;
Edit2: TEdit;
Label1: TLabel;
Label2: TLabel;
Timer1: TTimer;
Timer2: TTimer;
Edit3: TEdit;
Label4: TLabel;
Button1: TButton;
Button2: TButton;
GroupBox1: TGroupBox;
Label5: TLabel;
Timer3: TTimer;
procedure Timer2Timer(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Timer3Timer(Sender: TObject);
procedure FormKeyPress(Sender: TObject; var Key: Char);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
tnid: TNotifyIconData;
HMainIcon: HICON;
procedure CMClickIcon(var msg: TMessage); message WM_NOTIFYICON;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function WindowsExit(RebootParam: Longword): Boolean;
var
TTokenHd: THandle;
TTokenPvg: TTokenPrivileges;
cbtpPrevious: DWORD;
rTTokenPvg: TTokenPrivileges;
pcbtpPreviousRequired: DWORD;
tpResult: Boolean;
const
SE_SHUTDOWN_NAME = 'SeShutdownPrivilege';
begin
if Win32Platform = VER_PLATFORM_WIN32_NT then
begin
tpResult := OpenProcessToken(GetCurrentProcess(),
TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY,
TTokenHd) ;
if tpResult then
begin
tpResult := LookupPrivilegeValue(nil,
SE_SHUTDOWN_NAME,
TTokenPvg.Privileges[0].Luid) ;
TTokenPvg.PrivilegeCount := 1;
TTokenPvg.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
cbtpPrevious := SizeOf(rTTokenPvg) ;
pcbtpPreviousRequired := 0;
if tpResult then
Windows.AdjustTokenPrivileges(TTokenHd,
False,
TTokenPvg,
cbtpPrevious,
rTTokenPvg,
pcbtpPreviousRequired) ;
end;
end;
Result := ExitWindowsEx(RebootParam, 0) ;
end;
procedure TForm1.Timer2Timer(Sender: TObject);
var
saat:string;
begin
saat:=timetostr(time);
GroupBox2.caption:=saat;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
saat,dakika,saniye, salise:word;
d:ttime;
begin
saat:=strtoint(edit1.text);
dakika:=strtoint(edit2.Text);
saniye:=strtoint(edit3.Text);
salise:=0;
d:=encodetime(saat,dakika,saniye,salise);
if d=time then
WindowsExit(EWX_POWEROFF or EWX_FORCE) ;
end;
procedure TForm1.CMClickIcon(var msg: TMessage);
begin
case msg.lparam of
WM_LBUTTONDBLCLK : Show;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
ShowMessage('Lütfen Bilgisayarın Kapatılacağı Saati, Dakikayı, Saniyeyi Yazınız ve Başlat a Tıklayınız..');
HMainIcon := LoadIcon(MainInstance, 'MAINICON');
Shell_NotifyIcon(NIM_DELETE, @tnid);
tnid.cbSize := sizeof(TNotifyIconData);
tnid.Wnd := handle;
tnid.uID := 123;
tnid.uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;
tnid.uCallbackMessage := WM_NOTIFYICON;
tnid.hIcon := HMainIcon;
tnid.szTip := 'POP3 Server';
Shell_NotifyIcon(NIM_ADD, @tnid);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
button1.Enabled:=false;
button2.Enabled:=true;
timer1.Enabled:=true;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
button2.Enabled:=false;
button1.Enabled:=true;
timer1.Enabled:=false;
end;
procedure TForm1.Timer3Timer(Sender: TObject);
var
c:TColor;
begin
c:=Label5.Color;
Label5.Color:=Label5.Font.Color;
Label5.Font.Color:=c;
End;
procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
begin
if Key = #27 then halt;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action := caNone;
Hide;
end;
end.