Bilgisayarınızı ayarlanan saatte kapatmaya yarayan kodlar aşağıdadır. Yararlı olacağını umarım. unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, Buttons, ComCtrls,ShellApi, XPMan, Menus;
type
TForm1 = class(TForm)
kapat: TDateTimePicker;
BitBtn1: TBitBtn;
Timer1: TTimer;
Label1: TLabel;
BitBtn2: TBitBtn;
XPManifest1: TXPManifest;
PopupMenu1: TPopupMenu;
ProgramGster1: TMenuItem;
Kapat1: TMenuItem;
Label2: TLabel;
Timer2: TTimer;
procedure Timer1Timer(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Kapat1Click(Sender: TObject);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure ProgramGster1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Timer2Timer(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
stray:NOTIFYICONDATA;
implementation
{$R *.dfm}
function cikis(flag : word): Boolean;
var veri : TOSVersionInfo;
hToken : THandle;
tp : TTokenPrivileges;
h : DWord;
begin
result := false;
veri.dwOSVersionInfoSize:=SizeOf(veri);
GetVersionEx(veri);
if veri.dwPlatformId = VER_PLATFORM_WIN32_NT then // Windows NT
begin
OpenProcessToken(GetCurrentProcess(),TOKEN_ADJUST_ PRIVILEGES,hToken);
LookupPrivilegeValue(nil,'SeShutdownPrivilege',tp. Privileges[0].Luid);
tp.PrivilegeCount := 1;
tp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
h := 0;
AdjustTokenPrivileges(hToken,False,tp,0,PTokenPriv ileges(nil)^,h);
CloseHandle(hToken);
result := ExitWindowsEx(flag,0);
Application.Terminate;
end
else
begin
Result := ExitWindowsEx(flag,0);
Application.Terminate;
end;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
VAR
KAL:STRING;
begin
bitbtn1.Visible:=false;
bitbtn2.Visible:=true;
if timetostr(kapat.Time)=timetostr(time) then begin
cikis(1);
end;
form1.Hint:=timetostr(kapat.Time-time)+' kaldı';
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
timer1.Interval:=1000;
end;
procedure TForm1.BitBtn2Click(Sender: TObject);
begin
timer1.Interval:=0;
bitbtn1.Visible:=true;
bitbtn2.Visible:=false;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
kapat.Time:=time;
ZeroMemory(0, 0);
CreateMutex(nil,FALSE,'PROGRAMADI');
if GetLastError = ERROR_ALREADY_EXISTS then
begin
ShowMessage('Program Zaten Çalışıyor. Program Kapatılacak!');
Halt(0);
end;
//SetWindowLong(Application.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW);
with stray do
begin
cbsize:=sizeof(stray);
wnd:=form1.handle;
hicon:=Application.icon.Handle;
uID:=0;
sztip:=' kaldı';
uflags:=7;
uCallBackMessage:=$200;//icon üzerine tıklama kontrolu için
end;
Shell_NotifyIcon(0,@stray);
end;
procedure TForm1.Kapat1Click(Sender: TObject);
begin
halt(0);
end;
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var nokta:TPoint;
begin
getCursorPos(nokta);
if (x=$205) then PopupMenu1.Popup(nokta.x,nokta.y);
if (x=$203) then BEGIN
IF FORM1.ACTIVE=FALSE THEN BEGIN FORM1.Show; END
ELSE BEGIN FORM1.Hide; END;END;
end;
procedure TForm1.ProgramGster1Click(Sender: TObject);
begin
IF FORM1.ACTIVE=FALSE THEN BEGIN FORM1.Show; END
ELSE BEGIN FORM1.Hide; END;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
action:=canone;
form1.Hide;
end;
procedure TForm1.Timer2Timer(Sender: TObject);
begin
label2.Caption:=timetostr(time);
end;
end.
Cuma Mart 27, 2009 12:06 am