|
Trouver une ressource
Vous ne trouvez pas de réponse à votre problème ? Alors posez la question dans le forum. Souvenez-vous qu'il n'y a jamais de question bête, mais rester dans l'ignorance parce que l'on n'ose pas poser une question, ça c'est une erreur !
LE PROGRAMMATEUR
Information sur la source
Description
Salut tout le monde Ce petit programme comme son nom l’indique est un organisateur de multiples événements avec le temps. Grâce à ce petit travail vous pouvez : Quitter votre programme ; Le rendre visible ; Afficher un message ; Lancer un fichier ; Supprimer un fichier ; Redémarrer l’ordinateur ; Quitter l’ordinateur ; Dans un temps donné. Avant de terminer je vous souhaite bonne chance, bon courage et bonne programmation. Et pour terminer je vous souhaite bon Noël.
Source
- 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.
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.
Conclusion
Mes dédicaces à tous ceux qui ne savent ni lire ni écrire... bon programmation.
Fichier Zip
Pour les "Membres Club", vous pouvez télécharger directement un fichier contenu dans le zip sans télécharger le zip en entier !
Télécharger le zip
Sources du même auteur
Sources de la même categorie
Commentaires et avis
Discussions en rapport avec ce code source dans le forum
Nul comme programmeur ! [ par mil51 ]
Bonjour tout le monde,C'est mon premier jour. D'abord je salue tout le monde et vous paye à boire; Ensuite j'aimerai " si possible apprendre le systèm
Sourire [ par lucien ]
Voici une source différente de l'ordinaire, peut-être n'est -elle pas à sa place, vous me le pardonnerez amicalementAu commencement Dieu créa le digit
[URGENT] Recherche Analyste Programmeur expérimenté en Delphi [ par g rosinosky ]
On recherche urgemment un développeur Delphi sur Paris. Bonne connaissance de l'IDE et de Delphi Objet souhaitée.Voici la description du poste :Entrep
j'ai besoin d'un programmeur [ par visualk ]
Bonjour ! Je suis programmeur delphi et graphiste 3d 3ds max je travaille sur un projet en delphi une idée novice et j'ai besoin d'un programmeur pou
|
Téléchargements
Logiciels à télécharger sur le même thème :
|