Skip to content

Commit

Permalink
Update options code for encryption removal
Browse files Browse the repository at this point in the history
Added additional error handling and removed some unneeded code, including the rest of the legacy modEncrypt module.
  • Loading branch information
joyfullservice committed Mar 17, 2021
1 parent f720fbb commit db95567
Showing 7 changed files with 59 additions and 104 deletions.
34 changes: 19 additions & 15 deletions Version Control.accda.src/forms/frmVCSInstall.bas
Original file line number Diff line number Diff line change
@@ -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

4 changes: 3 additions & 1 deletion Version Control.accda.src/forms/frmVCSMain.bas
Original file line number Diff line number Diff line change
@@ -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

25 changes: 11 additions & 14 deletions Version Control.accda.src/modules/clsOptions.bas
Original file line number Diff line number Diff line change
@@ -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,22 +369,17 @@ 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
Set dWrapper("Info") = dInfo
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"
42 changes: 0 additions & 42 deletions Version Control.accda.src/modules/modEncrypt.bas

This file was deleted.

32 changes: 25 additions & 7 deletions Version Control.accda.src/modules/modInstall.bas
Original file line number Diff line number Diff line change
@@ -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
3 changes: 1 addition & 2 deletions Version Control.accda.src/modules/modObjects.bas
Original file line number Diff line number Diff line change
@@ -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.
'---------------------------------------------------------------------------------------
'
23 changes: 0 additions & 23 deletions Version Control.json

This file was deleted.

0 comments on commit db95567

Please sign in to comment.