New Date new bug

[Scott Turchin]

I've used this code for almost a year with little to no problem.
It has always checked the atomic clock, specifically one preferred server but it hhas always worked.

Now, we roll into 01-01-01 and further, ie 01-14-01 and my code is CONFUSED!!!!!!!!!
It says the year is 2014 on the 14th and 2015 on the 15th etc....

Can anyone explain this? It's the Varianttime function, see the Message Box below in the AtomicClock Function

'------------------------------------------------------------------------------------------------------------------------
'-----------------------------------------------------------------------------------
'Function CheckAtomicTime
'This function takes a server and checks the Atomic clock on Port wPort.
'Network delays are calculated here, but also returned for display.
'aTimeout is in milliseconds, so for 30 seconds use 30000
'A SYSTEMTIME structure is also returned.
'The function returns a string containing the time in NIST format.
'-----------------------------------------------------------------------------------
Function CheckAtomicTime(lserv As String,wPort As Long,aTimeOut As Long,Delay As Double, st As SYSTEMTIME) As String
Local buffer    As String
Local lpbuf     As String
Local UTCTime   As String
Local vbdate    As Double

Dim Start       As Dword
Dim Stopp       As Dword
Dim QT          As QuadFILETIME
Dim Pc          As Long

Pc& = SetPriorityClass(GetCurrentProcess(), %HIGH_PRIORITY_CLASS)

lserv = Extract$(Ltrim$(lserv), Any " (")
g_Result = PlayWavFromResource(g_hInst,WAVE + "2",WAV + "02")

'Record your starttime In milliseconds
Start = TimeGetTime()
Tcp Open Port wPort At lserv As #hTcp TIMEOUT aTimeOut
Do
  Tcp Recv #hTcp, 1600, buffer
  lpbuf = lpbuf + buffer
Loop While Len(buffer)
Tcp Close #hTcp
g_Result = PlayWavFromResource(g_hInst,WAVE + "3",WAV + "03")
lpbuf = Trim$(lpbuf, $LF)
Replace $LF With $CRLF In lpbuf
UTCTime = Trim$(lpbuf, $LF)

If Len(UTCTIme) = 5 Then 'It's RFC868 Time standard not NIST
   MsgBox "This appears to be an RFC868 Time Server"
   Exit Function
End If

Function = UTCTime
Delay = TimeGetTime - Delay
Stopp = TimeGetTime()

'Convert your Atomic time into a SYSTEMTIME structure ST
'FILETIME returns 100's of NANOSECONDS so you have to adjust
'Delay To reflect this resulotion
Delay = (Stopp - Start)* 10000

'NIST TIME SERVER (Nuclear)
'51923 01-01-14 16:53:37 00 0 0 318.5 UTC(NIST) * 
If Right$(UTCTime,2) = "* " Then
    ' Convert date and time to a SYSTEMTIME structure using a date VARIANT
    vbDate = StrToVbDate(Parse$(UTCTime," ",2) + " " + Parse$(UTCTime," ",3))
    VariantTimeToSystemTime vbDate, st
    MsgBox Str$(st.wyear) & " " & Str$(st.wmonth)
    Right here the st.wyear shows as 2014 on the 14th of jan.

ElseIf Len(UTCTime) = 5 Then
     RFC868toSystemTime CvDwd(UTCTime), st
'ElseIf
   'Internet Time Server
   '"Wed, 13 Oct 1999 15:07:52 -0700"
ElseIf Len(UTCTime) < 2 Then
    Function = Date$ + " DEBUG:"
    Exit Function
End If

'convert your Atomic time In ST To FileTime In QT
SystemTimeToFileTime ST,QT
'Now Add the delay To the Quad-element that overlay the FILETIME-struct
QT.qdTime = (QT.qdTime + Delay) - 50000 'subtract 50ms NIST network delay
'Convert back To SYSTEMTIME
FileTimeToSystemTime QT,ST
Delay = Delay \ 10000
End Function        


I put these in here as well although they don't seem to be responsible.........??


'===================================<Time Conversion Functions to SYSTEMTIME>==================
Function uString(ByVal x As String)Export As String

  Local y As String
  Local n As Integer

  If Len(x) Then
    For n = 1 To Len(x)
      y = y + Mki$(Asc(x, n))
    Next n
  End If
  Function = y
End Function

'------------------------------------------------------------------------------

Function StrToVbDate(ByVal dt As String) Export As Double
  Local x      As Long
  Local y      As String
  Local vbdate As Double

  dt = uString(dt)
  If IsFalse(VarDateFromStr(ByVal StrPtr(dt), 0, 0, vbdate)) Then
    Function = vbdate
  End If

End Function
'-----------------------------------------------------------------------------------
Function VbDateToStr(ByVal vbdate As Double) Export As String
Local d  As Asciiz * 64
Local dt As String
Local st As SYSTEMTIME
Local tDay              As Asciiz * 64
Local tTime             As Asciiz * 64
VariantTimeToSystemTime vbdate, st
GetDateFormat %LOCALE_USER_DEFAULT,%DATE_SHORTDATE, st, ByVal %NULL, tDay, 64
GetTimeFormat %LOCALE_USER_DEFAULT, %TIME_FORCE24HOURFORMAT,st, ByVal %NULL, tTime, 64
Function = tDay + " " + tTime
End Function

------------------
Scott
mailto:[email protected][email protected]</A>

[This message has been edited by Scott Turchin (edited January 14, 2001).]