diff --git a/Version Control.accda.src/modules/IDbSchema.cls b/Version Control.accda.src/modules/IDbSchema.cls new file mode 100644 index 00000000..c16d3446 --- /dev/null +++ b/Version Control.accda.src/modules/IDbSchema.cls @@ -0,0 +1,100 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "IDbSchema" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = False +Attribute VB_Exposed = False +'--------------------------------------------------------------------------------------- +' Module : IDbSchema (Abstract Class) +' Author : Adam Waller +' Date : 7/14/2023 +' Purpose : This class interface defines the standard functions for exporting and +' : importing database server objects for version control. This class should +' : be implemented into the classes defined for each server type used when +' : exporting object definitions for server-side objects. +' : NOTE: This is not intended to write to an external database server, but +' : only to download object definitions that may be related to development +' : in Microsoft Access databases. +'--------------------------------------------------------------------------------------- +Option Compare Database +Option Explicit + + +'--------------------------------------------------------------------------------------- +' Procedure : Initialize +' Author : Adam Waller +' Date : 7/14/2023 +' Purpose : Initialize the instance of the server connection +'--------------------------------------------------------------------------------------- +' +Public Sub Initialize(dInstance As Dictionary) +End Sub + + +'--------------------------------------------------------------------------------------- +' Procedure : Export +' Author : Adam Waller +' Date : 7/14/2023 +' Purpose : Export the database server objects (schema) to source files +'--------------------------------------------------------------------------------------- +' +Public Sub Export(blnFullExport As Boolean, Optional strAlternatePath As String) +End Sub + + +'--------------------------------------------------------------------------------------- +' Procedure : BaseFolder +' Author : Adam Waller +' Date : 7/14/2023 +' Purpose : Base folder for export, (available after initializing) +'--------------------------------------------------------------------------------------- +' +Public Property Get BaseFolder() As String +End Property + + +'--------------------------------------------------------------------------------------- +' Procedure : ServerType +' Author : Adam Waller +' Date : 7/14/2023 +' Purpose : The type of database server represented by this class +'--------------------------------------------------------------------------------------- +' +Public Property Get ServerType() As eDatabaseServerType +End Property + + +'--------------------------------------------------------------------------------------- +' Procedure : TypeDescription +' Author : Adam Waller +' Date : 7/14/2023 +' Purpose : Return description for this server type (i.e. Microsoft SQL Server) +'--------------------------------------------------------------------------------------- +' +Public Property Get TypeDescription() +End Property + + +'--------------------------------------------------------------------------------------- +' Procedure : ServerVersion +' Author : Adam Waller +' Date : 7/14/2023 +' Purpose : Return the server version identifier +'--------------------------------------------------------------------------------------- +' +Public Property Get ServerVersion() As String +End Property + + +'--------------------------------------------------------------------------------------- +' Procedure : Name +' Author : Adam Waller +' Date : 7/14/2023 +' Purpose : Return a name to reference the object for use in logs and screen output. +'--------------------------------------------------------------------------------------- +' +Public Property Get Name() As String +End Property diff --git a/Version Control.accda.src/modules/clsSchemaMsSql.cls b/Version Control.accda.src/modules/clsSchemaMsSql.cls new file mode 100644 index 00000000..f30d0f75 --- /dev/null +++ b/Version Control.accda.src/modules/clsSchemaMsSql.cls @@ -0,0 +1,292 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "clsSchemaMsSql" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = False +Attribute VB_Exposed = False +'--------------------------------------------------------------------------------------- +' Author : Adam Waller +' Date : 4/23/2020 +' Purpose : This class extends the IDbSchema class to perform the specific +' : operations required by this particular object type. +' : (I.e. The specific way you export or import this component.) +'--------------------------------------------------------------------------------------- +Option Compare Database +Option Explicit + + +' This requires us to use all the public methods and properties of the implemented class +' which keeps all the server classes consistent in how they are used in the export +' process. The implemented functions should be kept private as they are called +' from the implementing class, not this class. +Implements IDbSchema + + +' Handle local variables +Private Type udtThis + blnInitialized As Boolean + strName As String + strBaseFolder As String + strConnect As String + strUserID As String + strPassword As String +End Type +Private this As udtThis + + +'--------------------------------------------------------------------------------------- +' Procedure : IDbSchema_Export +' Author : Adam Waller +' Date : 7/14/2023 +' Purpose : +'--------------------------------------------------------------------------------------- +' +Private Sub IDbSchema_Export(blnFullExport As Boolean, Optional strAlternatePath As String) + + Dim dFile As Dictionary + Dim dIndex As Dictionary + Dim dObjects As Dictionary + Dim dteLast As Date + Dim rstObjects As ADODB.Recordset + Dim blnUseGetDDL As Boolean + Dim conn As ADODB.Connection + Dim strItem As String + Dim strPath As String + Dim blnExport As Boolean + Dim dItem As Dictionary + + ' Make sure we initialize before running the export + If Not this.blnInitialized Then Exit Sub + + Perf.StartTiming + + ' Load index + Set dFile = ReadJsonFile(IndexPath) + If Not dFile Is Nothing Then + Set dIndex = dFile("Items") + Else + Set dIndex = New Dictionary + End If + + ' Return list of objects from the server + If Not blnFullExport Then dteLast = Nz2(dNZ(dIndex, "Items\LastExport"), CDate(0)) + Set conn = New ADODB.Connection + Perf.OperationStart "Retrieve SQL Objects" + conn.Open this.strConnect, this.strUserID, this.strPassword + Set rstObjects = conn.Execute(CodeDb.QueryDefs("qryMsSqlServerObjects").SQL) + Perf.OperationEnd + + ' Loop through objects, building dictionary of items that match our filter. + Perf.OperationStart "Loop through SQL objects" + With rstObjects + 'strPath + Do While Not .EOF + + ' Build item path and full path to source file + strItem = Nz(!Folder) & PathSep & GetSafeFileName(Nz(!Name)) & ".sql" + strPath = this.strBaseFolder & strItem + + ' Reset variables + blnExport = True + Set dItem = Nothing + + ' Check for item in index + If dIndex.Exists(strItem) Then + Set dItem = dIndex(strItem) + ' Export if the dates are different + blnExport = (dItem("LastModified") <> ConvertToIso((!last_modified))) + End If + + ' Export if flag set + If blnExport Then + ExportObject Nz(!type_desc), Nz(!schema), Nz(!Name), strPath, conn, dIndex + ' Update record in index + UpdateIndex rstObjects, strItem, dIndex, dItem + End If + + + .MoveNext + Loop + .Close + End With + Perf.OperationEnd + + ' Close connection + conn.Close + + Perf.EndTiming + Debug.Print Perf.GetReports + + ' Now, loop back through the files and remove any file that is not represented by + ' the list of objects returned from the server. + + + ' Save the index + WriteFile BuildJsonFile(TypeName(Me), dIndex, "Version Control System Schema Index"), this.strBaseFolder & "vcs-index.json" + +End Sub + + +'--------------------------------------------------------------------------------------- +' Procedure : ExportObject +' Author : Adam Waller +' Date : 7/18/2023 +' Purpose : Export the object definition and update the index +'--------------------------------------------------------------------------------------- +' +Private Sub ExportObject(strType, strSchema As String, strName As String, strPath As String, _ + ByRef oConn As ADODB.Connection, ByRef dIndex As Dictionary) + + Static intUseSP As Integer + + Dim strSqlDef + Dim strDefinition As String + Dim rst As ADODB.Recordset + Dim rst2 As ADODB.Recordset + Dim strFullName As String + Dim varTest As Variant + Dim cmd As ADODB.Command + Dim strCmdTemplate As String + + ' Prepare template statement for sp_GetDDL to work around VARCHAR(MAX) issue + ' with many SQL Server ODBC drivers. + strCmdTemplate = _ + "DECLARE @table TABLE (item text) " & _ + "INSERT INTO @table exec sp_GetDDL N'{name}' " & _ + "SELECT * FROM @table" + + ' Cache whether or not + 'if intusesp=0 then intusesp = + + strFullName = "[" & strSchema & "].[" & strName & "]" + + ' Determine how to export this type of object + Select Case strType + Case "USER_TABLE", "VIEW", "SYNONYM", "SQL_STORED_PROCEDURE", _ + "SQL_SCALAR_FUNCTION", "SQL_INLINE_TABLE_VALUED_FUNCTION", "SQL_TABLE_VALUED_FUNCTION" + strSqlDef = Replace(strCmdTemplate, "{name}", strFullName) + 'strSqlDef = "exec sp_help " & strFullName & "" + + Case "TYPE_TABLE", "SEQUENCE_OBJECT", "SERVICE_QUEUE", "SYSTEM_TABLE", "INTERNAL_TABLE" + ' Unsupported non-dependent objects + + End Select + + ' Sanity check + If Len(strSqlDef) Then + Perf.OperationStart "Run sp_GetDDL on " & strType + Set cmd = New ADODB.Command + With cmd + Set .ActiveConnection = oConn + .CommandText = strSqlDef + Set rst = .Execute + End With + + ' Get secondary recordset with object definition record + Set rst2 = rst.NextRecordset + With rst2 + If Not .EOF Then strDefinition = Nz(.Fields(0)) + If strDefinition = vbNullString Then + If FSO.FileExists(strPath) Then DeleteFile strPath + Else + ' Export to file + WriteFile strDefinition, strPath + End If + .Close + End With + Perf.OperationEnd + End If + +End Sub + + + +'--------------------------------------------------------------------------------------- +' Procedure : UpdateIndex +' Author : Adam Waller +' Date : 7/19/2023 +' Purpose : Update the entry in the index using values from the recordset +'--------------------------------------------------------------------------------------- +' +Private Sub UpdateIndex(rst As ADODB.Recordset, strRelativePath As String, _ + ByRef dIndex As Dictionary, Optional ByRef dItem As Dictionary) + + Perf.OperationStart "Update Schema Index" + ' See if we are working with an existing entry + If dItem Is Nothing Then + ' Add the new entry + Set dItem = New Dictionary + dIndex.Add strRelativePath, dItem + End If + + ' Update the meta values + dItem("ExportDate") = Now() + dItem("LastModified") = Nz(rst!last_modified) + Perf.OperationEnd + +End Sub + + + + +Private Function PurgeOrphanedObjects() + +End Function + + +'--------------------------------------------------------------------------------------- +' Procedure : IDbSchema_Initialize +' Author : Adam Waller +' Date : 7/18/2023 +' Purpose : Initialize the database schema +'--------------------------------------------------------------------------------------- +' +Private Sub IDbSchema_Initialize(dInstance As Scripting.IDictionary) + With this + .strName = dNZ(dInstance, "Name") + .strConnect = dNZ(dInstance, "Connect") + .strBaseFolder = Options.GetExportFolder & "databases\" & GetSafeFileName(.strName) & PathSep + .blnInitialized = True + End With +End Sub + + + +Private Property Get IDbSchema_BaseFolder() As String + IDbSchema_BaseFolder = this.strBaseFolder +End Property + + +Private Function IndexPath() As String + IndexPath = this.strBaseFolder & "vcs-index.json" +End Function + + +Private Property Get IDbSchema_Name() As String + +End Property + + +'--------------------------------------------------------------------------------------- +' Procedure : IDbSchema_ServerType +' Author : Adam Waller +' Date : 7/14/2023 +' Purpose : Return server type +'--------------------------------------------------------------------------------------- +' +Private Property Get IDbSchema_ServerType() As eDatabaseServerType + IDbSchema_ServerType = estMsSql +End Property + + +Private Property Get IDbSchema_TypeDescription() As Variant + IDbSchema_TypeDescription = "Microsoft SQL Server" +End Property + + +Private Property Get IDbSchema_ServerVersion() As String + +End Property diff --git a/Version Control.accda.src/modules/modConstants.bas b/Version Control.accda.src/modules/modConstants.bas index 13589b43..8c8f975c 100644 --- a/Version Control.accda.src/modules/modConstants.bas +++ b/Version Control.accda.src/modules/modConstants.bas @@ -81,6 +81,12 @@ Public Enum eDatabaseComponentType [_Last] End Enum +' Database server types for external databases +Public Enum eDatabaseServerType + estMsSql + estMySql +End Enum + ' Error levels used for logging and monitoring the status ' of the current operation. Public Enum eErrorLevel @@ -135,4 +141,5 @@ End Enum Public Enum eContainerFilter ecfAllObjects ecfVBAItems + ecfSchemas End Enum diff --git a/Version Control.accda.src/queries/qryMsSqlServerObjects.bas b/Version Control.accda.src/queries/qryMsSqlServerObjects.bas new file mode 100644 index 00000000..01576233 --- /dev/null +++ b/Version Control.accda.src/queries/qryMsSqlServerObjects.bas @@ -0,0 +1,23 @@ +dbMemo "SQL" ="SELECT o.[name],\015\012 SCHEMA_NAME(o.[schema_id]) AS [schema],\015\012 o" + ".modify_date AS last_modified, c.modify_date AS test,\015\012\011o.type_desc,\015" + "\012\011CASE o.[type]\015\012\011\011WHEN 'V' THEN 'views'\015\012\011\011WHEN '" + "U' THEN 'tables'\015\012\011\011WHEN 'IT' THEN 'tables'\011\011-- Internal table" + "s\015\012\011\011WHEN 'TR' THEN 'tables'\015\012\011\011WHEN 'P' THEN 'proceedur" + "es'\015\012\011\011WHEN 'FN' THEN 'functions'\011-- Scalar function\015\012\011\011" + "WHEN 'IF' THEN 'functions'\011-- Inline table valued function\015\012\011\011WHE" + "N 'TF' THEN 'functions'\011-- Table valued function\015\012\011\011WHEN 'TT' THE" + "N 'types'\011\011-- Type table\015\012\011\011WHEN 'SO' THEN 'sequences'\011-- S" + "equence object\015\012\011\011WHEN 'SN' THEN 'synonymns'\011-- Synonyms\015\012\011" + "\011ELSE 'unknown'\015\012\011END as folder,\015\012\011o.[type] AS object_type\015" + "\012 -- ,*\015\012FROM sys.objects o\015\012-- Join child objects to find gre" + "atest last_modified date\015\012LEFT JOIN \015\012sys.objects c ON c.object_id =" + " o.parent_object_id\015\012WHERE 1 = 1\015\012--AND o.type = 'TT'\015\012AND o.p" + "arent_object_id = 0\015\012AND o.[type] NOT IN (\015\012\011 'S' -- System Tabl" + "es\015\012\011,'SQ' -- Service queues\015\012\011,'TR' -- Triggers saved from t" + "ables\015\012\011,'IT' -- Internal tables\015\012\011)\015\012ORDER BY o.[modif" + "y_date] DESC;\015\012\015\012\015\012" +dbMemo "Connect" ="ODBC;" +dbBoolean "ReturnsRecords" ="-1" +dbInteger "ODBCTimeout" ="60" +dbBoolean "LogMessages" ="0" +dbByte "Orientation" ="0" diff --git a/Version Control.accda.src/queries/qryMsSqlServerObjects.sql b/Version Control.accda.src/queries/qryMsSqlServerObjects.sql new file mode 100644 index 00000000..568584cf --- /dev/null +++ b/Version Control.accda.src/queries/qryMsSqlServerObjects.sql @@ -0,0 +1,36 @@ +SELECT o.[name], + SCHEMA_NAME(o.[schema_id]) AS [schema], + o.modify_date AS last_modified, c.modify_date AS test, + o.type_desc, + CASE o.[type] + WHEN 'V' THEN 'views' + WHEN 'U' THEN 'tables' + WHEN 'IT' THEN 'tables' -- Internal tables + WHEN 'TR' THEN 'tables' + WHEN 'P' THEN 'proceedures' + WHEN 'FN' THEN 'functions' -- Scalar function + WHEN 'IF' THEN 'functions' -- Inline table valued function + WHEN 'TF' THEN 'functions' -- Table valued function + WHEN 'TT' THEN 'types' -- Type table + WHEN 'SO' THEN 'sequences' -- Sequence object + WHEN 'SN' THEN 'synonymns' -- Synonyms + ELSE 'unknown' + END as folder, + o.[type] AS object_type + -- ,* +FROM sys.objects o +-- Join child objects to find greatest last_modified date +LEFT JOIN +sys.objects c ON c.object_id = o.parent_object_id +WHERE 1 = 1 +--AND o.type = 'TT' +AND o.parent_object_id = 0 +AND o.[type] NOT IN ( + 'S' -- System Tables + ,'SQ' -- Service queues + ,'TR' -- Triggers saved from tables + ,'IT' -- Internal tables + ) +ORDER BY o.[modify_date] DESC; + +