diff --git a/Version Control.accda.src/forms/frmVCSDatabase.bas b/Version Control.accda.src/forms/frmVCSDatabase.bas index d2f2713b..2583ea68 100644 --- a/Version Control.accda.src/forms/frmVCSDatabase.bas +++ b/Version Control.accda.src/forms/frmVCSDatabase.bas @@ -394,7 +394,7 @@ Begin Form LayoutCachedHeight =6120 Begin Begin Label - OverlapFlags =85 + OverlapFlags =93 Left =720 Top =4380 Width =4620 @@ -677,36 +677,55 @@ Begin Form ForeThemeColorIndex =-1 ForeTint =100.0 End - Begin CheckBox - Visible = NotDefault - OverlapFlags =85 - Left =5640 - Top =4410 + Begin CommandButton + FontUnderline = NotDefault + TabStop = NotDefault + OverlapFlags =87 + Left =5340 + Top =4440 + Width =1140 + Height =240 + FontSize =10 TabIndex =8 - Name ="chkRegExFilter" + Name ="cmdTest" + Caption ="Test Filter..." + OnClick ="[Event Procedure]" + LeftPadding =135 + TopPadding =135 + RightPadding =150 + BottomPadding =150 + HorizontalAnchor =1 + BackStyle =0 - LayoutCachedLeft =5640 - LayoutCachedTop =4410 - LayoutCachedWidth =5900 - LayoutCachedHeight =4650 - Begin - Begin Label - OverlapFlags =247 - Left =5870 - Top =4380 - Width =735 - Height =315 - ForeColor =5324600 - Name ="Label255" - Caption ="RegEx" - LayoutCachedLeft =5870 - LayoutCachedTop =4380 - LayoutCachedWidth =6605 - LayoutCachedHeight =4695 - ForeThemeColorIndex =-1 - ForeTint =100.0 - End - End + CursorOnHover =1 + LayoutCachedLeft =5340 + LayoutCachedTop =4440 + LayoutCachedWidth =6480 + LayoutCachedHeight =4680 + Alignment =1 + ForeThemeColorIndex =10 + ForeTint =100.0 + Gradient =0 + BackColor =5324600 + BackThemeColorIndex =-1 + BackTint =100.0 + OldBorderStyle =0 + BorderColor =15321539 + BorderThemeColorIndex =-1 + BorderTint =100.0 + HoverThemeColorIndex =10 + HoverTint =100.0 + PressedThemeColorIndex =10 + PressedShade =100.0 + HoverForeThemeColorIndex =10 + HoverForeTint =100.0 + PressedForeThemeColorIndex =10 + PressedForeTint =100.0 + WebImagePaddingLeft =9 + WebImagePaddingTop =9 + WebImagePaddingRight =10 + WebImagePaddingBottom =10 + Overlaps =1 End End End @@ -815,11 +834,26 @@ End Sub '--------------------------------------------------------------------------------------- ' Private Sub cmdSaveAndClose_Click() + If SaveConnection Then + Form_frmVCSOptions.RefreshSchemaList + DoCmd.Close acForm, Me.Name + End If +End Sub + + +'--------------------------------------------------------------------------------------- +' Procedure : SaveConnection +' Author : Adam Waller +' Date : 7/21/2023 +' Purpose : Save the current connection, return true if successful. +'--------------------------------------------------------------------------------------- +' +Private Function SaveConnection() As Boolean Dim dSchema As Dictionary Dim strKey As String - If Not PassedValidation Then Exit Sub + If Not PassedValidation Then Exit Function If IsLoaded(acForm, "frmVCSOptions") Then With Form_frmVCSOptions.DatabaseSchemas @@ -845,16 +879,13 @@ Private Sub cmdSaveAndClose_Click() ' Save connection string to .env file SaveConnectionString - ' Refresh list - Form_frmVCSOptions.RefreshSchemaList - - ' Close form - DoCmd.Close acForm, Me.Name + ' Return success + SaveConnection = True Else MsgBox2 "Options form not found", "The Options form must be open to save changes to external database connections", , vbExclamation End If -End Sub +End Function '--------------------------------------------------------------------------------------- @@ -881,3 +912,39 @@ Private Function PassedValidation() As Boolean End If End Function + + +'--------------------------------------------------------------------------------------- +' Procedure : cmdTest_Click +' Author : Adam Waller +' Date : 7/21/2023 +' Purpose : Test the current filter and return the number of objects found. +'--------------------------------------------------------------------------------------- +' +Private Sub cmdTest_Click() + + Dim cSchema As IDbSchema + Dim lngCount As Long + Dim dblStart As Double + Dim dParams As Dictionary + + If Not SaveConnection Then Exit Sub + + Select Case cboType + Case eDatabaseServerType.estMsSql + Set cSchema = New clsSchemaMsSql + 'Case eDatabaseServerType.estMsSql + End Select + + ' Retrieve object count from server. + If Not cSchema Is Nothing Then + Set dParams = GetSchemaInitParams(Nz(txtName)) + dParams("Filter") = Nz(txtFilter) + cSchema.Initialize dParams + dblStart = Perf.MicroTimer + lngCount = cSchema.ObjectCount(False) + MsgBox2 lngCount & " Objects Found", "A total of " & lngCount & " database objects were retrieved in " & _ + Round(Perf.MicroTimer - dblStart, 2) & " seconds.", , vbInformation + End If + +End Sub diff --git a/Version Control.accda.src/modules/IDbSchema.cls b/Version Control.accda.src/modules/IDbSchema.cls index 4197bff9..fde759aa 100644 --- a/Version Control.accda.src/modules/IDbSchema.cls +++ b/Version Control.accda.src/modules/IDbSchema.cls @@ -35,14 +35,14 @@ End Sub '--------------------------------------------------------------------------------------- -' Procedure : GetChangeCount +' Procedure : ObjectCount ' Author : Adam Waller ' Date : 7/21/2023 -' Purpose : Return a count of how many changes were found between the database -' : objects and the current index file. +' Purpose : Return a count of total objects, or how many changes were found between +' : the database server objects and the current index file. '--------------------------------------------------------------------------------------- ' -Public Function GetChangeCount() As Long +Public Function ObjectCount(blnModifiedOnly As Boolean) As Long End Function diff --git a/Version Control.accda.src/modules/clsSchemaMsSql.cls b/Version Control.accda.src/modules/clsSchemaMsSql.cls index ba6a12af..70b63146 100644 --- a/Version Control.accda.src/modules/clsSchemaMsSql.cls +++ b/Version Control.accda.src/modules/clsSchemaMsSql.cls @@ -33,6 +33,7 @@ Private Type udtThis strConnect As String strUserID As String strPassword As String + varFilters As Variant End Type Private this As udtThis @@ -219,6 +220,42 @@ Private Sub UpdateIndex(strItem As String, dObject As Dictionary) End Sub +'--------------------------------------------------------------------------------------- +' Procedure : PassesFilter +' Author : Adam Waller +' Date : 7/21/2023 +' Purpose : Returns true if this item passed any user-defined filter rules. +' : The current implementation processes rules sequentially, applying each +' : rule in order. Last matching rule will apply to the object. +'--------------------------------------------------------------------------------------- +' +Private Function PassesFilter(strItem As String) As Boolean + + Dim blnPass As Boolean + Dim lngRule As Long + Dim strRule As String + + ' Loop through rules + For lngRule = 0 To UBound(this.varFilters) + strRule = Trim(this.varFilters(lngRule)) + Select Case Left(strRule, 1) + Case "#", vbNullString + ' Ignore comments and blank lines + Case "!" + ' Negative rule (do not include) + If strItem Like Mid(strRule, 2) Then blnPass = False + Case Else + ' Positive rule + If strItem Like strRule Then blnPass = True + End Select + Next lngRule + + ' Return final result + PassesFilter = blnPass + +End Function + + '--------------------------------------------------------------------------------------- ' Procedure : ScanDatabaseObjects ' Author : Adam Waller @@ -277,26 +314,30 @@ Private Sub ScanDatabaseObjects() strItem = Nz(!Folder) & PathSep & GetSafeFileName(Nz(!Name)) & ".sql" strPath = this.strBaseFolder & strItem - ' Add all objects to full collection - Set dItem = New Dictionary - dItem("LastModified") = Nz(!last_modified) - m_AllItems.Add strItem, dItem - - ' Reset flag - blnModified = True - - ' See if this item has been modified - If m_Index.Exists(strItem) Then - blnModified = (dItem("LastModified") <> Nz(!last_modified)) - End If - - ' Build dictionary of modified objects - If blnModified Then - Set dItem = CloneDictionary(dItem) - dItem("type_desc") = Nz(!type_desc) - dItem("schema") = Nz(!schema) - dItem("name") = Nz(!Name) - m_ModifiedItems.Add strItem, dItem + ' See if we pass the filter + If PassesFilter(strItem) Then + + ' Add all objects to full collection + Set dItem = New Dictionary + dItem("LastModified") = Nz(!last_modified) + m_AllItems.Add strItem, dItem + + ' Reset flag + blnModified = True + + ' See if this item has been modified + If m_Index.Exists(strItem) Then + blnModified = (dItem("LastModified") <> Nz(!last_modified)) + End If + + ' Build dictionary of modified objects + If blnModified Then + Set dItem = CloneDictionary(dItem) + dItem("type_desc") = Nz(!type_desc) + dItem("schema") = Nz(!schema) + dItem("name") = Nz(!Name) + m_ModifiedItems.Add strItem, dItem + End If End If ' Move to next object @@ -324,9 +365,10 @@ End Function ' Purpose : Return count of modified objects '--------------------------------------------------------------------------------------- ' -Private Function IDbSchema_GetChangeCount() As Long +Private Function IDbSchema_ObjectCount(blnModifiedOnly As Boolean) As Long If m_AllItems Is Nothing Then ScanDatabaseObjects - IDbSchema_GetChangeCount = m_ModifiedItems.Count + If m_AllItems Is Nothing Then Exit Function + IDbSchema_ObjectCount = IIf(blnModifiedOnly, m_ModifiedItems.Count, m_AllItems.Count) End Function @@ -338,10 +380,25 @@ End Function '--------------------------------------------------------------------------------------- ' Private Sub IDbSchema_Initialize(dInstance As Scripting.IDictionary) + + Dim strFilter As String + Dim varRules As Variant + + ' Build filters + strFilter = dNZ(dInstance, "Filter") + If Trim(Replace(strFilter, vbCrLf, vbNullString)) = vbNullString Then + ' Blank lines, or nothing defined + varRules = Array("*") + Else + ' Create array of rules (we will skip comments and blank lines later) + varRules = Split(strFilter, vbCrLf) + End If + With this .strName = dNZ(dInstance, "Name") .strConnect = dNZ(dInstance, "Connect") .strBaseFolder = Options.GetExportFolder & "databases\" & GetSafeFileName(.strName) & PathSep + .varFilters = varRules .blnInitialized = (Len(.strConnect)) End With End Sub diff --git a/Version Control.accda.src/modules/modImportExport.bas b/Version Control.accda.src/modules/modImportExport.bas index 21bdafac..ae1b9e63 100644 --- a/Version Control.accda.src/modules/modImportExport.bas +++ b/Version Control.accda.src/modules/modImportExport.bas @@ -617,22 +617,15 @@ Public Sub ExportSchemas(blnFullExport As Boolean) Log.Add " - " & strName & strType Perf.CategoryStart strName & strType Log.Flush - ' Load parameters for initializing the connection - Set dParams = CloneDictionary(Options.SchemaExports(varKey)) - dParams("Name") = strName - strFile = BuildPath2(Options.GetExportFolder & "databases", GetSafeFileName(strName), ".env") - If Not FSO.FileExists(strFile) Then + ' Load parameters for initializing the connection + Set dParams = GetSchemaInitParams(strName) + If dParams("Connect") = vbNullString Then Log.Add " No connection string found. (.env)", , , "Red", , True Log.Error eelWarning, "File not found: " & strFile, ModuleName & ".ExportSchemas" Log.Add "Set the connection string for this external database connection in VCS options to automatically create this file.", False Log.Add "(This file may contain authentication credentials and should be excluded from version control.)", False Else - ' Use .env file to initialize connection - With New clsDotEnv - .LoadFromFile strFile - .MergeIntoDictionary dParams, False - End With cSchema.Initialize dParams cSchema.Export blnFullExport End If diff --git a/Version Control.accda.src/modules/modVCSUtility.bas b/Version Control.accda.src/modules/modVCSUtility.bas index eb45bcc5..758c4043 100644 --- a/Version Control.accda.src/modules/modVCSUtility.bas +++ b/Version Control.accda.src/modules/modVCSUtility.bas @@ -890,3 +890,39 @@ Error_Handler: .Raise .Number, .Source, .Description, .HelpFile, .HelpContext End With End Sub + + +'--------------------------------------------------------------------------------------- +' Procedure : GetSchemaParams +' Author : Adam Waller +' Date : 7/21/2023 +' Purpose : Return the schema initialization parameters for dependency injection. +'--------------------------------------------------------------------------------------- +' +Public Function GetSchemaInitParams(strName As String) As Dictionary + + Dim dParams As Dictionary + Dim strFile As String + + ' Load parameters for initializing the connection + Set dParams = CloneDictionary(Options.SchemaExports(strName)) + dParams("Name") = strName + + strFile = BuildPath2(Options.GetExportFolder & "databases", GetSafeFileName(strName), ".env") + If Not FSO.FileExists(strFile) Then + Log.Add " No connection string found. (.env)", , , "Red", , True + Log.Error eelWarning, "File not found: " & strFile, ModuleName & ".ExportSchemas" + Log.Add "Set the connection string for this external database connection in VCS options to automatically create this file.", False + Log.Add "(This file may contain authentication credentials and should be excluded from version control.)", False + Else + ' Use .env file to initialize connection + With New clsDotEnv + .LoadFromFile strFile + .MergeIntoDictionary dParams, False + End With + End If + + ' Return initialization parameters + Set GetSchemaInitParams = dParams + +End Function