Additional Optimizations for parsing time

Version Control.accda.src/dbs-properties.json

@@ -41,7 +41,7 @@
       "Type": 10
     },
     "AppVersion": {
-      "Value": "4.0.26",
+      "Value": "4.0.27",
       "Type": 10
     },
     "Auto Compact": {

Version Control.accda.src/modules/modUtcConverter.bas

@@ -466,14 +466,14 @@ Public Function ParseIso(utc_IsoString As String _
     Exit Function
 #Else
     If UBound(utc_Parts) > 0 Then
-        utc_DateTimeOut = ConvDateUTC2(utc_Parts(0)) + ConvTimeUTC2(utc_Parts(1))
+        utc_DateTimeOut = ConvDateUTC(utc_Parts(0)) + ConvTimeUTC(utc_Parts(1))
         If Not OutputUTCDate Then
             ParseIso = ConvertToLocalDate(utc_DateTimeOut)
         Else
             ParseIso = utc_DateTimeOut
         End If
     Else ' Assume any "Date Only" Text doesn't have a timezone (they aren't converted the other way, either)
-        ParseIso = ConvDateUTC2(utc_Parts(0))
+        ParseIso = ConvDateUTC(utc_Parts(0))
     End If
     Exit Function
 #End If
@@ -563,18 +563,38 @@ Public Function ConvertToISO8601Time(ByVal DateIn As Date _
     End If
 
     ConvertToISO8601Time = String_BufferToString(tString_Buffer)
+
 End Function
 
 
 ' Provides a format string to other functions that complies with ISO8601
-Private Function ISOTimeFormatStr(Optional IncludeMilliseconds As Boolean = False _
-                                , Optional includeTimeZone As Boolean = False) As String
-    Dim tString_Buffer As StringBufferCache
+Public Function ISOTimeFormatStr(Optional ByVal IncludeMilliseconds As Boolean = False _
+                                , Optional ByVal IncludeTimeZonePart As Boolean = False _
+                                , Optional ByVal IncludeLocalTimeZone As Boolean = False) As String
+
+    Static f_dFormatString As Scripting.Dictionary
+
+    Dim DictPosition As Long
+
+    If f_dFormatString Is Nothing Then Set f_dFormatString = New Scripting.Dictionary
+
+    DictPosition = (4 And IncludeMilliseconds) + (2 And IncludeTimeZonePart) + (1 And IncludeLocalTimeZone)
+
+    If Not f_dFormatString.Exists(DictPosition) Then
+        With New clsConcat
+            .Add "yyyy-mm-ddTHH:mm:ss"
+            If IncludeMilliseconds Then .Add ".000"
+            If IncludeTimeZonePart And IncludeLocalTimeZone Then
+                .Add CurrentISOTimezoneOffset
+            ElseIf IncludeTimeZonePart Then
+                .Add ISO8601UTCTimeZone
+            End If
+            f_dFormatString.Add DictPosition, .GetStr
+        End With
+    End If
+
+    ISOTimeFormatStr = f_dFormatString.Item(DictPosition)
 
-    String_BufferAppend tString_Buffer, "yyyy-mm-ddTHH:mm:ss"
-    If IncludeMilliseconds Then String_BufferAppend tString_Buffer, ".000"
-    If includeTimeZone Then String_BufferAppend tString_Buffer, ISOTimezoneOffset
-    ISOTimeFormatStr = String_BufferToString(tString_Buffer)
 End Function
 
 
@@ -644,6 +664,7 @@ Private Function utc_ConvertDate(utc_Value As Double _
     End If
 End Function
 
+
 Private Function utc_ExecuteInShell(utc_ShellCommand As String) As utc_ShellResult
 #If VBA7 Then
     ' 64bit Mac
@@ -677,8 +698,10 @@ End Function
 #Else
 ' Windows
 
+
 ' Pass in a date, this will return a Windows SystemTime structure with millisecond accuracy.
 Private Function utc_DateToSystemTime(ByRef utc_Value As Date) As utc_SYSTEMTIME ' "Helper Functions
+
     With utc_DateToSystemTime
         .utc_wYear = VBA.Year(utc_Value)
         .utc_wMonth = VBA.Month(utc_Value)
@@ -692,17 +715,21 @@ Private Function utc_DateToSystemTime(ByRef utc_Value As Date) As utc_SYSTEMTIME
             .utc_wSecond = VBA.Second(utc_Value)
         End If
     End With
+
 End Function
 
 
-Private Function utc_SystemTimeToDate(ByRef utc_Value As utc_SYSTEMTIME) As Date ' "Helper Function" for Public Functions (below)
+Private Function utc_SystemTimeToDate(ByRef utc_Value As utc_SYSTEMTIME) As Date
+' "Helper Function" for Public Functions (below)
+
     utc_SystemTimeToDate = DateSerial(utc_Value.utc_wYear _
                                     , utc_Value.utc_wMonth _
                                     , utc_Value.utc_wDay) + _
                             TimeSerialDbl(utc_Value.utc_wHour _
                                         , utc_Value.utc_wMinute _
                                         , utc_Value.utc_wSecond _
                                         , utc_Value.utc_wMilliseconds)
+
 End Function
 
 
@@ -713,28 +740,28 @@ End Function
 ' Purpose   : Attempt a higher performance conversion first, then fall back to RegEx.
 '---------------------------------------------------------------------------------------
 '
-Private Function ConvDateUTC2(ByVal InVal As String) As Date
+Private Function ConvDateUTC(ByRef InVal As String) As Date
 
     Dim varParts As Variant
 
     If InVal Like "####-##-##" Then
         ' Use high-performance conversion to date
         varParts = Split(InVal, "-")
-        ConvDateUTC2 = DateSerial(varParts(0), varParts(1), varParts(2))
+        ConvDateUTC = DateSerial(varParts(0), varParts(1), varParts(2))
     Else
         ' Fall back to slower RegEx function
-        ConvDateUTC2 = ConvDateUTC(InVal)
+        ConvDateUTC = ConvDateUTC2(InVal)
     End If
 
 End Function
 
 
-Private Function ConvDateUTC(ByVal InVal As String) As Date
+Private Function ConvDateUTC2(ByRef InVal As String) As Date
+
     Dim RetVal As Variant
+    Dim RegEx As New RegExp ' Object
 
-'    Dim RegEx As Object
 '    Set RegEx = CreateObject("VBScript.RegExp")
-    Dim RegEx As New RegExp
     With RegEx
         .Global = True
         .Multiline = True
@@ -773,7 +800,8 @@ Private Function ConvDateUTC(ByVal InVal As String) As Date
         End If
     End With
 
-    ConvDateUTC = RetVal
+    ConvDateUTC2 = RetVal
+
 End Function
 
 
@@ -784,29 +812,30 @@ End Function
 ' Purpose   : Attempt a higher performance conversion first, then fall back to RegEx.
 '---------------------------------------------------------------------------------------
 '
-Private Function ConvTimeUTC2(ByVal InVal As String) As Date
+Private Function ConvTimeUTC(ByRef InVal As String) As Date
 
     Dim varParts As Variant
+    Dim InValSeconds As String
 
     If InVal Like "##:##:##.###Z" Then
         ' Use high-performance conversion to date
         varParts = Split(InVal, ":")
-        ConvTimeUTC2 = TimeSerial(varParts(0), varParts(1), Left(varParts(2), 2))
+        InValSeconds = Mid(varParts(2), 1, Len(varParts(2)) - 1)
+        ConvTimeUTC = TimeSerialDbl(varParts(0), varParts(1), InValSeconds)
     Else
         ' Fall back to slower RegEx function
-        ConvTimeUTC2 = ConvTimeUTC(InVal)
+        ConvTimeUTC = ConvTimeUTC2(InVal)
     End If
 
 End Function
 
 
-Private Function ConvTimeUTC(ByRef InVal As String) As Date
+Private Function ConvTimeUTC2(ByRef InVal As String) As Date
 
     Dim dblHours As Double
     Dim dblMinutes As Double
     Dim dblSeconds As Double
     Dim dblMilliseconds As Double
-
     Dim RegEx As New RegExp ' Object
     'Set RegEx = CreateObject("VBScript.RegExp")
 
@@ -840,10 +869,11 @@ Private Function ConvTimeUTC(ByRef InVal As String) As Date
         dblSeconds = CDbl(NzEmpty(.SubMatches(2), vbNullString))
     End With
 
-    ConvTimeUTC = TimeSerialDbl(dblHours, dblMinutes, dblSeconds)
+    ConvTimeUTC2 = TimeSerialDbl(dblHours, dblMinutes, dblSeconds)
 
 End Function
 
+
 Private Function NzEmpty(ByVal Value As Variant, Optional ByVal value_when_null As Variant = 0) As Variant
 
     Dim return_value As Variant
@@ -869,20 +899,25 @@ Public Function TimeSerialDbl(ByVal HoursIn As Double _
                             , ByVal MinutesIn As Double _
                             , ByVal SecondsIn As Double _
                             , Optional ByVal MillisecondsIn As Double = 0) As Double
+
     Dim tMS As Double
     Dim tSec As Double
     Dim tSecTemp As Double
+
     tSec = VBA.CDbl(RoundDown(SecondsIn))
     tSecTemp = SecondsIn - tSec
     tMS = (tSecTemp * (TotalMillisecondsInDay / TotalSecondsInDay)) \ 1
     tMS = tMS + MillisecondsIn
     If (tSecTemp > 0.5) Then tSec = tSec - 1
     If tMS = 500 Then tMS = tMS - 0.001 ' Shave a hair, because otherwise it'll round up too much.
     TimeSerialDbl = (HoursIn / TotalHoursInDay) + (MinutesIn / TotalMinutesInDay) + CDbl((tSec / TotalSecondsInDay)) + (tMS / TotalMillisecondsInDay)
+
 End Function
 
+
 ' If given a time double, will return the millisecond portion of the time.
-Private Function GetMilliseconds(ByVal TimeIn As Double) As Variant
+Private Function GetMilliseconds(ByRef TimeIn As Date) As Variant
+
     Dim IntDatePart As Long
     Dim DblTimePart As Double
     Dim LngSeconds As Long ' Used to remove whole seconds.
@@ -904,6 +939,7 @@ Private Function GetMilliseconds(ByVal TimeIn As Double) As Variant
     MSCount = ((DblMS * (TotalMillisecondsInDay))) \ 1
     If MSCount >= 1000 Then MSCount = 0
     GetMilliseconds = MSCount
+
 End Function
 
 
@@ -939,13 +975,15 @@ Public Function CurrentLocalBiasFromUTC(Optional ByVal OutputAsHours As Boolean
 
 End Function
 
+
 Public Function CurrentISOTimezoneOffset() As String
     CurrentISOTimezoneOffset = ISOTimezoneOffset(CurrentLocalBiasFromUTC)
 End Function
 
 
-Public Function GetBiasForGivenLocalDate(ByVal LocalDateIn As Date _
+Public Function GetBiasForGivenLocalDate(ByRef LocalDateIn As Date _
                                         , Optional ByVal OutputAsHours As Boolean = False) As Long
+
     Dim DateUTCNow As Date
 
     DateUTCNow = ConvertToUtc(LocalDateIn)
@@ -958,40 +996,44 @@ Public Function GetBiasForGivenLocalDate(ByVal LocalDateIn As Date _
     Else
         GetBiasForGivenLocalDate = VBA.DateDiff("h", LocalDateIn, DateUTCNow)
     End If
+
 End Function
 
+
 Public Function ISOTimezoneOffsetOnDate(ByVal LocalDateIn As Date) As String
     ISOTimezoneOffsetOnDate = ISOTimezoneOffset(GetBiasForGivenLocalDate(LocalDateIn))
 End Function
 
 
 ' Provides the ISO Offset time from an input (or current offset if none is passed in) to build an ISO8601 output String
+'
 Private Function ISOTimezoneOffset(Optional TimeBias As Long = 0) As String
 
-    Dim strOffsetOut As String
-
-    Dim tString_Buffer As StringBufferCache
-
     Dim OffsetLong As Long
     Dim hourOffset As Long
     Dim minOffset As Long
 
-    ' Counterintuitively, the Bias is postive (time ahead), the offset is the negative value of bias.
-    OffsetLong = TimeBias * -1
-
-    hourOffset = OffsetLong \ 60
-    minOffset = OffsetLong Mod 60
+    If TimeBias = 0 Then
 
-    If OffsetLong = 0 Then
         ISOTimezoneOffset = ISO8601UTCTimeZone
-    Else
-        If OffsetLong > 0 Then String_BufferAppend tString_Buffer, "+"
-        String_BufferAppend tString_Buffer, VBA.CStr(VBA.Format(hourOffset, "00"))
-        String_BufferAppend tString_Buffer, ISO8601TimeDelimiter
-        String_BufferAppend tString_Buffer, VBA.CStr(VBA.Format(minOffset, "00"))
 
-        ISOTimezoneOffset = String_BufferToString(tString_Buffer)
+    Else
+        ' Counterintuitively, the Bias is postive (time ahead),
+        ' and the offset is the negative value of bias.
+        OffsetLong = TimeBias * -1
+        hourOffset = OffsetLong \ 60
+        minOffset = OffsetLong Mod 60
+
+        With New clsConcat
+            If OffsetLong > 0 Then .Add "+"
+            .Add VBA.CStr(VBA.Format(hourOffset, "00"))
+            .Add ISO8601TimeDelimiter
+            .Add VBA.CStr(VBA.Format(minOffset, "00"))
+
+            ISOTimezoneOffset = .GetStr
+        End With
     End If
+
 End Function