![]() |
|
|||||||
| Home | Register | FAQ | Members List | Search | Today's Posts | Mark Forums Read |
| Additional Libraries Users contributed libraries. This sub-forum is only available to licensed users. |
![]() |
|
|
LinkBack | Thread Tools | Display Modes |
|
||||
|
Ciao Filippo,
Execellent! Awesome! Thanks to your DLL, I can set the clock with GPS date and time. Here is the source for everybody. Perhaps someone can shorten it ![]() Code:
'Requires Registry DLL (object reg), Bitwise DLL (object bit) and Filippo's SysTime DLL (object SysTime)
Sub Globals
Dim zti(0) As Byte 'binary array for GetTimeZone
End Sub
Sub App_Start
Reg.New1
SysTime.New1
End Sub
Sub mnuSetSystemDateTime_Click
If GPS.Status<>"A" Then Return 'Aborts if no stable GPS signal present
'GPS.UTCDate and GPS.UTCTime available from Sub GPS_GPSDecoded. Please see gps.dll Help for details
Dim x, y, i, zt
zt = GetTimeZone
x = DateParse(GPS2Date(GPS.UTCDate))
y = TimeParse(GPS2Time(GPS.UTCTime)) + zt/24 * cTicksPerDay 'add your local time zone
i = Msgbox("GPS date and time converted to local is " & CrLf & Date(x) & " " & Time(y) & CrLf & "Set the device?"," Confirmation",cMsgBoxYesNo,cMsgBoxQuestion)
If i = cNo Then Return
ErrorLabel(SetError) 'There is no success flag in the SysTime DLL
SysTime.New1
Systime.SetDate(DateMonth(x),DateDay(x),DateYear(x))
Systime.SetTime(TimeHour(y),TimeMinute(y),TimeSecond(y))
Msgbox("GPS Date and Time set."," GPS Date and Time",cMsgBoxNone,cMsgBoxAsterisk)
Return
SetError:
Msgbox("Error setting Date and Time."," GPS Date and Time",cMsgBoxNone,cMsgBoxHand)
End Sub
Sub GPS2Time(x)
Dim colon
TimeFormat("HH:mm:ss")
colon=SubString(x,0,6)
colon=StrInsert(colon,2,":")
colon=StrInsert(colon,5,":")
x = TimeParse(colon)
if chkAMPM.Checked=True Then TimeFormat("hh:mm:ss tt") 'A check box selects EU or US format
Return Time(x)
End Sub
Sub GPS2Date(x)
Dim dash
DateFormat ("yyyy/mm/dd")
dash="20" & SubString(x,4,2) & "/"
dash=dash & SubString(x,2,2) & "/"
dash=dash & SubString(x,0,2)
x = DateParse(dash)
if chkAMPM.Checked=false then 'A check box selects EU or US format
DateFormat("dd/mm/yyyy")
else
DateFormat("mm/dd/yyyy")
End if
Return Date(x)
End Sub
Sub GetTimeZone
Dim m, i, b
Reg.RootKey(Reg.rtLocalMachine)
If cPPC = True Then
zti()=Reg.GetValue("Time","TimeZoneInformation")
For i = 3 To 0 Step -1
m = m & bit.DecToHex(zti(i))
Next
m = bit.HexToDec(m) / 60 * (-1)
Else
m = Reg.GetValue("System\CurrentControlSet\Control\TimeZoneInformation","ActiveTimeBias")
m = m / 60 * (-1)
End If
If m > 0 Then m = "+" & m
Return m
End Sub
|
|
||||
|
Sorry gents,
There is an error in mnuSetSystemDateTime_Click which I have corrected as: Code:
Sub mnuSetSystemDateTime_Click
If GPS.Status="A" Then
Dim x, i
x =DateParse(GPS2Time(GPS.UTCTime)) 'addition of time zone must account for date change
x = x - x Mod cTicksPerDay
x = x + TimeParse(GPS2Time(GPS.UTCTime)) + zt * cTicksPerHour
i = Msgbox("GPS date and time converted to local is " & CrLf & Date(x) & " " & Time(x) & CrLF & "Set the device?"," Confirmation",cMsgBoxYesNo,cMsgBoxQuestion)
If i = cNo Then Return
ErrorLabel(SetError)
SysTime.New1
Systime.SetDate(DateMonth(x),DateDay(x),DateYear(x))
Systime.SetTime(TimeHour(x),TimeMinute(x),TimeSecond(x))
Msgbox("GPS Date and Time set."," GPS Date and Time",cMsgBoxNone,cMsgBoxAsterisk)
Return
SetError:
Msgbox("Error setting Date and Time."," GPS Date and Time",cMsgBoxNone,cMsgBoxHand)
Else
Msgbox("GPS data unstable or not available."," GPS Status",cMsgBoxNone,cMsgBoxHand)
Return
End If
End Sub
|
|
|||
|
Hi Filippo,
I think there is an error in your help file for SetDate Quote:
Syntax: SetDate(Month As Integer, Day As Integer, Year As Integer) ![]() Edit: "Does anyone know how to set the BIOS date & time in the Desktop?" I see that it does! Last edited by Zenerdiode : 07-05-2008 at 08:12 PM. |
![]() |
| Currently Active Users Viewing This Thread: 1 (0 members and 1 guests) | |
| Thread Tools | |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Thread Starter | Forum | Replies | Last Post |
| PhoneticAlgorithms Library (ex-StringComparison Library) | moster67 | Additional Libraries | 10 | 11-11-2008 08:46 PM |
| Door library (Beta) - Special library | Erel | Official Updates | 48 | 07-18-2008 03:33 PM |
| Merging Outlook library and Phone library | Erel | Official Updates | 2 | 07-14-2008 04:38 PM |