diff --git a/.gitignore b/.gitignore index 5b367109..238b3069 100644 --- a/.gitignore +++ b/.gitignore @@ -9,10 +9,7 @@ *.laccdb # Comment out the following line if you wish to include the log files in git. -Export.log -Import.log -Build.log -Merge.log +*.log # The local VCS index file is paired with the database and should not # be comitted to version control. diff --git a/Testing/Testing.accdb.src/dbs-properties.json b/Testing/Testing.accdb.src/dbs-properties.json index c3edebc4..63080bc0 100644 --- a/Testing/Testing.accdb.src/dbs-properties.json +++ b/Testing/Testing.accdb.src/dbs-properties.json @@ -1,4 +1,4 @@ -{ +{ "Info": { "Class": "clsDbProperty", "Description": "Database Properties (DAO)" diff --git a/Testing/Testing.accdb.src/forms/frmMain.bas b/Testing/Testing.accdb.src/forms/frmMain.bas index 8a435d6e..20651e57 100644 --- a/Testing/Testing.accdb.src/forms/frmMain.bas +++ b/Testing/Testing.accdb.src/forms/frmMain.bas @@ -15,7 +15,7 @@ Begin Form ItemSuffix =13 Right =15975 Bottom =11745 - DatasheetGridlinesColor =14806254 + DatasheetGridlinesColor =15132391 RecSrcDt = Begin 0x18691eff0b76e540 End @@ -186,10 +186,10 @@ Begin Form LayoutCachedWidth =8520 LayoutCachedHeight =3660 PictureCaptionArrangement =5 - BackColor =14136213 - BorderColor =14136213 - HoverColor =15060409 - PressedColor =9592887 + BackColor =14461583 + BorderColor =14461583 + HoverColor =15189940 + PressedColor =9917743 HoverForeColor =4210752 PressedForeColor =4210752 WebImagePaddingLeft =2 @@ -314,10 +314,10 @@ Begin Form LayoutCachedWidth =8520 LayoutCachedHeight =4620 PictureCaptionArrangement =5 - BackColor =14136213 - BorderColor =14136213 - HoverColor =15060409 - PressedColor =9592887 + BackColor =14461583 + BorderColor =14461583 + HoverColor =15189940 + PressedColor =9917743 HoverForeColor =4210752 PressedForeColor =4210752 WebImagePaddingLeft =2 diff --git a/Testing/Testing.accdb.src/macros/AutoExec.bas b/Testing/Testing.accdb.src/macros/AutoExec.bas index e02a6814..38c9591c 100644 --- a/Testing/Testing.accdb.src/macros/AutoExec.bas +++ b/Testing/Testing.accdb.src/macros/AutoExec.bas @@ -1,4 +1,4 @@ -Version =196611 +Version =196611 ColumnsShown =0 Begin Action ="OpenForm" diff --git a/Testing/Testing.accdb.src/modules/basExtendedChars.bas b/Testing/Testing.accdb.src/modules/basExtendedChars.bas index 9b92f411..7628473b 100644 --- a/Testing/Testing.accdb.src/modules/basExtendedChars.bas +++ b/Testing/Testing.accdb.src/modules/basExtendedChars.bas @@ -1,6 +1,6 @@ Option Compare Database Option Explicit -' The following line uses extended ASCII characters -' and should show up as a solid line. -'————————————————————————————————————————————————————————— +' This module is used to prove that all ASCII characters survive the export\import cycle. + +'—————————————————————————————————————————————————————————————————————————————————————————— \ No newline at end of file diff --git a/Testing/Testing.accdb.src/nav-pane-groups.json b/Testing/Testing.accdb.src/nav-pane-groups.json index ba907d04..958f7c5f 100644 --- a/Testing/Testing.accdb.src/nav-pane-groups.json +++ b/Testing/Testing.accdb.src/nav-pane-groups.json @@ -1,4 +1,4 @@ -{ +{ "Info": { "Class": "clsDbNavPaneGroup", "Description": "Navigation Pane Custom Groups", @@ -6,25 +6,11 @@ }, "Items": { "Categories": [ - { - "Name": "Custom", - "Flags": 0, - "Position": 3, - "Groups": [ - ] - }, { "Name": "My Category", "Flags": 0, "Position": 2, "Groups": [ - { - "Name": "Unassigned Objects", - "Flags": 4, - "Position": 1, - "Objects": [ - ] - }, { "Name": "Macros & Reports", "Flags": 0, @@ -77,7 +63,7 @@ { "Name": "Unassigned Objects", "Flags": 4, - "Position": 3, + "Position": 1, "Objects": [ ] } diff --git a/Testing/Testing.accdb.src/queries/qryNavigationPaneGroups.bas b/Testing/Testing.accdb.src/queries/qryNavigationPaneGroups.bas index f493d072..af0c1874 100644 --- a/Testing/Testing.accdb.src/queries/qryNavigationPaneGroups.bas +++ b/Testing/Testing.accdb.src/queries/qryNavigationPaneGroups.bas @@ -1,4 +1,4 @@ -Operation =1 +Operation =1 Option =0 Where ="(((MSysNavPaneGroups.Name) Is Not Null) AND ((MSysNavPaneGroups.GroupCategoryID)" "=3))" diff --git a/Testing/Testing.accdb.src/queries/qryNavigationPaneGroups.sql b/Testing/Testing.accdb.src/queries/qryNavigationPaneGroups.sql index 98382a48..711cdc66 100644 --- a/Testing/Testing.accdb.src/queries/qryNavigationPaneGroups.sql +++ b/Testing/Testing.accdb.src/queries/qryNavigationPaneGroups.sql @@ -1,4 +1,4 @@ -SELECT MSysNavPaneGroups.Name AS GroupName, MSysNavPaneGroups.Flags AS GroupFlags, MSysNavPaneGroups.Position AS GroupPosition, MSysObjects.Type AS ObjectType, MSysObjects.Name AS ObjectName, MSysNavPaneGroupToObjects.Flags AS ObjectFlags, MSysNavPaneGroupToObjects.Icon AS ObjectIcon, MSysNavPaneGroupToObjects.Position AS ObjectPosition +SELECT MSysNavPaneGroups.Name AS GroupName, MSysNavPaneGroups.Flags AS GroupFlags, MSysNavPaneGroups.Position AS GroupPosition, MSysObjects.Type AS ObjectType, MSysObjects.Name AS ObjectName, MSysNavPaneGroupToObjects.Flags AS ObjectFlags, MSysNavPaneGroupToObjects.Icon AS ObjectIcon, MSysNavPaneGroupToObjects.Position AS ObjectPosition FROM MSysNavPaneGroups LEFT JOIN (MSysNavPaneGroupToObjects LEFT JOIN MSysObjects ON MSysNavPaneGroupToObjects.ObjectID = MSysObjects.Id) ON MSysNavPaneGroups.Id = MSysNavPaneGroupToObjects.GroupID WHERE (((MSysNavPaneGroups.Name) Is Not Null) AND ((MSysNavPaneGroups.GroupCategoryID)=3)) ORDER BY MSysNavPaneGroups.Name, MSysObjects.Type, MSysObjects.Name; diff --git a/Testing/Testing.accdb.src/reports/rptDefaultPrinter.bas b/Testing/Testing.accdb.src/reports/rptDefaultPrinter.bas index 2713d05f..f1dc3cb3 100644 --- a/Testing/Testing.accdb.src/reports/rptDefaultPrinter.bas +++ b/Testing/Testing.accdb.src/reports/rptDefaultPrinter.bas @@ -1,4 +1,4 @@ -Version =20 +Version =20 VersionRequired =20 Begin Report LayoutForPrint = NotDefault @@ -13,7 +13,7 @@ Begin Report Width =8884 DatasheetFontHeight =11 ItemSuffix =1 - DatasheetGridlinesColor =14806254 + DatasheetGridlinesColor =15132391 RecSrcDt = Begin 0xe05ff061b477e540 End diff --git a/Testing/Testing.accdb.src/reports/rptNavigationPaneGroups.bas b/Testing/Testing.accdb.src/reports/rptNavigationPaneGroups.bas index 5ffb6abf..e769e7bd 100644 --- a/Testing/Testing.accdb.src/reports/rptNavigationPaneGroups.bas +++ b/Testing/Testing.accdb.src/reports/rptNavigationPaneGroups.bas @@ -1,4 +1,4 @@ -Version =20 +Version =20 VersionRequired =20 Begin Report LayoutForPrint = NotDefault @@ -13,7 +13,7 @@ Begin Report Width =11700 DatasheetFontHeight =11 ItemSuffix =7 - DatasheetGridlinesColor =14806254 + DatasheetGridlinesColor =15132391 RecSrcDt = Begin 0x2df649898e77e540 End @@ -74,7 +74,7 @@ Begin Report Begin FormHeader KeepTogether = NotDefault Height =960 - BackColor =15849926 + BackColor =15064278 Name ="ReportHeader" AutoHeight =1 AlternateBackThemeColorIndex =1 diff --git a/Testing/Testing.accdb.src/reports/rptNonDefaultPaperSize.bas b/Testing/Testing.accdb.src/reports/rptNonDefaultPaperSize.bas index 36836bb1..43046fe6 100644 --- a/Testing/Testing.accdb.src/reports/rptNonDefaultPaperSize.bas +++ b/Testing/Testing.accdb.src/reports/rptNonDefaultPaperSize.bas @@ -1,4 +1,4 @@ -Version =20 +Version =20 VersionRequired =20 Begin Report LayoutForPrint = NotDefault @@ -13,7 +13,7 @@ Begin Report Width =8884 DatasheetFontHeight =11 ItemSuffix =1 - DatasheetGridlinesColor =14806254 + DatasheetGridlinesColor =15132391 RecSrcDt = Begin 0xe05ff061b477e540 End diff --git a/Testing/Testing.accdb.src/tables/tblInternal.txt b/Testing/Testing.accdb.src/tables/tblInternal.txt index 51e32cd4..6084073e 100644 --- a/Testing/Testing.accdb.src/tables/tblInternal.txt +++ b/Testing/Testing.accdb.src/tables/tblInternal.txt @@ -1,4 +1,4 @@ -ID ObjectType Notes +ID ObjectType Notes 1 Table 2 Form 3 Query diff --git a/Testing/Testing.accdb.src/tables/tblSaveXML.xml b/Testing/Testing.accdb.src/tables/tblSaveXML.xml index 819f60cf..90bfb999 100644 --- a/Testing/Testing.accdb.src/tables/tblSaveXML.xml +++ b/Testing/Testing.accdb.src/tables/tblSaveXML.xml @@ -1,4 +1,4 @@ - + 1 Table diff --git a/Testing/Testing.accdb.src/tbldefs/USysApplicationLog.sql b/Testing/Testing.accdb.src/tbldefs/USysApplicationLog.sql index 06da3b54..1ef9c5aa 100644 --- a/Testing/Testing.accdb.src/tbldefs/USysApplicationLog.sql +++ b/Testing/Testing.accdb.src/tbldefs/USysApplicationLog.sql @@ -1,4 +1,4 @@ -CREATE TABLE [USysApplicationLog] ( +CREATE TABLE [USysApplicationLog] ( [ID] AUTOINCREMENT CONSTRAINT [PrimaryKey] PRIMARY KEY UNIQUE NOT NULL, [SourceObject] VARCHAR (255), [Data Macro Instance ID] VARCHAR (255), diff --git a/Testing/Testing.accdb.src/tbldefs/tblHidden.sql b/Testing/Testing.accdb.src/tbldefs/tblHidden.sql index d9978db4..92f4ad4a 100644 --- a/Testing/Testing.accdb.src/tbldefs/tblHidden.sql +++ b/Testing/Testing.accdb.src/tbldefs/tblHidden.sql @@ -1,3 +1,3 @@ -CREATE TABLE [tblHidden] ( +CREATE TABLE [tblHidden] ( [ID] AUTOINCREMENT CONSTRAINT [PrimaryKey] PRIMARY KEY UNIQUE NOT NULL ) diff --git a/Testing/Testing.accdb.src/tbldefs/tblInternal.sql b/Testing/Testing.accdb.src/tbldefs/tblInternal.sql index 88031d31..1e2204cb 100644 --- a/Testing/Testing.accdb.src/tbldefs/tblInternal.sql +++ b/Testing/Testing.accdb.src/tbldefs/tblInternal.sql @@ -1,4 +1,4 @@ -CREATE TABLE [tblInternal] ( +CREATE TABLE [tblInternal] ( [ID] AUTOINCREMENT, [ObjectType] VARCHAR (255), [Notes] VARCHAR (255), diff --git a/Testing/Testing.accdb.src/tbldefs/tblLinkedAccess.sql b/Testing/Testing.accdb.src/tbldefs/tblLinkedAccess.sql index 43049d8b..8c9ac08f 100644 --- a/Testing/Testing.accdb.src/tbldefs/tblLinkedAccess.sql +++ b/Testing/Testing.accdb.src/tbldefs/tblLinkedAccess.sql @@ -1,4 +1,4 @@ -CREATE TABLE [tblLinkedAccess] ( +CREATE TABLE [tblLinkedAccess] ( [ID] AUTOINCREMENT, [ObjectType] VARCHAR (255), [Notes] VARCHAR (255), diff --git a/Testing/Testing.accdb.src/tbldefs/tblLinkedCSV.sql b/Testing/Testing.accdb.src/tbldefs/tblLinkedCSV.sql index d05cd942..fb3b1165 100644 --- a/Testing/Testing.accdb.src/tbldefs/tblLinkedCSV.sql +++ b/Testing/Testing.accdb.src/tbldefs/tblLinkedCSV.sql @@ -1,4 +1,4 @@ -CREATE TABLE [tblLinkedCSV] ( +CREATE TABLE [tblLinkedCSV] ( [ID] LONG , [Color] VARCHAR (255) ) diff --git a/Testing/Testing.accdb.src/tbldefs/tblSaveXML.sql b/Testing/Testing.accdb.src/tbldefs/tblSaveXML.sql index 6e4a944b..76fe6dcf 100644 --- a/Testing/Testing.accdb.src/tbldefs/tblSaveXML.sql +++ b/Testing/Testing.accdb.src/tbldefs/tblSaveXML.sql @@ -1,4 +1,4 @@ -CREATE TABLE [tblSaveXML] ( +CREATE TABLE [tblSaveXML] ( [ID] AUTOINCREMENT, [ObjectType] VARCHAR (255), [Notes] VARCHAR (255), diff --git a/Testing/Testing.accdb.src/tdmacros/tblSaveXML.xml b/Testing/Testing.accdb.src/tdmacros/tblSaveXML.xml index af8dce9c..8398320e 100644 --- a/Testing/Testing.accdb.src/tdmacros/tblSaveXML.xml +++ b/Testing/Testing.accdb.src/tdmacros/tblSaveXML.xml @@ -1,2 +1,2 @@ - + UpdatedID[ID]tblSaveXML[ID]=[UpdatedID]UpdateDateNow() diff --git a/Testing/Testing.accdb.src/themes/Office Theme.thmx b/Testing/Testing.accdb.src/themes/Office Theme.thmx index 3345f5e7..53dd1919 100644 Binary files a/Testing/Testing.accdb.src/themes/Office Theme.thmx and b/Testing/Testing.accdb.src/themes/Office Theme.thmx differ diff --git a/Testing/Testing.accdb.src/vbe-project.json b/Testing/Testing.accdb.src/vbe-project.json index 695bd6fe..311fd974 100644 --- a/Testing/Testing.accdb.src/vbe-project.json +++ b/Testing/Testing.accdb.src/vbe-project.json @@ -1,14 +1,13 @@ -{ +{ "Info": { "Class": "clsDbVbeProject", - "Description": "VBE Project", - "VCS Version": "3.1.25" + "Description": "VBE Project" }, "Items": { "Name": "VCS Testing", "Description": "For automated testing of Version Control", "FileName": "rel:Testing.accdb", - "HelpFile": "", + "HelpFile": "99672516", "HelpContextId": 123456, "Mode": 0, "Protection": 0, diff --git a/Testing/Testing.accdb.src/vbeforms/frmForm20.frm b/Testing/Testing.accdb.src/vbeforms/frmForm20.frm index 61b85650..daf6c50c 100644 --- a/Testing/Testing.accdb.src/vbeforms/frmForm20.frm +++ b/Testing/Testing.accdb.src/vbeforms/frmForm20.frm @@ -16,6 +16,8 @@ Attribute VB_Exposed = False + + Option Compare Database Option Explicit diff --git a/Testing/Testing.accdb.src/vbeforms/frmForm20.frx b/Testing/Testing.accdb.src/vbeforms/frmForm20.frx index 160d20eb..ae75c6b4 100644 Binary files a/Testing/Testing.accdb.src/vbeforms/frmForm20.frx and b/Testing/Testing.accdb.src/vbeforms/frmForm20.frx differ diff --git a/Testing/Testing.accdb.src/vcs-options.json b/Testing/Testing.accdb.src/vcs-options.json index a1fce781..acce4090 100644 --- a/Testing/Testing.accdb.src/vcs-options.json +++ b/Testing/Testing.accdb.src/vcs-options.json @@ -1,6 +1,6 @@ -{ +{ "Info": { - "AddinVersion": "3.2.3", + "AddinVersion": "3.3.7", "AccessVersion": "14.0 32-bit" }, "Options": { diff --git a/Version Control.accda.src/dbs-properties.json b/Version Control.accda.src/dbs-properties.json index 13661251..05a9c89b 100644 --- a/Version Control.accda.src/dbs-properties.json +++ b/Version Control.accda.src/dbs-properties.json @@ -1,4 +1,4 @@ -{ +{ "Info": { "Class": "clsDbProperty", "Description": "Database Properties (DAO)" @@ -41,7 +41,7 @@ "Type": 10 }, "AppVersion": { - "Value": "3.3.6", + "Value": "3.3.7", "Type": 10 }, "Auto Compact": { @@ -117,7 +117,7 @@ "Type": 4 }, "ProjVer": { - "Value": 119, + "Value": 142, "Type": 3 }, "QueryTimeout": { @@ -197,7 +197,7 @@ "Type": 2 }, "Version": { - "Value": "14.0", + "Value": "12.0", "Type": 12 }, "WebDesignMode": { diff --git a/Version Control.accda.src/forms/frmVCSInstall.bas b/Version Control.accda.src/forms/frmVCSInstall.bas index c7cb699e..772884e9 100644 --- a/Version Control.accda.src/forms/frmVCSInstall.bas +++ b/Version Control.accda.src/forms/frmVCSInstall.bas @@ -1,4 +1,4 @@ -Version =20 +Version =20 VersionRequired =20 Begin Form PopUp = NotDefault @@ -21,7 +21,7 @@ Begin Form Top =2430 Right =-6105 Bottom =10335 - DatasheetGridlinesColor =14806254 + DatasheetGridlinesColor =15132391 RecSrcDt = Begin 0x79e78b777268e540 End @@ -1419,7 +1419,7 @@ Begin Form Width =2160 FontSize =9 TabIndex =4 - ForeColor =16711680 + ForeColor =12673797 Name ="cmdExplainOptions" Caption ="Explain options..." HyperlinkAddress ="https://github.com/joyfullservice/msaccess-vcs-integration/wiki/Installation" @@ -1527,10 +1527,10 @@ Begin Form LayoutCachedTop =120 LayoutCachedWidth =7080 LayoutCachedHeight =300 - BackColor =14136213 - BorderColor =14136213 - HoverColor =15060409 - PressedColor =9592887 + BackColor =14461583 + BorderColor =14461583 + HoverColor =15189940 + PressedColor =9917743 HoverForeColor =4210752 PressedForeColor =4210752 WebImagePaddingLeft =2 diff --git a/Version Control.accda.src/forms/frmVCSMain.bas b/Version Control.accda.src/forms/frmVCSMain.bas index c54b4e7f..594d7f69 100644 --- a/Version Control.accda.src/forms/frmVCSMain.bas +++ b/Version Control.accda.src/forms/frmVCSMain.bas @@ -1,4 +1,4 @@ -Version =20 +Version =20 VersionRequired =20 Begin Form PopUp = NotDefault @@ -20,7 +20,7 @@ Begin Form Top =2430 Right =28545 Bottom =15015 - DatasheetGridlinesColor =14806254 + DatasheetGridlinesColor =15132391 RecSrcDt = Begin 0x79e78b777268e540 End @@ -1642,7 +1642,7 @@ Begin Form Height =240 FontSize =10 BorderColor =10921638 - ForeColor =16711680 + ForeColor =12673797 Name ="lblOpenLogFile" Caption ="Open Log File..." OnClick ="[Event Procedure]" diff --git a/Version Control.accda.src/forms/frmVCSOptions.bas b/Version Control.accda.src/forms/frmVCSOptions.bas index f2a0969c..b92d304f 100644 --- a/Version Control.accda.src/forms/frmVCSOptions.bas +++ b/Version Control.accda.src/forms/frmVCSOptions.bas @@ -1,4 +1,4 @@ -Version =20 +Version =20 VersionRequired =20 Begin Form PopUp = NotDefault @@ -20,7 +20,7 @@ Begin Form Top =2040 Right =20025 Bottom =10035 - DatasheetGridlinesColor =14806254 + DatasheetGridlinesColor =15132391 RecSrcDt = Begin 0x79e78b777268e540 End @@ -816,7 +816,7 @@ Begin Form Height =315 TabIndex =10 BorderColor =10921638 - ForeColor =4138256 + ForeColor =3484194 Name ="cboSecurity" RowSourceType ="Value List" RowSource ="1;\"Encrypt\";2;\"Remove\";3;\"None\"" @@ -932,7 +932,7 @@ Begin Form Top =5520 Width =2160 TabIndex =13 - ForeColor =16711680 + ForeColor =12673797 Name ="cmdExplainOptions" Caption ="Explain options..." HyperlinkAddress ="https://github.com/joyfullservice/msaccess-vcs-integration/wiki/Documentation#op" @@ -1032,7 +1032,7 @@ Begin Form FontSize =10 BackColor =14262935 BorderColor =15321539 - ForeColor =16711680 + ForeColor =12673797 Name ="lblPrintSettingsOptions" Caption ="Options..." OnClick ="[Event Procedure]" @@ -1999,7 +1999,7 @@ Begin Form Height =315 TabIndex =4 BorderColor =10921638 - ForeColor =4138256 + ForeColor =3484194 Name ="cboTableDataSaveType" RowSourceType ="Value List" GridlineColor =10921638 @@ -2178,7 +2178,7 @@ Begin Form FontSize =10 BackColor =14262935 BorderColor =15321539 - ForeColor =16711680 + ForeColor =12673797 Name ="lblAddOtherTable" Caption ="Other..." OnClick ="[Event Procedure]" @@ -2567,7 +2567,7 @@ Begin Form Height =315 TabIndex =5 BorderColor =10921638 - ForeColor =4138256 + ForeColor =3484194 Name ="cboMergeConflicts" RowSourceType ="Value List" RowSource ="\"Cancel Merge\";\"Skip Object\";\"Overwrite\"" @@ -2805,7 +2805,7 @@ Begin Form Top =4860 Width =1560 TabIndex =1 - ForeColor =16711680 + ForeColor =12673797 Name ="cmdEncryptionDetails" Caption ="Details..." HyperlinkAddress ="https://github.com/joyfullservice/msaccess-vcs-integration/wiki/Encryption" @@ -3466,7 +3466,7 @@ Begin Form Top =1260 Width =1560 TabIndex =3 - ForeColor =16711680 + ForeColor =12673797 Name ="cmdSeeDocs" Caption ="See Docs..." HyperlinkAddress ="https://github.com/joyfullservice/msaccess-vcs-integration/wiki/Documentation" diff --git a/Version Control.accda.src/macros/autoexec.bas b/Version Control.accda.src/macros/autoexec.bas index 199c0708..408035ae 100644 --- a/Version Control.accda.src/macros/autoexec.bas +++ b/Version Control.accda.src/macros/autoexec.bas @@ -1,4 +1,4 @@ -Version =196611 +Version =196611 ColumnsShown =0 Begin Action ="RunCode" diff --git a/Version Control.accda.src/modules/clsDbSharedImage.bas b/Version Control.accda.src/modules/clsDbSharedImage.bas index f72c8c47..34feb095 100644 --- a/Version Control.accda.src/modules/clsDbSharedImage.bas +++ b/Version Control.accda.src/modules/clsDbSharedImage.bas @@ -46,7 +46,6 @@ Private Sub IDbComponent_Export() Dim strFile As String Dim dItem As Dictionary - Dim stm As ADODB.Stream ' Build header file Set dItem = New Dictionary @@ -59,8 +58,8 @@ Private Sub IDbComponent_Export() ' Save image file using extension from embedded file. strFile = IDbComponent_BaseFolder & FSO.GetBaseName(IDbComponent_SourceFile) & "." & FSO.GetExtensionName(m_FileName) - Set stm = New ADODB.Stream - With stm + + With New ADODB.Stream .Type = adTypeBinary .Open .Write StripOLEHeader(m_FileData) ' Binary data diff --git a/Version Control.accda.src/modules/clsPerformance.bas b/Version Control.accda.src/modules/clsPerformance.bas index b037cb57..b8b115ec 100644 --- a/Version Control.accda.src/modules/clsPerformance.bas +++ b/Version Control.accda.src/modules/clsPerformance.bas @@ -247,44 +247,56 @@ End Function '--------------------------------------------------------------------------------------- ' Public Function GetReports() As String - - Const cstrSpacer As String = "-------------------------------------" + + Const cstrTitle As String = "PERFORMANCE REPORTS" Dim varKey As Variant Dim curTotal As Currency Dim dblCount As Double - + Dim lngCol(0 To 2) As Long + Dim strSpacer As String + + ' Set up column sizes + lngCol(0) = 25 + lngCol(1) = 10 + lngCol(2) = 10 + strSpacer = Space(lngCol(0) + lngCol(1) + lngCol(2)) + strSpacer = Replace(strSpacer, " ", "-") + With New clsConcat .AppendOnAdd = vbCrLf - .Add cstrSpacer - .Add " PERFORMANCE REPORTS" - .Add cstrSpacer + .Add strSpacer + .Add Space((Len(strSpacer) - Len(cstrTitle)) / 2) & cstrTitle + .Add strSpacer ' Table for object types - .Add ListResult("Object Type", "Count", "Seconds", 20, 30), vbCrLf, cstrSpacer + .Add ListResult("Object Type", "Count", "Seconds", lngCol), vbCrLf, strSpacer For Each varKey In m_dComponents.Keys .Add ListResult(CStr(varKey), CStr(m_dComponents(varKey).Count), _ - Format(m_dComponents(varKey).Total, "0.00"), 20, 30) + Format(m_dComponents(varKey).Total, "0.00"), lngCol) ' Add to totals dblCount = dblCount + m_dComponents(varKey).Count curTotal = curTotal + m_dComponents(varKey).Total Next varKey - .Add cstrSpacer + .Add strSpacer .Add ListResult("TOTALS:", CStr(dblCount), _ - Format(curTotal, "0.00"), 20, 30) + Format(curTotal, "0.00"), lngCol) + .Add strSpacer .Add vbNullString ' Table for operations curTotal = 0 - .Add cstrSpacer - .Add ListResult("Operations", "Count", "Seconds", 20, 30), vbCrLf, cstrSpacer + .Add strSpacer + .Add ListResult("Operations", "Count", "Seconds", lngCol), vbCrLf, strSpacer For Each varKey In m_dOperations.Keys .Add ListResult(CStr(varKey), CStr(m_dOperations(varKey).Count), _ - Format(m_dOperations(varKey).Total, "0.00"), 20, 30) + Format(m_dOperations(varKey).Total, "0.00"), lngCol) curTotal = curTotal + m_dOperations(varKey).Total Next varKey + .Add strSpacer .Add ListResult("Other Operations", vbNullString, _ - Format(m_Overall.Total - curTotal, "0.00"), 20, 30) + Format(m_Overall.Total - curTotal, "0.00"), lngCol) + .Add strSpacer .Add vbNullString ' Check for unfinished operations @@ -318,9 +330,9 @@ End Function '--------------------------------------------------------------------------------------- ' Private Function ListResult(strHeading As String, strResult1 As String, strResult2 As String, _ - intResultPos1 As Integer, intResultPos2 As Integer) As String - ListResult = PadRight(strHeading, intResultPos1) & _ - PadRight(strResult1, intResultPos2 - intResultPos1) & strResult2 + lngCol() As Long) As String + ListResult = PadRight(strHeading, lngCol(0)) & _ + PadRight(strResult1, lngCol(1)) & strResult2 End Function @@ -331,13 +343,13 @@ End Function ' Purpose : Pads a string '--------------------------------------------------------------------------------------- ' -Private Function PadRight(strText As String, intLen As Integer, Optional intMinTrailingSpaces As Integer = 1) As String +Private Function PadRight(strText As String, lngLen As Long, Optional lngMinTrailingSpaces As Long = 1) As String Dim strResult As String Dim strTrimmed As String - strResult = Space$(intLen) - strTrimmed = Left$(strText, intLen - intMinTrailingSpaces) + strResult = Space$(lngLen) + strTrimmed = Left$(strText, lngLen - lngMinTrailingSpaces) ' Use mid function to write over existing string of spaces. Mid$(strResult, 1, Len(strTrimmed)) = strTrimmed diff --git a/Version Control.accda.src/modules/modConstants.bas b/Version Control.accda.src/modules/modConstants.bas index 88d65ac0..21c69f4c 100644 --- a/Version Control.accda.src/modules/modConstants.bas +++ b/Version Control.accda.src/modules/modConstants.bas @@ -13,6 +13,12 @@ Public Const JSON_WHITESPACE As Integer = 2 Public Const UTF8_BOM As String = "" Public Const UCS2_BOM As String = "ÿþ" +' Read/write chunks of text, rather than the whole thing at once for massive +' performance gains when reading large files. +' See https://docs.microsoft.com/is-is/sql/ado/reference/ado-api/readtext-method +Public Const clngChunkSize As Long = 131072 ' (128K) + + ' Object types used when determining SQL modification date. Public Enum eSqlObjectType estView @@ -67,4 +73,4 @@ Public Enum eErrorLevel eelWarning ' Logged to file eelError ' Displayed and logged eelCritical ' Cancel operation -End Enum +End Enum \ No newline at end of file diff --git a/Version Control.accda.src/modules/modEncoding.bas b/Version Control.accda.src/modules/modEncoding.bas index 36823d40..1e258b38 100644 --- a/Version Control.accda.src/modules/modEncoding.bas +++ b/Version Control.accda.src/modules/modEncoding.bas @@ -9,32 +9,6 @@ Option Private Module Option Explicit -''' Maps a character string to a UTF-16 (wide character) string -Private Declare PtrSafe Function MultiByteToWideChar Lib "kernel32" ( _ - ByVal CodePage As Long, _ - ByVal dwFlags As Long, _ - ByVal lpMultiByteStr As LongPtr, _ - ByVal cchMultiByte As Long, _ - ByVal lpWideCharStr As LongPtr, _ - ByVal cchWideChar As Long _ - ) As Long - -''' WinApi function that maps a UTF-16 (wide character) string to a new character string -Private Declare PtrSafe Function WideCharToMultiByte Lib "kernel32" ( _ - ByVal CodePage As Long, _ - ByVal dwFlags As Long, _ - ByVal lpWideCharStr As LongPtr, _ - ByVal cchWideChar As Long, _ - ByVal lpMultiByteStr As LongPtr, _ - ByVal cbMultiByte As Long, _ - ByVal lpDefaultChar As Long, _ - ByVal lpUsedDefaultChar As Long _ - ) As Long - - -' CodePage constant for UTF-8 -Private Const CP_UTF8 = 65001 - ' Cache the Ucs2 requirement for this database Private m_blnUcs2 As Boolean Private m_strDbPath As String @@ -147,7 +121,7 @@ Public Sub ConvertUcs2Utf8(strSourceFile As String, strDestinationFile As String ' performance gains when reading large files. ' See https://docs.microsoft.com/is-is/sql/ado/reference/ado-api/readtext-method Do While Not .AtEndOfStream - cData.Add .Read(131072) ' 128K + cData.Add .Read(clngChunkSize) ' 128K Loop .Close End With @@ -198,20 +172,9 @@ Public Sub ConvertUtf8Ucs2(strSourceFile As String, strDestinationFile As String FSO.CopyFile strSourceFile, strDestinationFile End If Else - ' Monitor performance - Perf.OperationStart "Unicode Conversion" - - ' Read file contents and convert byte array to string - utf8Bytes = GetFileBytes(strSourceFile) - strText = Utf8BytesToString(utf8Bytes) - - ' Write as UCS-2 LE (BOM) - With FSO.CreateTextFile(strDestinationFile, True, TristateTrue) - .Write strText - .Close - End With - Perf.OperationEnd - + ' Encode as UCS2-LE (UTF-16 LE) + ReEncodeFile strSourceFile, "UTF-8", strDestinationFile, "UTF-16" + ' Remove original file if specified. If blnDeleteSourceFileAfterConversion Then DeleteFile strSourceFile, True End If @@ -230,9 +193,10 @@ End Sub Public Sub ConvertAnsiUtf8(strSourceFile As String, strDestinationFile As String, _ Optional blnDeleteSourceFileAfterConversion As Boolean = True) - ' Convert the ANSI content to UTF-8, and write to a new file. - ' (Adds UTF-8 BOM if extended characters are used.) - WriteFile ReadFile(strSourceFile, "_autodetect_all"), strDestinationFile + ' Perform file conversion + ReEncodeFile strSourceFile, "_autodetect_all", strDestinationFile, "UTF-8", adSaveCreateOverWrite + + ' Remove original file if specified. If blnDeleteSourceFileAfterConversion Then DeleteFile strSourceFile End Sub @@ -249,15 +213,7 @@ Public Sub ConvertUtf8Ansi(strSourceFile As String, strDestinationFile As String Optional blnDeleteSourceFileAfterConversion As Boolean = True) ' Perform file conversion - Perf.OperationStart "ANSI Conversion" - With New ADODB.Stream - .Charset = "_autodetect_all" - .Open - .WriteText ReadFile(strSourceFile) - .SaveToFile strDestinationFile, adSaveCreateOverWrite - .Close - End With - Perf.OperationEnd + ReEncodeFile strSourceFile, "UTF-8", strDestinationFile, "_autodetect_all", adSaveCreateOverWrite ' Remove original file if specified. If blnDeleteSourceFileAfterConversion Then DeleteFile strSourceFile @@ -293,254 +249,70 @@ End Function ' Procedure : FileHasBom ' Author : Adam Waller ' Date : 8/1/2020 -' Purpose : Check for the specified BOM +' Purpose : Check for the specified BOM by reading the first few bytes in the file. '--------------------------------------------------------------------------------------- ' Private Function FileHasBom(strFilePath As String, strBom As String) As Boolean - Dim strFound As String - strFound = StrConv((GetFileBytes(strFilePath, Len(strBom))), vbUnicode) - FileHasBom = (strFound = strBom) -End Function - - -'--------------------------------------------------------------------------------------- -' Procedure : RemoveUTF8BOM -' Author : Adam Kauffman -' Date : 1/24/2019 -' Purpose : Will remove a UTF8 BOM from the start of the string passed in. -'--------------------------------------------------------------------------------------- -' -Public Function RemoveUTF8BOM(ByVal fileContents As String) As String - Dim UTF8BOM As String - UTF8BOM = Chr$(239) & Chr$(187) & Chr$(191) ' == &HEFBBBF - Dim fileBOM As String - fileBOM = Left$(fileContents, 3) - - If fileBOM = UTF8BOM Then - RemoveUTF8BOM = Mid$(fileContents, 4) - Else ' No BOM detected - RemoveUTF8BOM = fileContents - End If + FileHasBom = (strBom = StrConv(GetFileBytes(strFilePath, Len(strBom)), vbUnicode)) End Function '--------------------------------------------------------------------------------------- -' Procedure : BytesLength -' Author : Casper Englund -' Date : 2020/05/01 -' Purpose : Return length of byte array -'--------------------------------------------------------------------------------------- -Private Function BytesLength(abBytes() As Byte) As Long - - ' Ignore error if array is uninitialized - On Error Resume Next - BytesLength = UBound(abBytes) - LBound(abBytes) + 1 - If Err.Number <> 0 Then Err.Clear - On Error GoTo 0 - -End Function - - -'--------------------------------------------------------------------------------------- -' Procedure : Utf8BytesToString -' Author : Adapted by Casper Englund -' Date : 2020/05/01 -' Purpose : Return VBA "Unicode" string from byte array encoded in UTF-8 -'--------------------------------------------------------------------------------------- -Public Function Utf8BytesToString(abUtf8Array() As Byte) As String - - Dim nBytes As Long - Dim nChars As Long - Dim strOut As String - Dim bUtf8Bom As Boolean - - Utf8BytesToString = vbNullString - - ' Catch uninitialized input array - nBytes = BytesLength(abUtf8Array) - If nBytes <= 0 Then Exit Function - bUtf8Bom = abUtf8Array(0) = 239 _ - And abUtf8Array(1) = 187 _ - And abUtf8Array(2) = 191 - - If bUtf8Bom Then - Dim i As Long - Dim abTempArr() As Byte - ReDim abTempArr(BytesLength(abUtf8Array) - 3) - For i = 3 To UBound(abUtf8Array) - abTempArr(i - 3) = abUtf8Array(i) - Next i - - abUtf8Array = abTempArr - End If - - ' Get number of characters in output string - nChars = MultiByteToWideChar(CP_UTF8, 0&, VarPtr(abUtf8Array(0)), nBytes, 0&, 0&) - - ' Dimension output buffer to receive string - strOut = String(nChars, 0) - nChars = MultiByteToWideChar(CP_UTF8, 0&, VarPtr(abUtf8Array(0)), nBytes, StrPtr(strOut), nChars) - Utf8BytesToString = Left$(strOut, nChars) - -End Function - - -'--------------------------------------------------------------------------------------- -' Procedure : Utf8BytesFromString -' Author : Adapted by Casper Englund -' Date : 2020/05/01 -' Purpose : Return byte array with VBA "Unicode" string encoded in UTF-8 -'--------------------------------------------------------------------------------------- -Public Function Utf8BytesFromString(strInput As String) As Byte() - - Dim nBytes As Long - Dim abBuffer() As Byte - - ' Catch empty or null input string - Utf8BytesFromString = vbNullString - If Len(strInput) < 1 Then Exit Function - - ' Get length in bytes *including* terminating null - nBytes = WideCharToMultiByte(CP_UTF8, 0&, StrPtr(strInput), -1, 0&, 0&, 0&, 0&) - - ' We don't want the terminating null in our byte array, so ask for `nBytes-1` bytes - ReDim abBuffer(nBytes - 2) ' NB ReDim with one less byte than you need - nBytes = WideCharToMultiByte(CP_UTF8, 0&, StrPtr(strInput), -1, ByVal VarPtr(abBuffer(0)), nBytes - 1, 0&, 0&) - Utf8BytesFromString = abBuffer - -End Function - - -'--------------------------------------------------------------------------------------- -' Procedure : ReadFile -' Author : Adam Waller / Indigo -' Date : 11/4/2020 -' Purpose : Read text file. -' : Read in UTF-8 encoding, removing a BOM if found at start of file. -'--------------------------------------------------------------------------------------- -' -Public Function ReadFile(strPath As String, Optional strCharset As String = "UTF-8") As String - - Dim stm As ADODB.Stream - Dim strText As String - Dim cData As clsConcat - Dim strBom As String - - ' Get BOM header, if applicable - Select Case strCharset - Case "UTF-8": strBom = UTF8_BOM - Case "Unicode": strBom = UCS2_BOM - End Select - - If FSO.FileExists(strPath) Then - Perf.OperationStart "Read File" - Set cData = New clsConcat - Set stm = New ADODB.Stream - With stm - .Charset = strCharset - .Open - .LoadFromFile strPath - ' Check for BOM - If strBom <> vbNullString Then - strText = .ReadText(Len(strBom)) - If strText <> strBom Then cData.Add strText - End If - ' Read chunks of text, rather than the whole thing at once for massive - ' performance gains when reading large files. - ' See https://docs.microsoft.com/is-is/sql/ado/reference/ado-api/readtext-method - Do While Not .EOS - cData.Add .ReadText(131072) ' 128K - Loop - .Close - End With - Set stm = Nothing - Perf.OperationEnd - End If - - ' Return text contents of file. - ReadFile = cData.GetStr - -End Function - - -'--------------------------------------------------------------------------------------- -' Procedure : WriteFile +' Procedure : StringHasExtendedASCII ' Author : Adam Waller -' Date : 1/23/2019 -' Purpose : Save string variable to text file. (Building the folder path if needed) -' : Saves in UTF-8 encoding, adding a BOM if extended or unicode content -' : is found in the file. https://stackoverflow.com/a/53036838/4121863 +' Date : 3/6/2020 +' Purpose : Returns true if the string contains non-ASCI characters. '--------------------------------------------------------------------------------------- ' -Public Sub WriteFile(strText As String, strPath As String) - - Dim strContent As String - Dim bteUtf8() As Byte - - ' Ensure that we are ending the content with a vbcrlf - strContent = strText - If Right$(strText, 2) <> vbCrLf Then strContent = strContent & vbCrLf +Public Function StringHasExtendedASCII(strText As String) As Boolean - ' Build a byte array from the text - bteUtf8 = Utf8BytesFromString(strContent) + Perf.OperationStart "Extended Chars Check" + With New VBScript_RegExp_55.RegExp + ' Include extended ASCII characters here. + .Pattern = "[^\u0000-\u007F]" + StringHasExtendedASCII = .Test(strText) + End With + Perf.OperationEnd - ' Write binary content to file. - WriteBinaryFile bteUtf8, StringHasUnicode(strContent), strPath - -End Sub +End Function '--------------------------------------------------------------------------------------- -' Procedure : WriteBinaryFile -' Author : Adam Waller -' Date : 8/3/2020 -' Purpose : Write binary content to a file with optional UTF-8 BOM. +' Procedure : ReEncodeFile +' Author : Adam Kauffman / Adam Waller +' Date : 3/4/2021 +' Purpose : Change File Encoding. It reads and writes at the same time so the files must be different. '--------------------------------------------------------------------------------------- ' -Public Sub WriteBinaryFile(bteContent() As Byte, blnUtf8Bom As Boolean, strPath As String) +Public Sub ReEncodeFile(strInputFile As String, strInputCharset As String, _ + strOutputFile As String, strOutputCharset As String, _ + Optional intOverwriteMode As SaveOptionsEnum = adSaveCreateOverWrite) - Dim stm As ADODB.Stream - Dim bteBOM(0 To 2) As Byte + Dim objOutputStream As ADODB.Stream - ' Write to a binary file using a Stream object - Set stm = New ADODB.Stream - With stm - .Type = adTypeBinary + ' Open streams and copy data + Perf.OperationStart "Enc " & _ + Replace(strInputCharset, "_autodetect_all", "AUTO") & " as " & _ + Replace(strOutputCharset, "_autodetect_all", "AUTO") + Set objOutputStream = New ADODB.Stream + With New ADODB.Stream .Open - If blnUtf8Bom Then - bteBOM(0) = &HEF - bteBOM(1) = &HBB - bteBOM(2) = &HBF - .Write bteBOM - End If - .Write bteContent - VerifyPath strPath - Perf.OperationStart "Write to Disk" - .SaveToFile strPath, adSaveCreateOverWrite - Perf.OperationEnd + .Type = adTypeBinary + .LoadFromFile strInputFile + .Type = adTypeText + .Charset = strInputCharset + objOutputStream.Open + objOutputStream.Charset = strOutputCharset + ' Copy data over by chunks to boost performance + Do While .EOS <> True + .CopyTo objOutputStream, clngChunkSize + Loop + .Close End With -End Sub - - -'--------------------------------------------------------------------------------------- -' Procedure : StringHasUnicode -' Author : Adam Waller -' Date : 3/6/2020 -' Purpose : Returns true if the string contains non-ASCI characters. -'--------------------------------------------------------------------------------------- -' -Public Function StringHasUnicode(strText As String) As Boolean - - Dim reg As VBScript_RegExp_55.RegExp - - Perf.OperationStart "Unicode Check" - Set reg = New VBScript_RegExp_55.RegExp - With reg - ' Include extended ASCII characters here. - .Pattern = "[^\u0000-\u007F]" - StringHasUnicode = .Test(strText) - End With + ' Save file and log performance + objOutputStream.SaveToFile strOutputFile, intOverwriteMode + objOutputStream.Close Perf.OperationEnd -End Function \ No newline at end of file +End Sub \ No newline at end of file diff --git a/Version Control.accda.src/modules/modFileAccess.bas b/Version Control.accda.src/modules/modFileAccess.bas index 857da4a8..1854d5e9 100644 --- a/Version Control.accda.src/modules/modFileAccess.bas +++ b/Version Control.accda.src/modules/modFileAccess.bas @@ -41,6 +41,92 @@ Public Function GetTempFile(Optional strPrefix As String = "VBA") As String End Function +'--------------------------------------------------------------------------------------- +' Procedure : ReadFile +' Author : Adam Waller / Indigo +' Date : 11/4/2020 +' Purpose : Read text file. +' : Read in UTF-8 encoding, removing a BOM if found at start of file. +'--------------------------------------------------------------------------------------- +' +Public Function ReadFile(strPath As String, Optional strCharset As String = "UTF-8") As String + + Dim strText As String + Dim cData As clsConcat + Dim strBom As String + + ' Get BOM header, if applicable + Select Case strCharset + Case "UTF-8": strBom = UTF8_BOM + Case "Unicode": strBom = UCS2_BOM + End Select + + Set cData = New clsConcat + + If FSO.FileExists(strPath) Then + Perf.OperationStart "Read File" + With New ADODB.Stream + .Charset = strCharset + .Open + .LoadFromFile strPath + ' Check for BOM + If strBom <> vbNullString Then + strText = .ReadText(Len(strBom)) + If strText <> strBom Then cData.Add strText + End If + ' Read chunks of text, rather than the whole thing at once for massive + ' performance gains when reading large files. + ' See https://docs.microsoft.com/is-is/sql/ado/reference/ado-api/readtext-method + Do While Not .EOS + ' This method might cause corruption of mixed byte width files, see issue #186 + cData.Add .ReadText(clngChunkSize) ' 128K + Loop + .Close + End With + Perf.OperationEnd + End If + + ' Return text contents of file. + ReadFile = cData.GetStr + +End Function + + +'--------------------------------------------------------------------------------------- +' Procedure : WriteFile +' Author : Adam Waller +' Date : 1/23/2019 +' Purpose : Save string variable to text file. (Building the folder path if needed) +' : Saves in UTF-8 encoding, adding a BOM if extended or unicode content +' : is found in the file. https://stackoverflow.com/a/53036838/4121863 +'--------------------------------------------------------------------------------------- +' +Public Sub WriteFile(strText As String, strPath As String) + + Dim strContent As String + Dim dblPos As Double + + Perf.OperationStart "Write File" + + ' Write to a UTF-8 eoncoded file + With New ADODB.Stream + .Type = adTypeText + .Open + .Charset = "UTF-8" + .WriteText strText + ' Ensure that we are ending the content with a vbcrlf + If Right(strText, 2) <> vbCrLf Then .WriteText vbCrLf + ' Write to disk + VerifyPath strPath + .SaveToFile strPath, adSaveCreateOverWrite + .Close + End With + + Perf.OperationEnd + +End Sub + + '--------------------------------------------------------------------------------------- ' Procedure : GetFileBytes ' Author : Adam Waller @@ -50,18 +136,15 @@ End Function '--------------------------------------------------------------------------------------- ' Public Function GetFileBytes(strPath As String, Optional lngBytes As Long = adReadAll) As Byte() - - Dim stmFile As ADODB.Stream - - Set stmFile = New ADODB.Stream - With stmFile + Perf.OperationStart "Read File Bytes" + With New ADODB.Stream .Type = adTypeBinary .Open .LoadFromFile strPath GetFileBytes = .Read(lngBytes) .Close End With - + Perf.OperationEnd End Function @@ -87,7 +170,11 @@ End Sub '--------------------------------------------------------------------------------------- ' Public Sub MkDirIfNotExist(strPath As String) - If Not FSO.FolderExists(StripSlash(strPath)) Then FSO.CreateFolder StripSlash(strPath) + If Not FSO.FolderExists(StripSlash(strPath)) Then + Perf.OperationStart "Create Folder" + FSO.CreateFolder StripSlash(strPath) + Perf.OperationEnd + End If End Sub @@ -133,6 +220,8 @@ Public Sub VerifyPath(strPath As String) Dim intPart As Integer Dim strVerified As String + Perf.OperationStart "Verify Path" + ' Determine if the path is a file or folder If Right$(strPath, 1) = PathSep Then ' Folder name. (Folder names can contain periods) @@ -169,7 +258,10 @@ Public Sub VerifyPath(strPath As String) Next intPart End If End If - + + ' End timing of operation + Perf.OperationEnd + End Sub @@ -249,25 +341,13 @@ End Function Public Function ReadJsonFile(strPath As String) As Dictionary Dim strText As String - Dim stm As ADODB.Stream + strText = ReadFile(strPath) - If FSO.FileExists(strPath) Then - Set stm = New ADODB.Stream - With stm - .Charset = "UTF-8" - .Open - .LoadFromFile strPath - strText = .ReadText(adReadAll) - .Close - End With - - ' If it looks like json content, then parse into a dictionary object. - If Left$(strText, 3) = UTF8_BOM Then strText = Mid$(strText, 4) - If Left$(strText, 1) = "{" Then Set ReadJsonFile = ParseJson(strText) + ' If it looks like json content, then parse into a dictionary object. + If Left$(strText, 1) = "{" Then + Set ReadJsonFile = ParseJson(strText) End If - Set stm = Nothing - End Function diff --git a/Version Control.accda.src/modules/modUnitTesting.bas b/Version Control.accda.src/modules/modUnitTesting.bas index ce28d2c7..7024fcbb 100644 --- a/Version Control.accda.src/modules/modUnitTesting.bas +++ b/Version Control.accda.src/modules/modUnitTesting.bas @@ -130,6 +130,15 @@ TestFail: Assert.Fail "Test raised an error: #" & Err.Number & " - " & Err.Description End Sub +'@TestMethod("TextConversion") +Private Sub TestUTF8BytesToString() + Dim inText As String + inText = "—T€st€ros—" + + ' If the text comes out the same as it went in the we have proven both methods + Assert.AreEqual Utf8BytesToString(Utf8BytesFromString(inText)), inText +End Sub + '@TestMethod("Sorting") Private Sub TestSortDictionaryByKeys() @@ -214,3 +223,47 @@ TestExit: TestFail: Assert.Fail "Test raised an error: #" & Err.Number & " - " & Err.Description End Sub + + +'--------------------------------------------------------------------------------------- +' Procedure : Utf8BytesToString +' Author : Adam Kauffman +' Date : 2021-03-04 +' Purpose : Return VBA "Unicode" string from byte array encoded in UTF-8 +'--------------------------------------------------------------------------------------- +Private Function Utf8BytesToString(abUtf8Array() As Byte) As String + + With New ADODB.Stream + .Charset = "UTF-8" + .Open + .Type = adTypeBinary + .Write abUtf8Array + .Position = 0 + .Type = adTypeText + Utf8BytesToString = .ReadText(adReadAll) + .Close + End With + +End Function + + +'--------------------------------------------------------------------------------------- +' Procedure : Utf8BytesFromString +' Author : Adam Kauffman +' Date : 2021-03-04 +' Purpose : Return byte array with VBA "Unicode" string encoded in UTF-8 +'--------------------------------------------------------------------------------------- +Private Function Utf8BytesFromString(strInput As String) As Byte() + + With New ADODB.Stream + .Charset = "UTF-8" + .Open + .Type = adTypeText + .WriteText strInput + .Position = 0 + .Type = adTypeBinary + Utf8BytesFromString = .Read(adReadAll) + .Close + End With + +End Function \ No newline at end of file diff --git a/Version Control.accda.src/modules/modVCSUtility.bas b/Version Control.accda.src/modules/modVCSUtility.bas index ed25bb40..e73e267f 100644 --- a/Version Control.accda.src/modules/modVCSUtility.bas +++ b/Version Control.accda.src/modules/modVCSUtility.bas @@ -179,8 +179,8 @@ Public Sub SaveComponentAsText(intType As AcObjectType, _ Case acModule '(ANSI text file) ' Modules may contain extended characters that need UTF-8 conversion ' to display correctly in some editors. - If StringHasUnicode(ReadFile(strTempFile, "_autodetect_all")) Then - ' Convert to UTF-8 BOM + If StringHasExtendedASCII(ReadFile(strTempFile, "_autodetect_all")) Then + ' Convert to UTF-8 ConvertAnsiUtf8 strTempFile, strFile Else ' Leave as ANSI diff --git a/Version Control.accda.src/nav-pane-groups.json b/Version Control.accda.src/nav-pane-groups.json index f51014d4..ba324fc4 100644 --- a/Version Control.accda.src/nav-pane-groups.json +++ b/Version Control.accda.src/nav-pane-groups.json @@ -1,4 +1,4 @@ -{ +{ "Info": { "Class": "clsDbNavPaneGroup", "Description": "Navigation Pane Custom Groups", diff --git a/Version Control.accda.src/queries/qryNavPaneGroups.bas b/Version Control.accda.src/queries/qryNavPaneGroups.bas index e7ba5292..b078925f 100644 --- a/Version Control.accda.src/queries/qryNavPaneGroups.bas +++ b/Version Control.accda.src/queries/qryNavPaneGroups.bas @@ -1,4 +1,4 @@ -Operation =1 +Operation =1 Option =0 Where ="(((MSysNavPaneGroups.Name) Is Not Null) AND ((MSysNavPaneGroupCategories.Type)=4" "))" diff --git a/Version Control.accda.src/queries/qryNavPaneGroups.sql b/Version Control.accda.src/queries/qryNavPaneGroups.sql index f6b7da2c..2abb0a1f 100644 --- a/Version Control.accda.src/queries/qryNavPaneGroups.sql +++ b/Version Control.accda.src/queries/qryNavPaneGroups.sql @@ -1,4 +1,4 @@ -SELECT MSysNavPaneGroupCategories.Name AS CategoryName, MSysNavPaneGroupCategories.Position AS CategoryPosition, MSysNavPaneGroupCategories.Flags AS CategoryFlags, MSysNavPaneGroups.Name AS GroupName, MSysNavPaneGroups.Flags AS GroupFlags, MSysNavPaneGroups.Position AS GroupPosition, MSysObjects.Type AS ObjectType, MSysObjects.Name AS ObjectName, MSysNavPaneGroupToObjects.Flags AS ObjectFlags, MSysNavPaneGroupToObjects.Icon AS ObjectIcon, MSysNavPaneGroupToObjects.Position AS ObjectPosition, MSysNavPaneGroupToObjects.Name AS NameInGroup, MSysNavPaneGroupCategories.Id AS CategoryID, MSysNavPaneGroups.Id AS GroupID, MSysNavPaneGroupToObjects.Id AS LinkID +SELECT MSysNavPaneGroupCategories.Name AS CategoryName, MSysNavPaneGroupCategories.Position AS CategoryPosition, MSysNavPaneGroupCategories.Flags AS CategoryFlags, MSysNavPaneGroups.Name AS GroupName, MSysNavPaneGroups.Flags AS GroupFlags, MSysNavPaneGroups.Position AS GroupPosition, MSysObjects.Type AS ObjectType, MSysObjects.Name AS ObjectName, MSysNavPaneGroupToObjects.Flags AS ObjectFlags, MSysNavPaneGroupToObjects.Icon AS ObjectIcon, MSysNavPaneGroupToObjects.Position AS ObjectPosition, MSysNavPaneGroupToObjects.Name AS NameInGroup, MSysNavPaneGroupCategories.Id AS CategoryID, MSysNavPaneGroups.Id AS GroupID, MSysNavPaneGroupToObjects.Id AS LinkID FROM (MSysNavPaneGroupCategories INNER JOIN MSysNavPaneGroups ON MSysNavPaneGroupCategories.Id = MSysNavPaneGroups.GroupCategoryID) LEFT JOIN (MSysNavPaneGroupToObjects LEFT JOIN MSysObjects ON MSysNavPaneGroupToObjects.ObjectID = MSysObjects.Id) ON MSysNavPaneGroups.Id = MSysNavPaneGroupToObjects.GroupID WHERE (((MSysNavPaneGroups.Name) Is Not Null) AND ((MSysNavPaneGroupCategories.Type)=4)) ORDER BY MSysNavPaneGroupCategories.Name, MSysNavPaneGroups.Name, MSysObjects.Type, MSysObjects.Name; diff --git a/Version Control.accda.src/themes/Office Theme.thmx b/Version Control.accda.src/themes/Office Theme.thmx index fdd23337..53dd1919 100644 Binary files a/Version Control.accda.src/themes/Office Theme.thmx and b/Version Control.accda.src/themes/Office Theme.thmx differ diff --git a/Version Control.accda.src/vbe-project.json b/Version Control.accda.src/vbe-project.json index 0460a6fd..00d48228 100644 --- a/Version Control.accda.src/vbe-project.json +++ b/Version Control.accda.src/vbe-project.json @@ -1,13 +1,13 @@ -{ +{ "Info": { "Class": "clsDbVbeProject", "Description": "VBE Project" }, "Items": { "Name": "MSAccessVCS", - "Description": "Version 3.3.6 deployed on 3/3/2021", + "Description": "Version 3.3.3 deployed on 3/5/2021", "FileName": "rel:Version Control.accda", - "HelpFile": "", + "HelpFile": "100746350", "HelpContextId": 0, "Mode": 0, "Protection": 0, diff --git a/Version Control.accda.src/vbe-references.json b/Version Control.accda.src/vbe-references.json index 87f600bd..1865fcd6 100644 --- a/Version Control.accda.src/vbe-references.json +++ b/Version Control.accda.src/vbe-references.json @@ -1,8 +1,7 @@ -{ +{ "Info": { "Class": "clsDbVbeReference", - "Description": "VBE References", - "VCS Version": "3.1.76" + "Description": "VBE References" }, "Items": { "stdole": { @@ -23,7 +22,7 @@ }, "Office": { "GUID": "{2DF8D04C-5BFA-101B-BDE5-00AA0044DE52}", - "Version": "2.5" + "Version": "2.7" }, "Scripting": { "GUID": "{420B2830-E718-11CF-893D-00A0C9054228}", diff --git a/Version Control.accda.src/vcs-options.json b/Version Control.accda.src/vcs-options.json index 91e662b9..3326f439 100644 --- a/Version Control.accda.src/vcs-options.json +++ b/Version Control.accda.src/vcs-options.json @@ -1,7 +1,7 @@ -{ +{ "Info": { - "AddinVersion": "3.3.6", - "AccessVersion": "14.0 32-bit" + "AddinVersion": "3.3.3", + "AccessVersion": "16.0 64-bit" }, "Options": { "ExportFolder": "",