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/forms/frmVCSInstall.bas b/Version Control.accda.src/forms/frmVCSInstall.bas index 772884e9..580c2af9 100644 --- a/Version Control.accda.src/forms/frmVCSInstall.bas +++ b/Version Control.accda.src/forms/frmVCSInstall.bas @@ -17,10 +17,10 @@ Begin Form GridY =24 DatasheetFontHeight =11 ItemSuffix =39 - Left =-17265 - Top =2430 - Right =-6105 - Bottom =10335 + Left =-25575 + Top =1710 + Right =-255 + Bottom =14295 DatasheetGridlinesColor =15132391 RecSrcDt = Begin 0x79e78b777268e540 @@ -1573,6 +1573,23 @@ End Sub ' Private Sub cmdInstall_Click() + ' Check for legacy encryption key. + 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 " & _ + "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 + ' Show hourglass, as there may be a brief pause before the confirmation message. DoCmd.Hourglass True @@ -1628,5 +1645,5 @@ Private Sub Form_Load() Else lblInstalled.Caption = "Version " & InstalledVersion & " currently installed." End If - + End Sub diff --git a/Version Control.accda.src/forms/frmVCSMain.bas b/Version Control.accda.src/forms/frmVCSMain.bas index 79b382f8..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 @@ -2042,7 +2044,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/forms/frmVCSOptions.bas b/Version Control.accda.src/forms/frmVCSOptions.bas index ffd4348d..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\"" @@ -1102,59 +1102,14 @@ 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 - Left =6900 - Top =5520 + Left =7140 + Top =5640 Width =2160 - TabIndex =11 - ForeColor =12673797 + TabIndex =10 + ForeColor =16711680 Name ="cmdExplainOptions" Caption ="Explain options..." HyperlinkAddress ="https://github.com/joyfullservice/msaccess-vcs-integration/wiki/Documentation#op" @@ -1198,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 @@ -1253,7 +1208,7 @@ Begin Form FontSize =10 BackColor =14262935 BorderColor =15321539 - ForeColor =12673797 + ForeColor =16711680 Name ="lblPrintSettingsOptions" Caption ="Options..." HyperlinkAddress ="#" @@ -2185,7 +2140,7 @@ Begin Form Height =315 TabIndex =4 BorderColor =10921638 - ForeColor =3484194 + ForeColor =4138256 Name ="cboTableDataSaveType" RowSourceType ="Value List" GridlineColor =10921638 @@ -2364,7 +2319,7 @@ Begin Form FontSize =10 BackColor =14262935 BorderColor =15321539 - ForeColor =12673797 + ForeColor =16711680 Name ="lblAddOtherTable" Caption ="Other..." OnClick ="[Event Procedure]" @@ -2753,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\"" @@ -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 @@ -3652,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" @@ -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,70 +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 -' 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 @@ -4366,7 +3949,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,8 +3989,6 @@ Private Sub MapControlsToOptions(eAction As eMapAction) ' Enable pages based on options. chkUseGitIntegration_Click - cboSecurity_Click - SetKeyStatusDisplay End Sub @@ -4473,22 +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.Caption = "Encryption key is currently set." - Else - lblKeyStatus.Caption = "No encryption key found for current user." - End If -End Sub - - '--------------------------------------------------------------------------------------- ' Procedure : cmdUninstall_Click ' Author : Adam Kauffman 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..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,15 +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 - ' 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)) - End If + varValue = GetRelativePath(CStr(varValue)) End If End If Set dItem = New Dictionary @@ -127,9 +118,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 - ' 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) - 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) 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/clsOptions.bas b/Version Control.accda.src/modules/clsOptions.bas index a7e3d045..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,8 +32,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 Public UseShortHash As Boolean @@ -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,10 +71,8 @@ Public Sub LoadDefaults() .SaveTableSQL = True .StripPublishOption = True .AggressiveSanitize = True - .Security = esNone - .KeyName = modEncrypt.DefaultKeyName .ShowVCSLegacy = True - .HashAlgorithm = "SHA256" + .HashAlgorithm = DefaultHashAlgorithm .UseShortHash = True ' Table data export @@ -215,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 @@ -234,8 +223,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) @@ -245,6 +232,8 @@ Public Sub LoadOptionsFromFile(strFile As String) End If End If + CatchAny eelError, "Loading options from " & strFile, ModuleName & ".LoadOptionsFromFile" + End Sub @@ -363,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 @@ -375,19 +366,11 @@ 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 - strOption = CStr(varOption) - Select Case strOption - Case "Security" - ' Translate enums to friendly names. - dOptions.Add strOption, GetEnumName(CallByName(Me, strOption, VbGet)) - 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 @@ -395,33 +378,21 @@ Private Function SerializeOptions() As Dictionary Set dWrapper("Options") = dOptions Set SerializeOptions = dWrapper + CatchAny eelError, "Serializing options", ModuleName & ".SerializeOptions" + 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) -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)) +Public Function GetHash() As String + GetHash = GetDictionaryHash(SerializeOptions) End Function @@ -505,11 +476,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 @@ -529,8 +495,6 @@ Private Sub Class_Initialize() .Add "RunBeforeExport" .Add "RunAfterExport" .Add "RunAfterBuild" - .Add "Security" - .Add "KeyName" .Add "ShowVCSLegacy" .Add "HashAlgorithm" .Add "UseShortHash" 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/modEncrypt.bas b/Version Control.accda.src/modules/modEncrypt.bas deleted file mode 100644 index c00ba8e6..00000000 --- a/Version Control.accda.src/modules/modEncrypt.bas +++ /dev/null @@ -1,363 +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 : 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 -' 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 -' 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 - - -'--------------------------------------------------------------------------------------- -' 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 diff --git a/Version Control.accda.src/modules/modHash.bas b/Version Control.accda.src/modules/modHash.bas index 36938849..730766f4 100644 --- a/Version Control.accda.src/modules/modHash.bas +++ b/Version Control.accda.src/modules/modHash.bas @@ -63,7 +63,7 @@ Public Declare PtrSafe Function BCryptGetProperty Lib "BCrypt.dll" ( _ Private Const ModuleName As String = "modHash" -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 = DefaultHashAlgorithm) As Byte() 'Erik A, 2019, adapted by Adam Waller 'Hash data by using the Next Generation Cryptography API @@ -130,14 +130,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 = 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 = "SHA512") 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) @@ -200,7 +200,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, DefaultHashAlgorithm) If Options.UseShortHash Then intLength = 7 ' Start performance timer and compute the hash diff --git a/Version Control.accda.src/modules/modImportExport.bas b/Version Control.accda.src/modules/modImportExport.bas index 442f8a9d..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 @@ -61,7 +62,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 @@ -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 @@ -155,7 +159,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 @@ -222,16 +226,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 @@ -253,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 @@ -377,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 @@ -491,7 +491,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 76503bd0..81d01ff1 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" @@ -86,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 @@ -177,9 +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.) - '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 @@ -309,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" @@ -422,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 @@ -476,12 +480,34 @@ 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 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.accda.src/modules/modUnitTesting.bas b/Version Control.accda.src/modules/modUnitTesting.bas index 178866f0..4db2c614 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/vcs-options.json b/Version Control.accda.src/vcs-options.json index 776dcc33..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.3", + "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", 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" - } -}