Hallo,
in embeddedVB ging das so. Vielleicht hilft es jemandem weiter. Das Setzten der Systemzeit koennte zB ueber GPS erfolgen. Die Routine ist etwas umstaendlich, funktioniert jedoch unter Pocket PC 2003, WM5/6 nicht getestet.
Private Sub cmdSetClock_Click()
If Not ready Then Msgbox "GPS Data is instable at this stage.", vbInformation, " GPS Not Ready": Exit Sub
Dim st As Date
st = Int(Now) + (Mid(gga(1), 1, 2) + Mid(gga(1), 3, 2) / 60 + Mid(gga(1), 5, 2) / 3600 + (zt - sv)) / 24
If SetDeviceTime(Year(st), Month(st), Weekday(st), Day(st), Hour(st), Minute(st), Second(st), 0) Then
Msgbox "Clock set to" & vbCrLf & FormatDateTime(st, vbGeneralDate), vbInformation, " GPS Clock"
Else
Msgbox "Error when setting clock.", vbCritical, " GPS Clock"
End If
End Sub
Public Function SetDeviceTime(Year As Integer, Month As Integer, DayOfWeek As Integer, Day As Integer, Hour As Integer, Minute As Integer, Second As Integer, Millisecond As Integer) As Boolean 'for PPC clock set
Dim bs As String
Dim lRet As Long
bs = ToBinaryString(Year, CE_INTEGER) 'CE_INTEGER=2
bs = bs & ToBinaryString(Month, CE_INTEGER)
bs = bs & ToBinaryString(DayOfWeek, CE_INTEGER)
bs = bs & ToBinaryString(Day, CE_INTEGER)
bs = bs & ToBinaryString(Hour, CE_INTEGER)
bs = bs & ToBinaryString(Minute, CE_INTEGER)
bs = bs & ToBinaryString(Second, CE_INTEGER)
bs = bs & ToBinaryString(Millisecond, CE_INTEGER)
lRet = SetLocalTime(bs)
If lRet = 0 Then SetDeviceTime = False Else SetDeviceTime = True
End Function
Public Function ToBinaryString(Number As Variant, Bytes As Integer) As String 'for PPC clock set
Dim i As Integer
Dim bIsNegative As Boolean
If Bytes > 4 OR Bytes < 1 Then Exit Function
If Number < 0 Then
bIsNegative = True
Number = Number * -1
Number = Number Xor ((2 ^ (8 * Bytes - 1)) - 1)
Number = Number + 1
End If
For i = 0 To Bytes - 1
If i = Bytes - 1 AND bIsNegative Then
ToBinaryString = ToBinaryString & (ChrB(GetByteValue(Number, i) + &H80))
Else
ToBinaryString = ToBinaryString & ChrB(GetByteValue(Number, i))
End If
Next i
End Function
Public Function GetByteValue(Number As Variant, BytePos As Integer) As Long
Dim mask As Long
On Error Resume Next
If BytePos > 3 OR BytePos < 0 Then Exit Function
If BytePos < 3 Then
mask = &HFF * (2 ^ (8 * BytePos))
Else
mask = &H7F * (2 ^ (8 * BytePos))
End If
GetByteValue = Number AND mask
GetByteValue = GetByteValue / (2 ^ (8 * BytePos))
End Function
|