Add Schema Export support for MySQL databases

You can now export basic object definitions from MySQL databases. (Probably far less used than Microsoft SQL Server, but still helpful for some of my projects.) #415
joyfullservice · Aug 7, 2023 · 2559c4f · 2559c4f
1 parent 934b0e5
commit 2559c4f
Show file tree

Hide file tree

Showing 9 changed files with 752 additions and 67 deletions.
diff --git a/Version Control.accda.src/dbs-properties.json b/Version Control.accda.src/dbs-properties.json
@@ -41,7 +41,7 @@
       "Type": 10
     },
     "AppVersion": {
-      "Value": "4.0.17",
+      "Value": "4.0.18",
       "Type": 10
     },
     "Auto Compact": {

diff --git a/Version Control.accda.src/forms/frmVCSDatabase.bas b/Version Control.accda.src/forms/frmVCSDatabase.bas
@@ -845,6 +845,7 @@ Begin Form
                     TabIndex =12
                     Name ="cmdExamples"
                     Caption ="Examples..."
+                    OnClick ="[Event Procedure]"
                     LeftPadding =135
                     TopPadding =135
                     RightPadding =150
@@ -988,6 +989,18 @@ Private Sub cmdCancel_Click()
 End Sub
 
 
+'---------------------------------------------------------------------------------------
+' Procedure : cmdExamples_Click
+' Author    : Adam Waller
+' Date      : 8/2/2023
+' Purpose   : Show syntax examples on the Wiki
+'---------------------------------------------------------------------------------------
+'
+Private Sub cmdExamples_Click()
+
+End Sub
+
+
 '---------------------------------------------------------------------------------------
 ' Procedure : cmdSaveAndClose_Click
 ' Author    : Adam Waller
@@ -1018,31 +1031,38 @@ Private Function SaveConnection() As Boolean
     If Not PassedValidation Then Exit Function
 
     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
+        With Form_frmVCSOptions
+
+            ' Make sure we have a dictionary object
+            If .DatabaseSchemas Is Nothing Then Set .DatabaseSchemas = New Dictionary
+
+            ' Save to options form
+            With .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
-            End If
 
-            ' Load form values
-            SetParamsFromForm .Item(strKey)
+                ' Load form values
+                SetParamsFromForm .Item(strKey)
 
-            ' Connection string
-            If chkSaveDotEnv Then
-                CheckGitignoreDotEnv
-                ' Save connection string to .env file
-                SaveConnectionStringToFile
-                ' Remove connect parameter from dictionary
-                If .Item(strKey).Exists("Connect") Then .Item(strKey).Remove "Connect"
-            End If
+                ' Connection string
+                If chkSaveDotEnv Then
+                    CheckGitignoreDotEnv
+                    ' Save connection string to .env file
+                    SaveConnectionStringToFile
+                    ' Remove connect parameter from dictionary
+                    If .Item(strKey).Exists("Connect") Then .Item(strKey).Remove "Connect"
+                End If
+            End With
         End With
 
         ' Return success
@@ -1144,7 +1164,8 @@ Private Sub cmdTest_Click()
     Select Case cboType
         Case eDatabaseServerType.estMsSql
             Set cSchema = New clsSchemaMsSql
-        'Case eDatabaseServerType.estMsSql
+        Case eDatabaseServerType.estMySql
+            Set cSchema = New clsSchemaMySql
     End Select
 
     ' Retrieve object count from server.

diff --git a/Version Control.accda.src/modules/clsSchemaMsSql.cls b/Version Control.accda.src/modules/clsSchemaMsSql.cls
@@ -359,42 +359,6 @@ Private Function GetTableDefFallback(strTable As String, oConn As ADODB.Connecti
 End Function
 
 
-'---------------------------------------------------------------------------------------
-' 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
@@ -423,7 +387,7 @@ Private Sub ScanDatabaseObjects()
     ' Open database connection
     Set conn = GetNewOpenConnection
     If conn Is Nothing Then Exit Sub
-    
+
     ' Return list of objects from the server
     Perf.OperationStart "Retrieve SQL Objects"
     Set rstObjects = conn.Execute(CodeDb.QueryDefs("qryMsSqlServerObjects").SQL)
@@ -444,7 +408,7 @@ Private Sub ScanDatabaseObjects()
             strPath = this.strBaseFolder & strItem
 
             ' See if we pass the filter
-            If PassesFilter(strItem) Then
+            If PassesSchemaFilter(strItem, this.varFilters) Then
 
                 ' Add all objects to full collection
                 m_AllItems.Add strItem, Nz(!last_modified)
@@ -493,7 +457,7 @@ End Sub
 Private Function GetNewOpenConnection() As ADODB.Connection
 
     Dim oConn As ADODB.Connection
-    
+
     Set oConn = New ADODB.Connection
     With oConn
         LogUnhandledErrors
@@ -504,15 +468,15 @@ Private Function GetNewOpenConnection() As ADODB.Connection
             .Open this.strConnect
         End If
     End With
-    
+
     ' Check for any connection error
     If CatchAny(eelError, "Unable to connect to " & this.strName, ModuleName(Me)) Then
         Log.Add "Connection string: " & this.strConnect, False
     Else
         ' Return open connection
         Set GetNewOpenConnection = oConn
     End If
-    
+
 End Function