From 26bf0308b8b592f8a10f198d33a811c4d92a5f21 Mon Sep 17 00:00:00 2001 From: Hecon5 <54177882+hecon5@users.noreply.github.com> Date: Wed, 15 Nov 2023 12:46:13 -0500 Subject: [PATCH 1/5] Revert the ConvDateUTC and ConvTimeUTC functions to always parse the "Fast" way first and revert otherwise. this allows the optimization to be used everywhere with no code changes. Ensure that millisecond accuracy is kept for otherse using the function. No Speed impact is noted on my end to doing this. --- .../modules/modUtcConverter.bas | 33 ++++++++++--------- 1 file changed, 18 insertions(+), 15 deletions(-) diff --git a/Version Control.accda.src/modules/modUtcConverter.bas b/Version Control.accda.src/modules/modUtcConverter.bas index a632f023..d6ffb21f 100644 --- a/Version Control.accda.src/modules/modUtcConverter.bas +++ b/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 @@ -713,28 +713,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 +773,8 @@ Private Function ConvDateUTC(ByVal InVal As String) As Date End If End With - ConvDateUTC = RetVal + ConvDateUTC2 = RetVal + End Function @@ -784,29 +785,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(ByVal InVal As String) As Date Dim varParts As Variant + Dim SecondsInPart 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)) + SecondsInPart = Mid(varParts(2), 1, Len(varParts(2)) - 1) + ConvTimeUTC = TimeSerialDbl(varParts(0), varParts(1), SecondsInPart) 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 +842,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 From 19618005aba52534befe1602ff9e6ac67d51f66b Mon Sep 17 00:00:00 2001 From: Hecon5 <54177882+hecon5@users.noreply.github.com> Date: Wed, 15 Nov 2023 12:31:57 -0500 Subject: [PATCH 2/5] Pass by ref so we don't need to build more memory use. Optimize Offset string building to only do math when it's required and fix whitespace. --- .../modules/modUtcConverter.bas | 57 ++++++++++++------- 1 file changed, 38 insertions(+), 19 deletions(-) diff --git a/Version Control.accda.src/modules/modUtcConverter.bas b/Version Control.accda.src/modules/modUtcConverter.bas index d6ffb21f..ed4ff8ca 100644 --- a/Version Control.accda.src/modules/modUtcConverter.bas +++ b/Version Control.accda.src/modules/modUtcConverter.bas @@ -644,6 +644,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 +678,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,10 +695,13 @@ 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) + _ @@ -703,6 +709,7 @@ Private Function utc_SystemTimeToDate(ByRef utc_Value As utc_SYSTEMTIME) As Date , utc_Value.utc_wMinute _ , utc_Value.utc_wSecond _ , utc_Value.utc_wMilliseconds) + End Function @@ -872,9 +879,11 @@ 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 @@ -882,10 +891,13 @@ Public Function TimeSerialDbl(ByVal HoursIn As Double _ 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. @@ -907,6 +919,7 @@ Private Function GetMilliseconds(ByVal TimeIn As Double) As Variant MSCount = ((DblMS * (TotalMillisecondsInDay))) \ 1 If MSCount >= 1000 Then MSCount = 0 GetMilliseconds = MSCount + End Function @@ -942,13 +955,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) @@ -961,40 +976,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 From 0ef2d027693b774394b675eb49d03ad8cba84ad2 Mon Sep 17 00:00:00 2001 From: Hecon5 <54177882+hecon5@users.noreply.github.com> Date: Wed, 15 Nov 2023 12:32:52 -0500 Subject: [PATCH 3/5] Cache the format types instead of needing to build them every time. --- .../modules/modUtcConverter.bas | 34 +++++++++++++++---- 1 file changed, 27 insertions(+), 7 deletions(-) diff --git a/Version Control.accda.src/modules/modUtcConverter.bas b/Version Control.accda.src/modules/modUtcConverter.bas index ed4ff8ca..77015a02 100644 --- a/Version Control.accda.src/modules/modUtcConverter.bas +++ b/Version Control.accda.src/modules/modUtcConverter.bas @@ -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 From 732f4e5564ced7fcad66d70c00f8609195d3ca0c Mon Sep 17 00:00:00 2001 From: Hecon5 <54177882+hecon5@users.noreply.github.com> Date: Wed, 15 Nov 2023 12:53:14 -0500 Subject: [PATCH 4/5] Bump Version --- Version Control.accda.src/dbs-properties.json | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Version Control.accda.src/dbs-properties.json b/Version Control.accda.src/dbs-properties.json index 76c27ef6..340b7a82 100644 --- a/Version Control.accda.src/dbs-properties.json +++ b/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": { From 500b891d1d91e841de71ca2b2b3316241a2f9d4a Mon Sep 17 00:00:00 2001 From: Hecon5 <54177882+hecon5@users.noreply.github.com> Date: Wed, 15 Nov 2023 12:57:37 -0500 Subject: [PATCH 5/5] Verify consistent naming and byref passing of strings --- Version Control.accda.src/modules/modUtcConverter.bas | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/Version Control.accda.src/modules/modUtcConverter.bas b/Version Control.accda.src/modules/modUtcConverter.bas index 77015a02..2e45c59e 100644 --- a/Version Control.accda.src/modules/modUtcConverter.bas +++ b/Version Control.accda.src/modules/modUtcConverter.bas @@ -812,16 +812,16 @@ End Function ' Purpose : Attempt a higher performance conversion first, then fall back to RegEx. '--------------------------------------------------------------------------------------- ' -Private Function ConvTimeUTC(ByVal InVal As String) As Date +Private Function ConvTimeUTC(ByRef InVal As String) As Date Dim varParts As Variant - Dim SecondsInPart As String + Dim InValSeconds As String If InVal Like "##:##:##.###Z" Then ' Use high-performance conversion to date varParts = Split(InVal, ":") - SecondsInPart = Mid(varParts(2), 1, Len(varParts(2)) - 1) - ConvTimeUTC = TimeSerialDbl(varParts(0), varParts(1), SecondsInPart) + InValSeconds = Mid(varParts(2), 1, Len(varParts(2)) - 1) + ConvTimeUTC = TimeSerialDbl(varParts(0), varParts(1), InValSeconds) Else ' Fall back to slower RegEx function ConvTimeUTC = ConvTimeUTC2(InVal)