Page 1
Page 2
Page 3
So we get our data back in rbuff, and
call the routine Set_Date_And_Time.
We get the date and time back in the format DDD MMM DD
HH:MM:SS YYYY so we need a function to re-format it
for us.
Public Function FormatNetworkDateTime
_
(NetTime As String) As Date
Dim strDate As String
Dim strTime As String
strDate = Trim(Mid(NetTime, 4, 7)) & " " &
_
Trim(Mid(NetTime, 21))
strTime = Trim(Mid(NetTime, 12, 9))
If IsDate(strDate) And IsDate(strTime) Then
FormatNetworkDateTime = _
CDate(strDate & " " & strTime)
Else
FormatNetworkDateTime = Now
End If
End Function
This will give us a date and time back
in a nice format of
mm/dd/yy hh:mm:ss AM.
If for some reason we have not got a
valid date and time, we will just send back the current
date and time.
The next bit of the article on setting
the system date and time was taken from the pages of http://www.commedia.pt/ce/udts1.html
and an article by Antonio Paneiro.
The API Call SetLocalTime uses a User Defined Type,
one of the few(??!!) functions currently missing
from eVB. Therefore we need to use some of the trickery
outlined by Antonio.
The SetLocalTime is defined to
pass a string by value, instead of a UDT.
The UDT for SetLocalTime consists of
8 integer values, so we will use IntegerToBinaryString
to concatenate the 8 integers into a string. We then pass
the string to SetLocalTime, and hope for the best. The return
code will tell us whether or not we have suceeded (0 means
failure).
Private Sub Set_Date_And_Time()
Dim Xtime As String
Xtime = FormatNetworkDateTime(Rbuff)
iyear = DatePart("yyyy", Xtime)
imonth = DatePart("m", Xtime)
idow = Weekday(Xtime)
iday = DatePart("d", Xtime)
ihour = DatePart("H", Xtime)
imin = DatePart("n", Xtime)
isec = DatePart("s", Xtime)
imill = 0
sysTime = _
IntegerToBinaryString(iyear) & _
IntegerToBinaryString(imonth) & _
IntegerToBinaryString(idow) & _
IntegerToBinaryString(iday) & _
IntegerToBinaryString(ihour) & _
IntegerToBinaryString(imin) & _
IntegerToBinaryString(isec) & _
IntegerToBinaryString(imill)
Dim lret As Long
lret = SetLocalTime(sysTime)
If lret = 0 Then
MsgBox "Failed to set local time!", _
vbInformation, "Failed to set time"
Else
MsgBox "Time set to " & Mid(Rbuff, 1, 24),_
vbInformation, "Time Set"
End If
End Sub
Public Function IntegerToBinaryString
_
(ByVal intin As Integer) As String
Dim aux As Integer
aux = intin
If intin < 0 Then
aux = intin - &H8000
End If
IntegerToBinaryString = _
IntegerToBinaryString & ChrB(aux Mod 256)
aux = aux \ 256
If intin < 0 Then
IntegerToBinaryString = _
IntegerToBinaryString & ChrB(aux + &H80)
Else
IntegerToBinaryString = _
IntegerToBinaryString & ChrB(aux)
End If
End Function
This is the finished result after calling
a time server.
All very well you may say, but I am
one of the few people on the planet who does not live in
the UTC (Universal Time, Coordinated) time zone. This used
to be called GMT (Greenwich Mean Time) when I was a boy.
Don't you just love those TLA's?
Well, we have an answer to that, but
we will save adjusting the time to a Time Zone until the
next time.
Previous Page