Timeserver v1.0.3

Soyez le premier à donner votre avis sur cette source.

Vue 6 962 fois - Téléchargée 927 fois

Description

Un programme ridiculement simple par rapport au service qu'il rend !
Se connecte à des serveurs de temps de type strate2 ( liste sur http://www.cru.fr/services/ntp/serveurs_francais ) et vous retourne la date et l'heure d'une horloge atomique.
Vous permet également de synchroniser votre PC avec l'heure atomique.
Projet basé sur le super article suivant : ftp://ftp-developpez.com/svaillant/delphi_datetime/svaillant-datetime.pdf

Source / Exemple :


Version     : 1.0.3
Date        : 08 Mars 2010

Micro Projet 03 - On utilise un composant Indy (TidSNTP) pour se connecter à un
serveur de temps de type strate 2 pour récupérer la date et l'heure provenant
d'une horloge atomique. Le composant bug dans les versions 6 et moins de Delphi,
pour y remédier il faut avoir au moins la version 9.0 des composants Indy. Il
faut avoir les droits d'administrateur pour changer l'heure et la date du PC.
===============================================================================}
unit f_main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdUDPBase, IdUDPClient,
  IdSNTP, ExtCtrls;

type
  TTimeServ = class(TForm)
    SNTP: TIdSNTP;
    ListeServeur: TListBox;
    ServeurNameBox: TGroupBox;
    LabServeur: TLabel;
    LocalBox: TGroupBox;
    LabDateLocale: TLabel;
    LabHeureLocale: TLabel;
    ServeurBox: TGroupBox;
    LabDateServeur: TLabel;
    LabHeureServeur: TLabel;
    BtnSysTime: TButton;
    Timer: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure ListeServeurClick(Sender: TObject);
    procedure TimerTimer(Sender: TObject);
    procedure BtnSysTimeClick(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;

var
  TimeServ: TTimeServ;

implementation

{$R *.dfm}
{$R 'Resources\UAC_Manifest.RES'} // Pour avoir les droits d'administrateur

procedure TTimeServ.ListeServeurClick(Sender: TObject);
begin
// On affiche le nom du serveur sélectionné
 LabServeur.Caption := ListeServeur.Items[ListeServeur.ItemIndex];
// On déclare le nom du serveur au composant TidSNTP
 SNTP.Host := ListeServeur.Items[ListeServeur.ItemIndex];
end;

// Interval = 100 donc on  va exécuter cette routine 10 fois par seconde
procedure TTimeServ.TimerTimer(Sender: TObject);
var Date1 : TDateTime;
begin
// L'instant présent
 Date1 := Now;
// On affiche la date locale
 LabDateLocale.Caption := DateToStr(Date1);
// On affiche l'heure locale
 LabHeureLocale.Caption := TimeToStr(Date1);
// On affiche la date du serveur de temps
 LabDateServeur.Caption := DateToStr(SNTP.DateTime);
// On affiche l'heure du serveur de temps
 LabHeureServeur.Caption := TimeToStr(SNTP.DateTime);
end;

procedure TTimeServ.BtnSysTimeClick(Sender: TObject);
var SysTime : TSystemTime;
begin
// On utilise une fonction interne du composant pour changer l'heure locale
 SNTP.SyncTime;
end;

procedure TTimeServ.FormCreate(Sender: TObject);
begin
// Teste si "servers.txt" est présent dans le répertoire courant
if not FileExists(GetCurrentDir+'\servers.txt') then
 begin
// Si le fichier n'existe pas dans notre répertoire, on le signale
   ShowMessage('le fichier "servers.txt" n''est pas dans le répertoire');
// Et on met fin à l'application
   Application.Terminate;
 end
else
 begin
// On charge la liste des serveurs depuis le répertoire courant
  ListeServeur.Items.LoadFromFile(GetCurrentDir+'\servers.txt');
// On sélectionne le premier serveur de la liste
  ListeServeur.ItemIndex := 0;
// On affiche le nom du serveur sélectionné
  LabServeur.Caption := ListeServeur.Items[ListeServeur.ItemIndex];
// On déclare le nom du serveur au composant TidSNTP
  SNTP.Host := ListeServeur.Items[ListeServeur.ItemIndex];
  SNTP.Active := True;
 end;
end;

end.

Conclusion :


Toujours à l'heure juste maintenant :)

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

Messages postés
9
Date d'inscription
mercredi 31 mai 2006
Statut
Membre
Dernière intervention
8 février 2010

C'est pour cela que j'ai parlé "d'une sorte de "Halt" et pas de "halt" ;-)
Puisqu'on rentre dans les détails, L'aide de Delphi7 indique " Appelez Terminate pour terminer par programme l'exécution d'une application. En appelant Terminate au lieu de libérer l'objet application, vous permettez à l'application de s'arrêter d'une manière plus ordonnée." et la version anglaise précise "Terminate calls the Windows API PostQuitMessage function to perform an orderly shutdown of the application. Terminate is not immediate. Terminate is called automatically on a WM_QUIT message and when the main form closes."
@Christophe67: il me semble avoir déjà lu sur ce site un (ou des ?) débat(s) sur le thème Terminate/Close, si tu veux en savoir plus.
Cordialement
Messages postés
3793
Date d'inscription
samedi 22 décembre 2007
Statut
Membre
Dernière intervention
3 juin 2016
7
Salut,
effectivement, si la fenêtre est en cours de création elle ne peut techniquement pas encore être détruite et libérée. Cependant, Terminate ne constitue pas un "Halt" à proprement parler car il ne tue pas le processus directement. Il s'occupe de libérer tout ce qui peut l'être (fenêtres du projet, composants, objets en variable globale), appelle les API windows qu'il faut et ensuite seulement termine le processus. Pour effectuer un Halt (pas de libération de mémoire, on termine net le processus, on peut utiliser la commande Halt ou bien l'API ExitProcess. Mais c'est violent et recommandé que dans les cas extrêmes (par exemple une application en trop mauvais état, qui si elle continue causerait des dommages irréparables sur le disque).

Cordialement, Bacterius !
Messages postés
9
Date d'inscription
mercredi 31 mai 2006
Statut
Membre
Dernière intervention
8 février 2010

Bonjour Christophe67,
Je crois que l'explication à ton soucis de Close/Terminate est simplement qu'on ne peux pas demander à une From de se fermer "normalement" alors qu'elle est en train d'être créé. Terminate provoque un arrêt brutal de l'application (une sorte de "Halt") et n'est pas soumis aux contraintes que Close.
Cordialement
Messages postés
3793
Date d'inscription
samedi 22 décembre 2007
Statut
Membre
Dernière intervention
3 juin 2016
7
@Cari : ah, intéressant, je vais regarder ça de plus près quand j'aurai un peu de temps libre :)

Cordialement, Bacterius !
Messages postés
2527
Date d'inscription
jeudi 15 janvier 2004
Statut
Membre
Dernière intervention
16 octobre 2019
13
@Mauricio
«Pour la petite histoire, ton code m' a rappelé un bug de la Playstation3 en Février de cette année...»

Ca doit être le tsunami du bug de l'an 2000. lol

@Bacterius
Après recherches, il semble bien que la solution pour synchroniser deux horloges distantes existera bientôt grâce au CERN et à Einstein.

@@Christophe67
Je peux me tromper, mais il me semble que ton application sera obsolète bien avant les sites que tu utilises.
Afficher les 21 commentaires

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.