diff --git a/Version Control.accda.src/dbs-properties.json b/Version Control.accda.src/dbs-properties.json index a4853bdb..58b40237 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.25", + "Value": "4.1.0", "Type": 10 }, "Auto Compact": { diff --git a/Version Control.accda.src/modules/clsOptions.cls b/Version Control.accda.src/modules/clsOptions.cls index 9769b4f8..915d11ac 100644 --- a/Version Control.accda.src/modules/clsOptions.cls +++ b/Version Control.accda.src/modules/clsOptions.cls @@ -654,6 +654,7 @@ Private Sub Class_Initialize() ' Other run-time options JsonOptions.AllowUnicodeChars = True + JsonOptions.ConvertDateToIso = True End Sub diff --git a/Version Control.accda.src/modules/clsVCSIndex.cls b/Version Control.accda.src/modules/clsVCSIndex.cls index 837a3ce1..396e42e6 100644 --- a/Version Control.accda.src/modules/clsVCSIndex.cls +++ b/Version Control.accda.src/modules/clsVCSIndex.cls @@ -118,7 +118,7 @@ Public Sub Save(Optional strInFolder As String) varValue = CallByName(Me, CStr(varKey), VbGet) ' Save blank dates as null If Right(varKey, 4) = "Date" Then - m_dIndex(varKey) = ZNDate(CStr(varValue)) + m_dIndex(varKey) = ZNDate(varValue) Else m_dIndex(varKey) = CStr(varValue) End If @@ -222,14 +222,14 @@ Public Function Update(cItem As IDbComponent, intAction As eIndexOperationType, If dteDateTime = 0 Then dteDateTime = Now Select Case intAction Case eatExport, eatAltExport - .Item("ExportDate") = CStr(dteDateTime) + .Item("ExportDate") = dteDateTime Case eatImport - .Item("ImportDate") = CStr(dteDateTime) + .Item("ImportDate") = dteDateTime End Select ' Save timestamp of exported source file. dteDateTime = GetLastModifiedDate(cItem.SourceFile) - .Item("SourceModified") = ZNDate(CStr(dteDateTime)) + .Item("SourceModified") = ZNDate(dteDateTime) ' Save hash of file properties .Item("FilePropertiesHash") = GetFilePropertyHash(cItem.SourceFile) @@ -494,7 +494,7 @@ Public Function GetModifiedSourceFiles(cCategory As IDbComponent) As Dictionary strPath = Join(Array("Components", cCategory.Category, FSO.GetFileName(strFile), "SourceModified"), PathSep) ' Compare modified date of file with modified date in index. ' File is considered not modified if the index date matches the file modification date. - blnModified = Not (dNZ(m_dIndex, strPath) = CStr(GetLastModifiedDate(strFile))) + blnModified = Not (dNZ(m_dIndex, strPath) = GetLastModifiedDate(strFile)) End If ' Add modified files to collection If blnModified Then .Add strFile, vbNullString diff --git a/Version Control.accda.src/modules/modJsonConverter.bas b/Version Control.accda.src/modules/modJsonConverter.bas index 1fe4fba9..d7c0ea7b 100644 --- a/Version Control.accda.src/modules/modJsonConverter.bas +++ b/Version Control.accda.src/modules/modJsonConverter.bas @@ -157,6 +157,10 @@ Private Type json_Options ' The solidus (/) is not required to be escaped, use this option to escape them as \/ in ConvertToJson EscapeSolidus As Boolean + ' Before version 2.3.1 dates were converted to UTC in ConvertToJson method, but not when json was parsed. + ' Convert datetime values to UTC/ISO8601 (false, slower) or dont change local <-> global times (true, faster) + ConvertDateToIso As Boolean + ' Allow Unicode characters in JSON text. Set to True to use native Unicode or false for escaped values. AllowUnicodeChars As Boolean End Type @@ -240,11 +244,16 @@ Public Function ConvertToJson(ByVal JsonValue As Variant, Optional ByVal Whitesp Select Case VBA.VarType(JsonValue) Case VBA.vbNull ConvertToJson = "null" + Case VBA.vbDate ' Date - json_DateStr = ConvertToIso(VBA.CDate(JsonValue)) - + If JsonOptions.ConvertDateToIso Then + json_DateStr = ConvertToIsoTime(VBA.CDate(JsonValue)) + Else + json_DateStr = VBA.CStr(JsonValue) + End If ConvertToJson = """" & json_DateStr & """" + Case VBA.vbString ' String (or large number encoded as string) If Not JsonOptions.UseDoubleForLargeNumbers And json_StringIsLargeNumber(JsonValue) Then @@ -556,7 +565,9 @@ Private Function json_ParseValue(json_String As String, ByRef json_Index As Long End Select End Function -Private Function json_ParseString(json_String As String, ByRef json_Index As Long) As String +Private Function json_ParseString(ByRef json_String As String _ + , ByRef json_Index As Long) As Variant + Dim json_Quote As String Dim json_Char As String Dim json_Code As String @@ -609,6 +620,10 @@ Private Function json_ParseString(json_String As String, ByRef json_Index As Lon End Select Case json_Quote json_ParseString = json_BufferToString(json_Buffer, json_BufferPosition) + If JsonOptions.ConvertDateToIso Then ' Only convert and test for condition if needed for speed boost. + If (json_ParseString Like "####-##-##T##:##:##*") Then _ + json_ParseString = ParseIso(VBA.CStr$(json_ParseString)) ' Return as a date + End If json_Index = json_Index + 1 Exit Function Case Else @@ -881,265 +896,7 @@ Private Function json_BufferToString(ByRef json_Buffer As String, ByVal json_Buf End If End Function -'' -' VBA-UTC v1.0.6 -' (c) Tim Hall - https://github.com/VBA-tools/VBA-UtcConverter -' -' UTC/ISO 8601 Converter for VBA -' -' Errors: -' 10011 - UTC parsing error -' 10012 - UTC conversion error -' 10013 - ISO 8601 parsing error -' 10014 - ISO 8601 conversion error -' -' @module UtcConverter -' @author tim.hall.engr@gmail.com -' @license MIT (http://www.opensource.org/licenses/mit-license.php) -'' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' - -' (Declarations moved to top) - -' ============================================= ' -' Public Methods -' ============================================= ' - -'' -' Parse UTC date to local date -' -' @method ParseUtc -' @param {Date} UtcDate -' @return {Date} Local date -' @throws 10011 - UTC parsing error -'' -Public Function ParseUtc(utc_UtcDate As Date) As Date - On Error GoTo utc_ErrorHandling - -#If Mac Then - ParseUtc = utc_ConvertDate(utc_UtcDate) -#Else - Dim utc_TimeZoneInfo As utc_TIME_ZONE_INFORMATION - Dim utc_LocalDate As utc_SYSTEMTIME - - utc_GetTimeZoneInformation utc_TimeZoneInfo - utc_SystemTimeToTzSpecificLocalTime utc_TimeZoneInfo, utc_DateToSystemTime(utc_UtcDate), utc_LocalDate - - ParseUtc = utc_SystemTimeToDate(utc_LocalDate) -#End If - - Exit Function - -utc_ErrorHandling: - Err.Raise 10011, "UtcConverter.ParseUtc", "UTC parsing error: " & Err.Number & " - " & Err.Description -End Function - -'' -' Convert local date to UTC date -' -' @method ConvertToUrc -' @param {Date} utc_LocalDate -' @return {Date} UTC date -' @throws 10012 - UTC conversion error -'' -Public Function ConvertToUtc(utc_LocalDate As Date) As Date - On Error GoTo utc_ErrorHandling - -#If Mac Then - ConvertToUtc = utc_ConvertDate(utc_LocalDate, utc_ConvertToUtc:=True) -#Else - Dim utc_TimeZoneInfo As utc_TIME_ZONE_INFORMATION - Dim utc_UtcDate As utc_SYSTEMTIME - utc_GetTimeZoneInformation utc_TimeZoneInfo - utc_TzSpecificLocalTimeToSystemTime utc_TimeZoneInfo, utc_DateToSystemTime(utc_LocalDate), utc_UtcDate - - ConvertToUtc = utc_SystemTimeToDate(utc_UtcDate) -#End If - - Exit Function - -utc_ErrorHandling: - Err.Raise 10012, "UtcConverter.ConvertToUtc", "UTC conversion error: " & Err.Number & " - " & Err.Description +Private Function ConvertToIso(utc_LocalDate As Date) As String + ConvertToIso = ConvertToUTCISO8601TimeStamp(utc_LocalDate) End Function - -'' -' Parse ISO 8601 date string to local date -' -' @method ParseIso -' @param {Date} utc_IsoString -' @return {Date} Local date -' @throws 10013 - ISO 8601 parsing error -'' -Public Function ParseIso(utc_IsoString As String) As Date - On Error GoTo utc_ErrorHandling - - Dim utc_Parts() As String - Dim utc_DateParts() As String - Dim utc_TimeParts() As String - Dim utc_OffsetIndex As Long - Dim utc_HasOffset As Boolean - Dim utc_NegativeOffset As Boolean - Dim utc_OffsetParts() As String - Dim utc_Offset As Date - - utc_Parts = VBA.Split(utc_IsoString, "T") - utc_DateParts = VBA.Split(utc_Parts(0), "-") - ParseIso = VBA.DateSerial(VBA.CInt(utc_DateParts(0)), VBA.CInt(utc_DateParts(1)), VBA.CInt(utc_DateParts(2))) - - If UBound(utc_Parts) > 0 Then - If VBA.InStr(utc_Parts(1), "Z") Then - utc_TimeParts = VBA.Split(VBA.Replace(utc_Parts(1), "Z", vbNullString), ":") - Else - utc_OffsetIndex = VBA.InStr(1, utc_Parts(1), "+") - If utc_OffsetIndex = 0 Then - utc_NegativeOffset = True - utc_OffsetIndex = VBA.InStr(1, utc_Parts(1), "-") - End If - - If utc_OffsetIndex > 0 Then - utc_HasOffset = True - utc_TimeParts = VBA.Split(VBA.Left$(utc_Parts(1), utc_OffsetIndex - 1), ":") - utc_OffsetParts = VBA.Split(VBA.Right$(utc_Parts(1), Len(utc_Parts(1)) - utc_OffsetIndex), ":") - - Select Case UBound(utc_OffsetParts) - Case 0 - utc_Offset = TimeSerial(VBA.CInt(utc_OffsetParts(0)), 0, 0) - Case 1 - utc_Offset = TimeSerial(VBA.CInt(utc_OffsetParts(0)), VBA.CInt(utc_OffsetParts(1)), 0) - Case 2 - ' VBA.Val does not use regional settings, use for seconds to avoid decimal/comma issues - utc_Offset = TimeSerial(VBA.CInt(utc_OffsetParts(0)), VBA.CInt(utc_OffsetParts(1)), Int(VBA.Val(utc_OffsetParts(2)))) - End Select - - If utc_NegativeOffset Then: utc_Offset = -utc_Offset - Else - utc_TimeParts = VBA.Split(utc_Parts(1), ":") - End If - End If - - Select Case UBound(utc_TimeParts) - Case 0 - ParseIso = ParseIso + VBA.TimeSerial(VBA.CInt(utc_TimeParts(0)), 0, 0) - Case 1 - ParseIso = ParseIso + VBA.TimeSerial(VBA.CInt(utc_TimeParts(0)), VBA.CInt(utc_TimeParts(1)), 0) - Case 2 - ' VBA.Val does not use regional settings, use for seconds to avoid decimal/comma issues - ParseIso = ParseIso + VBA.TimeSerial(VBA.CInt(utc_TimeParts(0)), VBA.CInt(utc_TimeParts(1)), Int(VBA.Val(utc_TimeParts(2)))) - End Select - - ParseIso = ParseUtc(ParseIso) - - If utc_HasOffset Then - ParseIso = ParseIso - utc_Offset - End If - End If - - Exit Function - -utc_ErrorHandling: - Err.Raise 10013, "UtcConverter.ParseIso", "ISO 8601 parsing error for " & utc_IsoString & ": " & Err.Number & " - " & Err.Description -End Function - -'' -' Convert local date to ISO 8601 string -' -' @method ConvertToIso -' @param {Date} utc_LocalDate -' @return {Date} ISO 8601 string -' @throws 10014 - ISO 8601 conversion error -'' -Public Function ConvertToIso(utc_LocalDate As Date) As String - On Error GoTo utc_ErrorHandling - - ConvertToIso = VBA.Format$(ConvertToUtc(utc_LocalDate), "yyyy-mm-ddTHH:mm:ss.000Z") - - Exit Function - -utc_ErrorHandling: - Err.Raise 10014, "UtcConverter.ConvertToIso", "ISO 8601 conversion error: " & Err.Number & " - " & Err.Description -End Function - -' ============================================= ' -' Private Functions -' ============================================= ' - -#If Mac Then - -Private Function utc_ConvertDate(utc_Value As Date, Optional utc_ConvertToUtc As Boolean = False) As Date - Dim utc_ShellCommand As String - Dim utc_Result As utc_ShellResult - Dim utc_Parts() As String - Dim utc_DateParts() As String - Dim utc_TimeParts() As String - - If utc_ConvertToUtc Then - utc_ShellCommand = "date -ur `date -jf '%Y-%m-%d %H:%M:%S' " & _ - "'" & VBA.Format$(utc_Value, "yyyy-mm-dd HH:mm:ss") & "' " & _ - " +'%s'` +'%Y-%m-%d %H:%M:%S'" - Else - utc_ShellCommand = "date -jf '%Y-%m-%d %H:%M:%S %z' " & _ - "'" & VBA.Format$(utc_Value, "yyyy-mm-dd HH:mm:ss") & " +0000' " & _ - "+'%Y-%m-%d %H:%M:%S'" - End If - - utc_Result = utc_ExecuteInShell(utc_ShellCommand) - - If utc_Result.utc_Output = "" Then - Err.Raise 10015, "UtcConverter.utc_ConvertDate", "'date' command failed" - Else - utc_Parts = Split(utc_Result.utc_Output, " ") - utc_DateParts = Split(utc_Parts(0), "-") - utc_TimeParts = Split(utc_Parts(1), ":") - - utc_ConvertDate = DateSerial(utc_DateParts(0), utc_DateParts(1), utc_DateParts(2)) + _ - TimeSerial(utc_TimeParts(0), utc_TimeParts(1), utc_TimeParts(2)) - End If -End Function - -Private Function utc_ExecuteInShell(utc_ShellCommand As String) As utc_ShellResult -#If VBA7 Then - Dim utc_File As LongPtr - Dim utc_Read As LongPtr -#Else - Dim utc_File As Long - Dim utc_Read As Long -#End If - - Dim utc_Chunk As String - - On Error GoTo utc_ErrorHandling - utc_File = utc_popen(utc_ShellCommand, "r") - - If utc_File = 0 Then: Exit Function - - Do While utc_feof(utc_File) = 0 - utc_Chunk = VBA.Space$(50) - utc_Read = CLng(utc_fread(utc_Chunk, 1, Len(utc_Chunk) - 1, utc_File)) - If utc_Read > 0 Then - utc_Chunk = VBA.Left$(utc_Chunk, CLng(utc_Read)) - utc_ExecuteInShell.utc_Output = utc_ExecuteInShell.utc_Output & utc_Chunk - End If - Loop - -utc_ErrorHandling: - utc_ExecuteInShell.utc_ExitCode = CLng(utc_pclose(utc_File)) -End Function - -#Else - -Private Function utc_DateToSystemTime(utc_Value As Date) As utc_SYSTEMTIME - utc_DateToSystemTime.utc_wYear = VBA.Year(utc_Value) - utc_DateToSystemTime.utc_wMonth = VBA.Month(utc_Value) - utc_DateToSystemTime.utc_wDay = VBA.Day(utc_Value) - utc_DateToSystemTime.utc_wHour = VBA.Hour(utc_Value) - utc_DateToSystemTime.utc_wMinute = VBA.Minute(utc_Value) - utc_DateToSystemTime.utc_wSecond = VBA.Second(utc_Value) - utc_DateToSystemTime.utc_wMilliseconds = 0 -End Function - -Private Function utc_SystemTimeToDate(utc_Value As utc_SYSTEMTIME) As Date - utc_SystemTimeToDate = DateSerial(utc_Value.utc_wYear, utc_Value.utc_wMonth, utc_Value.utc_wDay) + _ - TimeSerial(utc_Value.utc_wHour, utc_Value.utc_wMinute, utc_Value.utc_wSecond) -End Function - -#End If diff --git a/Version Control.accda.src/modules/modUtcConverter.bas b/Version Control.accda.src/modules/modUtcConverter.bas index fa996bb5..d980bfa5 100644 --- a/Version Control.accda.src/modules/modUtcConverter.bas +++ b/Version Control.accda.src/modules/modUtcConverter.bas @@ -297,14 +297,43 @@ utc_ErrorHandling: Err.Raise 10012, "UtcConverter.ConvertToUtc", "UTC conversion error: " & Err.Number & " - " & Err.Description End Function + +Public Function TimeStampDate(Optional LocalTimeStamp As Boolean = False) As Date + + Dim TimeStampOut As Date + +#If Mac Then + ' I'm sure there's a way to do this better, but this works for now. + TimeStampOut = ConvertToUtc(VBA.Now()) + If Not LocalTimeStamp Then TimeStampOut = ConvertToUtc(TimeStampOut) + +#Else + Dim tSysTime As utc_SYSTEMTIME + + If Not LocalTimeStamp Then + GetSystemTime tSysTime + TimeStampOut = utc_SystemTimeToDate(tSysTime) + + Else + GetLocalTime tSysTime + TimeStampOut = utc_SystemTimeToDate(tSysTime) + End If +#End If + + TimeStampDate = TimeStampOut + +End Function + + ' NOTE: As of now, "LocalTimeStamp" does nothing on a Mac; need to build "getTimeZoneOffset" for Mac, and I don't have one. ' It will, however, output a UTC string that is correct for local time (eg, in the correct UTC for the given local time) ' I also don't know how to get millisecond values out of a Mac, so that'll return zero, as well. Public Function ISO8601TimeStamp(Optional IncludeMilliseconds As Boolean = True _ , Optional LocalTimeStamp As Boolean = False) As String - Dim CurrentTimeVB As Date + Dim CurrentTimeVB As Date Dim tString_Buffer As StringBufferCache + ' Note: This varies slightly from ConvertToISO8601Time because it's faster to do on Windows if you have SYSTEMTIME #If Mac Then ' I'm sure there's a way to do this better, but this works for now.