View Single Post
  #17 (permalink)  
Old 09-20-2009, 04:45 PM
mjcoon mjcoon is offline
Basic4ppc Expert
 
Join Date: May 2008
Location: Berkshire, UK
Posts: 810
Awards Showcase
Beta Tester 
Total Awards: 1
Default

By way of restitution for my criticism of alfcen's code (which he invited us to shorten) and pay-back for all the assistance here, I offer my version of the crucial portion.

It assumes the presence of a multi-line textBox1 for display of disparate times, which is of course optional. Only if the time disparity is greater than one second does it invite the user to confirm alteration of system time. The user can prevaricate as long as desired without impacting the accuracy!

It uses ByteConverter DLL rather than BitWise DLL, which makes the code for deriving the local offset much simpler.

The original system time is a parameter so that it can be measured at the time that the GPS time is acquired, so that the time taken to perform parsing is not added in.

I don't know why the local time offset appears at registry value byte 168 in my PDA versus byte zero in alfcen's.

Code:
'Requires Registry DLL (object reg), ByteConverter DLL and Filippo's SysTime DLL (object SysTime)

Sub CompareSystemTime(nowTicks, yearUTC, monthUTC, dayUTC, hourUTC, minuteUTC, secondUTC)
    moString = Format(monthUTC, 
"D2")
    dyString = Format(dayUTC, 
"D2")
    yrString = Format(yearUTC, 
"D4")
    DateFormat(
"yyyy-mm-dd")
    TimeFormat(
"HH:mm:ss")
    dateString = yrString & 
"-" & moString & "-" & dyString
    dateTicks = DateParse(dateString)
    timeUTCTicks = TimeAdd(dateTicks, hourUTC, minuteUTC, secondUTC)
    textBox1.Text = 
"Date&time (UTC)=" & CRLF & cTab & Date(timeUTCTicks) & "  " & Time(timeUTCTicks)
    minsOffset = - GetActiveTimeBias
    timeTicks = TimeAdd(timeUTCTicks, 
0, minsOffset, 0)
    disparity = 
Int((timeTicks - nowTicks) / cTicksPerSecond + 0.5)
    
If disparity = 1 Then
        unit = 
" second"
    
Else
        unit = 
" seconds"
    
End If
    textBox1.Text = textBox1.Text & 
CRLF & "Date&time (local)=" & CRLF & cTab & Date(timeTicks) & "  " & Time(timeTicks) & _
            
CRLF & "System time =" & CRLF & cTab & Date(nowTicks) & "  " & Time(nowTicks) & _
            
CRLF & "Time disparity = " & disparity & unit
    
If Abs(disparity) > 1 Then
        
If Msgbox("Disparity = " &     disparity & unit, "Adjust system time?", cMsgboxYesNo) = cYes Then
            adjustTime(disparity)
        
End If
    
End If
End Sub

Sub GetActiveTimeBias        'In minutes, to go from local to UTC (!)
  Dim m, i, b
  Reg.New1
  Reg.RootKey(Reg.rtLocalMachine)
  
If cPPC = True Then
    zti()=Reg.GetValue(
"Time","TimeZoneInformation")
    m = Converter.Int32FromBytes(zti(), 
168)
  
Else
    m = Reg.GetValue(
"System\CurrentControlSet\Control\TimeZoneInformation","ActiveTimeBias")
  
End If
  
Return m    
End Sub

Sub adjustTime(seconds)
    TimeObj.New1
    timeNow = Now
    timeAdjusted = timeNow + seconds * cTicksPerSecond
    TimeObj.SetDate(DateMonth(timeAdjusted),DateDay(timeAdjusted),DateYear(timeAdjusted))    
' Tweak the current system date
    TimeObj.SetTime(TimeHour(timeAdjusted),TimeMinute(timeAdjusted),TimeSecond(timeAdjusted))     ' Tweak the current System time
End Sub
Reply With Quote