Merge branch 'dev' into clsPerformanceUpdates

josef-poetzl · Oct 19, 2023 · b1af656 · b1af656
2 parents 8c6d7f9 + 1cda774
commit b1af656
Show file tree

Hide file tree

Showing 2 changed files with 105 additions and 11 deletions.
diff --git a/Version Control.accda.src/modules/clsSqlFormatter.cls b/Version Control.accda.src/modules/clsSqlFormatter.cls
@@ -38,6 +38,14 @@ Private Const cstrReservedNewline As String = "|LEFT OUTER JOIN|RIGHT OUTER JOIN
 Private Const cstrBoundaries As String = ",;:)(.=<>+-*/!^%|&#"
 Private Const cstrRegExSpecial As String = ".\+*?[^]$(){}=!<>|:-#/"
 
+' SQL Dialects
+Public Enum eSqlDialect
+    esdUnknown
+    esdAccess
+    esdMSSQL
+    esdMySQL
+End Enum
+
 ' Types of lists
 Private Enum eListType
     eltReserved
@@ -69,6 +77,7 @@ End Enum
 Private m_strSql As String
 Private m_colTokens As Collection
 Private m_lngPos As Long
+Private m_intDialect As eSqlDialect
 Private m_varWordCache(1 To 2) As Variant
 
 
@@ -79,7 +88,7 @@ Private m_varWordCache(1 To 2) As Variant
 ' Purpose   : This is the main function used outside the class for SQL formatting.
 '---------------------------------------------------------------------------------------
 '
-Public Function FormatSQL(Optional strSql As String) As String
+Public Function FormatSQL(Optional strSql As String, Optional intDialect As eSqlDialect) As String
 
     Dim lngIndentLevel As Long
     Dim blnNewline As Boolean
@@ -106,6 +115,9 @@ Public Function FormatSQL(Optional strSql As String) As String
     Perf.CategoryStart "Format SQL"
     Perf.OperationStart "Formating"
 
+    ' Set SQL dialect
+    m_intDialect = intDialect
+
     ' Tokenize the string, if provided
     If strSql <> vbNullString Then Tokenize strSql
 
@@ -430,6 +442,7 @@ Private Sub Tokenize(strSql As String)
     Const cstrBreakAfter As String = "LIMIT" & ";;;;"
 
     Dim strMatch As String
+    Dim lngLastPos As Long
 
     ' Reset collection of token items
     Set m_colTokens = New Collection
@@ -541,6 +554,15 @@ Private Sub Tokenize(strSql As String)
 
         End If
 
+        ' Make sure we don't get stuck on the same position
+        If m_lngPos = lngLastPos Then
+            Log.Error eelError, "Unable tp parse SQL after position " & m_lngPos, ModuleName(Me) & ".Tokenize"
+            AddToken ttUnknown, GetRange(Len(m_strSql) - m_lngPos)
+            Exit Do
+        Else
+            lngLastPos = m_lngPos
+        End If
+
     ' Move to next token
     Loop
 
@@ -698,7 +720,9 @@ End Function
 ' Procedure : GetQuotedString
 ' Author    : Adam Waller
 ' Date      : 8/12/2023
-' Purpose   : Return a quoted string (Applies four possible rules)
+' Purpose   : Return a quoted string (dialect-specific)
+'           : https://stackoverflow.com/q/10573922/4121863
+'           : https://stackoverflow.com/q/9719869/4121863
 '---------------------------------------------------------------------------------------
 '
 Private Function GetQuotedString(Optional lngStartOffset As Long = 0) As String
@@ -711,18 +735,30 @@ Private Function GetQuotedString(Optional lngStartOffset As Long = 0) As String
         ' Build out RegEx expression
         .Add "^("
 
-            ' (1) backtick quoted string using `` to escape
-            .Add "((`[^`]*($|`))+)|"
+            ' Accomodate dialect-specific variants
+            Select Case m_intDialect
 
-            ' (2) square bracket quoted string (SQL Server) using ]] to escape
-            .Add "((\[[^\]]*($|\]))(\][^\]]*($|\]))*)|"
+                Case esdMySQL
+                    ' Backtick quoted string using `` to escape
+                    .Add "((`[^`]*($|`))+)|"
 
-            ' (3) double quoted string using "" or \" to escape
-            .Add "((""[^""\\\\]*(?:\\\\.[^""\\\\]*)*(""|$))+)|"
+                    ' Double quoted string using "" or \" to escape
+                    .Add "((""[^""\\\\]*(?:\\\\.[^""\\\\]*)*(""|$))+)|"
 
-            ' (4) single quoted string using '' or \' to escape
-            .Add "((\'[^\'\\\\]*(?:\\\\.[^\'\\\\]*)*(\'|$))+)"      ' sx',
+                    ' Single quoted string using '' or \' to escape
+                    .Add "((\'[^\'\\\\]*(?:\\\\.[^\'\\\\]*)*(\'|$))+)"
 
+                Case Else
+                    ' Square bracket quoted string (SQL Server) using ]] to escape
+                    .Add "((\[[^\]]*($|\]))(\][^\]]*($|\]))*)|"
+
+                    ' Double quoted string using "" to escape
+                    .Add "((""[^""]*(""|$))+)|"
+
+                    ' Single quoted string using '' to escape
+                    .Add "((\'[^\']*(\'|$))+)"
+
+            End Select
         .Add ")"
         strExp = .GetStr
     End With

diff --git a/Version Control.accda.src/modules/modAPI.bas b/Version Control.accda.src/modules/modAPI.bas
@@ -220,7 +220,7 @@ Public Function ExampleLoadAddInAndRunExport()
     Dim objAddIn As Object  ' VBProject
 
     ' Build default add-in path
-    strAddInPath = GetAddInFileName
+    strAddInPath = Environ$("AppData") & "\MSAccessVCS\Version Control.accda"
 
     ' See if add-in project is already loaded.
     For Each proj In VBE.VBProjects
@@ -256,3 +256,61 @@ Public Function ExampleLoadAddInAndRunExport()
     End If
 
 End Function
+
+
+'---------------------------------------------------------------------------------------
+' Procedure : ExampleBuildFromSource
+' Author    : Adam Waller
+' Date      : 9/6/2023
+' Purpose   : This function can be copied to a local database and triggered with a
+'           : command line argument or other automation technique to load the VCS
+'           : add-in file and build this project from source.
+'           : NOTE: This expects the add-in to be installed in the default location
+'           : and using the default file name.
+'---------------------------------------------------------------------------------------
+'
+Public Function ExampleBuildFromSource()
+
+    Dim strAddInPath As String
+    Dim proj As Object      ' VBProject
+    Dim objAddIn As Object  ' VBProject
+
+    ' Build default add-in path
+    strAddInPath = Environ$("AppData") & "\MSAccessVCS\Version Control.accda"
+
+    ' See if add-in project is already loaded.
+    For Each proj In VBE.VBProjects
+        If StrComp(proj.FileName, strAddInPath, vbTextCompare) = 0 Then
+            Set objAddIn = proj
+        End If
+    Next proj
+
+    ' If not loaded, then attempt to load the add-in.
+    If objAddIn Is Nothing Then
+
+        ' The following lines will load the add-in at the application level,
+        ' but will not actually call the function. Ignore the error of function not found.
+        ' https://stackoverflow.com/questions/62270088/how-can-i-launch-an-access-add-in-not-com-add-in-from-vba-code
+        On Error Resume Next
+        Application.Run strAddInPath & "!DummyFunction"
+        On Error GoTo 0
+
+        ' See if it is loaded now...
+        For Each proj In VBE.VBProjects
+            If StrComp(proj.FileName, strAddInPath, vbTextCompare) = 0 Then
+                Set objAddIn = proj
+            End If
+        Next proj
+    End If
+
+    If objAddIn Is Nothing Then
+        MsgBox "Unable to load Version Control add-in. Please ensure that it has been installed" & vbCrLf & _
+            "and is functioning correctly. (It should be available in the Add-ins menu.)", vbExclamation
+    Else
+        ' Set the application interaction level to silent to skip confirmation dialogs.
+        Application.Run "MSAccessVCS.SetInteractionMode", 1
+        ' Launch the build process (as if we clicked the button on the ribbon)
+        Application.Run "MSAccessVCS.HandleRibbonCommand", "btnBuild"
+    End If
+
+End Function