Kod
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:= 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; //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.