Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Jacques
Bonjour, voici quelques lignes qui pourraient t'aider ... Pas testé, sorry
Option Explicit
'''''Time Server Port 37 service (RFC 868) '''''This is a sample project showing how to obtain the GMT '''''and update the system clock from the port 37 service on '''''Internet time servers using the winsock control.
Private Type SYSTEMTIME wYear As Integer wMonth As Integer wDayOfWeek As Integer wDay As Integer wHour As Integer wMinute As Integer wSecond As Integer wMilliseconds As Integer End Type
Private Declare Sub GetSystemTime Lib "kernel32" (lpSystemTime As SYSTEMTIME) Private Declare Function SetSystemTime Lib "kernel32" (lpSystemTime As SYSTEMTIME) As Long Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, _ Source As Any, ByVal Length As Long) Private Declare Function GetTickCount& Lib "kernel32" ()
Private mlngSecondsDiffTotal As Long
Private msngTimeout As Single Private mstrHosts(1 To 3) As String Private mbIsDone As Boolean Private mintCount As Integer Private mintNumGood As Integer
Private Sub Command1_Click() 'Reset all counters mbIsDone = True mintCount = 0 mlngSecondsDiffTotal = 0 msngTimeout = Timer
Winsock1.RemotePort = 37
'Start the process Timer1.Enabled = True
End Sub
Private Sub Form_Activate() Static bNotFirst As Boolean
End Sub
Private Sub Form_Load() Timer1.Enabled = False Timer1.Interval = 2000
'These hosts are working right now, but that may change. 'See http://www.eecis.udel.edu/~mills/ntp/clock1.htm for list of servers. 'Use trial and error to find new servers as not all will support RFC 868 '(outdated as SNTP is preferred.)
lngAvgDiff = CLng(CSng(mlngSecondsDiffTotal) / mintNumGood) sStatus "Average difference in s: " & lngAvgDiff Debug.Print DateAdd("s", lngAvgDiff, fGetGMTTime), " Average difference in s: " & lngAvgDiff 'Add the average difference in seconds to the current system GMT time. dt = DateAdd("s", lngAvgDiff, fGetGMTTime)
st.wDay = Day(dt) st.wMonth = Month(dt) st.wYear = Year(dt) st.wHour = Hour(dt) st.wMinute = Minute(dt) st.wSecond = Second(dt) 'This function takes GMT time as input and sets your system time appropriately. Call SetSystemTime(st) sStatus "Average difference in s: " & lngAvgDiff & " Time Synchronized."
Timer1.Enabled = False If UCase(Command$) Like "*AUTO*" Then Unload Me End If
End If
End If End Sub
Private Sub Winsock1_Connect()
Debug.Print "Connected"
End Sub
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim dblTime As Double Dim lngTimeFrom1990 As Long Dim lngTime As Long Dim dtGMT As Date Dim dtGMTLocal As Date Dim st As SYSTEMTIME Dim i As Integer Dim strTime As String Dim b() As Byte
If bytesTotal <> 4 Then Winsock1.Close Exit Sub End If
On Error Resume Next 'Purpose for this is to avoid overflows with DateAdd lngTimeFrom1990 = dblTime - 2840140800# If Err = 6 Then 'No good data received from time server. sStatus "Error in data returned." Exit Sub End If
Debug.Print dblTime
'calculate the GMT based on what was returned dtGMT = DateAdd("s", lngTimeFrom1990, #1/1/1990#) dtGMTLocal = fGetGMTTime
'Find the difference between system time and returned time. Debug.Print DateDiff("s", dtGMTLocal, dtGMT) & " s difference" sStatus DateDiff("s", dtGMTLocal, dtGMT) & " s difference" 'add to total for averaging. mlngSecondsDiffTotal = mlngSecondsDiffTotal + DateDiff("s", dtGMTLocal, dtGMT) Debug.Print mlngSecondsDiffTotal mintNumGood = mintNumGood + 1
mbIsDone = True
Winsock1.Close
End Sub
Private Sub Winsock1_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean) ' MsgBox Description sStatus Description Winsock1.Close End Sub
Public Function fGetGMTTime() As Date Dim st As SYSTEMTIME Call GetSystemTime(st) fGetGMTTime = DateSerial(st.wYear, st.wMonth, st.wDay) + TimeSerial(st.wHour, st.wMinute, st.wSecond)
End Function
Public Sub sStatus(strMsg) statSync.Panels(1).Text = " " & strMsg End Sub
"gilles" a écrit dans le message de news: je suis à la recherche d'un exemple de synchronisation de l'heure en VB par rapport a l'heure atomique
merci d'avance
Bonjour,
voici quelques lignes qui pourraient t'aider ... Pas testé, sorry
Option Explicit
'''''Time Server Port 37 service (RFC 868)
'''''This is a sample project showing how to obtain the GMT
'''''and update the system clock from the port 37 service on
'''''Internet time servers using the winsock control.
Private Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type
Private Declare Sub GetSystemTime Lib "kernel32" (lpSystemTime As
SYSTEMTIME)
Private Declare Function SetSystemTime Lib "kernel32" (lpSystemTime As
SYSTEMTIME) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory"
(Destination As Any, _
Source As Any, ByVal Length As Long)
Private Declare Function GetTickCount& Lib "kernel32" ()
Private mlngSecondsDiffTotal As Long
Private msngTimeout As Single
Private mstrHosts(1 To 3) As String
Private mbIsDone As Boolean
Private mintCount As Integer
Private mintNumGood As Integer
Private Sub Command1_Click()
'Reset all counters
mbIsDone = True
mintCount = 0
mlngSecondsDiffTotal = 0
msngTimeout = Timer
Winsock1.RemotePort = 37
'Start the process
Timer1.Enabled = True
End Sub
Private Sub Form_Activate()
Static bNotFirst As Boolean
End Sub
Private Sub Form_Load()
Timer1.Enabled = False
Timer1.Interval = 2000
'These hosts are working right now, but that may change.
'See http://www.eecis.udel.edu/~mills/ntp/clock1.htm for list of
servers.
'Use trial and error to find new servers as not all will support RFC 868
'(outdated as SNTP is preferred.)
lngAvgDiff = CLng(CSng(mlngSecondsDiffTotal) / mintNumGood)
sStatus "Average difference in s: " & lngAvgDiff
Debug.Print DateAdd("s", lngAvgDiff, fGetGMTTime), " Average
difference in s: " & lngAvgDiff
'Add the average difference in seconds to the current system GMT
time.
dt = DateAdd("s", lngAvgDiff, fGetGMTTime)
st.wDay = Day(dt)
st.wMonth = Month(dt)
st.wYear = Year(dt)
st.wHour = Hour(dt)
st.wMinute = Minute(dt)
st.wSecond = Second(dt)
'This function takes GMT time as input and sets your system time
appropriately.
Call SetSystemTime(st)
sStatus "Average difference in s: " & lngAvgDiff & " Time
Synchronized."
Timer1.Enabled = False
If UCase(Command$) Like "*AUTO*" Then
Unload Me
End If
End If
End If
End Sub
Private Sub Winsock1_Connect()
Debug.Print "Connected"
End Sub
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim dblTime As Double
Dim lngTimeFrom1990 As Long
Dim lngTime As Long
Dim dtGMT As Date
Dim dtGMTLocal As Date
Dim st As SYSTEMTIME
Dim i As Integer
Dim strTime As String
Dim b() As Byte
If bytesTotal <> 4 Then
Winsock1.Close
Exit Sub
End If
On Error Resume Next
'Purpose for this is to avoid overflows with DateAdd
lngTimeFrom1990 = dblTime - 2840140800#
If Err = 6 Then
'No good data received from time server.
sStatus "Error in data returned."
Exit Sub
End If
Debug.Print dblTime
'calculate the GMT based on what was returned
dtGMT = DateAdd("s", lngTimeFrom1990, #1/1/1990#)
dtGMTLocal = fGetGMTTime
'Find the difference between system time and returned time.
Debug.Print DateDiff("s", dtGMTLocal, dtGMT) & " s difference"
sStatus DateDiff("s", dtGMTLocal, dtGMT) & " s difference"
'add to total for averaging.
mlngSecondsDiffTotal = mlngSecondsDiffTotal + DateDiff("s", dtGMTLocal,
dtGMT)
Debug.Print mlngSecondsDiffTotal
mintNumGood = mintNumGood + 1
mbIsDone = True
Winsock1.Close
End Sub
Private Sub Winsock1_Error(ByVal Number As Integer, Description As String,
ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal
HelpContext As Long, CancelDisplay As Boolean)
' MsgBox Description
sStatus Description
Winsock1.Close
End Sub
Public Function fGetGMTTime() As Date
Dim st As SYSTEMTIME
Call GetSystemTime(st)
fGetGMTTime = DateSerial(st.wYear, st.wMonth, st.wDay) +
TimeSerial(st.wHour, st.wMinute, st.wSecond)
End Function
Public Sub sStatus(strMsg)
statSync.Panels(1).Text = " " & strMsg
End Sub
"gilles" <gminot@amada.fr> a écrit dans le message de
news:1136046378.229153.266300@g47g2000cwa.googlegroups.com...
je suis à la recherche d'un exemple de synchronisation de l'heure en
VB par rapport a l'heure atomique
Bonjour, voici quelques lignes qui pourraient t'aider ... Pas testé, sorry
Option Explicit
'''''Time Server Port 37 service (RFC 868) '''''This is a sample project showing how to obtain the GMT '''''and update the system clock from the port 37 service on '''''Internet time servers using the winsock control.
Private Type SYSTEMTIME wYear As Integer wMonth As Integer wDayOfWeek As Integer wDay As Integer wHour As Integer wMinute As Integer wSecond As Integer wMilliseconds As Integer End Type
Private Declare Sub GetSystemTime Lib "kernel32" (lpSystemTime As SYSTEMTIME) Private Declare Function SetSystemTime Lib "kernel32" (lpSystemTime As SYSTEMTIME) As Long Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, _ Source As Any, ByVal Length As Long) Private Declare Function GetTickCount& Lib "kernel32" ()
Private mlngSecondsDiffTotal As Long
Private msngTimeout As Single Private mstrHosts(1 To 3) As String Private mbIsDone As Boolean Private mintCount As Integer Private mintNumGood As Integer
Private Sub Command1_Click() 'Reset all counters mbIsDone = True mintCount = 0 mlngSecondsDiffTotal = 0 msngTimeout = Timer
Winsock1.RemotePort = 37
'Start the process Timer1.Enabled = True
End Sub
Private Sub Form_Activate() Static bNotFirst As Boolean
End Sub
Private Sub Form_Load() Timer1.Enabled = False Timer1.Interval = 2000
'These hosts are working right now, but that may change. 'See http://www.eecis.udel.edu/~mills/ntp/clock1.htm for list of servers. 'Use trial and error to find new servers as not all will support RFC 868 '(outdated as SNTP is preferred.)
lngAvgDiff = CLng(CSng(mlngSecondsDiffTotal) / mintNumGood) sStatus "Average difference in s: " & lngAvgDiff Debug.Print DateAdd("s", lngAvgDiff, fGetGMTTime), " Average difference in s: " & lngAvgDiff 'Add the average difference in seconds to the current system GMT time. dt = DateAdd("s", lngAvgDiff, fGetGMTTime)
st.wDay = Day(dt) st.wMonth = Month(dt) st.wYear = Year(dt) st.wHour = Hour(dt) st.wMinute = Minute(dt) st.wSecond = Second(dt) 'This function takes GMT time as input and sets your system time appropriately. Call SetSystemTime(st) sStatus "Average difference in s: " & lngAvgDiff & " Time Synchronized."
Timer1.Enabled = False If UCase(Command$) Like "*AUTO*" Then Unload Me End If
End If
End If End Sub
Private Sub Winsock1_Connect()
Debug.Print "Connected"
End Sub
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim dblTime As Double Dim lngTimeFrom1990 As Long Dim lngTime As Long Dim dtGMT As Date Dim dtGMTLocal As Date Dim st As SYSTEMTIME Dim i As Integer Dim strTime As String Dim b() As Byte
If bytesTotal <> 4 Then Winsock1.Close Exit Sub End If
On Error Resume Next 'Purpose for this is to avoid overflows with DateAdd lngTimeFrom1990 = dblTime - 2840140800# If Err = 6 Then 'No good data received from time server. sStatus "Error in data returned." Exit Sub End If
Debug.Print dblTime
'calculate the GMT based on what was returned dtGMT = DateAdd("s", lngTimeFrom1990, #1/1/1990#) dtGMTLocal = fGetGMTTime
'Find the difference between system time and returned time. Debug.Print DateDiff("s", dtGMTLocal, dtGMT) & " s difference" sStatus DateDiff("s", dtGMTLocal, dtGMT) & " s difference" 'add to total for averaging. mlngSecondsDiffTotal = mlngSecondsDiffTotal + DateDiff("s", dtGMTLocal, dtGMT) Debug.Print mlngSecondsDiffTotal mintNumGood = mintNumGood + 1
mbIsDone = True
Winsock1.Close
End Sub
Private Sub Winsock1_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean) ' MsgBox Description sStatus Description Winsock1.Close End Sub
Public Function fGetGMTTime() As Date Dim st As SYSTEMTIME Call GetSystemTime(st) fGetGMTTime = DateSerial(st.wYear, st.wMonth, st.wDay) + TimeSerial(st.wHour, st.wMinute, st.wSecond)
End Function
Public Sub sStatus(strMsg) statSync.Panels(1).Text = " " & strMsg End Sub
"gilles" a écrit dans le message de news: je suis à la recherche d'un exemple de synchronisation de l'heure en VB par rapport a l'heure atomique
merci d'avance
gilles
merci de ta rapidite et bonne année . je te tiens au courant si ca fonctionne bye et merci
merci de ta rapidite et bonne année . je te tiens au courant si ca
fonctionne
bye et merci
en fait active winsock me demande une license . Comment faire pour contourner ce probleme
A plus
3stone
Salut,
"gilles" | en fait active winsock me demande une license . Comment faire pour | contourner ce probleme
Je ne comprend pas toute la démarche...
WinXp le fait tout seul... et pour les autres, j'utiliserais un "micro-soft" que l'on trouve partout sur le net et je l'appelerai par un simple Shell(...)
"gilles"
| en fait active winsock me demande une license . Comment faire pour
| contourner ce probleme
Je ne comprend pas toute la démarche...
WinXp le fait tout seul... et pour les autres, j'utiliserais un "micro-soft"
que l'on trouve partout sur le net et je l'appelerai par un simple Shell(...)
"gilles" | en fait active winsock me demande une license . Comment faire pour | contourner ce probleme
Je ne comprend pas toute la démarche...
WinXp le fait tout seul... et pour les autres, j'utiliserais un "micro-soft" que l'on trouve partout sur le net et je l'appelerai par un simple Shell(...)
cest un epu par plaisir et connaitre winsock alors si tu sais comment je peux avoir cette license po pk ce pb apparait ca serait sympa
A plus
Salut,
"gilles" | en fait active winsock me demande une license . Comment faire pour | contourner ce probleme
Je ne comprend pas toute la démarche...
WinXp le fait tout seul... et pour les autres, j'utiliserais un "micro-s oft" que l'on trouve partout sur le net et je l'appelerai par un simple Shell( ...)
cest un epu par plaisir et connaitre winsock alors si tu sais comment
je peux avoir cette license po pk ce pb apparait ca serait sympa
A plus
Salut,
"gilles"
| en fait active winsock me demande une license . Comment faire pour
| contourner ce probleme
Je ne comprend pas toute la démarche...
WinXp le fait tout seul... et pour les autres, j'utiliserais un "micro-s oft"
que l'on trouve partout sur le net et je l'appelerai par un simple Shell( ...)
cest un epu par plaisir et connaitre winsock alors si tu sais comment je peux avoir cette license po pk ce pb apparait ca serait sympa
A plus
Salut,
"gilles" | en fait active winsock me demande une license . Comment faire pour | contourner ce probleme
Je ne comprend pas toute la démarche...
WinXp le fait tout seul... et pour les autres, j'utiliserais un "micro-s oft" que l'on trouve partout sur le net et je l'appelerai par un simple Shell( ...)
