![]() |
|
|
#1 (permalink) |
|
Yüzbaşı
![]() Üyelik tarihi: Jul 2007
Mesajlar: 251
|
Bilgisayarı Kapatan Program
İstediğiniz Tarih ve Saatte Bilgisayarınız Kapansın
Kod: unit Unit1;interfaceuses 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;begincase 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_PR IVILEGES 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(TTok enPrivileges),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.
__________________
[Linkleri görebilmek için üye olmalısınız. Üye olmak için tıklayınız...] Yukarıdaki İşaretlenmİş OLan yere TıkLayarak UYgunsuz Kullanımları moderatörlere veya Adminlere Bildirebilirsiniz. BilGiniZe... 8D1T 8y 4kR3p |
|
|
|
![]() |
| Konuyu Toplam 1 Üye okuyor. (0 Kayıtlı üye ve 1 Misafir) | |
| Seçenekler | |
| Stil | |
|
|