logo
vbRad Home
Source Code
Book Reviews
Forum
Links
About Us
Contribute

Compare Databases with SQL Effects Clarity
 
 Convert Internet Date/Time formats to VB date

Posted on
10/17/2003
Author:
Robert Gelb
Email:
Not Shown
Applies To OS:
NT, 9x, 2000
Product:
5, 6



Download... the code. (4 kb)

There is a proliferation of date/time formats on the internet, egged on by competing standards, setup by various international standards organizations. These dates appears in email message headers, RSS feeds, etc... The two date/time standards that are used most often are defined as ISO8601 and RFC822.

Unfortunately, Visual Basic does not provide an automatic way to convert these formats into the native VB Date data type. The situation is made even more complicated because ISO8601 and RFC822 also include time zone information. So it is not enough to be able to parse out the time and date -- you also must convert the time zone information and figure out what it means to your local time.

Format Examples Notes
ISO8601 1997-07-16T19:20:30+01:00 or
1997-07-16T19:20:30Z
+01:00 means that the time zone is 1 hour ahead of GMT/UTC. Z after the time means GMT/UTC
RFC822 Tue, 23 Sep 2003 13:21:00 -07:00 or
Tue, 23 Sep 2003 13:21:00 GMT
-07:00 means that the time zone is 7 hour behind of GMT/UTC. GMT means GMT/UTC. There are other written time zone settings, but the code doesn't support them. Feel free to add support.


The code here parses these date formats, compares and applies the time zone information as it relates to your time zone and returns the result in Visual Basic Date data type. You can either download the code or copy and paste it from below into a module or class. Then simply call InternetTimeToVbLocalTime method. Note that project contains other really useful date/time routines, such as GetGmtTime (gets GMT time based on your local time), GetTimeHere (gets your local time based on the GMT time), GetTimeDifference (gets the difference in seconds between your local time and the GMT time). And finally, you can sleep well at night, knowing that daylight savings time changes around the world are all accounted for.

Add the following to Module or Class

Option Explicit

Private Type SYSTEMTIME
    wYear As Integer
    wMonth As Integer

    wDayOfWeek As Integer
    wDay As Integer
    wHour As Integer

    wMinute As Integer
    wSecond As Integer
    wMilliseconds As Integer

End Type

Private Type TIME_ZONE_INFORMATION
    Bias As Long
    StandardName(31) As Integer

    StandardDate As SYSTEMTIME
    StandardBias As Long
    DaylightName(31) As Integer
    DaylightDate As SYSTEMTIME
    DaylightBias As Long

End Type

Private Declare Function GetTimeZoneInformation _
	Lib "kernel32" (lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long

Private Const TIME_ZONE_ID_INVALID& = &HFFFFFFFF
Private Const TIME_ZONE_ID_STANDARD& = 1
Private Const TIME_ZONE_ID_UNKNOWN& = 0

Private Const TIME_ZONE_ID_DAYLIGHT& = 2


Private Declare Function InternetTimeToSystemTime Lib "wininet.dll" _
       (ByVal lpszTime As String, _
        ByRef pst As SYSTEMTIME, _
        ByVal dwReserved As Long) _
        As Long


Public Function GetGmtTime(Optional StartingDate As Variant) As Date 'Parameters: StartingDate (Optional). The function will figure 'out GMT time based on StartingDate 'If StartingDate is not provided, the current time will be used Dim Difference As Long Difference = GetTimeDifference() If IsMissing(StartingDate) Then 'use current time GetGmtTime = DateAdd("s", -Difference, Now) Else 'use StartingDate GetGmtTime = DateAdd("s", -Difference, StartingDate) End If End Function
Public Function GetTimeDifference() As Long 'Returns the time difference between 'local & GMT time in seconds. 'If the result is negative, your time zone 'lags behind GMT zone. 'If the result is positive, your time zone is ahead. Dim tz As TIME_ZONE_INFORMATION Dim retcode As Long Dim Difference As Long 'retrieve the time zone information retcode = GetTimeZoneInformation(tz) 'convert to seconds Difference = -tz.Bias * 60 'cache the result GetTimeDifference = Difference 'if we are in daylight saving time, apply the bias. If retcode = TIME_ZONE_ID_DAYLIGHT& Then If tz.DaylightDate.wMonth <> 0 Then 'if tz.DaylightDate.wMonth = 0 then the daylight 'saving time change doesn't occur GetTimeDifference = Difference - tz.DaylightBias * 60 End If End If End Function
Public Function GetTimeHere(gmtTime As Date) As Date 'Parameters: gmtTime - Provides the time & date 'from which to make calculations 'Returns the time in your local time zone 'which corresposponds to GMT time Dim Differerence As Long Differerence = GetTimeDifference() GetTimeHere = DateAdd("s", Differerence, gmtTime) End Function
Public Function InternetTimeToVbLocalTime(ByVal DateString As String) As Date 'Currently we process 2 formats 'Rfc822 and Iso8601 'Iso8601 is either 1997-07-16T19:20:30+01:00 (25 bytes) or 1997-07-16T19:20:30Z (20 bytes) 'Rfc822 is Tue, 23 Sep 2003 13:21:00 -07:00 (32 bytes) or Tue, 23 Sep 2003 13:21:00 GMT (29 bytes) 'The key difference is that Iso8661 time has a latin letter T in position 11 DateString = Trim$(DateString) If Mid$(DateString, 11, 1) = "T" Then InternetTimeToVbLocalTime = Iso8601TimeToLocalVbTime(DateString) Else InternetTimeToVbLocalTime = Rfc822TimeToLocalVbTime(DateString) End If End Function
Private Function Iso8601TimeToLocalVbTime(ByVal sIso8601 As String) As Date 'format of the time is similar to this: 1997-07-16T19:20:30+01:00 'or 1997-07-16T19:20:30Z or 2003-10-09T09:40:46Z 'where Z is UTC (aka GMT time) 'formatting breakdown ' 1012141618202224 ' 1997-07-16T19:20:30+01:00 ' 1234567891113151719212325 Dim sYear As String Dim sMonth As String Dim sDay As String Dim sHour As String Dim sMinute As String Dim sSecond As String Dim sTimeZone As String Dim dtDateTime As Date Dim bSign As Boolean Dim dGMT As Long sYear = Left$(sIso8601, 4) sMonth = Mid$(sIso8601, 6, 2) sDay = Mid$(sIso8601, 9, 2) sHour = Mid$(sIso8601, 12, 2) sMinute = Mid$(sIso8601, 15, 2) sSecond = Mid$(sIso8601, 18, 2) sTimeZone = Mid$(sIso8601, 20) dtDateTime = CDate(DateSerial(sYear, sMonth, sDay) & " " & _ TimeSerial(sHour, sMinute, sSecond)) 'replace Z with +00:00 for easier processing sTimeZone = Replace(sTimeZone, "Z", "+00:00", , , vbTextCompare) 'get the size bSign = IIf(Left$(sTimeZone, 1) = "+", True, False) 'grab the hour & minutes dGMT = Val(Mid$(sTimeZone, Len(sTimeZone) - 3, 2)) + (CInt(Right$(sTimeZone, 2)) * 100 / 60) If bSign Then dtDateTime = DateAdd("H", -dGMT, dtDateTime) Else dtDateTime = DateAdd("H", dGMT, dtDateTime) End If Iso8601TimeToLocalVbTime = GetTimeHere(dtDateTime) End Function
Private Function Rfc822TimeToLocalVbTime(sRfc822 As String) As Date Dim uSystemTime As SYSTEMTIME Dim sWWW As String Dim iHours As Integer Dim dGMT As Long Dim sHourDifferential As String Dim dtDateTime As Date Dim sSign As String Dim bSign As Boolean Dim sEscapedTime As String Dim sTimeZoneString As String Dim iPos As Integer 'true = positive 'false = negative '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ sWWW = sRfc822 If InStr(1, sWWW, "GMT", vbTextCompare) > 0 Then sWWW = Replace(sWWW, "GMT", "+0000") End If 'check to make sure that the time zone is included If Len(Trim$(sWWW)) = 25 Then 'add time zone sWWW = sWWW & " +0000" End If If (InStr(1, sWWW, ",") = 0) Then sWWW = "Thu, " & sWWW Call InternetTimeToSystemTime(sWWW, uSystemTime, 0&) With uSystemTime dtDateTime = CDate(DateSerial(.wYear, .wMonth, .wDay) & " " & _ TimeSerial(.wHour, .wMinute, .wSecond)) End With 'get the sign from the back end 'remove colons, in case the time is 07:00 instead of 0700 sEscapedTime = Replace(sWWW, ":", "") sSign = Mid$(sEscapedTime, Len(sEscapedTime) - 4, 1) bSign = IIf(sSign = "-", False, True) 'grab the hour & minutes iPos = InStrRev(sWWW, " ") If iPos > 0 Then 'get rid of the space and the +/- sign sTimeZoneString = Mid$(sWWW, iPos + 2) 'escape it sTimeZoneString = Replace(sTimeZoneString, ":", "") sTimeZoneString = Replace(sTimeZoneString, " ", "") 'at this point we should have the following: 0700 dGMT = Val(Left$(sTimeZoneString, 2)) + Val(Right$(sWWW, 2)) * 100 / 60 'dGMT = Val(Mid$(sWWW, Len(sWWW) - 3, 2)) + (CInt(Right$(sWWW, 2)) * 100 / 60) Else dGMT = 0 End If If bSign Then dtDateTime = DateAdd("H", -dGMT, dtDateTime) Else dtDateTime = DateAdd("H", dGMT, dtDateTime) End If Rfc822TimeToLocalVbTime = GetTimeHere(dtDateTime) End Function

Download... the code. (4 kb)





Add Your Comment  

Name: Email Address: all fields optional
Notify me via email when someone responds to this message (valid email required).

Enter the word:
 



Comments
#1. By eryck. Posted on 3/23/2006 4:11:17 AM
what is the maennig of time in time out for visul basic 0.6

#2. By will. Posted on 5/9/2006 10:10:33 AM
Thanx for confusing me.

#3. By ashadchempakath. Posted on 6/22/2006 6:15:55 PM
nice but more complicated

#4. By Tim. Posted on 11/7/2006 7:06:30 PM
This is flawed. GetTimeDifference returns the time difference for the current date, but InternetTimeToVbLocalTime can be called with a date in the past or future that is not under the same daylight savings time.

So, given a random GMT, InternetTimeToVbLocalTime will be off by 1 hour about 50% of the time.

#5. By Tim. Posted on 11/7/2006 7:20:16 PM
Here is some same code that uses SystemTimeToTzSpecificLocalTime to get the correct time.

http://www.freevbcode.com/ShowCode.asp?ID=6774

#6. By myk. Posted on 3/9/2007 7:52:07 AM
good day.i want help from u.Please help us with our project.we need visual basic codes for daily time record sytem
help us pls

thank so much!!

#7. By Ashish. Posted on 5/10/2007 5:21:52 AM
Great post!! fantastic!! it really works wonders. Thank you for posting.

#8. By Alan. Posted on 5/25/2007 1:15:15 AM
Looks good - Worked for me... Thanks....

#9. By Joe. Posted on 7/16/2007 9:54:30 AM
Thank you very much, that helped me a great deal!

#10. By Rob. Posted on 8/10/2007 2:01:07 PM
Absolutely spot on, thanks very much for posting.

I added the following function to make it perfect for me:
Public Function GetMYSQLTimeDate(ByVal TimeDate As String) As String
GetMYSQLTimeDate = Mid(TimeDate, 7, 4) & "-" & Mid(TimeDate, 4, 2) & "-" & Left(TimeDate, 2) & _
" " & Right(TimeDate, 8)
End Function
Then call it as:
mySQLDateTime = GetMYSQLTimeDate(InternetTimeToVbLocalTime(EmailDateTime))

This gives me a date time string compatible to put straight in my mySql database DATETIME field.

Thanks again

#11. By gaurav Sharma. Posted on 12/2/2007 3:43:46 AM
Can anybody tellme a function so that i can compare two given times in minutes i.e. which one is big and by how many minutes//

#12. By senthil. Posted on 12/30/2007 12:31:32 PM
How to convert string to date format . for example 30Dec07 to 30/12/2007

please replay solution ...urgent

#13. By Linn. Posted on 2/18/2008 8:56:38 AM
can't download the code.

#14. By Ravi. Posted on 4/24/2008 5:35:20 AM
This is excellent and helped me a lot

#15. By Bimal. Posted on 7/4/2008 2:49:05 AM
I want to convert Nepali date in to English Date. I can't get the accurate result.

#16. By Bimal. Posted on 7/4/2008 2:50:18 AM
I want to convert Nepali date in to English Date. I can't get the accurate result. It is a great problem for me. Help me please..

#17. By c d sharma. Posted on 8/5/2008 9:54:37 AM
I am on network. I have 7 node and a Server. I want Server Current Date & Time At Data Saving On Node.

#18. By Chris. Posted on 8/20/2008 10:49:14 PM
Thanks for your help :)

Great post.

Chris

#19. By cgr. Posted on 10/13/2009 1:50:43 PM
This does not take into account opther time zones
I have added code to include others (not exclusive)
REPLACE
If InStr(1, sWWW, "GMT", vbTextCompare) > 0 Then
sWWW = Replace(sWWW, "GMT", "+0000")
End if

WITH

If InStr(1, sWWW, "GMT", vbTextCompare) > 0 Then
sWWW = Replace(sWWW, "GMT", "+0000")
ElseIf InStr(1, sWWW, "UT", vbTextCompare) > 0 Then
sWWW = Replace(sWWW, "UT", "+0000")
ElseIf InStr(1, sWWW, "EST", vbTextCompare) > 0 Then
sWWW = Replace(sWWW, "EST", "-0500")
ElseIf InStr(1, sWWW, "EDT", vbTextCompare) > 0 Then
sWWW = Replace(sWWW, "EDT", "-0400")
ElseIf InStr(1, sWWW, "CST", vbTextCompare) > 0 Then
sWWW = Replace(sWWW, "CST", "-0600")
ElseIf InStr(1, sWWW, "CDT", vbTextCompare) > 0 Then
sWWW = Replace(sWWW, "CDT", "-0500")
ElseIf InStr(1, sWWW, "MST", vbTextCompare) > 0 Then
sWWW = Replace(sWWW, "MST", "-0700")
ElseIf InStr(1, sWWW, "MDT", vbTextCompare) > 0 Then
sWWW = Replace(sWWW, "MDT", "-0600")
ElseIf InStr(1, sWWW, "PST", vbTextCompare) > 0 Then
sWWW = Replace(sWWW, "PST", "-0800")
ElseIf InStr(1, sWWW, "PDT", vbTextCompare) > 0 Then
sWWW = Replace(sWWW, "PDT", "-0700")
ElseIf InStr(1, sWWW, " Z", vbTextCompare) > 0 Then
sWWW = Replace(sWWW, " Z", " +0000")
ElseIf InStr(1, sWWW, " A", vbTextCompare) > 0 Then
sWWW = Replace(sWWW, " A", "-0100")
ElseIf InStr(1, sWWW, " M", vbTextCompare) > 0 Then
sWWW = Replace(sWWW, " M", "-1200")
ElseIf InStr(1, sWWW, " N", vbTextCompare) > 0 Then
sWWW = Replace(sWWW, " N", "+0100")
ElseIf InStr(1, sWWW, " Y", vbTextCompare) > 0 Then
sWWW = Replace(sWWW, " Y", "+1200")
ElseIf InStr(1, sWWW, "EET", vbTextCompare) > 0 Then
sWWW = Replace(sWWW, "EET", "+0200")
ElseIf InStr(1, sWWW, "CET", vbTextCompare) > 0 Then
sWWW = Replace(sWWW, "CET", "+0100")
ElseIf InStr(1, sWWW, "AEDT", vbTextCompare) > 0 Then
sWWW = Replace(sWWW, "AEDT", "+1100")
ElseIf InStr(1, sWWW, "AEST", vbTextCompare) > 0 Then
sWWW = Replace(sWWW, "AEST", "+1000")
ElseIf InStr(1, sWWW, "ACDT", vbTextCompare) > 0 Then
sWWW = Replace(sWWW, "ACDT", "+1030")
ElseIf InStr(1, sWWW, "ACST", vbTextCompare) > 0 Then
sWWW = Replace(sWWW, "ACST", "+0930")
ElseIf InStr(1, sWWW, "AWDT", vbTextCompare) > 0 Then
sWWW = Replace(sWWW, "AWDT", "+0900")
ElseIf InStr(1, sWWW, "AWST", vbTextCompare) > 0 Then
sWWW = Replace(sWWW, "AWST", "+0800")
ElseIf InStr(1, sWWW, "BST", vbTextCompare) > 0 Then
sWWW = Replace(sWWW, "BST", "+0100")
ElseIf InStr(1, sWWW, "WET", vbTextCompare) > 0 Then
sWWW = Replace(sWWW, "WET", "+0000")
ElseIf InStr(1, sWWW, "UTC", vbTextCompare) > 0 Then
sWWW = Replace(sWWW, "UTC", "+0000")
ElseIf InStr(1, sWWW, "EET", vbTextCompare) > 0 Then
sWWW = Replace(sWWW, "EET", "+0200")
ElseIf InStr(1, sWWW, "EET", vbTextCompare) > 0 Then
sWWW = Replace(sWWW, "EET", "+0200")
ElseIf InStr(1, sWWW, "EET", vbTextCompare) > 0 Then
sWWW = Replace(sWWW, "EET", "+0200")
End If