Başlangıç > Kodlar > Delphi ile Bilgisayarı kapatmak

Delphi ile Bilgisayarı kapatmak

İstediğiniz Tarih ve Saatte Bilgisayarınız Kapansın

unit Unit1;

interface

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

type
TForm1 = class(TForm)
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Timer1: TTimer;
Label5: TLabel;
Label6: TLabel;
DateTimePicker1: TDateTimePicker;
DateTimePicker2: TDateTimePicker;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
BitBtn3: TBitBtn;
Timer2: TTimer;
BitBtn4: TBitBtn;
Label7: TLabel;
Label8: TLabel;
procedure FormCreate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure BitBtn3Click(Sender: TObject);
procedure Timer2Timer(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
procedure BitBtn4Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1 : TForm1;
Dosya : TextFile;
Str   : String;
Say   : Byte;
Saat  : String;
Tarih : String;

implementation

{$R *.dfm}

function ShutMeDown:string;
var
hToken : THandle;
tkp,p : TTokenPrivileges;
RetLen : DWord;
ExReply: LongBool;
Reply : DWord;
begin
case Win32Platform of VER_PLATFORM_WIN32_WINDOWS: //***Windows 9x/ME***//
begin
ExReply:= ExitWindowsEx(EWX_POWEROFF or EWX_SHUTDOWN or EWX_FORCE,0);
if ExReply then
Result:='Shutdown Initiated'
else
Result:='Shutdown failed with ' + IntToStr(GetLastError);
end;
VER_PLATFORM_WIN32_NT: //***Windows NT/2000/XP***//
begin
if OpenProcessToken(GetCurrentProcess,TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY,hToken) then
begin
if LookupPrivilegeValue(nil,'SeShutdownPrivilege',tkp.Privileges[0].Luid) then
begin
tkp.PrivilegeCount := 1;
tkp.Privileges[0].Attributes :=SE_PRIVILEGE_ENABLED;
AdjustTokenPrivileges(hToken,False,tkp,SizeOf(TTokenPrivileges),p,RetLen);
Reply := GetLastError;
if Reply = ERROR_SUCCESS then
begin
ExReply:= ExitWindowsEx(EWX_POWEROFF or EWX_FORCE, 0);
if ExReply then
Result:='Shutdown Initiated'
else
Result:='Shutdown failed with ' + IntToStr(GetLastError);
end;
end;
end;
end;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Label3.Caption:=DateToStr(Date);
Label4.Caption:=TimeToStr(Time);
DateTimePicker1.Date:=Date;
DateTimePicker2.Time:=Time;
Tarih:=";
Saat:=";
Label7.Caption:=Tarih;
Label8.Caption:=Saat;
AssignFile(Dosya,'Kapat.Txt');
If FileExisTs('Kapat.Txt') Then
Reset(Dosya)
Else
Begin
Rewrite(Dosya);
CloseFile(Dosya);
Reset(Dosya);
End;
Readln(Dosya,Str);
CloseFile(Dosya);
If Str='Kurulu' Then
Begin
Rewrite(Dosya);
Str:='NewOpen';
Writeln(Dosya,Str);
CloseFile(Dosya);
Halt;
End;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
Label3.Caption:=DateToStr(Date);
Label4.Caption:=TimeToStr(Time);
Label7.Caption:=Tarih;
Label8.Caption:=Saat;
AssignFile(Dosya,'Kapat.Txt');
If FileExisTs('Kapat.Txt') Then
Reset(Dosya)
Else
Begin
Rewrite(Dosya);
CloseFile(Dosya);
Reset(Dosya);
End;
Readln(Dosya,Str);
CloseFile(Dosya);
If Str='NewOpen' Then
Begin
AssignFile(Dosya,'Kapat.Txt');
Rewrite(Dosya);
Str:='Kurulu';
Writeln(Dosya,Str);
CloseFile(Dosya);
Form1.Show;
End;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
Tarih:=DateToStr(DateTimePicker1.Date);
Saat :=TimeToStr(DateTimePicker2.Time);

AssignFile(Dosya,'Kapat.Txt');
Rewrite(Dosya);
Str:='Kurulu';
Writeln(Dosya,Str);
CloseFile(Dosya);
Timer2.Interval:=1000;
Form1.Hide;
end;

procedure TForm1.BitBtn3Click(Sender: TObject);
begin
AssignFile(Dosya,'Kapat.Txt');
Rewrite(Dosya);
Str:='NotKurulu';
Writeln(Dosya,Str);
CloseFile(Dosya);
Halt;
end;

procedure TForm1.Timer2Timer(Sender: TObject);
begin
If ((Label3.Caption=Tarih) And (Label4.Caption=Saat)) Then
Begin
AssignFile(Dosya,'Kapat.Txt');
Rewrite(Dosya);
Str:='NotKurulu';
Writeln(Dosya,Str);
CloseFile(Dosya);
ShutMeDown;
Halt;
End;
end;

procedure TForm1.BitBtn2Click(Sender: TObject);
begin
AssignFile(Dosya,'Kapat.Txt');
Rewrite(Dosya);
Str:='NotKurulu';
Writeln(Dosya,Str);
CloseFile(Dosya);
ShutMeDown;
Halt;
end;

procedure TForm1.BitBtn4Click(Sender: TObject);
begin
AssignFile(Dosya,'Kapat.Txt');
Rewrite(Dosya);
Str:='NotKurulu';
Writeln(Dosya,Str);
CloseFile(Dosya);
Tarih:=";
Saat :=";
end;

end.
//  halitclp@hotmail.com

 


TD Software


  1. Henüz yorum yapılmamış.
  1. No trackbacks yet.

Bir Cevap Yazın

Aşağıya bilgilerinizi girin veya oturum açmak için bir simgeye tıklayın:

WordPress.com Logosu

WordPress.com hesabınızı kullanarak yorum yapıyorsunuz. Log Out / Değiştir )

Twitter resmi

Twitter hesabınızı kullanarak yorum yapıyorsunuz. Log Out / Değiştir )

Facebook fotoğrafı

Facebook hesabınızı kullanarak yorum yapıyorsunuz. Log Out / Değiştir )

Google+ fotoğrafı

Google+ hesabınızı kullanarak yorum yapıyorsunuz. Log Out / Değiştir )

Connecting to %s

%d blogcu bunu beğendi: