Tekil Mesaj gösterimi
Alt 11 Mart 2015, 13:24   #1
Çevrimiçi
Kaf_Dağı
Kullanıcıların profil bilgileri misafirlere kapatılmıştır.
IF Ticaret Sayısı: (0)
IF Ticaret Yüzdesi:(%)
bilgisayarı istediğin saatte kapatma




bilgisayarı istediğin saatte kapatma

Kod:   Kodu kopyalamak için üzerine çift tıklayın!
unit sistemikapat; interface uses MMsystem,Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls; type TForm1 = class(TForm) Edit1: TEdit; Timer1: TTimer; Button1: TButton; Button2: TButton; Edit2: TEdit; Label1: TLabel; Label2: TLabel; Label3: TLabel; Button3: TButton; procedure Timer1Timer(Sender: TObject); procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); procedure FormCreate(Sender: TObject); procedure Button3Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; b,a:string; implementation {$R *.dfm} procedure TForm1.Timer1Timer(Sender: TObject); var dc:hdc; thetime: array[0..80] of char; begin CAPTION:=COPY(CAPTION,2,LENGTH(CAPTION)-1)+CAPTION[1]; Application.Title:=COPY(Application.Title,2,LENGTH(Application.Title)-1)+Application.Title[1]; Edit1.Text:=strpcopy(Thetime,timetostr(time)); strpcopy(Thetime,timetostr(time)); canvas.font.color:=clred; textout(dc,width div 2,5,thetime,strlen(thetime)); END; procedure Delay(ms : longint); var TheTime : LongInt; begin TheTime := GetTickCount + ms; while GetTickCount < TheTime do Application.ProcessMessages; end; procedure SendMCICommand(Cmd: string); var RetVal: Integer; ErrMsg: array[0..254] of char; begin RetVal := mciSendString(PChar(Cmd), nil, 0, 0); if RetVal <> 0 then begin {get message for returned value} mciGetErrorString(RetVal, ErrMsg, 255); MessageDlg(StrPas(ErrMsg), mtError, [mbOK], 0); end; end; 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:= ExitWindow***(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:= ExitWindow***(EWX_POWEROFF or EWX_FORCE, 0); if ExReply then Result:='Shutdown Initiated' else Result:='Shutdown failed with ' + IntToStr(GetLastError); end; end; end; end; //case bitişi end; end; procedure TForm1.Button1Click(Sender: TObject); begin a:=edit1.text; if a=b then BEGIN SendMCICommand('open waveaudio shareable'); SendMCICommand('play "D:\Belgeler\kapat.wav"'); delay(3000); SendMCICommand('close waveaudio'); ShutMeDown; end; end; procedure TForm1.Button2Click(Sender: TObject); begin b:=Edit2.Text; repeat Button1.Click; delay(500); until a=b; end; procedure TForm1.FormCreate(Sender: TObject); begin Form1.Position := poScreenCenter; end; procedure TForm1.Button3Click(Sender: TObject); begin a:=b; end; end.


__________________
SusKun ve Sessiz Mürekkep...


Kullanıcı imzalarındaki bağlantı ve resimleri görebilmek için en az 20 mesaja sahip olmanız gerekir ya da üye girişi yapmanız gerekir.

 
Alıntı ile Cevapla

IRCForumlari.NET Reklamlar
sohbet odaları reklam ver Benimmekan Mobil Sohbet