Библиотека интроспекции VBA для SQLite

Библиотека SQLiteDB VBA представляет собой набор вспомогательных функций VBA для движка SQLite. Основная цель этого проекта – предоставить удобный доступ к расширенным функциям самоанализа. Из-за своей универсальности библиотеки ADODB / ADOX предоставляют только ограниченную информацию о метаданных. В Самоанализ Подпакет этой библиотеки основан на общем механизме запросов SQL и специализированных SQL-запросах. Это облегчает доступ к полной информации как об особенностях используемого активного движка, так и об объектах / атрибутах присоединенной базы данных. Библиотека использует пакет ADODB и опирается на метод Кристиана Вернера. SQLiteODBC драйвер (я использую специально скомпилированный двоичный файл, в который встроена последняя версия SQLite, как описано здесь).

Диаграмма классов
ФигКлассСхема

Обратите внимание, что этот пост охватывает только основные функции. Дополнительная документация доступна на GitHub, а полный исходный код, тесты и примеры доступны на репозиторий проекта.

Три класса в верхней части диаграммы образуют Самоанализ подпакет, отвечающий за код SQL, связанный с метаданными, с SQLiteSQLDbInfo являясь объектом верхнего уровня. Он реализует часть функциональности, функции прокси, предоставляемые SQLiteSQLDbIdxFK, и инкапсулирует SQLiteSQLEngineInfo.


SQLiteSQLDbInfo

'@Folder "SQLiteDB.Introspection"
'@ModuleDescription "SQL queries for retrieving SQLite database metadata."
'@PredeclaredId
'@Exposed
'@IgnoreModule ProcedureNotUsed
Option Explicit

Private Type TSQLiteSQLDbInfo
    Schema As String
    Engine As SQLiteSQLEngineInfo
End Type
Private this As TSQLiteSQLDbInfo


Private Sub Class_Initialize()
    this.Schema = "main"
    Set this.Engine = SQLiteSQLEngineInfo
End Sub


Private Sub Class_Terminate()
    Set this.Engine = Nothing
End Sub


'''' @ClassMethodStrict
'''' This method should only be used on the default instance
''''
'@DefaultMember
'@Description "Default factory"
Public Function Create(Optional ByVal Schema As String = "main") As SQLiteSQLDbInfo
    Dim Instance As SQLiteSQLDbInfo
    Set Instance = New SQLiteSQLDbInfo
    Instance.Init Schema
    Set Create = Instance
End Function


Public Sub Init(ByVal Schema As String)
    this.Schema = Schema
End Sub


'@Description "Exposes SQLiteSQLEngineInfo introspection queries"
Public Property Get Engine() As SQLiteSQLEngineInfo
    Set Engine = this.Engine
End Property


'@Description "Generates a query returning the list of attached databases"
Public Property Get Databases() As String
    Databases = "SELECT name, file FROM pragma_database_list"
End Property


'''' @Proxy
'@Description "Generates a query returning all non-system database objects."
Public Function GetDbSchema(Optional ByVal Schema As String = vbNullString) As String
    GetDbSchema = SQLiteSQLDbIdxFK.DbSchema(IIf(Len(Schema) > 0, Schema, this.Schema))
End Function


'''' @Proxy
'@Description "Generates a query returning all non-system database objects, but triggers"
Public Function DbSchemaNoTriggers(Optional ByVal Schema As String = vbNullString) As String
    DbSchemaNoTriggers = SQLiteSQLDbIdxFK.DbSchemaNoTriggers(IIf(Len(Schema) > 0, Schema, this.Schema))
End Function


'''' @Proxy
'@Description "Generates a query returning triggers"
Public Function Triggers(Optional ByVal Schema As String = vbNullString) As String
    Triggers = SQLiteSQLDbIdxFK.Triggers(IIf(Len(Schema) > 0, Schema, this.Schema))
End Function


'''' For some reason, running SELECT * FROM <schema>.pragma_integrity_check
'''' with several attached databases gives the result as if <schema> is
'''' ignored and all attached databases are checked. Prefer to run this
'''' check when the only attached database is the one being checked.
'@Description "Generates a query running integrity check."
Public Property Get CheckIntegrity() As String
    CheckIntegrity = "SELECT * FROM pragma_integrity_check"
End Property


'''' For some reason, running SELECT * FROM <schema>.pragma_foreign_key_check
'''' with several attached databases gives the result as if <schema> is
'''' ignored and all attached databases are checked. Prefer to run this
'''' check when the only attached database is the one being checked.
'@Description "Generates a query running integrity check."
Public Property Get CheckFKs() As String
    CheckFKs = "SELECT * FROM pragma_foreign_key_check"
End Property


'''' @Proxy
'@Description "Generates a query returning database tables."
Public Function Tables(Optional ByVal Schema As String = vbNullString) As String
    Tables = SQLiteSQLDbIdxFK.Tables(IIf(Len(Schema) > 0, Schema, this.Schema))
End Function


'''' @Proxy
'@Description "Generates a query returning all foreing keys in the SQLite database"
Public Property Get ForeingKeys() As String
    ForeingKeys = SQLiteSQLDbIdxFK.ForeingKeys(this.Schema)
End Property


'''' @Proxy
'@Description "Generates a query returning all indices in the SQLite database"
Public Function Indices(Optional ByVal NonSys As Boolean = True) As String
    Indices = SQLiteSQLDbIdxFK.Indices(this.Schema, NonSys)
End Function


'''' @Proxy
'''' See the called class for details
'@Description "Generates a query returning child columns for all foreing keys and corresponding indices."
Public Property Get FKChildIndices() As String
    FKChildIndices = SQLiteSQLDbIdxFK.FKChildIndices(this.Schema)
End Property


'''' @Proxy
'''' See the called class for details
'@Description "Generates a query returning similar indices."
Public Property Get SimilarIndices() As String
    SimilarIndices = SQLiteSQLDbIdxFK.SimilarIndices(this.Schema)
End Property


'@Description "Generates a query returning table's columns."
Public Function TableColumns(ByVal TableName As String) As String
    Guard.EmptyString TableName
    TableColumns = "SELECT * " & _
                   "FROM " & this.Schema & ".pragma_table_xinfo('" & TableName & "')"
End Function


'@Description "Generates a query returning table's columns with placeholder columns."
Public Function TableColumnsEx(ByVal TableName As String) As String
    Guard.EmptyString TableName
    TableColumnsEx = "SELECT * , 0 AS [unique], '' as [check], '' as [collate] " & _
                     "FROM " & this.Schema & ".pragma_table_info('" & TableName & "')"
End Function


'@Description "Generates a query returning table's SQL."
Public Function TableSQL(ByVal TableName As String) As String
    Guard.EmptyString TableName
    TableSQL = "SELECT sql " & _
               "FROM sqlite_master " & _
               "WHERE type="table" AND name="" & TableName & """
End Function


'@Description "Generates a query returning table's foreign keys."
Public Function TableForeingKeys(ByVal TableName As String) As String
    TableForeingKeys = "SELECT * " & _
                       "FROM " & this.Schema & ".pragma_foreign_key_list('" & TableName & "')"
End Function

SQLiteSQLDbIdxFK

Объемный код, связанный с индексами базы данных и внешними ключами, вынесен в отдельный модуль.

'@Folder "SQLiteDB.Introspection"
'@ModuleDescription "SQL queries for retrieving detailed information on database indices and foreign keys."
'@PredeclaredId
''''
'''' Logically, this module is a part of SQLiteSQLDbInfo, and this FK/IDX code is
'''' placed in a separate module simply to isolate the large amount of SQL code.
'''' All methods of this module are exposed by SQLiteSQLDbInfo via composition.
'''' This class is not supposed to be used directly, and it does not need to be
'''' instantiated: all functionality can be used via the default instance.
''''
Option Explicit


'''' @ClassMethod
'''' This method can also be used on the default instance
''''
'''' Generates an SQLite query returning database tables, skipping
'''' system tables (prefixed with "sqlite_") and ordering by ROWID
'''' (in order of creation). If requested, a CTE WITH term is
'''' generated.
''''
'''' Args:
''''   Schema (string, optional, "main"):
''''     Schema name/alias
''''   CTEWITH (boolean, optional, False):
''''     If True, format as a CTE WITH term
''''
'''' Returns:
''''   String, containing the query
''''
'''' Examples:
''''   >>> ?SQLiteSQLDbIdxFK.Tables
''''   SELECT name, sql
''''   FROM main.sqlite_master
''''   WHERE type="table" AND (name NOT LIKE 'sqlite_%')
''''   ORDER BY ROWID ASC
''''
''''   >>> ?SQLiteSQLDbIdxFK.Tables(, True)
''''   t AS (
''''       SELECT name, sql
''''       FROM main.sqlite_master
''''       WHERE type="table" AND (name NOT LIKE 'sqlite_%')
''''       ORDER BY ROWID ASC
''''   )
''''
'@Description "Generates a query returning database tables."
Public Function Tables(Optional ByVal Schema As String = "main", _
                       Optional ByVal CTEWITH As Boolean = False) As String
    Dim Indent As String
    Dim Query As String
    Indent = IIf(CTEWITH, "    ", vbNullString)
    Query = Indent & Join(Array( _
        "SELECT tbl_name, sql", _
        "FROM " & Schema & ".sqlite_master", _
        "WHERE type="table" AND (name NOT LIKE 'sqlite_%')", _
        "ORDER BY ROWID ASC" _
    ), vbNewLine & Indent)
    Tables = IIf(CTEWITH, "t AS (" & vbNewLine & Query & vbNewLine & ")", Query)
End Function


'''' @ClassMethod
'''' This method can also be used on the default instance
''''
'''' Generates an SQLite query returning database views ordered by ROWID
'''' (in order of creation).
''''
'''' Args:
''''   Schema (string, optional, "main"):
''''     Schema name/alias
''''
'''' Returns:
''''   String, containing the query
''''
'''' Examples:
''''   >>> ?SQLiteSQLDbIdxFK.Views
''''   SELECT tbl_name, sql
''''   FROM main.sqlite_master
''''   WHERE type="view"
''''   ORDER BY ROWID ASC
''''
'@Description "Generates a query returning database views."
Public Function Views(Optional ByVal Schema As String = "main") As String
    Views = Join(Array( _
        "SELECT tbl_name, sql", _
        "FROM " & Schema & ".sqlite_master", _
        "WHERE type="view"", _
        "ORDER BY ROWID ASC" _
    ), vbNewLine)
End Function


'''' @ClassMethod
'''' This method can also be used on the default instance
''''
'''' Generates an SQLite query returning database triggers ordered by ROWID
'''' (in order of creation).
''''
'''' Args:
''''   Schema (string, optional, "main"):
''''     Schema name/alias
''''
'''' Returns:
''''   String, containing the query
''''
'''' Examples:
''''   >>> ?SQLiteSQLDbIdxFK.Triggers
''''   SELECT tbl_name, sql
''''   FROM main.sqlite_master
''''   WHERE type="trigger"
''''   ORDER BY ROWID ASC
''''
'@Description "Generates a query returning database triggers."
Public Function Triggers(Optional ByVal Schema As String = "main") As String
    Triggers = Join(Array( _
        "SELECT tbl_name, sql", _
        "FROM " & Schema & ".sqlite_master", _
        "WHERE type="trigger"", _
        "ORDER BY ROWID ASC" _
    ), vbNewLine)
End Function


'''' @ClassMethod
'''' This method can also be used on the default instance
''''
'''' Generates an SQLite query returning all non-system database objects
'''' ordered by type (tables, indices, views, triggers) and then by ROWID.
'''' The query returns two columns (sql, type_id).
''''
'''' Args:
''''   Schema (string, optional, "main"):
''''     Schema name/alias
''''
'''' Returns:
''''   String, containing the query
''''
'''' Examples:
''''   >>> ?SQLiteSQLDbIdxFK.DbSchema
''''   SELECT sql, (CASE type
''''       WHEN 'table' THEN 0
''''       WHEN 'index' THEN 1
''''       WHEN 'view'  THEN 3
''''                    ELSE 4
''''                    END) AS type_id
''''   FROM main.sqlite_master
''''   WHERE name NOT like 'sqlite_%'
''''   ORDER BY type_id, _ROWID_
''''
'@Description "Generates a query returning all non-system database objects."
Public Function DbSchema(Optional ByVal Schema As String = "main") As String
    DbSchema = Join(Array( _
        "SELECT sql, (CASE type", _
        "    WHEN 'table' THEN 0", _
        "    WHEN 'index' THEN 1", _
        "    WHEN 'view'  THEN 2", _
        "                 ELSE 3", _
        "                 END) AS type_id", _
        "FROM " & Schema & ".sqlite_master", _
        "WHERE name NOT like 'sqlite_%'", _
        "ORDER BY type_id, _ROWID_" _
    ), vbNewLine)
End Function


'''' @ClassMethod
'''' This method can also be used on the default instance
''''
'''' Generates an SQLite query returning all non-system database objects,
'''' except for triggers, ordered by type (tables, indices, views) and
'''' then by ROWID. The query returns two columns (sql, type_id).
''''
'''' Args:
''''   Schema (string, optional, "main"):
''''     Schema name/alias
''''
'''' Returns:
''''   String, containing the query
''''
'''' Examples:
''''   >>> ?SQLiteSQLDbIdxFK.DbSchemaNoTriggers
''''   SELECT sql, (CASE type
''''       WHEN 'table' THEN 0
''''       WHEN 'index' THEN 1
''''                    ELSE 2
''''                    END) AS type_id
''''   FROM main.sqlite_master
''''   WHERE (name NOT like 'sqlite_%') AND type <> 'trigger'
''''   ORDER BY type_id, _ROWID_
''''
'@Description "Generates a query returning all non-system database objects."
Public Function DbSchemaNoTriggers(Optional ByVal Schema As String = "main") As String
    DbSchemaNoTriggers = Join(Array( _
        "SELECT sql, (CASE type", _
        "    WHEN 'table' THEN 0", _
        "    WHEN 'index' THEN 1", _
        "                 ELSE 2", _
        "                 END) AS type_id", _
        "FROM " & Schema & ".sqlite_master", _
        "WHERE (name NOT like 'sqlite_%') AND type <> 'trigger'", _
        "ORDER BY type_id, _ROWID_" _
    ), vbNewLine)
End Function


'''' @ClassMethod
'''' This method can also be used on the default instance
''''
'''' Generates an SQLite query returning base info on database indices ordering
'''' by ROWID (in order of creation). If requested, a CTE WITH term is generated.
''''
'''' Args:
''''   Schema (string, optional, "main"):
''''     Schema name/alias
''''   CTEWITH (boolean, optional, False):
''''     If True, format as a CTE WITH term
''''
'''' Returns:
''''   String, containing the query
''''
'''' Examples:
''''   >>> ?SQLiteSQLDbIdxFK.IndexBase
''''   SELECT ROWID AS id, name AS idx_name, tbl_name, sql
''''   FROM main.sqlite_master
''''   WHERE type="index"
''''   ORDER BY ROWID ASC
''''
''''   >>> ?SQLiteSQLDbIdxFK.IndexBase(, True)
''''   ib AS (
''''       SELECT ROWID AS id, name AS idx_name, tbl_name, sql
''''       FROM main.sqlite_master
''''       WHERE type="index"
''''       ORDER BY ROWID ASC
''''   )
''''
'@Description "Generates a query returning indices (base info)."
Public Function IndexBase(Optional ByVal Schema As String = "main", _
                          Optional ByVal CTEWITH As Boolean = False) As String
    Dim Indent As String
    Dim Query As String
    Indent = IIf(CTEWITH, "    ", vbNullString)
    Query = Indent & Join(Array( _
        "SELECT ROWID AS id, name AS idx_name, tbl_name, sql", _
        "FROM " & Schema & ".sqlite_master", _
        "WHERE type="index"", _
        "ORDER BY ROWID ASC" _
    ), vbNewLine & Indent)
    IndexBase = IIf(CTEWITH, "ib AS (" & vbNewLine & Query & vbNewLine & ")", Query)
End Function


'''' @ClassMethod
'''' This method can also be used on the default instance
''''
'''' Generates an SQLite CTE WITH term for a foreign key list.
''''
'''' Args:
''''   Schema (string, optional, "main"):
''''     Schema name/alias
''''
'''' Returns:
''''   String, containing the CTE WITH term
''''
'''' Examples:
''''   >>> ?SQLiteSQLDbIdxFK.pForeignKeyList
''''   fkl AS (
''''       SELECT tbl_name AS child_table, [from] AS child_col0,
''''              [table] AS parent_table, [to] AS parent_col0,
''''              on_update, on_delete, id AS fk_id, seq AS fk_seq
''''       FROM t
''''       Join main.pragma_foreign_key_list(t.tbl_name)
''''       ORDER BY child_table, fk_id
''''   )
''''
'@Description "Generates a query returning a foreign key CTE WITH term."
Public Function pForeignKeyList(Optional ByVal Schema As String = "main") As String
    pForeignKeyList = Join(Array( _
        "fkl AS (", _
        "    SELECT tbl_name AS child_table, [from] AS child_col0,", _
        "           [table] AS parent_table, [to] AS parent_col0,", _
        "           on_update, on_delete, id AS fk_id, seq AS fk_seq", _
        "    FROM t", _
        "    JOIN " & Schema & ".pragma_foreign_key_list(t.tbl_name)", _
        "    ORDER BY child_table, fk_id", _
        "),", _
        "fk AS (", _
        "    SELECT *, group_concat(child_col0, ', ') AS child_cols,", _
        "              group_concat(parent_col0, ', ') AS parent_cols,", _
        "              min(fk_seq) AS min_fk_seq", _
        "    FROM fkl", _
        "    GROUP BY child_table, fk_id", _
        "    ORDER BY child_table, fk_id", _
        ")" _
    ), vbNewLine)
End Function


'''' @ClassMethod
'''' This method can also be used on the default instance
''''
'''' Generates an SQLite CTE WITH term for index info & list.
'''' For each index list info and join the tables. Only use <index name> here.
'''' For multi-column indices, keep the row with the first column and generates
'''' a column list. Generate database-wide list of additional index info columns
'''' from the per-table index lists.
''''
'''' Args:
''''   Schema (string, optional, "main"):
''''     Schema name/alias
''''
'''' Returns:
''''   String, containing the CTE WITH term
''''
'@Description "Generates a query returning a CTE WITH term for index info & list."
Public Function pIndexInfoList(Optional ByVal Schema As String = "main") As String
    pIndexInfoList = Join(Array( _
        "ii AS (", _
        "    SELECT ib.idx_name, min(ii.seqno) AS seqno, ii.name AS col0_name, group_concat(ii.name, ', ') AS columns", _
        "    FROM ib", _
        "    JOIN " & Schema & ".pragma_index_info(ib.idx_name) AS ii", _
        "    GROUP BY idx_name", _
        "),", _
        "il AS (", _
        "    SELECT name AS idx_name, seq AS idx_seq, [unique], origin, partial", _
        "    FROM t", _
        "    JOIN " & Schema & ".pragma_index_list(tbl_name)", _
        ")" _
    ), vbNewLine)
End Function


'''' @ClassMethod
'''' This method can also be used on the default instance
''''
'@Description "Generates a query returning all foreing keys in the SQLite database"
Public Function ForeingKeys(Optional ByVal Schema As String = "main") As String
    Dim StmtParts(0 To 5) As String
    StmtParts(0) = "WITH"
    
    '''' List all db tables
    StmtParts(1) = Tables(Schema, True) & ","
    
    '''' For each table, list foreign keys and join them to get a list of all foreign
    '''' keys for the DB. Each row contains info on a foreign key for a single column.
    '''' Yield a single row per foreign key, including multi-column keys. For multi-column
    '''' keys, keep the row with the first column and generates a column list.
    StmtParts(2) = pForeignKeyList(Schema)
    
    StmtParts(3) = "SELECT *"
    StmtParts(4) = "FROM fk AS foreign_keys"
    StmtParts(5) = "ORDER BY child_table, fk_id"
    
    ForeingKeys = Join(StmtParts, vbNewLine)
End Function


'''' @ClassMethod
'''' This method can also be used on the default instance
''''
'''' Generates an SQLite query returning database indices, ordering by ROWID.
'''' If "NonSys" = True, skip auto indices (prefixed with "sqlite_autoindex_").
''''
'@Description "Generates a query returning all indices in the SQLite database"
Public Function Indices(Optional ByVal Schema As String = "main", _
                        Optional ByVal NonSys As Boolean = True) As String
    Dim StmtParts(10 To 26) As String
    StmtParts(10) = "WITH"
    
    '''' List all db tables
    StmtParts(11) = Tables(Schema, True) & ","
    
    '''' List all db indices
    StmtParts(12) = IndexBase(Schema, True) & ","
    
    '''' For each index list info and join the tables. Only use <index name> here. For
    '''' multi-column indices, keep the row with the first column and generates a column list.
    '''' Generate database-wide list of additional index info columns from the per-table index lists
    StmtParts(13) = pIndexInfoList(Schema) & ","
    
    '''' After taking care of multi-row descriptions, add aditional columns from index list
    StmtParts(14) = "idx AS ("
    StmtParts(15) = "    SELECT ib.id, ib.idx_name, ib.tbl_name, ii.col0_name, ii.columns, ib.sql"
    StmtParts(16) = "    FROM ib, ii"
    StmtParts(17) = "    ON ib.idx_name = ii.idx_name"
    StmtParts(18) = "),"
    
    '''' Join additional info columns with index-wise list
    StmtParts(19) = "iex AS ("
    StmtParts(20) = "    SELECT idx.*, il.idx_seq, il.[unique], il.origin, il.partial"
    StmtParts(21) = "    FROM idx, il"
    StmtParts(22) = "    WHERE idx.idx_name = il.idx_name"
    StmtParts(23) = ")"
    
    StmtParts(24) = "SELECT *"
    StmtParts(25) = "FROM iex AS indices"
    StmtParts(26) = IIf(NonSys, _
                    "WHERE idx_name NOT LIKE 'sqlite_autoindex_%'" & vbNewLine, vbNullString) & _
                    "ORDER BY id"
    
    Indices = Join(StmtParts, vbNewLine)
End Function


'''' @ClassMethod
'''' This method can also be used on the default instance
''''
'''' Indices on child columns of foreing key relations are not mandatory,
'''' but generally should be defined. Database engine does not control whether
'''' such indices are defined. This query return a summary table showing all
'''' child columns and corresponding indices in the "idx_name" column. If this
'''' field is empty for a particular child column, the corresponding index has
'''' not been defined.
''''
'@Description "Generates a query returning child columns for all foreing keys and corresponding indices."
Public Function FKChildIndices(Optional ByVal Schema As String = "main") As String
    Dim StmtParts(10 To 34) As String
    StmtParts(10) = "WITH"
    StmtParts(11) = Tables(Schema, True) & ","
    StmtParts(12) = IndexBase(Schema, True) & ","
    StmtParts(13) = pIndexInfoList(Schema) & ","
    StmtParts(14) = "idx AS ("
    StmtParts(15) = "    SELECT ib.id, ib.idx_name, ib.tbl_name, ii.col0_name, ii.columns, ib.sql"
    StmtParts(16) = "    FROM ib, ii"
    StmtParts(17) = "    ON ib.idx_name = ii.idx_name"
    StmtParts(18) = "),"
    StmtParts(19) = "iex AS ("
    StmtParts(20) = "    SELECT idx.*, il.idx_seq, il.[unique], il.origin, il.partial"
    StmtParts(21) = "    FROM idx, il"
    StmtParts(22) = "    WHERE idx.idx_name = il.idx_name AND partial = 0"
    StmtParts(23) = "),"

    StmtParts(24) = pForeignKeyList(Schema) & ","

    '''' Join indices and foreign keys tables to see which child columns do not have indices.
    '''' Multi-column indices, having the child column set as the "prefix" are accepted.
    StmtParts(25) = "fki AS ("
    StmtParts(26) = "    SELECT fk.child_table, fk.child_cols, fk.parent_table, fk.parent_cols,"
    StmtParts(27) = "           iex.idx_name"
    StmtParts(28) = "    FROM fk"
    StmtParts(29) = "    LEFT JOIN iex"
    StmtParts(30) = "    ON fk.child_table = iex.tbl_name AND fk.child_cols = substr(iex.columns, 1, length(fk.child_cols))"
    StmtParts(31) = ")"
    StmtParts(32) = "SELECT *"
    StmtParts(33) = "FROM fki AS fkeys_childindices"
    StmtParts(34) = "ORDER BY child_table, child_cols"

    FKChildIndices = Join(StmtParts, vbNewLine)
End Function


'''' @ClassMethod
'''' This method can also be used on the default instance
''''
'''' If IDX1 indexes columns (A, B) and IDX2 indexes columns (A, B, C), that is
'''' IDX1 indexes a "prefix" of IDX2, IDX2 can replace IDX1. On the other hand,
'''' depending on statistics (if for any given pair (A, B), there are very few
'''' rows), IDX2 may not be justifiable (unless it is the primary key). This
'''' query aims to return all such similar ("prefix") indices, though it has not
'''' been thoughroughly verified. It may return some "false" positive. Whether
'''' it can miss indices is not clear.
''''
'@Description "Generates a query returning similar indices."
Public Function SimilarIndices(Optional ByVal Schema As String = "main") As String
    Dim StmtParts(10 To 39) As String
    StmtParts(10) = "WITH"
    StmtParts(11) = Tables(Schema, True) & ","
    StmtParts(12) = IndexBase(Schema, True) & ","
    StmtParts(13) = pIndexInfoList(Schema) & ","
    StmtParts(14) = "idx AS ("
    StmtParts(15) = "    SELECT ib.id, ib.idx_name, ib.tbl_name, ii.col0_name, ii.columns"
    StmtParts(16) = "    FROM ib, ii"
    StmtParts(17) = "    ON ib.idx_name = ii.idx_name"
    StmtParts(18) = "),"
    StmtParts(19) = "iex AS ("
    StmtParts(20) = "    SELECT idx.*, il.idx_seq, il.[unique], il.origin, il.partial"
    StmtParts(21) = "    FROM idx, il"
    StmtParts(22) = "    WHERE idx.idx_name = il.idx_name"
    StmtParts(23) = "),"
    StmtParts(24) = "fdup AS ("
    StmtParts(25) = "    SELECT tbl_name, col0_name, count(*) AS group_size"
    StmtParts(26) = "    FROM iex"
    StmtParts(27) = "    WHERE partial = 0"
    StmtParts(28) = "    GROUP BY tbl_name, col0_name"
    StmtParts(29) = "    HAVING group_size > 1"
    StmtParts(30) = "),"
    StmtParts(31) = "idup AS ("
    StmtParts(32) = "    SELECT iex.*, fdup.group_size"
    StmtParts(33) = "    FROM iex"
    StmtParts(34) = "    JOIN fdup"
    StmtParts(35) = "    ON iex.tbl_name = fdup.tbl_name AND iex.col0_name = fdup.col0_name"
    StmtParts(36) = ")"
    StmtParts(37) = "SELECT *"
    StmtParts(38) = "FROM idup AS similar_indices"
    StmtParts(39) = "ORDER BY tbl_name, col0_name, columns"
    
    SimilarIndices = Join(StmtParts, vbNewLine)
End Function

SQLiteSQLEngineInfo

Код, относящийся к движку, входит в этот модуль.

'@Folder "SQLiteDB.Introspection"
'@ModuleDescription "SQL queries for retrieving information about the engine configuration and available features."
'@PredeclaredId
'@Exposed
'@IgnoreModule ProcedureNotUsed
'''' All methods in this module are class methods and can be safely called on the default instance
'''' @ClassModule
Option Explicit


'@Description "Generates query returning available SQLite collations"
Public Property Get Collations() As String
    Collations = "SELECT * FROM pragma_collation_list AS collations ORDER BY name"
End Property


'@Description "Generates query returning compile options"
Public Property Get CompileOptions() As String
    CompileOptions = "SELECT * FROM pragma_compile_options AS compile_options"
End Property


'@Description "Generates query returning available SQLite functions"
Public Property Get Functions() As String
    Functions = "SELECT * FROM pragma_function_list AS functions ORDER BY name"
End Property


'@Description "Generates query returning available SQLite modules"
Public Property Get Modules() As String
    Modules = "SELECT * FROM pragma_module_list AS modules ORDER BY name"
End Property


'@Description "Generates query returning available SQLite pragmas"
Public Property Get Pragmas() As String
    Pragmas = "SELECT * FROM pragma_pragma_list AS pargmas ORDER BY name"
End Property


'@Description "Generates query returning SQLite version"
Public Property Get Version() As String
    Version = "SELECT sqlite_version() AS version"
End Property

ADOlib.RecordsetToQT

Эта процедура выводит данные записи из ADODB.Recordset на лист Excel с помощью функции QueryTable. В ADODB.Recordset объект напрямую предоставляется конструктору QueryTable, сохраняя компактность кода и эффективность процесса.

'@Description "Outputs Recordset to Excel Worksheet via QueryTable"
Public Sub RecordsetToQT(ByVal AdoRecordset As ADODB.Recordset, ByVal OutputRange As Excel.Range)
Attribute RecordsetToQT.VB_Description = "Outputs Recordset to Excel Worksheet via QueryTable"
    Guard.NullReference AdoRecordset
    Guard.NullReference OutputRange
    
    Dim QTs As Excel.QueryTables
    Set QTs = OutputRange.Worksheet.QueryTables
    
    '''' Cleans up target area before binding the data.
    '''' Provided range reference used to indicate the left column and
    '''' Recordset.Fields.Count determines the width.
    '''' If EntireColumn.Delete method is used, Range object becomes invalid, so
    '''' a textual address must be saved to reset the Range reference.
    '''' However, when multiple QTs are bound to the same worksheet,
    '''' EntireColumn.Delete shifts columns to the left, so the target range
    '''' may not be clear. EntireColumn.Clear clears the contents.
    Dim FieldsCount As Long
    FieldsCount = AdoRecordset.Fields.Count
    Dim QTRangeAddress As String
    QTRangeAddress = OutputRange.Address(External:=True)
    Dim QTRange As Excel.Range
    '@Ignore ImplicitActiveSheetReference
    Set QTRange = Range(QTRangeAddress)
    QTRange.Resize(1, FieldsCount).EntireColumn.Clear
    '@Ignore ImplicitActiveSheetReference
    Set QTRange = Range(QTRangeAddress)
    
    Dim WSQueryTable As Excel.QueryTable
    For Each WSQueryTable In QTs
        WSQueryTable.Delete
    Next WSQueryTable
    
    Dim NamedRange As Excel.Name
    For Each NamedRange In QTRange.Worksheet.Names
        NamedRange.Delete
    Next NamedRange
    
    Set WSQueryTable = QTs.Add(Connection:=AdoRecordset, Destination:=QTRange.Range("A1"))
    With WSQueryTable
        .FieldNames = True
        .RowNumbers = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SaveData = False
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .EnableEditing = True
    End With
    WSQueryTable.Refresh
    QTRange.Worksheet.UsedRange.Rows(1).HorizontalAlignment = xlCenter
End Sub

1 ответ
1

Микрообзор:

'@IgnoreModule ProcedureNotUsed

Раньше я тоже посыпал этим, но есть несколько причин, по которым не стоит его использовать:

  1. Это указывает на то, что ваши интеграционные тесты – если они содержатся в тех же файлах проекта – не попадают в этот путь кода, который должен быть исправлен или проигнорирован в каждом конкретном случае IMO.
  2. (Относительно) новый '@EntryPoint аннотация обычно является лучшим индикатором общедоступного API.
  3. '@IgnoreModule означает, что если вы выполняете рефакторинг, эта аннотация может нацелить различные подпрограммы на те, которые вы изначально планировали – это нормально, если модуль действительно предназначен только для общедоступного API, и аннотация всегда будет действительной. Но иногда вы игнорируете процедуры, которые могут быть не просто методами API.

Например, в SQLiteSQLDbInfo:

Public Sub Init(ByVal Schema As String)
    this.Schema = Schema
End Sub

Это могло быть Friend Sub потому что это не публичный API, а жизненно важно не забыть вызвать этот метод при рефакторинге Create метод и случайно сбросить вызов Init. ProcedureNotUsed может помочь с этим без необходимости реализации заводского интерфейса.


Также RD позволяет определить причину игнорирования для каждого '@Ignore[Module] аннотация с использованием двоеточия:

Dim QTRange As Excel.Range
'@Ignore ImplicitActiveSheetReference
Set QTRange = Range(QTRangeAddress)

… может быть:

Dim QTRange As Excel.Range
'@Ignore ImplicitActiveSheetReference: QTRangeAddress is a fully qualified external range
Set QTRange = Range(QTRangeAddress)

… тем не менее, если этот код попал в SheetX, тогда Range неявно относится к SheetX.Range что не удается, если QTRange находится в SheetY, так что лучше перестраховаться и использовать полностью квалифицированный Application.Range

Итак, для книги с 2 листами Sheet1 и Sheet2 следующий код:

Sub t()
    Debug.Print Range("[Book1]Sheet1!$A$1").Address(external:=True)
End Sub

… не работает в Sheet2, поскольку он ссылается на Sheet1, но:

Sub t()
    Debug.Print Application.Range("[Book1]Sheet1!$A$1").Address(external:=True)
End Sub

… отпечатки “[Book1]Sheet1! $ A $ 1 “, как ожидалось

  • Я бы пошел еще дальше и сказал, что Init следует преобразовать в свойство, называемое Schema с получателем, ограниченным как Public и сеттер в области видимости как Friend вот так Public Property Get Schema() As String Schema = this.Schema End Property Friend Property Let Schema(ByVal value As String ) this.Schema = value End Property вместе с некоторыми Gaurd.NullReference заявления.

    – рикманалександер


  • @rickmanalexander на самом деле, я следую шаблону, используемому в примерах RD, где фабрика по умолчанию называется Создавать. Но я расширил его параметризованным конструктором под названием В этом. По этой причине я предпочитаю оставить его как Sub.

    – PChemGuy


  • @Greedo Я в целом согласен, что голый Диапазон необходимо избегать. Однако обратите внимание, что я не использую код программной части. Этот код находится в обычном модуле. В репо проекта есть рабочая тетрадь SQLiteDBVBALibrary.xls. Если ты бежишь SQLiteIntropectionExample.Engine, вы должны получить информацию о движке SQLite, размещенную на листе “EngineInfo”. И не имеет значения, какой лист активен. В этом отношении не имеет значения, какая книга активна. Информация размещена на «EngineInfo». Я только что проверил это поведение в Excel 2002 и Excel 2016.

    – PChemGuy


  • @PChemGuy Да, я не хотел говорить об ошибке, это больше вызывает беспокойство, если вы позже рефакторируете и поместите код записи на лист где-нибудь в лист, но в вашей ситуации это очень маловероятно, поскольку вы неявно получаете dest лист из переданного диапазона, а не код программной части. Моя точка зрения была больше о “если RD что-то предлагает, а вы игнорируете это, обязательно объясните это и оставьте комментарий, чтобы позже напомнить себе об оправдании”. Я не знал о комментариях: до недавнего времени и вижу, что вы не используете их в других репозиториях, поэтому подумал, что было бы полезно выделить

    – Гридо


  • @Greedo Я только что узнал: комментарии к вашему ответу. Мне нравится эта функция, и я постараюсь начать ее использовать. На самом деле, мне обязательно стоит использовать Друг квалификатор чаще. Я часто делаю учеников Общественные просто для того, чтобы я мог провести их модульное тестирование. Я думаю Друг квалификатор был бы более уместным в таком случае.

    – PChemGuy


Добавить комментарий

Ваш адрес email не будет опубликован. Обязательные поля помечены *