LE PROGRAMMATEUR

unit AFirstPage;

interface

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

type
  TAFirst = class(TForm)
    PlTimer: TPanel;
    MEditTime: TMaskEdit;
    EditTime: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    PlOptions: TPanel;
    RBTerminate: TRadioButton;
    RBVisible: TRadioButton;
    RBMessage: TRadioButton;
    MMessage: TMemo;
    RBDeleteFile: TRadioButton;
    RBRebot: TRadioButton;
    RBEnd: TRadioButton;
    RBOpenFile: TRadioButton;
    PlButton: TPanel;
    SDBActivate: TSpeedButton;
    SPBTerminate: TSpeedButton;
    PlEtat: TPanel;
    TimerProg: TTimer;
    Dialog: TOpenDialog;
    procedure TimerProgTimer(Sender: TObject);
    procedure EditTimeChange(Sender: TObject);
    procedure RBOpenFileClick(Sender: TObject);
    procedure RBDeleteFileClick(Sender: TObject);
    procedure SDBActivateClick(Sender: TObject);
    procedure SPBTerminateClick(Sender: TObject);
    procedure RBVisibleClick(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;

var
  AFirst: TAFirst;
implementation

{$R *.dfm}

{
Le programmeur par HAFTARI fouad. pour plus d'informations n'hesitez pa de
nous contacter}


procedure TAFirst.TimerProgTimer(Sender: TObject);
begin
EditTime.text:= Timetostr(now);
end;

procedure TAFirst.EditTimeChange(Sender: TObject);
var sTokenIn,sTokenOut : TTOKENPRIVILEGES ;
    dwLen : DWORD ;
    hCurrentProcess,hToken : THANDLE ;
    Luid1 : TLargeInteger ;
begin
if EditTime.text=MEditTime.Text then // Si: le temps saisie égale à temps maintenant
begin

if RBTerminate.Checked then Application.Terminate; // 1 choix quitter l''application;

if RBVisible.Checked then AFirst.Visible:=true; // 2 choix affichage de l''application;

if RBMessage.Checked then ShowMessage(MMessage.Text); // 3 choix afficher le contenu du MMessage dans un message;

if RBOpenFile.Checked then

// Faites attention n'oublie pa ShellApi à ajouter dans les uses;
ShellExecute(GetDesktopWindow, 'Open', PChar(Dialog.FileName), nil, nil, SW_SHOWNORMAL);// ouvrire un fichier


// Supprission d'un fichier: On doit vérifier l''existance d'abord puis on le supprime;

if RBDeleteFile.Checked then begin
if FileExists(Dialog.FileName) then DeleteFile(Dialog.FileName); //si le fichier existe on le supprime;
end; //Fine de la condition si RBDeleteFile is checked


// Redémarrer l''ordinatur;
if RBRebot.Checked then begin
  hCurrentProcess := GetCurrentProcess ;
  OpenProcessToken (hCurrentProcess,TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken);
  LookupPrivilegeValue(nil,'SeShutdownPrivilege',Luid1) ;
  sTokenIn.PrivilegeCount := 1;
  sTokenIn.Privileges[0].Luid := Luid1;
  sTokenIn.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
  AdjustTokenPrivileges ( hToken, FALSE, sTokenIn,sizeof(TTOKENPRIVILEGES),sTokenOut, dwLen);
  CloseHandle (hToken);
  ExitWindowsEx(EWX_REBOOT, 0) ;
end; // fin de la condition Si RBRebot est coché;

//Arrêter l''ordinateur;
if RBEnd.Checked then begin
  hCurrentProcess := GetCurrentProcess ;
  OpenProcessToken (hCurrentProcess,TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken);
  LookupPrivilegeValue(nil,'SeShutdownPrivilege',Luid1) ;
  sTokenIn.PrivilegeCount := 1;
  sTokenIn.Privileges[0].Luid := Luid1;
  sTokenIn.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
  AdjustTokenPrivileges ( hToken, FALSE, sTokenIn,sizeof(TTOKENPRIVILEGES),sTokenOut, dwLen);
  CloseHandle (hToken);
  ExitWindowsEx(EWX_SHUTDOWN, 0) ;
end; // fin de la condition Si RBEnd est coché;


PlEtat.Caption:='Désactivé';  // Afficher l'Etat du programmeur dans PlEtat désactivé;
MEditTime.Text:='';          // Vider MEditTime

end; //Fin de la condition si Temps saisie= temps maintenant;
end;

procedure TAFirst.RBOpenFileClick(Sender: TObject);
begin
Dialog.Execute;
end;

procedure TAFirst.RBDeleteFileClick(Sender: TObject);
begin
Dialog.Execute;
end;

procedure TAFirst.SDBActivateClick(Sender: TObject);
begin
PlEtat.Caption:='Activé';
end;

procedure TAFirst.SPBTerminateClick(Sender: TObject);
begin
  if MessageDlg('Etes vous sûr de vouloir quitter le programme',
                mtConfirmation, [mbYes, mbNo], 0) = mrYes then
                                        Application.Terminate;
end;

procedure TAFirst.RBVisibleClick(Sender: TObject);
begin
  if MessageDlg('Etes vous sûr de vouloir rendre invisible le programme',
                mtConfirmation, [mbYes, mbNo], 0) = mrYes then
                                        AFirst.Visible:=false;
end;

end.

Télécharger le zip