From 421a8172b1a3aeb12954a0d59676dd2af4a7b67d Mon Sep 17 00:00:00 2001 From: joyfullservice Date: Thu, 20 Jul 2023 18:05:30 -0500 Subject: [PATCH] Build out option to save database schemas I can now add, edit and delete external database connections. The connection strings are stored in .env files, not included in the options file. #415 --- .gitignore | 3 + .../forms/frmVCSDatabase.bas | 180 +++++++++++++++++- .../forms/frmVCSOptions.bas | 118 +++++++++++- .../modules/clsOptions.cls | 7 + 4 files changed, 295 insertions(+), 13 deletions(-) diff --git a/.gitignore b/.gitignore index 7c773159..cada36ef 100644 --- a/.gitignore +++ b/.gitignore @@ -15,5 +15,8 @@ # be comitted to version control. vcs-index.json +# Ignore any dotenv files +*.env + # TwinBasic ribbon project packages Ribbon/Source/Packages diff --git a/Version Control.accda.src/forms/frmVCSDatabase.bas b/Version Control.accda.src/forms/frmVCSDatabase.bas index ecd869f9..d2f2713b 100644 --- a/Version Control.accda.src/forms/frmVCSDatabase.bas +++ b/Version Control.accda.src/forms/frmVCSDatabase.bas @@ -16,10 +16,10 @@ Begin Form Width =10080 DatasheetFontHeight =11 ItemSuffix =256 - Left =-25575 - Top =1500 - Right =-5310 - Bottom =14085 + Left =20761 + Top =2250 + Right =-29055 + Bottom =13995 RecSrcDt = Begin 0x79e78b777268e540 End @@ -278,7 +278,7 @@ Begin Form Top =1800 Width =3360 Height =315 - Name ="txtCommitMessage" + Name ="txtName" HorizontalAnchor =2 LayoutCachedLeft =720 @@ -313,7 +313,7 @@ Begin Form Width =5820 Height =315 TabIndex =1 - Name ="Text245" + Name ="txtDescription" HorizontalAnchor =2 LayoutCachedLeft =720 @@ -348,7 +348,7 @@ Begin Form Width =5820 Height =315 TabIndex =2 - Name ="Text247" + Name ="txtConnect" HorizontalAnchor =2 LayoutCachedLeft =720 @@ -420,6 +420,7 @@ Begin Form TabIndex =4 Name ="cmdCancel" Caption ="Cancel" + OnClick ="[Event Procedure]" LeftPadding =135 TopPadding =135 RightPadding =150 @@ -457,6 +458,7 @@ Begin Form TabIndex =5 Name ="cmdSaveAndClose" Caption =" Save && Close" + OnClick ="[Event Procedure]" LeftPadding =135 TopPadding =135 RightPadding =150 @@ -647,7 +649,7 @@ Begin Form ForeColor =5324600 Name ="Label252" Caption ="Database Type:" - HorizontalAnchor =2 + HorizontalAnchor =1 LayoutCachedLeft =4500 LayoutCachedTop =1440 LayoutCachedWidth =6330 @@ -717,3 +719,165 @@ Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Compare Database Option Explicit + + +' Store original name, just in case we rename an existing entry. +Private m_strOriginalName As String + + +'--------------------------------------------------------------------------------------- +' Procedure : LoadSchema +' Author : Adam Waller +' Date : 7/20/2023 +' Purpose : Load a schema by name +'--------------------------------------------------------------------------------------- +' +Public Sub LoadSchema(strName As String, dSchema As Dictionary) + + ' Load values from options + txtName = strName + cboType = dSchema("DatabaseType") + txtDescription = dSchema("Description") + txtFilter = dSchema("Filter") + + ' Load connection string + txtConnect = LoadConnectionString(strName) + +End Sub + + +'--------------------------------------------------------------------------------------- +' Procedure : LoadConnectionString +' Author : Adam Waller +' Date : 7/20/2023 +' Purpose : Load the connection string from the .env file. +'--------------------------------------------------------------------------------------- +' +Private Function LoadConnectionString(strSchemaName As String) As String + + Dim strFile As String + + ' Load connection string from .env file + strFile = BuildPath2(Options.GetExportFolder & "databases", GetSafeFileName(strSchemaName), ".env") + If FSO.FileExists(strFile) Then + With New clsDotEnv + .LoadFromFile strFile + LoadConnectionString = .GetVar("CONNECT", False) + End With + End If + +End Function + + +'--------------------------------------------------------------------------------------- +' Procedure : SaveConnectionString +' Author : Adam Waller +' Date : 7/20/2023 +' Purpose : Saves the connection string to a .env file. +'--------------------------------------------------------------------------------------- +' +Private Sub SaveConnectionString() + + Dim strFile As String + + ' Guard clause safety check + If Nz(txtName) = vbNullString Or Nz(txtConnect) = vbNullString Then Exit Sub + + ' Update the value in the .env file. (Creating the file, if needed.) + strFile = BuildPath2(Options.GetExportFolder & "databases", GetSafeFileName(Nz(txtName)), ".env") + With New clsDotEnv + ' Reload file so we preserve existing values + .LoadFromFile strFile + .SetVar "CONNECT", Nz(txtConnect) + .SaveToFile strFile + End With + +End Sub + + +'--------------------------------------------------------------------------------------- +' Procedure : cmdCancel_Click +' Author : Adam Waller +' Date : 7/20/2023 +' Purpose : Close this form +'--------------------------------------------------------------------------------------- +' +Private Sub cmdCancel_Click() + DoCmd.Close acForm, Me.Name +End Sub + + +'--------------------------------------------------------------------------------------- +' Procedure : cmdSaveAndClose_Click +' Author : Adam Waller +' Date : 7/20/2023 +' Purpose : Save the schema back to the options form. +'--------------------------------------------------------------------------------------- +' +Private Sub cmdSaveAndClose_Click() + + Dim dSchema As Dictionary + Dim strKey As String + + If Not PassedValidation Then Exit Sub + + If IsLoaded(acForm, "frmVCSOptions") Then + With Form_frmVCSOptions.DatabaseSchemas + + ' Get a reference to dictionary object + strKey = Nz(txtName) + If Not .Exists(strKey) Then + ' Could be a rename + Set dSchema = New Dictionary + .Add strKey, dSchema + ' Remove any previous entry + If Len(m_strOriginalName) Then + If .Exists(m_strOriginalName) Then .Remove m_strOriginalName + End If + End If + + ' Update meta values + .Item(strKey)("DatabaseType") = CInt(cboType) + .Item(strKey)("Description") = Nz(txtDescription) + .Item(strKey)("Filter") = Nz(txtFilter) + End With + + ' Save connection string to .env file + SaveConnectionString + + ' Refresh list + Form_frmVCSOptions.RefreshSchemaList + + ' Close form + DoCmd.Close acForm, Me.Name + Else + MsgBox2 "Options form not found", "The Options form must be open to save changes to external database connections", , vbExclamation + End If + +End Sub + + +'--------------------------------------------------------------------------------------- +' Procedure : PassedValidation +' Author : Adam Waller +' Date : 7/20/2023 +' Purpose : Return true if we pass validation on the form to save the entry. +'--------------------------------------------------------------------------------------- +' +Private Function PassedValidation() As Boolean + + Dim strMsg As String + + ' TODO: Could add more validation for filter entries + + If Len(Nz(txtConnect)) < 5 Then strMsg = "Please enter connection string for database" + If Nz(cboType, -1) < 0 Then strMsg = "Please select database type" + If Len(Nz(txtName)) = 0 Then strMsg = "Connection name is required" + + If Len(strMsg) Then + MsgBox2 "Please fix validation issues to continue", strMsg, "See online wiki for additional documentation", vbExclamation + Else + PassedValidation = True + End If + +End Function diff --git a/Version Control.accda.src/forms/frmVCSOptions.bas b/Version Control.accda.src/forms/frmVCSOptions.bas index 6171d9ee..bfdf454a 100644 --- a/Version Control.accda.src/forms/frmVCSOptions.bas +++ b/Version Control.accda.src/forms/frmVCSOptions.bas @@ -16,10 +16,10 @@ Begin Form Width =10080 DatasheetFontHeight =11 ItemSuffix =248 - Left =-25575 - Top =1500 - Right =-5310 - Bottom =14085 + Left =20761 + Top =2250 + Right =31426 + Bottom =13995 RecSrcDt = Begin 0x79e78b777268e540 End @@ -1909,14 +1909,19 @@ Begin Form WebImagePaddingBottom =2 Begin Begin ListBox + ColumnHeads = NotDefault + RowSourceTypeInt =1 OverlapFlags =247 IMESentenceMode =3 + ColumnCount =2 Left =1020 Top =2520 Width =4440 Height =2880 Name ="lstDatabases" - RowSourceType ="Table/Query" + RowSourceType ="Value List" + ColumnWidths ="2520" + OnDblClick ="[Event Procedure]" HorizontalAnchor =2 VerticalAnchor =2 @@ -1971,6 +1976,7 @@ Begin Form TabIndex =1 Name ="cmdDeleteDatabase" Caption =" Delete" + OnClick ="[Event Procedure]" LeftPadding =135 TopPadding =135 RightPadding =150 @@ -2043,6 +2049,7 @@ Begin Form TabIndex =2 Name ="cmdAddDatabase" Caption =" Add" + OnClick ="[Event Procedure]" LeftPadding =135 TopPadding =135 RightPadding =150 @@ -2116,6 +2123,7 @@ Begin Form TabIndex =3 Name ="cmdEditDatabase" Caption =" Edit..." + OnClick ="[Event Procedure]" LeftPadding =135 TopPadding =135 RightPadding =150 @@ -3736,6 +3744,10 @@ Private Enum eMapAction End Enum +' Dictionary to stash database schemas while managing options. +Public DatabaseSchemas As Dictionary + + '--------------------------------------------------------------------------------------- ' Procedure : chkTableShowHidden_Click ' Author : Adam Waller @@ -3766,6 +3778,94 @@ Private Sub chkUseGitIntegration_Click() End Sub +'--------------------------------------------------------------------------------------- +' Procedure : cmdAddDatabase_Click +' Author : Adam Waller +' Date : 7/20/2023 +' Purpose : Add an external database connection +'--------------------------------------------------------------------------------------- +' +Private Sub cmdAddDatabase_Click() + DoCmd.OpenForm "frmVCSDatabase" +End Sub + + +'--------------------------------------------------------------------------------------- +' Procedure : cmdEditDatabase_Click +' Author : Adam Waller +' Date : 7/20/2023 +' Purpose : Edit an existing database connection +'--------------------------------------------------------------------------------------- +' +Private Sub cmdEditDatabase_Click() + If Len(Nz(lstDatabases)) > 0 Then + ' Open the form as hidden, then load the properties + DoCmd.OpenForm "frmVCSDatabase", , , , , acHidden + With Form_frmVCSDatabase + .LoadSchema lstDatabases, Me.DatabaseSchemas(Nz(lstDatabases)) + .Visible = True + End With + End If +End Sub + + +'--------------------------------------------------------------------------------------- +' Procedure : lstDatabases_DblClick +' Author : Adam Waller +' Date : 7/20/2023 +' Purpose : Shortcut to edit the selected database +'--------------------------------------------------------------------------------------- +' +Private Sub lstDatabases_DblClick(Cancel As Integer) + cmdEditDatabase_Click +End Sub + + +'--------------------------------------------------------------------------------------- +' Procedure : cmdDeleteDatabase_Click +' Author : Adam Waller +' Date : 7/20/2023 +' Purpose : Delete a database connection +'--------------------------------------------------------------------------------------- +' +Private Sub cmdDeleteDatabase_Click() + Dim strName As String + strName = Nz(lstDatabases) + If Len(strName) = 0 Then + MsgBox2 "Select a connection to delete", , , vbExclamation + Else + With Me.DatabaseSchemas + If .Exists(strName) Then .Remove strName + End With + RefreshSchemaList + End If +End Sub + + +'--------------------------------------------------------------------------------------- +' Procedure : LoadSchemas +' Author : Adam Waller +' Date : 7/20/2023 +' Purpose : Load (or reload) the schemas from a dictionary object +'--------------------------------------------------------------------------------------- +' +Public Sub RefreshSchemaList() + + Dim varKey As Variant + + With lstDatabases + .RowSource = vbNullString + ' Add header row + .AddItem "Name;Description" + ' Update list from dictionary + For Each varKey In Me.DatabaseSchemas.Keys + .AddItem CStr(varKey) & ";" & Me.DatabaseSchemas(varKey)("Description") + Next varKey + End With + +End Sub + + '--------------------------------------------------------------------------------------- ' Procedure : cmdCancel_Click ' Author : Adam Waller @@ -4159,6 +4259,7 @@ Private Sub Form_Load() MapControlsToOptions emaClassToForm RefreshTableDisplay + RefreshSchemaList ' Load list of table data export formats Dim frmTableData As Form_frmVCSTableData @@ -4270,6 +4371,13 @@ Private Sub MapControlsToOptions(eAction As eMapAction) SaveTableList End If + ' Database schemas + If eAction = emaClassToForm Then + Set DatabaseSchemas = CloneDictionary(Options.SchemaExports) + ElseIf eAction = emaFormToClass Then + Set Options.SchemaExports = CloneDictionary(DatabaseSchemas) + End If + ' Enable pages based on options. chkUseGitIntegration_Click diff --git a/Version Control.accda.src/modules/clsOptions.cls b/Version Control.accda.src/modules/clsOptions.cls index b607ed1d..c63de319 100644 --- a/Version Control.accda.src/modules/clsOptions.cls +++ b/Version Control.accda.src/modules/clsOptions.cls @@ -36,6 +36,7 @@ Public SanitizeColors As eSanitizeLevel Public SanitizeLevel As eSanitizeLevel Public ExtractThemeFiles As Boolean Public TablesToExportData As Dictionary +Public SchemaExports As Dictionary Public RunBeforeExport As String Public RunAfterExport As String Public RunBeforeBuild As String @@ -96,6 +97,9 @@ Public Sub LoadDefaults() AddTableToExportData "USysRegInfo", etdTabDelimited AddTableToExportData "USysRibbons", etdTabDelimited + ' External Database Schemas + Set .SchemaExports = New Dictionary + ' Print settings to export Set .ExportPrintSettings = New Dictionary With .ExportPrintSettings @@ -242,6 +246,8 @@ Public Sub LoadOptionsFromFile(strFile As String) Set Me.ExportPrintSettings = dOptions(strKey) Case "TablesToExportData" Set Me.TablesToExportData = CloneDictionary(dOptions(strKey), ecmTextCompare) + Case "SchemaExports" + Set Me.SchemaExports = CloneDictionary(dOptions(strKey), ecmTextCompare) Case Else ' Regular top-level properties CallByName Me, strKey, VbLet, dOptions(strKey) @@ -610,6 +616,7 @@ Private Sub Class_Initialize() .Add "SanitizeLevel" .Add "ExtractThemeFiles" .Add "TablesToExportData" + .Add "SchemaExports" .Add "RunBeforeExport" .Add "RunAfterExport" .Add "RunBeforeBuild"