VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CInetTime"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
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

Private 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

Private 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

Private 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
    '       123456789 1113151719212325

    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))

    If Len(sTimeZone) > 0 Then
        '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
    Else
        dtDateTime = DateAdd("S", -GetTimeDifference(), 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

Public Function VbLocalTimeToInternetTime(ByVal dt As Date, ByVal fmt As String) As String
    Dim diff As Long
    
    diff = GetTimeDifference()
    
    If fmt = "iso8601" Then
        VbLocalTimeToInternetTime = _
            format(DateValue(dt), "yyyy-mm-dd") & "T" & _
            format(TimeValue(dt), "hh:nn:ss") & _
            IIf(Sgn(diff) < 0, "-", "+") & format(DateAdd("s", Abs(diff), TimeSerial(0, 0, 0)), "hh:nn")
    Else
        Call Err.Raise(-1, , "Unsupported time format.")
    End If
End Function
