Synchroniser l'heure du PC avec une pendule externe [Résolu]

[gillou026]

Bonjour

Dans une application, j'ai besoin de pouvoir régler l'heure de mon PC de façon à ce qu'elle soit synchro (au moins pendant quelques heures) avec une horloge HH:MM:SS externe.

Je veux que les secondes soient parfaitement synchro (enfin à 50 ms près ... c'est suffisant).

En gros sur mon appli j'ai l'horloge qui s'affiche en temps réel HH:MM:SS et 2 boutons "+50ms" et "-50ms" qui doivent agir sur les secondes du PC.

Je me met en face la pendule de référence (une pendule radio pilotée par exemple) et je clique sur + ou - de façon à ajuster l'heure du PC jusqu'à ce que visuellement le changement se fasse en même temps.

Lire et afficher l'heure sur la form : je sais faire.

Par contre ajouter ou enlever mes 50 ms et aller l'écrire dans l'horloge : Là j'ai besoin de vous .... je ne sais pas faire ....

Quelqu'un pour m'aider ???

[Andnotor]

SetLocalTime, mais pourquoi ne pas utiliser un serveur NTP ? Pas de connexion Internet ?

[gillou026]

Le PC peut être en pleine nature sans connexion internet effectivement ...

Et puis l'horloge avec laquelle je veux me synchroniser n'est peut être pas à l'heure d'internet ....

Merci pour la réponse ...

Je vais regarder ça.

[gillou026]

Heuuuu je viens de jeter un coup d'oeil mais ça m'aide pas vraiment ...

Comme j'intègre ça dans mon appli ????

C'est sous Delphi 6 ...

[tourlourou]

Regarde peut-être du côté de DecodeTime/EncodeTime ?

[ShaiLeTroll]

et DateTimeToSystemTime

Voir ce code par exemple : ...change the system time by Thomas Stutz

Utilise un TDateTimePicker pour fournir le paramètre TDateTime

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
{
  For Windows 9X/ME/NT/2000/XP:
 
  The SetLocalTime function fails if the calling process does not have
  the SE_SYSTEMTIME_NAME privilege. This privilege is disabled by default.
  Use the AdjustTokenPrivileges function to enable this privilege.
}
 
function SetPCSystemTime(dDateTime: TDateTime): Boolean;
const
  SE_SYSTEMTIME_NAME = 'SeSystemtimePrivilege';
var
  hToken: THandle;
  ReturnLength: DWORD;
  tkp, PrevTokenPriv: TTokenPrivileges;
  luid: TLargeInteger;
  dSysTime: TSystemTime;
begin
  Result := False;
  if (Win32Platform = VER_PLATFORM_WIN32_NT) then
  begin
    if OpenProcessToken(GetCurrentProcess,
      TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) then
    begin
      try
        if not LookupPrivilegeValue(nil, SE_SYSTEMTIME_NAME, luid) then Exit;
        tkp.PrivilegeCount := 1;
        tkp.Privileges[0].luid := luid;
        tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
        if not AdjustTokenPrivileges(hToken, False, tkp, SizeOf(TTOKENPRIVILEGES),
          PrevTokenPriv, ReturnLength) then
          Exit;
        if (GetLastError <> ERROR_SUCCESS) then
        begin
          raise Exception.Create(SysErrorMessage(GetLastError));
          Exit;
        end;
      finally
        CloseHandle(hToken);
      end;
    end;
  end;
  DateTimeToSystemTime(dDateTime, dSysTime);
  Result := Windows.SetLocalTime(dSysTime);
end;

[gillou026]

je viens de trouver un truc qui devait me dépanner ...

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
 
var
  Form1: TForm1;
  t:_SYSTEMTIME;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.Button1Click(Sender: TObject);
begin
 
       GetSystemTime(t);
       label1.caption := inttostr(t.wHour);
       label2.caption := inttostr(t.wMinute);
       label3.caption := inttostr(t.wSecond);
       t.wYear:= 2012;
       t.wMonth:= 12;
       t.wDay:= 17;
       t.wHour:= 16;
       t.wMinute:= 40;
       t.wSecond:= 30;
       t.wMilliseconds := 500;
       SetSystemTime(t);
end;
 
end.

Avec ça on peut aller écrire direct dans l'horloge du PC. J'ai plus qu'à faire une boucle pour attendre que les ms du PC soient à 500 et en fonction du bouton sur lequel j'ai appuyé (+ ou -), j'ajoute ou enlève 50ms.

Je vais tester ...

[gillou026]

Bon effectivement ça marche super bien ....

Voici juste un extrait de code pour régler (ajouter) une minute. C'est pareil pour régler le reste.

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
 
var
  Form1: TForm1;
  tampon : word;
  t:_SYSTEMTIME;
 
////////////////////////////////////////////////////////////////////
procedure TForm1.ajouter_minuteClick(Sender: TObject);
begin
        GetSystemTime(t);
        tampon := t.wMinute;
        tampon := tampon + 1;
        if (tampon >= 60) then
        begin
            tampon := 0;
        end;
        t.wMinute := tampon;
        SetSystemTime(t);
end;