From 769053d42b129d549f6e5b8f8bdbd45a92062e5e Mon Sep 17 00:00:00 2001 From: Hecon5 <54177882+hecon5@users.noreply.github.com> Date: Tue, 16 Mar 2021 07:54:59 -0400 Subject: [PATCH 01/25] Removing encryption routines and tools from use --- Version Control.accda.src/dbs-properties.json | 4 +- .../forms/frmVCSOptions.bas | 405 +----------------- .../modules/clsDbProjProperty.bas | 7 +- .../modules/clsDbProperty.bas | 8 +- .../modules/clsDbSavedSpec.bas | 2 +- .../modules/clsDbTableDef.bas | 4 +- .../modules/clsDbVbeReference.bas | 6 +- .../modules/clsOptions.bas | 35 -- .../modules/modImportExport.bas | 10 +- .../modules/modInstall.bas | 3 +- .../modules/modUnitTesting.bas | 43 -- .../modules/modVCSUtility.bas | 2 +- Version Control.accda.src/vbe-references.json | 2 +- Version Control.accda.src/vcs-options.json | 2 +- 14 files changed, 21 insertions(+), 512 deletions(-) diff --git a/Version Control.accda.src/dbs-properties.json b/Version Control.accda.src/dbs-properties.json index 7205cd34..1213d995 100644 --- a/Version Control.accda.src/dbs-properties.json +++ b/Version Control.accda.src/dbs-properties.json @@ -117,7 +117,7 @@ "Type": 4 }, "ProjVer": { - "Value": 142, + "Value": 141, "Type": 3 }, "QueryTimeout": { @@ -197,7 +197,7 @@ "Type": 2 }, "Version": { - "Value": "12.0", + "Value": "14.0", "Type": 12 }, "WebDesignMode": { diff --git a/Version Control.accda.src/forms/frmVCSOptions.bas b/Version Control.accda.src/forms/frmVCSOptions.bas index ffd4348d..a44eadc5 100644 --- a/Version Control.accda.src/forms/frmVCSOptions.bas +++ b/Version Control.accda.src/forms/frmVCSOptions.bas @@ -1102,51 +1102,6 @@ Begin Form End End End - Begin ComboBox - LimitToList = NotDefault - RowSourceTypeInt =1 - OverlapFlags =247 - IMESentenceMode =3 - ColumnCount =2 - ListWidth =1440 - Left =7020 - Top =5100 - Width =1920 - Height =315 - TabIndex =10 - BorderColor =10921638 - ForeColor =3484194 - Name ="cboSecurity" - RowSourceType ="Value List" - RowSource ="1;\"Encrypt\";2;\"Remove\";3;\"None\"" - ColumnWidths ="0" - GridlineColor =10921638 - - LayoutCachedLeft =7020 - LayoutCachedTop =5100 - LayoutCachedWidth =8940 - LayoutCachedHeight =5415 - Begin - Begin Label - OverlapFlags =247 - Left =6000 - Top =5100 - Width =900 - Height =320 - BorderColor =8355711 - ForeColor =5324600 - Name ="Col1_Label" - Caption ="Security:" - GridlineColor =10921638 - LayoutCachedLeft =6000 - LayoutCachedTop =5100 - LayoutCachedWidth =6900 - LayoutCachedHeight =5420 - ForeThemeColorIndex =-1 - ForeTint =100.0 - End - End - End Begin CommandButton FontUnderline = NotDefault OverlapFlags =247 @@ -2881,280 +2836,6 @@ Begin Form End End End - Begin Page - OverlapFlags =247 - Left =615 - Top =1980 - Width =8850 - Height =4185 - BorderColor =10921638 - Name ="pgeEncrypt" - Caption ="Encryption" - GridlineColor =10921638 - LayoutCachedLeft =615 - LayoutCachedTop =1980 - LayoutCachedWidth =9465 - LayoutCachedHeight =6165 - WebImagePaddingLeft =2 - WebImagePaddingTop =2 - WebImagePaddingRight =2 - WebImagePaddingBottom =2 - Begin - Begin Label - OverlapFlags =247 - Left =1140 - Top =2760 - Width =7860 - Height =2040 - BorderColor =8355711 - ForeColor =5324600 - Name ="Label92" - Caption ="The 'Encryption' used by this tool is based on the RC4 algorithm which provides " - "a lightweight basic encryption capability using a key stored in the current user" - "'s registry profile. This provides a convenient way to mask sensitive data when " - "exporting source code, and to restore it when building from source.\015\012\015\012" - "This capability comes with some very important caveats that are explained in the" - " online documentation. Please review the documentation before using this feature" - ".\015\012" - GridlineColor =10921638 - LayoutCachedLeft =1140 - LayoutCachedTop =2760 - LayoutCachedWidth =9000 - LayoutCachedHeight =4800 - ForeThemeColorIndex =-1 - ForeTint =100.0 - End - Begin CommandButton - Enabled = NotDefault - OverlapFlags =247 - Left =3540 - Top =5280 - Width =2880 - Height =630 - ForeColor =4210752 - Name ="cmdSetEncryptionKey" - Caption ="Set Encryption Key..." - OnClick ="[Event Procedure]" - LeftPadding =135 - TopPadding =135 - RightPadding =150 - BottomPadding =150 - GridlineColor =10921638 - - LayoutCachedLeft =3540 - LayoutCachedTop =5280 - LayoutCachedWidth =6420 - LayoutCachedHeight =5910 - BackColor =14262935 - BackThemeColorIndex =-1 - BackTint =100.0 - BorderColor =15321539 - BorderThemeColorIndex =-1 - BorderTint =100.0 - HoverColor =15321539 - HoverThemeColorIndex =-1 - HoverTint =100.0 - PressedColor =13072231 - PressedThemeColorIndex =-1 - PressedShade =100.0 - HoverForeColor =4210752 - PressedForeColor =4210752 - WebImagePaddingLeft =9 - WebImagePaddingTop =9 - WebImagePaddingRight =9 - WebImagePaddingBottom =9 - End - Begin Label - OverlapFlags =247 - Left =1140 - Top =2160 - Width =7020 - Height =480 - FontSize =16 - BorderColor =8355711 - ForeColor =5324600 - Name ="Label94" - Caption ="IMPORTANT NOTICE - PLEASE READ CAREFULLY" - GridlineColor =10921638 - LayoutCachedLeft =1140 - LayoutCachedTop =2160 - LayoutCachedWidth =8160 - LayoutCachedHeight =2640 - ForeThemeColorIndex =-1 - ForeTint =100.0 - End - Begin CommandButton - FontUnderline = NotDefault - TabStop = NotDefault - OverlapFlags =247 - Left =7200 - Top =4860 - Width =1560 - TabIndex =1 - ForeColor =12673797 - Name ="cmdEncryptionDetails" - Caption ="Details..." - HyperlinkAddress ="https://github.com/joyfullservice/msaccess-vcs-integration/wiki/Encryption" - GridlineColor =10921638 - ImageData = Begin - 0x2800000010000000100000000100200000000000000000000000000000000000 , - 0x000000000000000000000000000000000000000000000000e0e8e000e0c8b000 , - 0xe0d8d000e0d0c010e0d0c010d0d0c010d0d0c000d0d0d000e0e0e00000000000 , - 0x0000000000000000000000000000000000000000f0e8e0009068303080582080 , - 0x905010c0804820e0804820c0804810b06040108050381030d0c8c01000000000 , - 0x000000000000000000000000e0780000e0a05010a0683070c08860f0e0c8b0ff , - 0xf0f0f0fffffffffffffffffff0f0f0ffe0c8c0ffa07850c040301060d0c8c010 , - 0xe0d8d0000000000000000000e0882000b0703070e0a880fffff0e0ffe0b8a0ff , - 0xd08050ffc05820ffc05820ffd08050ffe0b8a0fff0e8e0ffb09070f050301060 , - 0xd0c8c000e0e0e00000000000b0783030d09870f0fff0e0ffe0a890ffc05010ff , - 0xc05010ffe0a890ffffffffffb04810ffb04810ffd0a080fff0f0e0ffa07050d0 , - 0x50381030d0d0d000f0f0f000b0784080f0d8c0fff0c8b0ffe05820ffd05810ff , - 0xd05010ffe08050ffe0a880ffc05010ffb04810ffb04810ffe0b8a0ffe0c8c0ff , - 0x50401080d0d0d010f0f0f000d08040e0fff8f0fff09870fff06020ffe05820ff , - 0xe05820fff0a890ffffffffffd05010ffc05010ffb05010ffc07850fff0f0f0ff , - 0x804020c0e0d0c000f0f0f000d08040f0ffffffffff7840ffff6830fff06820ff , - 0xf06020fff08850fffffffffff0c0b0ffc05820ffb05010ffb05820ffffffffff , - 0x804820e0e0d0c010f0f0f000d08850f0ffffffffff8050ffff7030ffff6830ff , - 0xff6830ffff6820fff09060fffff8f0fff0d8c0ffc05020ffc05820ffffffffff , - 0x804820e0e0d8d010f0f0f000d08050c0fff8f0ffffa880ffff7040ffff8850ff , - 0xffb090ffff7030fff06820fff09070fffffffffff08050ffd08860fffff0f0ff , - 0x805820b0e0d8d010f0f0f000c0804070f0d8c0ffffd0c0ffff7840ffff9870ff , - 0xffffffffffc8b0ffff9060ffffc8b0fffff8f0fff07840fff0c8b0ffe0c8b0ff , - 0x90602070e0c8b00000000000c0884030e0a070f0fff8f0ffffc0a0ffff7840ff , - 0xffb8a0fffff8f0fffffffffffff0e0ffff9870fff0b8a0fffff0e0ffc08850e0 , - 0xa0682030f0e8e0000000000000000000c0884060e0b8a0f0fff8f0ffffd0c0ff , - 0xffa880ffff8850ffff8850ffffa880fff0d0c0fffff0e0ffd0a880f0a0683060 , - 0xe0c0a00000000000000000000000000000000000c0884060e0a070f0f0d8c0ff , - 0xfff8f0fffffffffffffffffffff8f0fff0d8c0ffc09060e0a0703050f0b89000 , - 0x0000000000000000000000000000000000000000f0f0f000c0884030c0804070 , - 0xe0a070c0d09870e0d09860f0d09870d0b0784070b0784020f0e8f00000000000 , - 0x0000000000000000000000000000000000000000000000000000000000000000 , - 0xf0f0f000f0f0f000f0f0f000f0f0f000f0f0f00000000000f0f0f00000000000 , - 0x0000000000000000 - End - BackStyle =0 - - LayoutCachedLeft =7200 - LayoutCachedTop =4860 - LayoutCachedWidth =8760 - LayoutCachedHeight =5220 - PictureCaptionArrangement =4 - ForeThemeColorIndex =10 - ForeTint =100.0 - Gradient =0 - BackColor =14262935 - BackThemeColorIndex =-1 - BackTint =100.0 - OldBorderStyle =0 - BorderColor =15321539 - BorderThemeColorIndex =-1 - BorderTint =100.0 - HoverColor =15321539 - HoverThemeColorIndex =-1 - HoverTint =100.0 - PressedColor =13072231 - PressedThemeColorIndex =-1 - PressedShade =100.0 - HoverForeColor =4210752 - PressedForeColor =4210752 - WebImagePaddingLeft =2 - WebImagePaddingTop =2 - WebImagePaddingRight =2 - WebImagePaddingBottom =2 - End - Begin CheckBox - OverlapFlags =247 - Left =4260 - Top =4920 - TabIndex =2 - BorderColor =10921638 - Name ="chkIUnderstand" - DefaultValue ="False" - OnClick ="[Event Procedure]" - GridlineColor =10921638 - - LayoutCachedLeft =4260 - LayoutCachedTop =4920 - LayoutCachedWidth =4520 - LayoutCachedHeight =5160 - Begin - Begin Label - OverlapFlags =247 - Left =4545 - Top =4860 - Width =1335 - Height =315 - BorderColor =8355711 - ForeColor =5324600 - Name ="Label97" - Caption ="I understand" - GridlineColor =10921638 - LayoutCachedLeft =4545 - LayoutCachedTop =4860 - LayoutCachedWidth =5880 - LayoutCachedHeight =5175 - ForeThemeColorIndex =-1 - ForeTint =100.0 - End - End - End - Begin Label - OverlapFlags =247 - Left =6840 - Top =5340 - Width =2400 - Height =600 - BorderColor =8355711 - ForeColor =8355711 - Name ="lblKeyStatus" - Caption ="No encryption key found for current user." - GridlineColor =10921638 - LayoutCachedLeft =6840 - LayoutCachedTop =5340 - LayoutCachedWidth =9240 - LayoutCachedHeight =5940 - End - Begin TextBox - Enabled = NotDefault - OverlapFlags =247 - IMESentenceMode =3 - Left =1140 - Top =5460 - Width =2040 - Height =315 - TabIndex =3 - BorderColor =10921638 - ForeColor =4210752 - Name ="txtKeyName" - GridlineColor =10921638 - - LayoutCachedLeft =1140 - LayoutCachedTop =5460 - LayoutCachedWidth =3180 - LayoutCachedHeight =5775 - Begin - Begin Label - OverlapFlags =247 - Left =1140 - Top =5100 - Width =1140 - Height =315 - BorderColor =8355711 - ForeColor =5324600 - Name ="Label100" - Caption ="Key Name:" - GridlineColor =10921638 - LayoutCachedLeft =1140 - LayoutCachedTop =5100 - LayoutCachedWidth =2280 - LayoutCachedHeight =5415 - ForeThemeColorIndex =-1 - ForeTint =100.0 - End - End - End - End - End Begin Page OverlapFlags =247 Left =615 @@ -3847,31 +3528,6 @@ Private Enum eMapAction End Enum -'--------------------------------------------------------------------------------------- -' Procedure : cboSecurity_Click -' Author : Adam Waller -' Date : 6/1/2020 -' Purpose : Show encryption tab when relevant. -'--------------------------------------------------------------------------------------- -' -Private Sub cboSecurity_Click() - pgeEncrypt.Visible = (cboSecurity = esEncrypt) -End Sub - - -'--------------------------------------------------------------------------------------- -' Procedure : chkIUnderstand_Click -' Author : Adam Waller -' Date : 4/24/2020 -' Purpose : Make sure the user understands what they are doing before using encryption. -'--------------------------------------------------------------------------------------- -' -Private Sub chkIUnderstand_Click() - cmdSetEncryptionKey.Enabled = chkIUnderstand - txtKeyName.Enabled = chkIUnderstand -End Sub - - '--------------------------------------------------------------------------------------- ' Procedure : chkTableShowHidden_Click ' Author : Adam Waller @@ -4185,15 +3841,6 @@ End Sub '--------------------------------------------------------------------------------------- ' Private Sub cmdSaveAndClose_Click() - - ' Encourage user to set encryption key. - If Options.Security = esEncrypt And (Not modEncrypt.EncryptionKeySet) Then - If MsgBox2("Encryption Key Not Set", "No encryption key has been set for the current user." & vbCrLf & _ - "This is used to mask sensitive data when exporting source.", "Would you like to do this now?", vbQuestion + vbYesNo) = vbYes Then - pgeEncrypt.SetFocus - Exit Sub - End If - End If ' Save options and close. MapControlsToOptions emaFormToClass @@ -4219,52 +3866,6 @@ Private Sub cmdSaveAsDefault_Click() End Sub -'--------------------------------------------------------------------------------------- -' Procedure : cmdSetEncryptionKey_Click -' Author : Adam Waller -' Date : 4/24/2020 -' Purpose : Set a named encryption key. -'--------------------------------------------------------------------------------------- -' -Private Sub cmdSetEncryptionKey_Click() - - Dim strName As String - Dim strKey As String - - ' Prompt the user to enter a name for the key. The name will be stored in options. - If Nz(txtKeyName) = vbNullString Then - MsgBox2 "Key Name Required", "Please enter a friendly name for this encryption key.", _ - "Developers will need to use the same *name* and *key* to decrypt secured items." & vbCrLf & _ - "A named key can be used on multiple computers and/or multiple projects, depending" & vbCrLf & _ - "on your development requirements. See online documentation for more details.", vbInformation - txtKeyName.SetFocus - Exit Sub - Else - strName = txtKeyName - End If - - ' Now prompt for the key itself. - strKey = InputBox("Enter new encryption key:" & vbCrLf & "(At least 32 characters long)") - If strKey = vbNullString Then - Exit Sub - ElseIf Len(strKey) < 32 Then - MsgBox2 "Must be at least 32 characters", "Please enter a longer string of characters to set the key.", , vbExclamation - Else - modEncrypt.SetEncryptionKey strName, strKey - If MsgBox2("Use this key by default?", "Would you like to use '" & strName & "' as the default key name for new projects?", _ - "In most environments you will use the same key for all your projects.", vbYesNo + vbQuestion) = vbYes Then - SetDefaultKeyName strKey - End If - MsgBox2 "Encryption Key Set", "Please save this key in a safe place. It is not saved with the project or options file.", "You will need to have this key to import encrypted data.", vbInformation - End If - SetKeyStatusDisplay - cmdSaveAndClose.SetFocus - chkIUnderstand = False - chkIUnderstand_Click - -End Sub - - '--------------------------------------------------------------------------------------- ' Procedure : SetDefaultKeyName ' Author : Adam Waller @@ -4366,7 +3967,7 @@ Private Sub MapControlsToOptions(eAction As eMapAction) Else Select Case ctl.Name Case "chkTableShowHidden", "chkTableShowSystem", "chkTableShowOther", _ - "cboTableDataSaveType", "txtTableName", "chkIUnderstand" + "cboTableDataSaveType", "txtTableName" ' Skip these exceptions. Case Else ' Get option name from control name following prefix. @@ -4406,7 +4007,7 @@ Private Sub MapControlsToOptions(eAction As eMapAction) ' Enable pages based on options. chkUseGitIntegration_Click - cboSecurity_Click + SetKeyStatusDisplay End Sub @@ -4482,7 +4083,7 @@ End Sub ' Private Sub SetKeyStatusDisplay() If modEncrypt.EncryptionKeySet Then - lblKeyStatus.Caption = "Encryption key is currently set." + lblKeyStatus.Caption = "WARNING: Encryption key is currently set! The encryption tools are DISCONTINUED!" Else lblKeyStatus.Caption = "No encryption key found for current user." End If diff --git a/Version Control.accda.src/modules/clsDbProjProperty.bas b/Version Control.accda.src/modules/clsDbProjProperty.bas index 1a8e2ca4..7b967c4a 100644 --- a/Version Control.accda.src/modules/clsDbProjProperty.bas +++ b/Version Control.accda.src/modules/clsDbProjProperty.bas @@ -49,11 +49,10 @@ Private Sub IDbComponent_Export() If Left(strPath, 4) = "rel:" Then varValue = strPath Else - ' The full path may contain sensitive info. Encrypt the path but not the file name. - varValue = SecurePath(CStr(varValue)) + varValue = CStr(varValue) End If ' ADP projects may have this property - dCollection.Add prp.Name, SecurePath(CStr(varValue)) + dCollection.Add prp.Name, CStr(varValue) Case Else dCollection.Add prp.Name, prp.Value End Select @@ -107,7 +106,7 @@ Private Sub IDbComponent_Import(strFile As String) Case "Name", "Connection" ' Skip these properties Case Else - varValue = Decrypt(dItems(varKey)) + varValue = dItems(varKey) If Left$(varValue, 4) = "rel:" Then varValue = GetPathFromRelative(CStr(varValue)) If dExisting.Exists(varKey) Then If dItems(varKey) <> dExisting(varKey) Then diff --git a/Version Control.accda.src/modules/clsDbProperty.bas b/Version Control.accda.src/modules/clsDbProperty.bas index b5233890..0a5b5e74 100644 --- a/Version Control.accda.src/modules/clsDbProperty.bas +++ b/Version Control.accda.src/modules/clsDbProperty.bas @@ -55,10 +55,7 @@ Private Sub IDbComponent_Export() If Left(strPath, 4) = "rel:" Then varValue = strPath Else - ' The full path may contain sensitive info. Secure the path but not the file name. - ' (Whether the value is encrypted, removed or left as plain text depends on - ' what is selected in the options.) - varValue = SecurePath(CStr(varValue)) + varValue = CStr(varValue) End If End If End If @@ -127,9 +124,6 @@ Private Sub IDbComponent_Import(strFile As String) ' Check if value is as Collection If Not TypeOf dItems(varKey)("Value") Is Collection Then varValue = dItems(varKey)("Value") - ' Check for encryption - strDecrypted = Decrypt(CStr(varValue)) - If CStr(varValue) <> strDecrypted Then varValue = strDecrypted ' Check for relative path If Left$(varValue, 4) = "rel:" Then varValue = GetPathFromRelative(CStr(varValue)) Else diff --git a/Version Control.accda.src/modules/clsDbSavedSpec.bas b/Version Control.accda.src/modules/clsDbSavedSpec.bas index 45fb199f..85d7a237 100644 --- a/Version Control.accda.src/modules/clsDbSavedSpec.bas +++ b/Version Control.accda.src/modules/clsDbSavedSpec.bas @@ -41,7 +41,7 @@ Private Sub IDbComponent_Export() With dSpec .Add "Name", m_Spec.Name .Add "Description", m_Spec.Description - .Add "XML", SecureBetween(m_Spec.XML, " ref.FullPath Or Options.Security = esNone Then + If strPath <> ref.FullPath Then ' Use relative path, or full path if not secured. .Add "FullPath", strPath Else ' Found a non-relative path. .Add "File", FSO.GetFileName(ref.FullPath) - If Options.Security <> esRemove Then .Add "FullPath", Secure(ref.FullPath) + .Add "FullPath", ref.FullPath End If Else If ref.Guid <> vbNullString Then .Add "GUID", ref.Guid diff --git a/Version Control.accda.src/modules/clsOptions.bas b/Version Control.accda.src/modules/clsOptions.bas index a7e3d045..d4081a7b 100644 --- a/Version Control.accda.src/modules/clsOptions.bas +++ b/Version Control.accda.src/modules/clsOptions.bas @@ -31,7 +31,6 @@ Public TablesToExportData As Dictionary Public RunBeforeExport As String Public RunAfterExport As String Public RunAfterBuild As String -Public Security As eSecurity Public KeyName As String Public ShowVCSLegacy As Boolean Public HashAlgorithm As String @@ -41,19 +40,9 @@ Public BreakOnError As Boolean ' Constants for enum values ' (These values are not permanently stored and ' may change between releases.) -Private Const Enum_Security_Encrypt = 1 -Private Const Enum_Security_Remove = 2 -Private Const Enum_Security_None = 3 Private Const Enum_Table_Format_TDF = 10 Private Const Enum_Table_Format_XML = 11 -' Options for security -Public Enum eSecurity - esEncrypt = Enum_Security_Encrypt - esRemove = Enum_Security_Remove - esNone = Enum_Security_None -End Enum - ' Private collections for options and enum values. Private m_colOptions As Collection Private m_dEnum As Dictionary @@ -82,8 +71,6 @@ Public Sub LoadDefaults() .SaveTableSQL = True .StripPublishOption = True .AggressiveSanitize = True - .Security = esNone - .KeyName = modEncrypt.DefaultKeyName .ShowVCSLegacy = True .HashAlgorithm = "SHA256" .UseShortHash = True @@ -234,8 +221,6 @@ Public Sub LoadOptionsFromFile(strFile As String) Set Me.ExportPrintSettings = dOptions(strKey) Case "TablesToExportData" Set Me.TablesToExportData = dOptions(strKey) - Case "Security" - Me.Security = GetEnumVal(dOptions(strKey)) Case Else ' Regular top-level properties CallByName Me, strKey, VbLet, dOptions(strKey) @@ -375,7 +360,6 @@ Private Function SerializeOptions() As Dictionary #End If dInfo.Add "AddinVersion", AppVersion dInfo.Add "AccessVersion", Application.Version & strBit - If Me.Security = esEncrypt Then dInfo.Add "Hash", GetHash ' Loop through options For Each varOption In m_colOptions @@ -411,20 +395,6 @@ Public Function GetOptionsHash() As String End Function -'--------------------------------------------------------------------------------------- -' Procedure : GetHash -' Author : Adam Waller -' Date : 7/29/2020 -' Purpose : Return a hash of the CodeProject.Name to verify encryption. -' : Note that the CodeProject.Name value is sometimes returned in all caps, -' : so we will force it to uppercase so the return value is consistent. -'--------------------------------------------------------------------------------------- -' -Private Function GetHash() As String - GetHash = Encrypt(UCase(CodeProject.Name)) -End Function - - '--------------------------------------------------------------------------------------- ' Procedure : GetTableExportFormatName ' Author : Adam Waller @@ -505,11 +475,6 @@ Private Sub Class_Initialize() ' Load enum values Set m_dEnum = New Dictionary - With m_dEnum - .Add Enum_Security_Encrypt, "Encrypt" - .Add Enum_Security_Remove, "Remove" - .Add Enum_Security_None, "None" - End With ' Load list of property names for reflection type behavior. With m_colOptions diff --git a/Version Control.accda.src/modules/modImportExport.bas b/Version Control.accda.src/modules/modImportExport.bas index 442f8a9d..c3f2220f 100644 --- a/Version Control.accda.src/modules/modImportExport.bas +++ b/Version Control.accda.src/modules/modImportExport.bas @@ -222,16 +222,8 @@ Public Sub Build(strSourceFolder As String, blnFullBuild As Boolean) End If End If - ' If we are using encryption, make sure we are able to decrypt the values. - ' NOTE: There is no CurrentProject at this point, so we will have limited - ' functionality with the options class. Set Options = Nothing Options.LoadOptionsFromFile strSourceFolder & "vcs-options.json" - If Options.Security = esEncrypt And Not VerifyHash(strSourceFolder & "vcs-options.json") Then - MsgBox2 "Encryption Key Mismatch", "The required encryption key is either missing or incorrect.", _ - "Please update the encryption key before building this project from source.", vbExclamation - Exit Sub - End If ' Build original file name for database If blnFullBuild Then @@ -491,7 +483,7 @@ Private Function VerifyHash(strOptionsFile As String) As Boolean VerifyHash = True Else ' Return true if we can successfully decrypt the hash. - VerifyHash = CanDecrypt(strHash) + VerifyHash = False End If End Function diff --git a/Version Control.accda.src/modules/modInstall.bas b/Version Control.accda.src/modules/modInstall.bas index 8da621e3..ef59c21e 100644 --- a/Version Control.accda.src/modules/modInstall.bas +++ b/Version Control.accda.src/modules/modInstall.bas @@ -179,7 +179,8 @@ Public Function UninstallVCSAddin() As Boolean ' (Not sure if we should delete private "keys", since there is no other ' copy of this data, and they would be required to decrypt encrypted content.) - 'DeleteSetting GetCodeVBProject.Name, "Private Keys" + If MsgBox2("Delete RC4 Keys?", "Do you want to delete the RC4 keys from the registry?", "This is strongly recomended!", _ + vbQuestion + vbDefaultButton1 + vbYesNo, "Delete RC4 Keys?") = vbYes Then DeleteSetting GetCodeVBProject.Name, "Private Keys" If Err Then Err.Clear On Error GoTo 0 diff --git a/Version Control.accda.src/modules/modUnitTesting.bas b/Version Control.accda.src/modules/modUnitTesting.bas index 6730367e..e9cc49f8 100644 --- a/Version Control.accda.src/modules/modUnitTesting.bas +++ b/Version Control.accda.src/modules/modUnitTesting.bas @@ -173,49 +173,6 @@ Private Sub TestQuickSort() End Sub -'@TestMethod("Encryption") -Private Sub TestSecureBetween() - On Error GoTo TestFail - - 'Arrange: - Dim expNonEncrypted As String - Dim actnonEncrypted As String - Dim expRemove As String - Dim actRemove As String - Dim expEncrypted As String - Dim actEncrypted As String - - expNonEncrypted = "this should be not be encrypted" - expRemove = "" - expEncrypted = "@{*" - - 'Act: - Options.Security = esNone - actnonEncrypted = SecureBetween(expNonEncrypted, "", "") - - Options.Security = esRemove - actRemove = SecureBetween(expNonEncrypted, "", "") - - Options.Security = esEncrypt - actEncrypted = SecureBetween(expNonEncrypted, "", "") - - Debug.Print actnonEncrypted - Debug.Print actRemove - Debug.Print actEncrypted - - 'Assert: - Assert.AreEqual expNonEncrypted, actnonEncrypted - Assert.AreEqual expRemove, actRemove - Assert.IsTrue actEncrypted Like expEncrypted - - -TestExit: - Exit Sub -TestFail: - Assert.Fail "Test raised an error: #" & Err.Number & " - " & Err.Description -End Sub - - '@TestMethod("Concat") Private Sub TestConcat() diff --git a/Version Control.accda.src/modules/modVCSUtility.bas b/Version Control.accda.src/modules/modVCSUtility.bas index daf38d8b..6145d79c 100644 --- a/Version Control.accda.src/modules/modVCSUtility.bas +++ b/Version Control.accda.src/modules/modVCSUtility.bas @@ -338,7 +338,7 @@ Public Function GetOriginalDbFullPathFromSource(strFolder As String) As String strPath = FSO.BuildPath(strFolder, "vbe-project.json") If FSO.FileExists(strPath) Then Set dContents = ReadJsonFile(strPath) - strFile = Decrypt(dNZ(dContents, "Items\FileName")) + strFile = dNZ(dContents, "Items\FileName") If Left$(strFile, 4) = "rel:" Then ' Use parent folder of source folder GetOriginalDbFullPathFromSource = BuildPath2(StripSlash(strFolder), "..", FSO.GetFileName(Mid$(strFile, 5))) diff --git a/Version Control.accda.src/vbe-references.json b/Version Control.accda.src/vbe-references.json index 1865fcd6..0d0ca906 100644 --- a/Version Control.accda.src/vbe-references.json +++ b/Version Control.accda.src/vbe-references.json @@ -22,7 +22,7 @@ }, "Office": { "GUID": "{2DF8D04C-5BFA-101B-BDE5-00AA0044DE52}", - "Version": "2.7" + "Version": "2.8" }, "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 776dcc33..719f049f 100644 --- a/Version Control.accda.src/vcs-options.json +++ b/Version Control.accda.src/vcs-options.json @@ -1,6 +1,6 @@ { "Info": { - "AddinVersion": "3.3.3", + "AddinVersion": "3.3.14", "AccessVersion": "16.0 64-bit" }, "Options": { From e10c3f56e1eca70b0e41d5c4b83a495fe956d079 Mon Sep 17 00:00:00 2001 From: Hecon5 <54177882+hecon5@users.noreply.github.com> Date: Tue, 16 Mar 2021 08:13:52 -0400 Subject: [PATCH 02/25] Tweaking encryption text box to be more prominent. --- .../forms/frmVCSOptions.bas | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) diff --git a/Version Control.accda.src/forms/frmVCSOptions.bas b/Version Control.accda.src/forms/frmVCSOptions.bas index a44eadc5..8e9c4801 100644 --- a/Version Control.accda.src/forms/frmVCSOptions.bas +++ b/Version Control.accda.src/forms/frmVCSOptions.bas @@ -1223,6 +1223,23 @@ Begin Form ForeThemeColorIndex =10 ForeTint =100.0 End + Begin Label + OverlapFlags =247 + Left =6660 + Top =4560 + Width =2400 + Height =600 + BorderColor =8355711 + Name ="lblKeyStatus" + Caption ="No encryption key found for current user." + GridlineColor =10921638 + LayoutCachedLeft =6660 + LayoutCachedTop =4560 + LayoutCachedWidth =9060 + LayoutCachedHeight =5160 + BorderThemeColorIndex =-1 + ForeTint =100.0 + End End End Begin Page From 785f73d97604a3e6d3b7d079d5237a2ab8bd34ec Mon Sep 17 00:00:00 2001 From: Hecon5 <54177882+hecon5@users.noreply.github.com> Date: Tue, 16 Mar 2021 08:32:57 -0400 Subject: [PATCH 03/25] removing encryption routines that aren't needed; we'll need to leave the key check to determine if there's a stored key or not. --- .../modules/modEncrypt.bas | 310 ------------------ 1 file changed, 310 deletions(-) diff --git a/Version Control.accda.src/modules/modEncrypt.bas b/Version Control.accda.src/modules/modEncrypt.bas index c00ba8e6..c5c2df65 100644 --- a/Version Control.accda.src/modules/modEncrypt.bas +++ b/Version Control.accda.src/modules/modEncrypt.bas @@ -15,97 +15,11 @@ Option Compare Database Option Private Module Option Explicit - Public Const DefaultKeyName = "MSAccessVCS" Private m_Name As String Private m_Key As String - -'--------------------------------------------------------------------------------------- -' Procedure : Secure -' Author : Adam Waller -' Date : 6/1/2020 -' Purpose : Secure the text based on the loaded option. -'--------------------------------------------------------------------------------------- -' -Public Function Secure(strText As String) As String - Select Case Options.Security - Case esEncrypt: Secure = Encrypt(strText) - Case esRemove: Secure = vbNullString - Case esNone: Secure = strText - End Select -End Function - - -'--------------------------------------------------------------------------------------- -' Procedure : SecureBetween -' Author : Casper Englund -' Date : 2020-06-03 -' Purpose : Secures content between two strings. -'--------------------------------------------------------------------------------------- -' -Public Function SecureBetween(strText As String, strStartAfter As String, strEndBefore As String, Optional Compare As VbCompareMethod) As String - - If strText = vbNullString Or Options.Security = esNone Then - SecureBetween = strText - Else - If Options.Security = esEncrypt Then - SecureBetween = EncryptBetween(strText, strStartAfter, strEndBefore, Compare) - ElseIf Options.Security = esRemove Then - Dim lngPos As Long - Dim lngStart As Long - Dim lngLen As Long - - lngPos = InStr(1, strText, strStartAfter, Compare) - If lngPos > 0 Then - lngStart = lngPos + Len(strStartAfter) - 1 - lngPos = InStr(lngStart + 1, strText, strEndBefore) - If lngPos > 0 Then - lngLen = lngPos - lngStart - End If - End If - - If lngLen = 0 Then - ' No tags found. Return original string - SecureBetween = strText - Else - SecureBetween = Left$(strText, lngStart) & Mid$(strText, lngStart + lngLen) - End If - - End If - End If - -End Function - - -'--------------------------------------------------------------------------------------- -' Procedure : SecurePath -' Author : Adam Waller -' Date : 6/1/2020 -' Purpose : Secures just the folder path, not the filename. -'--------------------------------------------------------------------------------------- -' -Public Function SecurePath(strPath As String) As String - - Dim strParent As String - - strParent = FSO.GetParentFolderName(strPath) - If strParent = vbNullString Then - ' Could be relative path or just a filename. - SecurePath = strPath - Else - If Options.Security = esRemove Then - SecurePath = FSO.GetFileName(strPath) - Else - ' Could be encrypted or plain text, depending on options. - SecurePath = FSO.BuildPath(Secure(strParent), FSO.GetFileName(strPath)) - End If - End If - -End Function - - '--------------------------------------------------------------------------------------- ' Procedure : IsEncrypted ' Author : Adam Waller @@ -130,234 +44,10 @@ Public Function EncryptionKeySet() As Boolean End Function -'--------------------------------------------------------------------------------------- -' Procedure : Encrypt -' Author : Adam Waller -' Date : 4/24/2020 -' Purpose : Encrypt a string using the saved key. Uses random key if none set. -'--------------------------------------------------------------------------------------- -' -Public Function Encrypt(strText As String) As String - If strText <> vbNullString Then Encrypt = "@{" & LCase$(EncryptRC4("RC4" & strText, GetKey)) & "}" -End Function - - -'--------------------------------------------------------------------------------------- -' Procedure : EncryptBetween -' Author : Adam Waller -' Date : 5/6/2020 -' Purpose : Encrypt an embedded string. (Such as the path in an XML document) -'--------------------------------------------------------------------------------------- -' -Public Function EncryptBetween(strText As String, strStartAfter As String, strEndBefore As String, Optional Compare As VbCompareMethod) As String - - Dim lngPos As Long - Dim lngStart As Long - Dim lngLen As Long - - lngPos = InStr(1, strText, strStartAfter, Compare) - If lngPos > 0 Then - lngStart = lngPos + Len(strStartAfter) - 1 - lngPos = InStr(lngStart + 1, strText, strEndBefore) - If lngPos > 0 Then - lngLen = lngPos - lngStart - End If - End If - - If lngLen = 0 Then - ' No tags found. Return original string - EncryptBetween = strText - Else - EncryptBetween = Left$(strText, lngStart) & _ - Encrypt(Mid$(strText, lngStart, lngLen)) & _ - Mid$(strText, lngStart + lngLen) - End If - -End Function - - -'--------------------------------------------------------------------------------------- -' Procedure : Decrypt -' Author : Adam Waller -' Date : 4/24/2020 -' Purpose : Decrypt the string using the saved key. (Keep in mind that only part(s) of -' : the string may be encrypted.) -'--------------------------------------------------------------------------------------- -' -Public Function Decrypt(strToDecrypt As String) As String - - Dim strSegment As String - Dim strTest As String - Dim strDecrypted As String - Dim lngStart As Long - Dim lngEnd As Long - - ' Start search at first character in string - lngStart = 1 - lngEnd = 1 - - ' Loop through each encrypted part of the string - Do - ' Identify encrypted portion of the string. - lngStart = InStr(lngStart, strToDecrypt, "@{") - - ' Any more tags found? - If lngStart < 1 Then - If lngEnd < 1 Then - ' Might not have been anything to decrypt - strDecrypted = strToDecrypt - Else - ' Add any remaining portion of the string - strDecrypted = strDecrypted & Mid$(strToDecrypt, lngEnd) - End If - Exit Do - End If - - ' Add any intermediate text - If lngStart > lngEnd Then - strDecrypted = strDecrypted & Mid$(strToDecrypt, lngEnd, lngStart - lngEnd) - End If - - ' Look for ending termination - lngEnd = InStr(lngStart + 3, strToDecrypt, "}") + 1 - If lngEnd > 1 Then - ' Get full encrypted segment - strSegment = Mid$(strToDecrypt, lngStart, lngEnd - lngStart) - ' Decrypt this segment. - strTest = DecryptRC4(Mid$(UCase$(strSegment), 3, lngEnd - lngStart - 3), GetKey) - If Left$(strTest, 3) = "RC4" Then - ' Successfully decrypted. - strDecrypted = strDecrypted & Mid$(strTest, 4) - Else - ' Leave encrypted string - strDecrypted = strDecrypted & strSegment - End If - ' Move to next position - lngStart = lngEnd - End If - Loop - - ' Return decrypted value - Decrypt = strDecrypted - -End Function - - -'--------------------------------------------------------------------------------------- -' Procedure : CanDecrypt -' Author : Adam Waller -' Date : 7/29/2020 -' Purpose : Returns true of the encrypted string can be successfully decrypted. -'--------------------------------------------------------------------------------------- -' -Public Function CanDecrypt(strEncrypted As String) As Boolean - CanDecrypt = (strEncrypted <> Decrypt(strEncrypted)) -End Function - - -'--------------------------------------------------------------------------------------- -' Procedure : SetEncryptionKey -' Author : Adam Waller -' Date : 4/24/2020 -' Purpose : Sets the encryption key in the current user's registry. -'--------------------------------------------------------------------------------------- -' -Public Sub SetEncryptionKey(strName As String, strKey As String) - SaveSetting GetCodeVBProject.Name, "Private Keys", strName, strKey - m_Name = strName - m_Key = strKey -End Sub - - -'--------------------------------------------------------------------------------------- -' Procedure : GetKey -' Author : Adam Waller -' Date : 4/24/2020 -' Purpose : Get the current key from the registry. (Or the CodeProject name if no key set.) -'--------------------------------------------------------------------------------------- -' Private Function GetKey() As String If m_Name = vbNullString Then m_Name = Options.KeyName If m_Name = vbNullString Then m_Name = DefaultKeyName If m_Key = vbNullString Then m_Key = GetSetting(GetCodeVBProject.Name, "Private Keys", m_Name, CodeProject.Name) ' Return cached key name, rather than looking it up from the registry each time. GetKey = m_Key -End Function - - -'--------------------------------------------------------------------------------------- -' Procedure : EncryptRC4 -' Author : Adam Waller -' Date : 4/9/2020 -' Purpose : Encrypt some text with a key. (Reversible Encryption) -'--------------------------------------------------------------------------------------- -' -Private Function EncryptRC4(strText As String, strKey As String) As String - EncryptRC4 = ToHexDump(CryptRC4(strText, strKey)) -End Function - - -'--------------------------------------------------------------------------------------- -' Procedure : DecryptRC4 -' Author : Adam Waller -' Date : 4/9/2020 -' Purpose : Decrypt the text using a key. -'--------------------------------------------------------------------------------------- -' -Private Function DecryptRC4(strEncrypted As String, strKey As String) As String - DecryptRC4 = CryptRC4(FromHexDump(strEncrypted), strKey) -End Function - - -' The following code is credited to https://stackoverflow.com/questions/7025644/vb6-encrypt-text-using-password -Private Function CryptRC4(sText As String, sKey As String) As String - Dim baS(0 To 255) As Byte - Dim baK(0 To 255) As Byte - Dim bytSwap As Byte - Dim lI As Long - Dim lJ As Long - Dim lIdx As Long - - For lIdx = 0 To 255 - baS(lIdx) = lIdx - baK(lIdx) = Asc(Mid$(sKey, 1 + (lIdx Mod Len(sKey)), 1)) - Next - For lI = 0 To 255 - lJ = (lJ + baS(lI) + baK(lI)) Mod 256 - bytSwap = baS(lI) - baS(lI) = baS(lJ) - baS(lJ) = bytSwap - Next - lI = 0 - lJ = 0 - For lIdx = 1 To Len(sText) - lI = (lI + 1) Mod 256 - lJ = (lJ + baS(lI)) Mod 256 - bytSwap = baS(lI) - baS(lI) = baS(lJ) - baS(lJ) = bytSwap - CryptRC4 = CryptRC4 & Chr$((pvCryptXor(baS((CLng(baS(lI)) + baS(lJ)) Mod 256), Asc(Mid$(sText, lIdx, 1))))) - Next -End Function - -Private Function pvCryptXor(ByVal lI As Long, ByVal lJ As Long) As Long - If lI = lJ Then - pvCryptXor = lJ - Else - pvCryptXor = lI Xor lJ - End If -End Function - -Private Function ToHexDump(sText As String) As String - Dim lIdx As Long - For lIdx = 1 To Len(sText) - ToHexDump = ToHexDump & Right$("0" & Hex$(Asc(Mid$(sText, lIdx, 1))), 2) - Next -End Function - -Private Function FromHexDump(sText As String) As String - Dim lIdx As Long - For lIdx = 1 To Len(sText) Step 2 - FromHexDump = FromHexDump & Chr$(CLng("&H" & Mid$(sText, lIdx, 2))) - Next End Function \ No newline at end of file From 54bcd0bdd4192c74cc1b196aabac3d79be142d1d Mon Sep 17 00:00:00 2001 From: Hecon5 <54177882+hecon5@users.noreply.github.com> Date: Tue, 16 Mar 2021 08:33:41 -0400 Subject: [PATCH 04/25] Resizing the key caption and changing behavior so that it only shows up when relevant; I've also had to move the "explain options" button as a result. --- .../forms/frmVCSOptions.bas | 42 +++++++++++-------- 1 file changed, 24 insertions(+), 18 deletions(-) diff --git a/Version Control.accda.src/forms/frmVCSOptions.bas b/Version Control.accda.src/forms/frmVCSOptions.bas index 8e9c4801..eac9be6a 100644 --- a/Version Control.accda.src/forms/frmVCSOptions.bas +++ b/Version Control.accda.src/forms/frmVCSOptions.bas @@ -1105,10 +1105,10 @@ Begin Form Begin CommandButton FontUnderline = NotDefault OverlapFlags =247 - Left =6900 - Top =5520 + Left =7140 + Top =5640 Width =2160 - TabIndex =11 + TabIndex =10 ForeColor =12673797 Name ="cmdExplainOptions" Caption ="Explain options..." @@ -1153,10 +1153,10 @@ Begin Form End BackStyle =0 - LayoutCachedLeft =6900 - LayoutCachedTop =5520 - LayoutCachedWidth =9060 - LayoutCachedHeight =5880 + LayoutCachedLeft =7140 + LayoutCachedTop =5640 + LayoutCachedWidth =9300 + LayoutCachedHeight =6000 PictureCaptionArrangement =4 ForeThemeColorIndex =10 ForeTint =100.0 @@ -1225,19 +1225,22 @@ Begin Form End Begin Label OverlapFlags =247 - Left =6660 - Top =4560 - Width =2400 - Height =600 + TextAlign =2 + Left =5520 + Top =4140 + Width =3780 + Height =1380 + FontWeight =700 BorderColor =8355711 + ForeColor =255 Name ="lblKeyStatus" - Caption ="No encryption key found for current user." GridlineColor =10921638 - LayoutCachedLeft =6660 - LayoutCachedTop =4560 - LayoutCachedWidth =9060 - LayoutCachedHeight =5160 + LayoutCachedLeft =5520 + LayoutCachedTop =4140 + LayoutCachedWidth =9300 + LayoutCachedHeight =5520 BorderThemeColorIndex =-1 + ForeThemeColorIndex =-1 ForeTint =100.0 End End @@ -4100,9 +4103,12 @@ End Sub ' Private Sub SetKeyStatusDisplay() If modEncrypt.EncryptionKeySet Then - lblKeyStatus.Caption = "WARNING: Encryption key is currently set! The encryption tools are DISCONTINUED!" + lblKeyStatus.Visible = True + lblKeyStatus.Caption = "WARNING:" & vbNewLine & vbNewLine & "Encryption key is currently set! The encryption tools are DISCONTINUED!" Else - lblKeyStatus.Caption = "No encryption key found for current user." + lblKeyStatus.Caption = vbNullString + lblKeyStatus.Visible = False + End If End Sub From ecc93679a91564c4aa84e6ed35202d6558fb52d8 Mon Sep 17 00:00:00 2001 From: Hecon5 <54177882+hecon5@users.noreply.github.com> Date: Tue, 16 Mar 2021 08:37:25 -0400 Subject: [PATCH 05/25] Increment app 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 1213d995..b0e5933d 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": "3.3.15", + "Value": "3.3.16", "Type": 10 }, "Auto Compact": { From eeebf199b17a0e510abf9d083f1029ac23c9cfd3 Mon Sep 17 00:00:00 2001 From: Hecon5 <54177882+hecon5@users.noreply.github.com> Date: Tue, 16 Mar 2021 08:43:09 -0400 Subject: [PATCH 06/25] revert these; there's no reason to upgrade them. --- Version Control.accda.src/dbs-properties.json | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Version Control.accda.src/dbs-properties.json b/Version Control.accda.src/dbs-properties.json index b0e5933d..821e99bb 100644 --- a/Version Control.accda.src/dbs-properties.json +++ b/Version Control.accda.src/dbs-properties.json @@ -117,7 +117,7 @@ "Type": 4 }, "ProjVer": { - "Value": 141, + "Value": 142, "Type": 3 }, "QueryTimeout": { @@ -197,7 +197,7 @@ "Type": 2 }, "Version": { - "Value": "14.0", + "Value": "12.0", "Type": 12 }, "WebDesignMode": { From 4075962571116e8e6347c7bb23c4f3a09abef5d1 Mon Sep 17 00:00:00 2001 From: Hecon5 <54177882+hecon5@users.noreply.github.com> Date: Tue, 16 Mar 2021 09:00:01 -0400 Subject: [PATCH 07/25] Unify hashing algorythm --- Version Control.accda.src/modules/clsOptions.bas | 2 +- Version Control.accda.src/modules/modHash.bas | 9 +++++---- 2 files changed, 6 insertions(+), 5 deletions(-) diff --git a/Version Control.accda.src/modules/clsOptions.bas b/Version Control.accda.src/modules/clsOptions.bas index d4081a7b..1a3b3bf2 100644 --- a/Version Control.accda.src/modules/clsOptions.bas +++ b/Version Control.accda.src/modules/clsOptions.bas @@ -72,7 +72,7 @@ Public Sub LoadDefaults() .StripPublishOption = True .AggressiveSanitize = True .ShowVCSLegacy = True - .HashAlgorithm = "SHA256" + .HashAlgorithm = DefaultHashAlgorythm .UseShortHash = True ' Table data export diff --git a/Version Control.accda.src/modules/modHash.bas b/Version Control.accda.src/modules/modHash.bas index 36938849..56d653a4 100644 --- a/Version Control.accda.src/modules/modHash.bas +++ b/Version Control.accda.src/modules/modHash.bas @@ -62,8 +62,9 @@ Public Declare PtrSafe Function BCryptGetProperty Lib "BCrypt.dll" ( _ Private Const ModuleName As String = "modHash" +Public Const DefaultHashAlgorythm As String = "SHA256" -Private Function NGHash(pData As LongPtr, lenData As Long, Optional HashingAlgorithm As String = "SHA256") As Byte() +Private Function NGHash(pData As LongPtr, lenData As Long, Optional HashingAlgorithm As String = DefaultHashAlgorythm) As Byte() 'Erik A, 2019, adapted by Adam Waller 'Hash data by using the Next Generation Cryptography API @@ -130,14 +131,14 @@ End Function ' Purpose : Wrappers for NGHash functions '--------------------------------------------------------------------------------------- ' -Private Function HashBytes(Data() As Byte, Optional HashingAlgorithm As String = "SHA512") As Byte() +Private Function HashBytes(Data() As Byte, Optional HashingAlgorithm As String = DefaultHashAlgorythm) As Byte() If DebugMode Then On Error Resume Next Else On Error Resume Next HashBytes = NGHash(VarPtr(Data(LBound(Data))), UBound(Data) - LBound(Data) + 1, HashingAlgorithm) If Catch(9) Then HashBytes = NGHash(VarPtr(Null), UBound(Data) - LBound(Data) + 1, HashingAlgorithm) CatchAny eelCritical, "Error hashing data!", ModuleName & ".HashBytes", True, True End Function -Private Function HashString(str As String, Optional HashingAlgorithm As String = "SHA512") As Byte() +Private Function HashString(str As String, Optional HashingAlgorithm As String = DefaultHashAlgorythm) As Byte() If DebugMode Then On Error Resume Next Else On Error Resume Next HashString = NGHash(StrPtr(str), Len(str) * 2, HashingAlgorithm) If Catch(9) Then HashString = NGHash(StrPtr(vbNullString), Len(str) * 2, HashingAlgorithm) @@ -200,7 +201,7 @@ Private Function GetHash(bteContent() As Byte) As String Dim strAlgorithm As String ' Get hashing options - strAlgorithm = Nz2(Options.HashAlgorithm, "SHA256") + strAlgorithm = Nz2(Options.HashAlgorithm, DefaultHashAlgorythm) If Options.UseShortHash Then intLength = 7 ' Start performance timer and compute the hash From bf42c4bd186a7149cd88bf48e1522f7049d29e37 Mon Sep 17 00:00:00 2001 From: Hecon5 <54177882+hecon5@users.noreply.github.com> Date: Tue, 16 Mar 2021 09:09:30 -0400 Subject: [PATCH 08/25] don't need to update this; --- Version Control.accda.src/vbe-references.json | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Version Control.accda.src/vbe-references.json b/Version Control.accda.src/vbe-references.json index 0d0ca906..1865fcd6 100644 --- a/Version Control.accda.src/vbe-references.json +++ b/Version Control.accda.src/vbe-references.json @@ -22,7 +22,7 @@ }, "Office": { "GUID": "{2DF8D04C-5BFA-101B-BDE5-00AA0044DE52}", - "Version": "2.8" + "Version": "2.7" }, "Scripting": { "GUID": "{420B2830-E718-11CF-893D-00A0C9054228}", From 616fd8270702fb363915798b7aac0a26b28ca0f0 Mon Sep 17 00:00:00 2001 From: Hecon5 <54177882+hecon5@users.noreply.github.com> Date: Tue, 16 Mar 2021 09:13:29 -0400 Subject: [PATCH 09/25] GetHash should be the same for each class. Rename them to use same no that Options.GetHash isn't needed to determine the encryption --- Version Control.accda.src/forms/frmVCSMain.bas | 2 +- Version Control.accda.src/modules/clsOptions.bas | 6 +++--- Version Control.accda.src/modules/modImportExport.bas | 4 ++-- 3 files changed, 6 insertions(+), 6 deletions(-) diff --git a/Version Control.accda.src/forms/frmVCSMain.bas b/Version Control.accda.src/forms/frmVCSMain.bas index 79b382f8..c2f4d42c 100644 --- a/Version Control.accda.src/forms/frmVCSMain.bas +++ b/Version Control.accda.src/forms/frmVCSMain.bas @@ -2042,7 +2042,7 @@ Public Sub Form_Load() ' Require full export after options change If DatabaseOpen Then - If VCSIndex.OptionsHash <> Options.GetOptionsHash Then + If VCSIndex.OptionsHash <> Options.GetHash Then chkFullExport = True chkFullExport.Enabled = False End If diff --git a/Version Control.accda.src/modules/clsOptions.bas b/Version Control.accda.src/modules/clsOptions.bas index 1a3b3bf2..ed1d5f27 100644 --- a/Version Control.accda.src/modules/clsOptions.bas +++ b/Version Control.accda.src/modules/clsOptions.bas @@ -383,15 +383,15 @@ End Function '--------------------------------------------------------------------------------------- -' Procedure : OptionsHash +' Procedure : GetHash ' Author : Adam Waller ' Date : 2/16/2021 ' Purpose : Return a hash of the current options. Used to detect if options have ' : changed, which may require a full export to reflect the change. '--------------------------------------------------------------------------------------- ' -Public Function GetOptionsHash() As String - GetOptionsHash = GetDictionaryHash(SerializeOptions) +Public Function GetHash() As String + GetHash = GetDictionaryHash(SerializeOptions) End Function diff --git a/Version Control.accda.src/modules/modImportExport.bas b/Version Control.accda.src/modules/modImportExport.bas index c3f2220f..5b12f6fd 100644 --- a/Version Control.accda.src/modules/modImportExport.bas +++ b/Version Control.accda.src/modules/modImportExport.bas @@ -61,7 +61,7 @@ Public Sub ExportSource(blnFullExport As Boolean) End If ' If options (or VCS version) have changed, a full export will be required - If (VCSIndex.OptionsHash <> Options.GetOptionsHash) Then blnFullExport = True + If (VCSIndex.OptionsHash <> Options.GetHash) Then blnFullExport = True ' Begin timer at start of export. sngStart = Timer @@ -155,7 +155,7 @@ Public Sub ExportSource(blnFullExport As Boolean) With VCSIndex .ExportDate = Now If blnFullExport Then .FullExportDate = Now - .OptionsHash = Options.GetOptionsHash + .OptionsHash = Options.GetHash .Save End With From bb947cf64a6796c8c0546a7a9b61c3c4d5d71976 Mon Sep 17 00:00:00 2001 From: Hecon5 <54177882+hecon5@users.noreply.github.com> Date: Tue, 16 Mar 2021 10:00:20 -0400 Subject: [PATCH 10/25] This will prompt users who have an encryption key present in their profile and disable installation if it is. --- .../forms/frmVCSInstall.bas | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/Version Control.accda.src/forms/frmVCSInstall.bas b/Version Control.accda.src/forms/frmVCSInstall.bas index 772884e9..f47e6b1c 100644 --- a/Version Control.accda.src/forms/frmVCSInstall.bas +++ b/Version Control.accda.src/forms/frmVCSInstall.bas @@ -1629,4 +1629,20 @@ Private Sub Form_Load() lblInstalled.Caption = "Version " & InstalledVersion & " currently installed." End If + If EncryptionKeySet Then + + If MsgBox2("WARNING: Encryption has been discontinued!", _ + "Your profile appears to have stored keys." & _ + "We STRONGLY recommend removing them prior to installing this update. " & _ + "This version will not remove your keys, so you can still get a prior version to decrypt and build your past databases." & _ + "We recommend exporting your database without encryption first prior to installing this update.", _ + "Allow update? YES = Install. Anything else = Cancel Update", vbCritical + vbYesNo + vbDefaultButton2, "Security Key found!") <> vbYes Then + + cmdInstall.Enabled = False + chkAddTrustedLocation.Enabled = False + chkOpenAfterInstall.Enabled = False + lblSubheading.Caption = "Cannot install: encryption key present. Open projects and remove keys first." + End If + End If + End Sub From 2636765e9f11966dbee5f3dae698e8b1d2c1768c Mon Sep 17 00:00:00 2001 From: Hecon5 <54177882+hecon5@users.noreply.github.com> Date: Tue, 16 Mar 2021 12:37:37 -0400 Subject: [PATCH 11/25] These have to stay for now to handle legacy setting imports. --- Version Control.accda.src/modules/clsOptions.bas | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/Version Control.accda.src/modules/clsOptions.bas b/Version Control.accda.src/modules/clsOptions.bas index ed1d5f27..cd03b11c 100644 --- a/Version Control.accda.src/modules/clsOptions.bas +++ b/Version Control.accda.src/modules/clsOptions.bas @@ -221,6 +221,9 @@ Public Sub LoadOptionsFromFile(strFile As String) Set Me.ExportPrintSettings = dOptions(strKey) Case "TablesToExportData" Set Me.TablesToExportData = dOptions(strKey) + Case "Security" + ' It's possible these are still in the saved options. + ' This ignores them, but doesn't error out. Case Else ' Regular top-level properties CallByName Me, strKey, VbLet, dOptions(strKey) @@ -366,8 +369,8 @@ Private Function SerializeOptions() As Dictionary strOption = CStr(varOption) Select Case strOption Case "Security" - ' Translate enums to friendly names. - dOptions.Add strOption, GetEnumName(CallByName(Me, strOption, VbGet)) + ' It's possible these are still in the saved options. + ' This ignores them, but doesn't error out. Case Else ' Simulate reflection to serialize properties. dOptions.Add strOption, CallByName(Me, strOption, VbGet) @@ -494,7 +497,6 @@ Private Sub Class_Initialize() .Add "RunBeforeExport" .Add "RunAfterExport" .Add "RunAfterBuild" - .Add "Security" .Add "KeyName" .Add "ShowVCSLegacy" .Add "HashAlgorithm" From a898060ac49b5a180e7af90475e544566f0fc533 Mon Sep 17 00:00:00 2001 From: Hecon5 <54177882+hecon5@users.noreply.github.com> Date: Tue, 16 Mar 2021 13:31:58 -0400 Subject: [PATCH 12/25] I thought I could speal. --- Version Control.accda.src/modules/clsOptions.bas | 2 +- Version Control.accda.src/modules/modHash.bas | 10 +++++----- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/Version Control.accda.src/modules/clsOptions.bas b/Version Control.accda.src/modules/clsOptions.bas index cd03b11c..57f7f423 100644 --- a/Version Control.accda.src/modules/clsOptions.bas +++ b/Version Control.accda.src/modules/clsOptions.bas @@ -72,7 +72,7 @@ Public Sub LoadDefaults() .StripPublishOption = True .AggressiveSanitize = True .ShowVCSLegacy = True - .HashAlgorithm = DefaultHashAlgorythm + .HashAlgorithm = DefaultHashAlgorithm .UseShortHash = True ' Table data export diff --git a/Version Control.accda.src/modules/modHash.bas b/Version Control.accda.src/modules/modHash.bas index 56d653a4..2e3e9325 100644 --- a/Version Control.accda.src/modules/modHash.bas +++ b/Version Control.accda.src/modules/modHash.bas @@ -62,9 +62,9 @@ Public Declare PtrSafe Function BCryptGetProperty Lib "BCrypt.dll" ( _ Private Const ModuleName As String = "modHash" -Public Const DefaultHashAlgorythm As String = "SHA256" +Public Const DefaultHashAlgorithm As String = "SHA256" -Private Function NGHash(pData As LongPtr, lenData As Long, Optional HashingAlgorithm As String = DefaultHashAlgorythm) As Byte() +Private Function NGHash(pData As LongPtr, lenData As Long, Optional HashingAlgorithm As String = DefaultHashAlgorithm) As Byte() 'Erik A, 2019, adapted by Adam Waller 'Hash data by using the Next Generation Cryptography API @@ -131,14 +131,14 @@ End Function ' Purpose : Wrappers for NGHash functions '--------------------------------------------------------------------------------------- ' -Private Function HashBytes(Data() As Byte, Optional HashingAlgorithm As String = DefaultHashAlgorythm) As Byte() +Private Function HashBytes(Data() As Byte, Optional HashingAlgorithm As String = DefaultHashAlgorithm) As Byte() If DebugMode Then On Error Resume Next Else On Error Resume Next HashBytes = NGHash(VarPtr(Data(LBound(Data))), UBound(Data) - LBound(Data) + 1, HashingAlgorithm) If Catch(9) Then HashBytes = NGHash(VarPtr(Null), UBound(Data) - LBound(Data) + 1, HashingAlgorithm) CatchAny eelCritical, "Error hashing data!", ModuleName & ".HashBytes", True, True End Function -Private Function HashString(str As String, Optional HashingAlgorithm As String = DefaultHashAlgorythm) As Byte() +Private Function HashString(str As String, Optional HashingAlgorithm As String = DefaultHashAlgorithm) As Byte() If DebugMode Then On Error Resume Next Else On Error Resume Next HashString = NGHash(StrPtr(str), Len(str) * 2, HashingAlgorithm) If Catch(9) Then HashString = NGHash(StrPtr(vbNullString), Len(str) * 2, HashingAlgorithm) @@ -201,7 +201,7 @@ Private Function GetHash(bteContent() As Byte) As String Dim strAlgorithm As String ' Get hashing options - strAlgorithm = Nz2(Options.HashAlgorithm, DefaultHashAlgorythm) + strAlgorithm = Nz2(Options.HashAlgorithm, DefaultHashAlgorithm) If Options.UseShortHash Then intLength = 7 ' Start performance timer and compute the hash From 859a8ebc9476fe05e4ec67397bf65e6498939067 Mon Sep 17 00:00:00 2001 From: Hecon5 <54177882+hecon5@users.noreply.github.com> Date: Tue, 16 Mar 2021 13:46:55 -0400 Subject: [PATCH 13/25] revised this per discussion. --- Version Control.accda.src/modules/clsDbProperty.bas | 8 +------- 1 file changed, 1 insertion(+), 7 deletions(-) diff --git a/Version Control.accda.src/modules/clsDbProperty.bas b/Version Control.accda.src/modules/clsDbProperty.bas index 0a5b5e74..8e23cd94 100644 --- a/Version Control.accda.src/modules/clsDbProperty.bas +++ b/Version Control.accda.src/modules/clsDbProperty.bas @@ -35,7 +35,6 @@ Private Sub IDbComponent_Export() Dim dCollection As Dictionary Dim dItem As Dictionary Dim varValue As Variant - Dim strPath As String Set dCollection = New Dictionary @@ -51,12 +50,7 @@ Private Sub IDbComponent_Export() If prp.Name = "AppIcon" Or prp.Name = "Name" Then If Len(varValue) > 0 Then ' Try to use a relative path - strPath = GetRelativePath(CStr(varValue)) - If Left(strPath, 4) = "rel:" Then - varValue = strPath - Else - varValue = CStr(varValue) - End If + varValue = GetRelativePath(CStr(varValue)) End If End If Set dItem = New Dictionary From d37c014ca2495bf0f23657a63e7e555d38d4c1c6 Mon Sep 17 00:00:00 2001 From: Hecon5 <54177882+hecon5@users.noreply.github.com> Date: Tue, 16 Mar 2021 13:52:37 -0400 Subject: [PATCH 14/25] This needs to go bye bye, too. --- .../forms/frmVCSOptions.bas | 18 ------------------ 1 file changed, 18 deletions(-) diff --git a/Version Control.accda.src/forms/frmVCSOptions.bas b/Version Control.accda.src/forms/frmVCSOptions.bas index eac9be6a..73de4f7c 100644 --- a/Version Control.accda.src/forms/frmVCSOptions.bas +++ b/Version Control.accda.src/forms/frmVCSOptions.bas @@ -3886,24 +3886,6 @@ Private Sub cmdSaveAsDefault_Click() End Sub -'--------------------------------------------------------------------------------------- -' Procedure : SetDefaultKeyName -' Author : Adam Waller -' Date : 5/2/2020 -' Purpose : Sets the key name as default for projects. -'--------------------------------------------------------------------------------------- -' -Private Sub SetDefaultKeyName(strName As String) - Dim cOptions As clsOptions - Set cOptions = New clsOptions - With cOptions - .LoadDefaultOptions - .KeyName = strName - .SaveOptionsAsDefault - End With -End Sub - - '--------------------------------------------------------------------------------------- ' Procedure : cmdUpdateTableData_Click ' Author : Adam Waller From 6f33ea9c76ab7ced23b4272d86cd799e63afdb84 Mon Sep 17 00:00:00 2001 From: Hecon5 <54177882+hecon5@users.noreply.github.com> Date: Tue, 16 Mar 2021 13:56:32 -0400 Subject: [PATCH 15/25] update these --- Version Control.accda.src/vcs-options.json | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/Version Control.accda.src/vcs-options.json b/Version Control.accda.src/vcs-options.json index 719f049f..9b8ef509 100644 --- a/Version Control.accda.src/vcs-options.json +++ b/Version Control.accda.src/vcs-options.json @@ -1,6 +1,6 @@ { "Info": { - "AddinVersion": "3.3.14", + "AddinVersion": "3.3.16", "AccessVersion": "16.0 64-bit" }, "Options": { @@ -48,7 +48,6 @@ "RunBeforeExport": "", "RunAfterExport": "", "RunAfterBuild": "", - "Security": "None", "KeyName": "MSAccessVCS", "ShowVCSLegacy": true, "HashAlgorithm": "SHA256", From 9f7b0ca0d4f516ea642d298f7a746cd043187740 Mon Sep 17 00:00:00 2001 From: joyfullservice Date: Wed, 17 Mar 2021 10:57:44 -0500 Subject: [PATCH 16/25] Give more explanation on encryption removal Adjusted to a little more gentle warning and hopefully more clear explanation about why we are removing the encryption feature. --- .../forms/frmVCSInstall.bas | 47 +++++++++---------- 1 file changed, 22 insertions(+), 25 deletions(-) diff --git a/Version Control.accda.src/forms/frmVCSInstall.bas b/Version Control.accda.src/forms/frmVCSInstall.bas index f47e6b1c..d6eb9179 100644 --- a/Version Control.accda.src/forms/frmVCSInstall.bas +++ b/Version Control.accda.src/forms/frmVCSInstall.bas @@ -17,11 +17,11 @@ Begin Form GridY =24 DatasheetFontHeight =11 ItemSuffix =39 - Left =-17265 + Left =3225 Top =2430 - Right =-6105 - Bottom =10335 - DatasheetGridlinesColor =15132391 + Right =28545 + Bottom =15015 + DatasheetGridlinesColor =14806254 RecSrcDt = Begin 0x79e78b777268e540 End @@ -1419,7 +1419,7 @@ Begin Form Width =2160 FontSize =9 TabIndex =4 - ForeColor =12673797 + ForeColor =16711680 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 =14461583 - BorderColor =14461583 - HoverColor =15189940 - PressedColor =9917743 + BackColor =14136213 + BorderColor =14136213 + HoverColor =15060409 + PressedColor =9592887 HoverForeColor =4210752 PressedForeColor =4210752 WebImagePaddingLeft =2 @@ -1573,6 +1573,19 @@ End Sub ' Private Sub cmdInstall_Click() + ' Check for legacy encryption key. + If EncryptionKeySet Then + If MsgBox2("IMPORTANT: Encryption Feature Removed", _ + "Prior versions of this add-in supported a reversible ""encryption"" of certain potentially sensitive items such as file paths. " & _ + "This feature has been removed in this version of the add-in. More information can be found on GitHub issue #193." & vbCrLf & vbCrLf & _ + "For security reasons, this upgrade will REMOVE the existing encryption key. If you have source files that use this key, " & _ + "and do NOT have a working copy of the built database, please build the project from source BEFORE upgrading the add-in. ", _ + "REMOVE existing encryption key? (Make sure you have a copy of this key.)", vbExclamation + vbYesNo + vbDefaultButton2) <> vbYes Then + + MsgBox2 "Installation Canceled", "Removal of existing encryption keys is required to upgrade.", , vbInformation + End If + End If + ' Show hourglass, as there may be a brief pause before the confirmation message. DoCmd.Hourglass True @@ -1628,21 +1641,5 @@ Private Sub Form_Load() Else lblInstalled.Caption = "Version " & InstalledVersion & " currently installed." End If - - If EncryptionKeySet Then - - If MsgBox2("WARNING: Encryption has been discontinued!", _ - "Your profile appears to have stored keys." & _ - "We STRONGLY recommend removing them prior to installing this update. " & _ - "This version will not remove your keys, so you can still get a prior version to decrypt and build your past databases." & _ - "We recommend exporting your database without encryption first prior to installing this update.", _ - "Allow update? YES = Install. Anything else = Cancel Update", vbCritical + vbYesNo + vbDefaultButton2, "Security Key found!") <> vbYes Then - - cmdInstall.Enabled = False - chkAddTrustedLocation.Enabled = False - chkOpenAfterInstall.Enabled = False - lblSubheading.Caption = "Cannot install: encryption key present. Open projects and remove keys first." - End If - End If End Sub From 9821a5270f7d48c7060562afb5c863f2c7209d83 Mon Sep 17 00:00:00 2001 From: joyfullservice Date: Wed, 17 Mar 2021 11:36:47 -0500 Subject: [PATCH 17/25] Encryption key will not exist after upgrade No need to warn the user, since the key will not exist after upgrading to the latest version. (Removing the key is required to upgrade.) --- .../forms/frmVCSOptions.bas | 65 ++++--------------- 1 file changed, 12 insertions(+), 53 deletions(-) diff --git a/Version Control.accda.src/forms/frmVCSOptions.bas b/Version Control.accda.src/forms/frmVCSOptions.bas index 73de4f7c..fc1f09de 100644 --- a/Version Control.accda.src/forms/frmVCSOptions.bas +++ b/Version Control.accda.src/forms/frmVCSOptions.bas @@ -16,11 +16,11 @@ Begin Form Width =10080 DatasheetFontHeight =11 ItemSuffix =228 - Left =-25575 - Top =1710 - Right =-255 - Bottom =14295 - DatasheetGridlinesColor =15132391 + Left =3225 + Top =2430 + Right =22695 + Bottom =15015 + DatasheetGridlinesColor =14806254 RecSrcDt = Begin 0x79e78b777268e540 End @@ -607,7 +607,7 @@ Begin Form Height =315 TabIndex =4 BorderColor =10921638 - ForeColor =3484194 + ForeColor =4138256 Name ="cboHashAlgorithm" RowSourceType ="Value List" RowSource ="\"SHA1\";\"SHA256\";\"SHA512\"" @@ -1109,7 +1109,7 @@ Begin Form Top =5640 Width =2160 TabIndex =10 - ForeColor =12673797 + ForeColor =16711680 Name ="cmdExplainOptions" Caption ="Explain options..." HyperlinkAddress ="https://github.com/joyfullservice/msaccess-vcs-integration/wiki/Documentation#op" @@ -1208,7 +1208,7 @@ Begin Form FontSize =10 BackColor =14262935 BorderColor =15321539 - ForeColor =12673797 + ForeColor =16711680 Name ="lblPrintSettingsOptions" Caption ="Options..." HyperlinkAddress ="#" @@ -1223,26 +1223,6 @@ Begin Form ForeThemeColorIndex =10 ForeTint =100.0 End - Begin Label - OverlapFlags =247 - TextAlign =2 - Left =5520 - Top =4140 - Width =3780 - Height =1380 - FontWeight =700 - BorderColor =8355711 - ForeColor =255 - Name ="lblKeyStatus" - GridlineColor =10921638 - LayoutCachedLeft =5520 - LayoutCachedTop =4140 - LayoutCachedWidth =9300 - LayoutCachedHeight =5520 - BorderThemeColorIndex =-1 - ForeThemeColorIndex =-1 - ForeTint =100.0 - End End End Begin Page @@ -2160,7 +2140,7 @@ Begin Form Height =315 TabIndex =4 BorderColor =10921638 - ForeColor =3484194 + ForeColor =4138256 Name ="cboTableDataSaveType" RowSourceType ="Value List" GridlineColor =10921638 @@ -2339,7 +2319,7 @@ Begin Form FontSize =10 BackColor =14262935 BorderColor =15321539 - ForeColor =12673797 + ForeColor =16711680 Name ="lblAddOtherTable" Caption ="Other..." OnClick ="[Event Procedure]" @@ -2728,7 +2708,7 @@ Begin Form Height =315 TabIndex =5 BorderColor =10921638 - ForeColor =3484194 + ForeColor =4138256 Name ="cboMergeConflicts" RowSourceType ="Value List" RowSource ="\"Cancel Merge\";\"Skip Object\";\"Overwrite\"" @@ -3353,7 +3333,7 @@ Begin Form Top =1260 Width =1560 TabIndex =3 - ForeColor =12673797 + ForeColor =16711680 Name ="cmdSeeDocs" Caption ="See Docs..." HyperlinkAddress ="https://github.com/joyfullservice/msaccess-vcs-integration/wiki/Documentation" @@ -4009,8 +3989,6 @@ Private Sub MapControlsToOptions(eAction As eMapAction) ' Enable pages based on options. chkUseGitIntegration_Click - - SetKeyStatusDisplay End Sub @@ -4076,25 +4054,6 @@ Private Sub lstTables_Click() End Sub -'--------------------------------------------------------------------------------------- -' Procedure : SetKeyStatusDisplay -' Author : Adam Waller -' Date : 4/24/2020 -' Purpose : Display whether we have set an encryption key yet. -'--------------------------------------------------------------------------------------- -' -Private Sub SetKeyStatusDisplay() - If modEncrypt.EncryptionKeySet Then - lblKeyStatus.Visible = True - lblKeyStatus.Caption = "WARNING:" & vbNewLine & vbNewLine & "Encryption key is currently set! The encryption tools are DISCONTINUED!" - Else - lblKeyStatus.Caption = vbNullString - lblKeyStatus.Visible = False - - End If -End Sub - - '--------------------------------------------------------------------------------------- ' Procedure : cmdUninstall_Click ' Author : Adam Kauffman From 6b3b7f3360047979507d307a7f7ca7cdbbac24a5 Mon Sep 17 00:00:00 2001 From: joyfullservice Date: Wed, 17 Mar 2021 11:46:11 -0500 Subject: [PATCH 18/25] Simplify after removing encryption option The only reason we saved a "File" property was when we were encrypting the full path. No longer needed. --- .../modules/clsDbVbeReference.bas | 10 +--------- 1 file changed, 1 insertion(+), 9 deletions(-) diff --git a/Version Control.accda.src/modules/clsDbVbeReference.bas b/Version Control.accda.src/modules/clsDbVbeReference.bas index e004ebac..680525d6 100644 --- a/Version Control.accda.src/modules/clsDbVbeReference.bas +++ b/Version Control.accda.src/modules/clsDbVbeReference.bas @@ -136,15 +136,7 @@ Private Function GetDictionary() As Dictionary With dRef If ref.Type = vbext_rk_Project Then ' references of types mdb,accdb,mde etc don't have a GUID - strPath = GetRelativePath(ref.FullPath) - If strPath <> ref.FullPath Then - ' Use relative path, or full path if not secured. - .Add "FullPath", strPath - Else - ' Found a non-relative path. - .Add "File", FSO.GetFileName(ref.FullPath) - .Add "FullPath", ref.FullPath - End If + .Add "FullPath", GetRelativePath(ref.FullPath) Else If ref.Guid <> vbNullString Then .Add "GUID", ref.Guid .Add "Version", CStr(ref.Major) & "." & CStr(ref.Minor) From 3d5eb1ecda3e73f233678391cb87aba9742e30f7 Mon Sep 17 00:00:00 2001 From: joyfullservice Date: Wed, 17 Mar 2021 11:51:28 -0500 Subject: [PATCH 19/25] Move constant and increment app version --- Version Control.accda.src/dbs-properties.json | 2 +- Version Control.accda.src/modules/modConstants.bas | 2 ++ Version Control.accda.src/modules/modHash.bas | 1 - 3 files changed, 3 insertions(+), 2 deletions(-) diff --git a/Version Control.accda.src/dbs-properties.json b/Version Control.accda.src/dbs-properties.json index 821e99bb..a370a552 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": "3.3.16", + "Value": "3.3.17", "Type": 10 }, "Auto Compact": { diff --git a/Version Control.accda.src/modules/modConstants.bas b/Version Control.accda.src/modules/modConstants.bas index 1aae1b99..2076d610 100644 --- a/Version Control.accda.src/modules/modConstants.bas +++ b/Version Control.accda.src/modules/modConstants.bas @@ -21,6 +21,8 @@ Public Const JSON_WHITESPACE As Integer = 2 Public Const UTF8_BOM As String = "" Public Const UCS2_BOM As String = "ÿþ" +' Default hashing algorithm +Public Const DefaultHashAlgorithm As String = "SHA256" ' Object types used when determining SQL modification date. Public Enum eSqlObjectType diff --git a/Version Control.accda.src/modules/modHash.bas b/Version Control.accda.src/modules/modHash.bas index 2e3e9325..730766f4 100644 --- a/Version Control.accda.src/modules/modHash.bas +++ b/Version Control.accda.src/modules/modHash.bas @@ -62,7 +62,6 @@ Public Declare PtrSafe Function BCryptGetProperty Lib "BCrypt.dll" ( _ Private Const ModuleName As String = "modHash" -Public Const DefaultHashAlgorithm As String = "SHA256" Private Function NGHash(pData As LongPtr, lenData As Long, Optional HashingAlgorithm As String = DefaultHashAlgorithm) As Byte() From 1021f1fd8274077d8ec41a193c9425f87e2c6600 Mon Sep 17 00:00:00 2001 From: Hecon5 <54177882+hecon5@users.noreply.github.com> Date: Wed, 17 Mar 2021 13:34:16 -0400 Subject: [PATCH 20/25] This isn't used anywhere; remove it, too. --- Version Control.accda.src/modules/modEncrypt.bas | 11 ----------- 1 file changed, 11 deletions(-) diff --git a/Version Control.accda.src/modules/modEncrypt.bas b/Version Control.accda.src/modules/modEncrypt.bas index c5c2df65..1ea060a2 100644 --- a/Version Control.accda.src/modules/modEncrypt.bas +++ b/Version Control.accda.src/modules/modEncrypt.bas @@ -20,17 +20,6 @@ Public Const DefaultKeyName = "MSAccessVCS" Private m_Name As String Private m_Key As String -'--------------------------------------------------------------------------------------- -' Procedure : IsEncrypted -' Author : Adam Waller -' Date : 4/28/2020 -' Purpose : Returns true if the value appears to be encrypted. -'--------------------------------------------------------------------------------------- -' -Public Function IsEncrypted(strText As String) As Boolean - IsEncrypted = (Left$(strText, 2) = "@{" And Right$(strText, 1) = "}") -End Function - '--------------------------------------------------------------------------------------- ' Procedure : EncryptionKeySet From 0b7d72199a9f37fc96187d5df91967e729545f76 Mon Sep 17 00:00:00 2001 From: Hecon5 <54177882+hecon5@users.noreply.github.com> Date: Wed, 17 Mar 2021 13:43:08 -0400 Subject: [PATCH 21/25] Delete the key upon install per change on frmVCSInstall. --- Version Control.accda.src/modules/modInstall.bas | 3 +++ 1 file changed, 3 insertions(+) diff --git a/Version Control.accda.src/modules/modInstall.bas b/Version Control.accda.src/modules/modInstall.bas index 72762936..7fdf807d 100644 --- a/Version Control.accda.src/modules/modInstall.bas +++ b/Version Control.accda.src/modules/modInstall.bas @@ -122,6 +122,9 @@ Public Function InstallVCSAddin() As Boolean Else If DebugMode Then On Error GoTo 0 Else On Error Resume Next + ' Remove legacy encryption (obfuscation, more like) keys + DeleteSetting GetCodeVBProject.Name, "Private Keys" + ' Register the Menu controls RegisterMenuItem "&VCS Open", "=AddInMenuItemLaunch()" RegisterMenuItem "&VCS Options", "=AddInOptionsLaunch()" From c1f1073fd79de2bd5167d5c9fa095dab5f46ccee Mon Sep 17 00:00:00 2001 From: Hecon5 <54177882+hecon5@users.noreply.github.com> Date: Wed, 17 Mar 2021 14:02:14 -0400 Subject: [PATCH 22/25] Decided that the key should've been removed before, but do it again, just in case. --- Version Control.accda.src/modules/modInstall.bas | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/Version Control.accda.src/modules/modInstall.bas b/Version Control.accda.src/modules/modInstall.bas index 7fdf807d..2a6b9f40 100644 --- a/Version Control.accda.src/modules/modInstall.bas +++ b/Version Control.accda.src/modules/modInstall.bas @@ -180,10 +180,10 @@ Public Function UninstallVCSAddin() As Boolean DeleteSetting GetCodeVBProject.Name, "Build" DeleteSetting GetCodeVBProject.Name, "Add-In" - ' (Not sure if we should delete private "keys", since there is no other - ' copy of this data, and they would be required to decrypt encrypted content.) - If MsgBox2("Delete RC4 Keys?", "Do you want to delete the RC4 keys from the registry?", "This is strongly recomended!", _ - vbQuestion + vbDefaultButton1 + vbYesNo, "Delete RC4 Keys?") = vbYes Then DeleteSetting GetCodeVBProject.Name, "Private Keys" + ' Remove private keys; since this (should have been) removed + ' during install, just do it again to verify. + DeleteSetting GetCodeVBProject.Name, "Private Keys" + If Err Then Err.Clear On Error GoTo 0 From a87b5fcf9b1d85e3513a8705348e1d1b871817cc Mon Sep 17 00:00:00 2001 From: joyfullservice Date: Wed, 17 Mar 2021 13:27:53 -0500 Subject: [PATCH 23/25] Add error handling to key removal After the initial removal, the key will not exist. Also moved it to the "CheckForLegacyInstall" procedure which handles other upgrade-related tasks. --- Version Control.accda.src/modules/modInstall.bas | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/Version Control.accda.src/modules/modInstall.bas b/Version Control.accda.src/modules/modInstall.bas index 2a6b9f40..6fd9284a 100644 --- a/Version Control.accda.src/modules/modInstall.bas +++ b/Version Control.accda.src/modules/modInstall.bas @@ -28,6 +28,7 @@ Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExec ByVal nShowCmd As Long) As LongPtr Private Const SW_SHOWNORMAL = 1 +Private Const ModuleName As String = "modInstall" ' Used to add a trusted location for the add-in path (when necessary) Private Const mcstrTrustedLocationName = "MSAccessVCS Version Control" @@ -122,9 +123,6 @@ Public Function InstallVCSAddin() As Boolean Else If DebugMode Then On Error GoTo 0 Else On Error Resume Next - ' Remove legacy encryption (obfuscation, more like) keys - DeleteSetting GetCodeVBProject.Name, "Private Keys" - ' Register the Menu controls RegisterMenuItem "&VCS Open", "=AddInMenuItemLaunch()" RegisterMenuItem "&VCS Options", "=AddInOptionsLaunch()" @@ -480,9 +478,15 @@ Public Sub CheckForLegacyInstall() ' Remove custom trusted location for Office AddIns folder. strName = "Office Add-ins" If HasTrustedLocationKey(strName) Then RemoveTrustedLocation strName - End If + ' Remove legacy RC4 encryption + If DebugMode Then On Error Resume Next Else On Error Resume Next + DeleteSetting GetCodeVBProject.Name, "Private Keys" + Catch 5 ' Key does not exist + + CatchAny eelError, "Checking for legacy install", ModuleName & ".CheckForLegacyInstall" + End Sub From f720fbb87eefc8e3bf27ccae00d1860bb4efe7e7 Mon Sep 17 00:00:00 2001 From: joyfullservice Date: Wed, 17 Mar 2021 15:14:01 -0500 Subject: [PATCH 24/25] Show errors when not logging to file The user should be notified of errors outside of an export/build process. --- Version Control.accda.src/modules/clsLog.bas | 26 ++++++++++++++++--- .../modules/modImportExport.bas | 16 +++++++++--- 2 files changed, 34 insertions(+), 8 deletions(-) diff --git a/Version Control.accda.src/modules/clsLog.bas b/Version Control.accda.src/modules/clsLog.bas index 93649fc3..9d18a5c4 100644 --- a/Version Control.accda.src/modules/clsLog.bas +++ b/Version Control.accda.src/modules/clsLog.bas @@ -9,6 +9,11 @@ Public PadLength As Integer Public LogFilePath As String Public ErrorLevel As eErrorLevel +' Set this to true when logging an operation such as an export or build +' then set back to false after writing the log file. This affects +' how error messages are reported to the user outside of operations. +Public Active As Boolean + Private Const cstrSpacer As String = "-------------------------------------" Private m_Log As clsConcat ' Log file output @@ -161,10 +166,21 @@ Public Sub Error(eLevel As eErrorLevel, strDescription As String, Optional strSo ' Log the error and display if higher than warning. Me.Add .GetStr, eLevel > eelWarning - ' Show message box for fatal error. - If eLevel = eelCritical Then - MsgBox2 "Unable to Continue", .GetStr, _ - "Please review the log file for additional details.", vbCritical + ' See if we are actively logging an operation + If Log.Active Then + ' Show message box for fatal error. + If eLevel = eelCritical Then + MsgBox2 "Unable to Continue", .GetStr, _ + "Please review the log file for additional details.", vbCritical + End If + Else + ' Show message on any error level when we are not logging to a file. + Select Case eLevel + Case eelNoError: ' Do nothing + Case eelWarning: MsgBox2 "Warning", .GetStr, , vbInformation + Case eelError: MsgBox2 "Error", .GetStr, , vbExclamation + Case eelCritical: MsgBox2 "Critical", .GetStr, , vbCritical + End Select End If End With @@ -244,6 +260,8 @@ Private Sub Class_Initialize() m_sngLastUpdate = 0 Me.PadLength = 30 Me.ErrorLevel = eelNoError + Me.Active = False + Me.LogFilePath = vbNullString End Sub diff --git a/Version Control.accda.src/modules/modImportExport.bas b/Version Control.accda.src/modules/modImportExport.bas index 5b12f6fd..447335e8 100644 --- a/Version Control.accda.src/modules/modImportExport.bas +++ b/Version Control.accda.src/modules/modImportExport.bas @@ -50,6 +50,7 @@ Public Sub ExportSource(blnFullExport As Boolean) Set Options = Nothing Options.LoadProjectOptions Log.Clear + Log.Active = True Perf.StartTiming ' Run any custom sub before export @@ -142,8 +143,11 @@ Public Sub ExportSource(blnFullExport As Boolean) ' Add performance data to log file and save file Perf.EndTiming - Log.Add vbCrLf & Perf.GetReports, False - Log.SaveFile FSO.BuildPath(Options.GetExportFolder, "Export.log") + With Log + .Add vbCrLf & Perf.GetReports, False + .SaveFile FSO.BuildPath(Options.GetExportFolder, "Export.log") + .Active = False + End With ' Check for VCS_ImportExport.bas (Used with other forks) CheckForLegacyModules @@ -245,6 +249,7 @@ Public Sub Build(strSourceFolder As String, blnFullBuild As Boolean) ' Start log and performance timers Log.Clear + Log.Active = True sngStart = Timer Perf.StartTiming @@ -369,8 +374,11 @@ Public Sub Build(strSourceFolder As String, blnFullBuild As Boolean) ' Add performance data to log file and save file. Perf.EndTiming - Log.Add vbCrLf & Perf.GetReports, False - Log.SaveFile FSO.BuildPath(Options.GetExportFolder, strType & ".log") + With Log + .Add vbCrLf & Perf.GetReports, False + .SaveFile FSO.BuildPath(Options.GetExportFolder, strType & ".log") + .Active = False + End With ' Wrap up build. DoCmd.Hourglass False From db95567b4b39698b01f5a6cbf2243f06eeb07fd4 Mon Sep 17 00:00:00 2001 From: joyfullservice Date: Wed, 17 Mar 2021 15:57:49 -0500 Subject: [PATCH 25/25] Update options code for encryption removal Added additional error handling and removed some unneeded code, including the rest of the legacy modEncrypt module. --- .../forms/frmVCSInstall.bas | 34 ++++++++------- .../forms/frmVCSMain.bas | 4 +- .../modules/clsOptions.bas | 25 +++++------ .../modules/modEncrypt.bas | 42 ------------------- .../modules/modInstall.bas | 32 ++++++++++---- .../modules/modObjects.bas | 3 +- Version Control.json | 23 ---------- 7 files changed, 59 insertions(+), 104 deletions(-) delete mode 100644 Version Control.accda.src/modules/modEncrypt.bas delete mode 100644 Version Control.json diff --git a/Version Control.accda.src/forms/frmVCSInstall.bas b/Version Control.accda.src/forms/frmVCSInstall.bas index d6eb9179..580c2af9 100644 --- a/Version Control.accda.src/forms/frmVCSInstall.bas +++ b/Version Control.accda.src/forms/frmVCSInstall.bas @@ -17,11 +17,11 @@ Begin Form GridY =24 DatasheetFontHeight =11 ItemSuffix =39 - Left =3225 - Top =2430 - Right =28545 - Bottom =15015 - DatasheetGridlinesColor =14806254 + Left =-25575 + Top =1710 + Right =-255 + Bottom =14295 + 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 @@ -1574,15 +1574,19 @@ End Sub Private Sub cmdInstall_Click() ' Check for legacy encryption key. - If EncryptionKeySet Then + If HasLegacyRC4Keys Then If MsgBox2("IMPORTANT: Encryption Feature Removed", _ "Prior versions of this add-in supported a reversible ""encryption"" of certain potentially sensitive items such as file paths. " & _ - "This feature has been removed in this version of the add-in. More information can be found on GitHub issue #193." & vbCrLf & vbCrLf & _ - "For security reasons, this upgrade will REMOVE the existing encryption key. If you have source files that use this key, " & _ - "and do NOT have a working copy of the built database, please build the project from source BEFORE upgrading the add-in. ", _ - "REMOVE existing encryption key? (Make sure you have a copy of this key.)", vbExclamation + vbYesNo + vbDefaultButton2) <> vbYes Then + "This feature has been removed in this version of the add-in. More information can be found on GitHub issue #193 " & _ + "of the joyfullservice/msaccess-vcs-integration project." & vbCrLf & vbCrLf & _ + "For security reasons, this upgrade will REMOVE all existing encryption keys used by this add-in. " & _ + "If you have source files for any projects that use these keys, " & _ + "and do NOT have a working copy of the built database, please build the project(s) from source BEFORE upgrading the add-in. ", _ + "REMOVE all existing encryption keys? (Make sure you have a copy of the keys.)", vbExclamation + vbYesNo + vbDefaultButton2) <> vbYes Then + ' Cancel the installation if the user clicked anything other than Yes. MsgBox2 "Installation Canceled", "Removal of existing encryption keys is required to upgrade.", , vbInformation + Exit Sub End If End If diff --git a/Version Control.accda.src/forms/frmVCSMain.bas b/Version Control.accda.src/forms/frmVCSMain.bas index c2f4d42c..28fad50b 100644 --- a/Version Control.accda.src/forms/frmVCSMain.bas +++ b/Version Control.accda.src/forms/frmVCSMain.bas @@ -18,7 +18,7 @@ Begin Form ItemSuffix =32 Left =-25575 Top =1710 - Right =-5925 + Right =-255 Bottom =14295 DatasheetGridlinesColor =15132391 RecSrcDt = Begin @@ -2011,6 +2011,8 @@ End Sub '--------------------------------------------------------------------------------------- ' Private Sub cmdOptions_Click() + ' Force reload of options from current project before opening the form. + Set Options = Nothing DoCmd.OpenForm "frmVCSOptions" End Sub diff --git a/Version Control.accda.src/modules/clsOptions.bas b/Version Control.accda.src/modules/clsOptions.bas index 57f7f423..32c253df 100644 --- a/Version Control.accda.src/modules/clsOptions.bas +++ b/Version Control.accda.src/modules/clsOptions.bas @@ -12,6 +12,7 @@ Option Explicit Private Const cstrOptionsFilename As String = "vcs-options.json" Private Const cstrSourcePathProperty As String = "VCS Source Path" +Private Const ModuleName As String = "clsOptions" ' Options Public ExportFolder As String @@ -31,7 +32,6 @@ Public TablesToExportData As Dictionary Public RunBeforeExport As String Public RunAfterExport As String Public RunAfterBuild As String -Public KeyName As String Public ShowVCSLegacy As Boolean Public HashAlgorithm As String Public UseShortHash As Boolean @@ -202,6 +202,8 @@ Public Sub LoadOptionsFromFile(strFile As String) Dim varOption As Variant Dim strKey As String + If DebugMode Then On Error GoTo 0 Else On Error Resume Next + ' Save file path, in case we need to use it to determine ' the export folder location with no database open. m_strOptionsFilePath = strFile @@ -221,9 +223,6 @@ Public Sub LoadOptionsFromFile(strFile As String) Set Me.ExportPrintSettings = dOptions(strKey) Case "TablesToExportData" Set Me.TablesToExportData = dOptions(strKey) - Case "Security" - ' It's possible these are still in the saved options. - ' This ignores them, but doesn't error out. Case Else ' Regular top-level properties CallByName Me, strKey, VbLet, dOptions(strKey) @@ -233,6 +232,8 @@ Public Sub LoadOptionsFromFile(strFile As String) End If End If + CatchAny eelError, "Loading options from " & strFile, ModuleName & ".LoadOptionsFromFile" + End Sub @@ -351,6 +352,8 @@ Private Function SerializeOptions() As Dictionary Dim strOption As String Dim strBit As String + If DebugMode Then On Error GoTo 0 Else On Error Resume Next + Set dOptions = New Dictionary Set dInfo = New Dictionary Set dWrapper = New Dictionary @@ -366,15 +369,8 @@ Private Function SerializeOptions() As Dictionary ' Loop through options For Each varOption In m_colOptions - strOption = CStr(varOption) - Select Case strOption - Case "Security" - ' It's possible these are still in the saved options. - ' This ignores them, but doesn't error out. - Case Else - ' Simulate reflection to serialize properties. - dOptions.Add strOption, CallByName(Me, strOption, VbGet) - End Select + ' Simulate reflection to serialize properties. + dOptions.Add CStr(varOption), CallByName(Me, CStr(varOption), VbGet) Next varOption 'Set SerializeOptions = new Dictionary @@ -382,6 +378,8 @@ Private Function SerializeOptions() As Dictionary Set dWrapper("Options") = dOptions Set SerializeOptions = dWrapper + CatchAny eelError, "Serializing options", ModuleName & ".SerializeOptions" + End Function @@ -497,7 +495,6 @@ Private Sub Class_Initialize() .Add "RunBeforeExport" .Add "RunAfterExport" .Add "RunAfterBuild" - .Add "KeyName" .Add "ShowVCSLegacy" .Add "HashAlgorithm" .Add "UseShortHash" diff --git a/Version Control.accda.src/modules/modEncrypt.bas b/Version Control.accda.src/modules/modEncrypt.bas deleted file mode 100644 index 1ea060a2..00000000 --- a/Version Control.accda.src/modules/modEncrypt.bas +++ /dev/null @@ -1,42 +0,0 @@ -'--------------------------------------------------------------------------------------- -' Module : basEncrypt -' Author : Adam Waller -' Date : 4/9/2020 -' Purpose : Adapted from: https://stackoverflow.com/questions/7025644/vb6-encrypt-text-using-password -' : -' : *** IMPORTANT!! *** -' : This is not considered a secure encryption algorithm for sensitive data. -' : If you need something more secure, please utilize actual cryptography -' : API calls or functions. This is intended simply as a basic way of masking -' : semi-secure data in source code. -' : See: https://github.com/joyfullservice/msaccess-vcs-integration/wiki/Encryption -'--------------------------------------------------------------------------------------- -Option Compare Database -Option Private Module -Option Explicit - -Public Const DefaultKeyName = "MSAccessVCS" - -Private m_Name As String -Private m_Key As String - - -'--------------------------------------------------------------------------------------- -' Procedure : EncryptionKeySet -' Author : Adam Waller -' Date : 4/24/2020 -' Purpose : Returns true if the encryption key has been set. -'--------------------------------------------------------------------------------------- -' -Public Function EncryptionKeySet() As Boolean - EncryptionKeySet = (GetKey <> CodeProject.Name) -End Function - - -Private Function GetKey() As String - If m_Name = vbNullString Then m_Name = Options.KeyName - If m_Name = vbNullString Then m_Name = DefaultKeyName - If m_Key = vbNullString Then m_Key = GetSetting(GetCodeVBProject.Name, "Private Keys", m_Name, CodeProject.Name) - ' Return cached key name, rather than looking it up from the registry each time. - GetKey = m_Key -End Function \ No newline at end of file diff --git a/Version Control.accda.src/modules/modInstall.bas b/Version Control.accda.src/modules/modInstall.bas index 6fd9284a..81d01ff1 100644 --- a/Version Control.accda.src/modules/modInstall.bas +++ b/Version Control.accda.src/modules/modInstall.bas @@ -87,7 +87,9 @@ Public Function InstallVCSAddin() As Boolean Dim strSource As String Dim strDest As String - + + If DebugMode Then On Error GoTo 0 Else On Error Resume Next + strSource = CodeProject.FullName strDest = GetAddinFileName VerifyPath strDest @@ -311,12 +313,10 @@ End Sub Private Sub RemoveMenuItem(ByVal strName As String, Optional Hive As eHive = ehHKCU) Dim strPath As String - Dim objShell As WshShell ' We need to remove three registry keys for each item. strPath = GetAddinRegPath(Hive) & strName & "\" - Set objShell = New WshShell - With objShell + With New IWshRuntimeLibrary.WshShell ' Just in case someone changed some of the keys... If DebugMode Then On Error Resume Next Else On Error Resume Next .RegDelete strPath & "Expression" @@ -424,6 +424,8 @@ Public Sub CheckForLegacyInstall() Dim strNewPath As String Dim strTest As String Dim objShell As IWshRuntimeLibrary.WshShell + + If DebugMode Then On Error GoTo 0 Else On Error Resume Next ' Legacy HKLM install If InstalledVersion < "3.2.0" Then @@ -481,15 +483,31 @@ Public Sub CheckForLegacyInstall() End If ' Remove legacy RC4 encryption - If DebugMode Then On Error Resume Next Else On Error Resume Next - DeleteSetting GetCodeVBProject.Name, "Private Keys" - Catch 5 ' Key does not exist + If HasLegacyRC4Keys Then DeleteSetting GetCodeVBProject.Name, "Private Keys" CatchAny eelError, "Checking for legacy install", ModuleName & ".CheckForLegacyInstall" End Sub +'--------------------------------------------------------------------------------------- +' Procedure : HasLegacyRC4Keys +' Author : Adam Waller +' Date : 3/17/2021 +' Purpose : Returns true if legacy RC4 keys were found in the registry. +'--------------------------------------------------------------------------------------- +' +Public Function HasLegacyRC4Keys() + Dim strValue As String + With New IWshRuntimeLibrary.WshShell + If DebugMode Then On Error Resume Next Else On Error Resume Next + strValue = .RegRead("HKCU\SOFTWARE\VB and VBA Program Settings\MSAccessVCS\Private Keys\") + HasLegacyRC4Keys = Not Catch(-2147024894) + CatchAny eelError, "Checking for legacy RC4 keys", ModuleName & ".HasLegacyRC4Keys" + End With +End Function + + '--------------------------------------------------------------------------------------- ' Procedure : RemoveLegacyInstall ' Author : Adam Waller diff --git a/Version Control.accda.src/modules/modObjects.bas b/Version Control.accda.src/modules/modObjects.bas index 1667a6c0..276bdbe4 100644 --- a/Version Control.accda.src/modules/modObjects.bas +++ b/Version Control.accda.src/modules/modObjects.bas @@ -44,8 +44,7 @@ End Function ' Purpose : A global property to access options from anywhere in code. ' : (Avoiding a global state is better OO programming, but this approach keeps ' : the coding simpler when you don't have to tie everything back to the -' : primary object.) I.e. You can just use `Encrypt("text")` instead of -' : having to use `Options.Encrypt("text")` +' : primary object.) ' : To clear the current set of options, simply set the property to nothing. '--------------------------------------------------------------------------------------- ' diff --git a/Version Control.json b/Version Control.json deleted file mode 100644 index b1e35fb7..00000000 --- a/Version Control.json +++ /dev/null @@ -1,23 +0,0 @@ -{ - "Info": { - "AddinVersion": "3.1.14", - "AccessVersion": "14.0 32-bit", - "Hash": "@{7206d6328b5c80f8ceae447eb65c6abd23260569ff1ffc94}" - }, - "Options": { - "ExportFolder": "", - "ShowDebug": false, - "UseFastSave": false, - "SavePrintVars": true, - "SaveQuerySQL": true, - "SaveTableSQL": true, - "StripPublishOption": true, - "AggressiveSanitize": true, - "TablesToExportData": { - }, - "RunBeforeExport": "", - "RunAfterExport": "", - "RunAfterBuild": "", - "KeyName": "VCS" - } -}