Skip to content

Commit

Permalink
Fixes #354 and Fixes #452 (#454)
Browse files Browse the repository at this point in the history 
From @hecon5:

Bump version minor number because it's not clear that the index will allow round trip from prior types in all cases; it worked on my machine, but that may not always be the case.

The date types for the index are handled natively by modJsonConverter and should import/export correctly regardless of user's date / time zone or date encoding on machines.
  • Loading branch information
@hecon5
hecon5 authored Nov 13, 2023
1 parent e723123 commit de4602e
Show file tree
Hide file tree
Showing 5 changed files with 57 additions and 270 deletions.
2 changes: 1 addition & 1 deletion Version Control.accda.src/dbs-properties.json
View file
Original file line number Diff line number Diff line change
Expand Up @@ -41,7 +41,7 @@
"Type": 10
},
"AppVersion": {
"Value": "4.0.25",
"Value": "4.1.0",
"Type": 10
},
"Auto Compact": {
Expand Down
1 change: 1 addition & 0 deletions Version Control.accda.src/modules/clsOptions.cls
View file
Original file line number Diff line number Diff line change
Expand Up @@ -654,6 +654,7 @@ Private Sub Class_Initialize()

' Other run-time options
JsonOptions.AllowUnicodeChars = True
JsonOptions.ConvertDateToIso = True

End Sub

Expand Down
10 changes: 5 additions & 5 deletions Version Control.accda.src/modules/clsVCSIndex.cls
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -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
Expand Down
283 changes: 20 additions & 263 deletions Version Control.accda.src/modules/modJsonConverter.bas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Loading

0 comments on commit de4602e

Please sign in to comment.