Verificador estructura de bases Access 2003

Introducción

SBDV permite un manejo a grandes rasgos de bases de datos en formato Access 2003. Permite crearlas y asegurarse de que las mismas no han sido modificadas verificando su estructura de datos (esto es para poder estar cien por ciento seguros de que nuestro sistema posee una correcta estructura de base de datos).

Este fue el motivo por el que SBDV ha sido preparado.

Datos del sistema

El sistema no posee muchos tipos de datos para Campos disponibles con los que trabajar todavía. He incluido los que considero más básicos, además de necesarios, para todo desarrollador, como ser: el tipo Texto, Entero y Autonúmerico. Por ello, quizá algún desarrollador prefiera no usar el sistema, pero lo único que puedo decir es que habrán otros que quieran un sistema sencillo para verificar la estructura de las bases de datos de su aplicación; aunque debo agregar que con el tiempo, si me es posible, expandiré las funcionalidades y tipos de datos que soporta.

Quedaré agradecido con las personas que tengan la bondad de reportar errores en el sistema, para que así pueda corregirlos. Mi dirección de correo se menciona la comienzo del artículo, en el nombre del autor.

Nota:
Deseo aclarar que el sistema trabaja con la tecnología ADO para manejar las bases de datos, pero no la versión .NET, ya que por motivos de tiempo, no he podido aprender a manejarla del todo bien. Algunos se rehusarán a usar el sistema por dicho motivo, aunque creo que habrá otros que no. Eso dependerá del sistema que quiere diseñar el desarrollador.

El código:

A continuación sigue el código en Visual Basic .NET para el sistema:

Option Explicit On
Option Strict On

'------------------------------------------------------------------------------
' SBDV (Sistema de Base de Datos Virtual (S.B.D.V.)
' Sistema de manejo a grandes rasgos de base de datos.
' [Versión 1.0.0].
'
'
' [Historial de cambios entre versiones.]
'
' Versión 1.0.0 (06/Feb/2010) Primera versión.
'
'
' [Ámbitos legales]
'
' El código de este sistema (en adelante, 'el SISTEMA') es LIBRE.
' Usted puede editar el SISTEMA o crear derivados de él cualquiera
' sea su fin. Solo se le prohíbe que, en caso de crear un derivado
' de el SISTEMA, lo publique a nombre del autor original (es decir,
' puede publicar exclusivamente derivados con otro nombre y a nombre
' de otro autor), y no es necesaria mención alguna del autor o del
' SISTEMA original.
'
'
' [Datos sobre el sistema]
'
' SBDV permite un manejo a grandes rasgos de bases de datos en
' formato Access 2003. Permite crearlas y asegurarse de que las
' mismas no han sido modificadas verificando su estructura de
' datos (esto es para poder estar cien por ciento seguros de que
' nuestro sistema posee una correcta estructura de base de datos).
' Este fue el motivo por el que SBDV ha sido preparado.
'
' El sistema no posee muchos tipos de datos para Campos disponibles
' con los que trabajar todavía. He incluido los que considero más
' básicos, además de necesarios, para todo desarrollador, como ser:
' el tipo Texto, Entero y Autonúmerico. Por ello, quizá algún
' desarrollador prefiera no usar el sistema, pero lo único que puedo
' decir es que habrán otros que quieran un sistema sencillo para
' verificar la estructura de las bases de datos de su aplicación;
' aunque debo agregar que con el tiempo, si me es posible, expandiré
' las funcionalidades y tipos de datos que soporta.
'
' Quedaré agradecido con las personas que tengan la bondad de
' reportar errores en el sistema, para que así pueda corregirlos.
' Mis direcciones de correo se mencionan al final.
'
' Deseo aclarar que el sistema trabaja con la tecnología ADO para
' manejar las bases de datos, pero no la versión .NET, ya que por
' motivos de tiempo, no he podido aprender a manejarla del todo bien.
' Algunos se rehusarán a usar el sistema por dicho motivo, aunque
' creo que habrá otros que no. Eso dependerá del sistema que quiere
' diseñar el desarrollador.
' 
'
' [Problemas conocidos]
'
' - El sistema posee un error (lo llamo así porque no es lo que yo
' espera que hiciera, aunque de todas formas, funciona bien) al
' importar una base de datos desde la clase BD (MiBD.Importar).
' Ocurre que por motivos que desconozco, la conexión se mantiene
' abierta a la base de datos que se importa después de importar la
' base de datos al sistema.
'
' El error ocurre, al parecer, cuando recupero culquier valor de una
' propiedad de un objeto Column de ADOX. P. Ej.:
'
'         Dim AutoIncrement As Boolean = CBool(Campo.Properties("AutoIncrement").Value)
'
'         La llamada a la línea de arriba, que se encuentra en
'         la función Importar de la clase BD, no daría error, pero
'         mantendrá la conexión abierta con la base de datos después
'         de terminar la importación.
'
' No sé porque ocurre eso, y agradecería que alguien me lo dijera
' para solucionarlo. Mis direcciones de correo se mencionan al final.
' Gracias.
'
'
' [Notas finales]
'
' Para que el sistema funcione correctamente, debe agregar las
' siguientes referencias COM a su proyecto:
'
'         Microsoft ActiveX Data Objects 2.1 Library
'         Microsoft ADO Ext. 2.8 for DLL and Security
'
' Para hacerlo, vaya al menú Proyecto > Agregar referencia...
' Una vez allí, vaya a la pestaña COM y busque las referencias
' y agréguelas.
'
'
' Correos: <[email protected]> | <[email protected]>
' © Alex Pizarro, 2010. Se reservan todos los derechos.
'------------------------------------------------------------------------------

Namespace SBDV
    'Estructuras y enumeraciones.
    Namespace Estructuras
        Public Enum CampoTipo
            Str = 0
            Int = 1
            Auto = 2
        End Enum
        '
        Public Class DatosBD
            Public Ruta As String
            Public Contraseña As String
            Public Sub New()
                Ruta = "" : Contraseña = ""
            End Sub
        End Class
    End Namespace

    'Clase principal.
    'Use esta clase para manejar su base de datos.
    Public Class BD
        Private p_Contraseña As String
        Private p_Tablas As Tablas
        Public Sub New()
            p_Contraseña = ""
            p_Tablas = New Tablas
        End Sub
        Protected Overrides Sub Finalize()
            p_Tablas = Nothing
            MyBase.Finalize()
        End Sub
        '
        ReadOnly Property Tablas() As Tablas
            Get
                Return p_Tablas
            End Get
        End Property
        '
        Property Contraseña() As String
            Get
                Return p_Contraseña
            End Get
            Set(ByVal value As String)
                p_Contraseña = value
            End Set
        End Property
        '
        Public Function Exportar(ByVal RutaBD As String) As Boolean
            Dim oCat As New ADOX.Catalog, SQL As String, oCn As ADODB.Connection = Nothing
            Dim bError As Boolean = False
            Try
                If Len(Dir(RutaBD)) > 0 Then
                    'Throw New Exception("La ruta que especificó es inválida o ya existe un archivo en esa ruta.")
                    bError = True
                    GoTo Finalmente
                End If
            Catch ex As Exception
                bError = True
                GoTo Finalmente
            End Try
            '
            Try
                SQL = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & RutaBD & ";"
                If Len(Contraseña) > 0 Then
                    SQL += "Jet OLEDB:Database Password=""" & Contraseña & """;"
                End If
                oCat.Create(SQL)
                oCn = CType(oCat.ActiveConnection, ADODB.Connection)
                '
                Dim Tabla As Tabla, Campo As Campo
                For Each Tabla In Me.Tablas.Colección
                    Dim tTabla As New ADOX.Table
                    With tTabla
                        .ParentCatalog = oCat
                        .Name = Tabla.Nombre
                        For Each Campo In Tabla.Campos.Colección
                            Select Case Campo.Tipo
                                Case Estructuras.CampoTipo.Str 'Cadena
                                    .Columns.Append(Campo.Nombre, ADOX.DataTypeEnum.adVarWChar, Campo.Tamaño)
                                    .Columns(Campo.Nombre).Attributes = ADOX.ColumnAttributesEnum.adColNullable
                                Case Estructuras.CampoTipo.Int 'Entero
                                    .Columns.Append(Campo.Nombre, ADOX.DataTypeEnum.adInteger)
                                Case Estructuras.CampoTipo.Auto 'Autonúmerico
                                    .Columns.Append(Campo.Nombre, ADOX.DataTypeEnum.adInteger)
                                    .Columns(Campo.Nombre).Properties("AutoIncrement").Value = True
                                    .Columns(Campo.Nombre).Properties("Increment").Value = 1
                            End Select
                            Campo = Nothing
                        Next
                        If Len(Tabla.Clave) > 0 Then
                            .Keys.Append("PrimaryKey", ADOX.KeyTypeEnum.adKeyPrimary, Tabla.Clave)
                        End If
                    End With
                    oCat.Tables.Append(tTabla)
                    tTabla = Nothing
                    Tabla = Nothing
                Next
            Catch ex As Exception
                'Throw New Exception(ex.Message)
                bError = True
                GoTo Finalmente
            End Try
Finalmente:
            If Not oCn Is Nothing Then
                oCn.Close() : oCn = Nothing
            End If
            oCat.ActiveConnection = Nothing : oCat = Nothing
            If bError Then
                Return False
            Else
                Return True
            End If
        End Function
        '
        Public Function Importar(ByVal RutaBD As String, Optional ByVal Contraseña As String = "") As Boolean
            If Len(RutaBD) = 0 OrElse Len(Dir(RutaBD)) = 0 Then Return False
            Dim oCat As New ADOX.Catalog, Tabla As ADOX.Table, Campo As ADOX.Column
            Dim oCn As New ADODB.Connection, SQL As String = ""
            Dim tBD As New BD, bError As Boolean = False
            '
            Try
                SQL = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & RutaBD & ";"
                If Len(Contraseña) > 0 Then
                    SQL += "Jet OLEDB:Database Password=""" & Contraseña & """;"
                End If
                oCn.CursorLocation = ADODB.CursorLocationEnum.adUseClient
                oCn.Mode = ADODB.ConnectModeEnum.adModeShareDenyNone
                oCn.Open(SQL)
                oCat.ActiveConnection = oCn
            Catch ex As Exception
                'Throw New Exception(ex.Message)
                bError = True
                GoTo Finalizar
            End Try
            '
            Try
                tBD.Contraseña = Contraseña
                For Each Tabla In oCat.Tables
                    If Tabla.Name.StartsWith("MSys") = False Then
                        tBD.Tablas.Agregar(Tabla.Name)
                        '
                        For Each Campo In Tabla.Columns
                            Dim tCampo As New Campo
                            tCampo.Nombre = Campo.Name
                            tCampo.Tamaño = Campo.DefinedSize
                            Dim Válido As Boolean = False
                            Dim Increment As Integer = CInt(Campo.Properties("Increment").Value)
                            Dim AutoIncrement As Boolean = CBool(Campo.Properties("AutoIncrement").Value)
                            Select Case Campo.Type
                                Case ADOX.DataTypeEnum.adVarWChar
                                    If Campo.Attributes = ADOX.ColumnAttributesEnum.adColNullable Then
                                        tCampo.Tipo = Estructuras.CampoTipo.Str
                                        Válido = True
                                    End If
                                Case ADOX.DataTypeEnum.adInteger
                                    If Increment = 1 AndAlso AutoIncrement = True Then
                                        tCampo.Tipo = Estructuras.CampoTipo.Auto
                                        Válido = True
                                    ElseIf Increment = 1 AndAlso AutoIncrement = False Then
                                        tCampo.Tipo = Estructuras.CampoTipo.Int
                                        Válido = True
                                    End If
                            End Select
                            Campo = Nothing
                            If Válido Then
                                tBD.Tablas(Tabla.Name).Campos.Agregar(tCampo)
                                tCampo = Nothing
                            Else
                                tCampo = Nothing
                                bError = True
                                GoTo Finalizar
                            End If
                        Next
                        '
                        If Tabla.Keys.Count > 0 AndAlso Tabla.Keys.Count = 1 Then
                            Dim Key As ADOX.Key, Column As ADOX.Column
                            For Each Key In Tabla.Keys
                                If Key.Columns.Count = 1 Then
                                    For Each Column In Key.Columns
                                        If Key.Type = ADOX.KeyTypeEnum.adKeyPrimary AndAlso Key.Name = "PrimaryKey" Then
                                            tBD.Tablas(Tabla.Name).Clave = Column.Name
                                        Else
                                            Tabla = Nothing
                                            Key = Nothing : Column = Nothing : bError = True
                                            GoTo Finalizar
                                        End If
                                        Column = Nothing
                                    Next
                                Else
                                    Tabla = Nothing
                                    Key = Nothing : Column = Nothing
                                    bError = True
                                    GoTo Finalizar
                                End If
                                Key = Nothing
                            Next
                        Else
                            Tabla = Nothing
                            bError = True
                            GoTo Finalizar
                        End If
                        '
                    End If
                    Tabla = Nothing
                Next
            Catch ex As Exception
                'Throw New Exception(ex.Message)
                Tabla = Nothing
                Campo = Nothing
                bError = True
                GoTo Finalizar
            End Try
Finalizar:  '
            Tabla = Nothing : Campo = Nothing
            If Not bError Then
                p_Contraseña = tBD.Contraseña
                p_Tablas = tBD.Tablas
            End If
            tBD = Nothing
            If oCn.State <> ADODB.ObjectStateEnum.adStateClosed Then oCn.Close()
            oCn = Nothing
            oCat.ActiveConnection = Nothing
            oCat = Nothing
            Return Not bError
        End Function
        '
        Public Function Importar(ByRef tBD As BD) As Boolean
            p_Contraseña = tBD.Contraseña
            p_Tablas = tBD.Tablas
        End Function
        '
        Public Function EsIgualA(ByRef tBD As BD) As Boolean
            If Me.Contraseña = tBD.Contraseña Then
                Return Me.Tablas.EsIgualA(tBD.Tablas)
            Else
                Return False
            End If
        End Function
        '
        Public Function Clonar() As BD
            Dim tBD As New BD
            tBD.Contraseña = Me.Contraseña
            tBD.p_Tablas = p_Tablas.Clonar
            Return tBD
        End Function
    End Class

    'Clase que gestiona clases de tipo Tabla.
    Public Class Tablas
        Private p_Tablas As Collection
        Public Sub New()
            p_Tablas = New Collection
        End Sub
        Protected Overrides Sub Finalize()
            p_Tablas.Clear()
            p_Tablas = Nothing
            MyBase.Finalize()
        End Sub
        '
        Public Sub Agregar(ByRef NuevaTabla As Tabla)
            '
            If Len(NuevaTabla.Nombre) > 0 Then
                If Not Contiene(NuevaTabla.Nombre) Then
                    p_Tablas.Add(NuevaTabla, NuevaTabla.Nombre)
                Else
                    Throw New Exception("La tabla ya está en la colección.")
                End If
            Else
                Throw New Exception("La tabla que desea agregar no tiene un nombre.")
            End If
        End Sub
        '
        Public Sub Agregar(ByVal Nombre As String)
            If Len(Nombre) > 0 Then
                Dim NuevaTabla As New Tabla
                NuevaTabla.Nombre = Nombre
                Call Agregar(NuevaTabla)
                NuevaTabla = Nothing
            Else
                Throw New Exception("Debe especificar un nombre para la nueva tabla.")
            End If
        End Sub
        '
        Public Sub Remover(ByVal NombreTabla As String)
            If Len(NombreTabla) > 0 Then
                If Contiene(NombreTabla) Then
                    p_Tablas.Remove(NombreTabla)
                Else
                    Throw New Exception("Error al intentar eliminar. La tabla  " & NombreTabla & " no existe.")
                End If
            Else
                Throw New Exception("Debe especificar un nombre de tabla para remover.")
            End If
        End Sub
        '
        Default ReadOnly Property Elemento(ByVal Nombre As String) As Tabla
            Get
                Try
                    Return CType(p_Tablas(Nombre), Tabla)
                Catch ex As Exception
                    Throw New Exception("Ocurrió un error. No se encontró el elemento en la colección.")
                    Return Nothing
                End Try
            End Get
        End Property
        '
        ReadOnly Property Total() As Integer
            Get
                Return p_Tablas.Count
            End Get
        End Property
        '
        Public Sub Vaciar()
            p_Tablas.Clear()
        End Sub
        '
        Public Function Contiene(ByVal NombreTabla As String) As Boolean
            Return p_Tablas.Contains(NombreTabla)
        End Function
        '
        Public Function ObtenerEnumerador() As System.Collections.IEnumerator
            Return p_Tablas.GetEnumerator
        End Function
        '
        ReadOnly Property Colección() As Collection
            Get
                Return p_Tablas
            End Get
        End Property
        '
        Public Function EsIgualA(ByRef tTablas As Tablas) As Boolean
            If Me.Total = tTablas.Total Then
                Dim tTabla As Tabla
                For Each tTabla In tTablas.Colección
                    If Me.Contiene(tTabla.Nombre) = False OrElse Me(tTabla.Nombre).EsIgualA(tTabla) = False Then
                        Return False
                    End If
                    tTabla = Nothing
                Next
                Return True
            Else
                Return False
            End If
        End Function
        '
        Public Function Clonar() As Tablas
            Dim tTablas As New Tablas, tTabla As Tabla
            For Each tTabla In Me.Colección
                tTablas.Agregar(tTabla.Clonar)
            Next
            Return tTablas
        End Function
    End Class

    'Clase Tabla.
    Public Class Tabla
        Private p_Nombre As String
        Private p_Clave As String
        Private p_Campos As Campos
        Public Sub New()
            p_Nombre = ""
            p_Clave = ""
            p_Campos = New Campos
        End Sub
        Protected Overrides Sub Finalize()
            p_Campos = Nothing
            MyBase.Finalize()
        End Sub
        '
        ReadOnly Property Campos() As Campos
            Get
                Return p_Campos
            End Get
        End Property
        '
        Property Nombre() As String
            Get
                Return p_Nombre
            End Get
            Set(ByVal value As String)
                p_Nombre = value
            End Set
        End Property
        '
        Property Clave() As String
            Get
                Return p_Clave
            End Get
            Set(ByVal value As String)
                If Campos.Contiene(value) Then
                    p_Clave = value
                Else
                    Throw New Exception("No se encontró el campo " & value & " para definir la clave principal.")
                End If
            End Set
        End Property
        '
        Public Function EsIgualA(ByRef tTabla As Tabla) As Boolean
            If Me.Nombre = tTabla.Nombre AndAlso Me.Clave = tTabla.Clave Then
                Return Me.Campos.EsIgualA(tTabla.Campos)
            Else
                Return False
            End If
        End Function
        '
        Public Function Clonar() As Tabla
            Dim tTabla As New Tabla
            tTabla.Nombre = p_Nombre
            tTabla.p_Campos = p_Campos.Clonar
            tTabla.Clave = p_Clave
            Return tTabla
        End Function
    End Class

    'Clase que gestiona clases de tipo Campo.
    Public Class Campos
        Private p_Campos As Collection
        Public Sub New()
            p_Campos = New Collection
        End Sub
        Protected Overrides Sub Finalize()
            Me.Vaciar()
            p_Campos = Nothing
            MyBase.Finalize()
        End Sub
        '
        Public Sub Agregar(ByRef NuevoCampo As Campo)
            '
            If Len(NuevoCampo.Nombre) > 0 Then
                If Not Contiene(NuevoCampo.Nombre) Then
                    p_Campos.Add(NuevoCampo, NuevoCampo.Nombre)
                Else
                    Throw New Exception("El campo ya está en la colección.")
                End If
            Else
                Throw New Exception("El campo que desea agregar no tiene un nombre.")
            End If
        End Sub
        '
        Public Sub Agregar(ByVal Nombre As String, Optional ByVal Tamaño As Integer = 255, _
        Optional ByVal Tipo As Estructuras.CampoTipo = Estructuras.CampoTipo.Str)
            If Len(Nombre) > 0 Then
                Dim NuevoCampo As New Campo
                With NuevoCampo
                    .Nombre = Nombre
                    .Tamaño = Tamaño
                    .Tipo = Tipo
                End With
                Call Agregar(NuevoCampo)
                NuevoCampo = Nothing
            Else
                Throw New Exception("Debe especificar un nombre para el nuevo campo.")
            End If
        End Sub
        '
        Public Sub Remover(ByVal NombreCampo As String)
            If Len(NombreCampo) > 0 Then
                If Contiene(NombreCampo) Then
                    p_Campos.Remove(NombreCampo)
                Else
                    Throw New Exception("Error al intentar eliminar. El campo  " & NombreCampo & " no existe.")
                End If
            Else
                Throw New Exception("Debe especificar un nombre de campo para remover.")
            End If
        End Sub
        '
        Default ReadOnly Property Elemento(ByVal Nombre As String) As Campo
            Get
                Try
                    Return CType(p_Campos(Nombre), Campo)
                Catch ex As Exception
                    Throw New Exception("Ocurrió un error. No se encontró el elemento en la colección.")
                    Return Nothing
                End Try
            End Get
        End Property
        '
        ReadOnly Property Total() As Integer
            Get
                Return p_Campos.Count
            End Get
        End Property
        '
        Public Sub Vaciar()
            p_Campos.Clear()
        End Sub
        '
        Public Function Contiene(ByVal NombreCampo As String) As Boolean
            Return p_Campos.Contains(NombreCampo)
        End Function
        '
        Public Function ObtenerEnumerador() As System.Collections.IEnumerator
            Return p_Campos.GetEnumerator
        End Function
        '
        ReadOnly Property Colección() As Collection
            Get
                Return p_Campos
            End Get
        End Property
        '
        Public Function EsIgualA(ByRef tCampos As Campos) As Boolean
            If Me.Total = tCampos.Total Then
                Dim tCampo As Campo
                For Each tCampo In tCampos.Colección
                    If Me.Contiene(tCampo.Nombre) = False OrElse Me(tCampo.Nombre).EsIgualA(tCampo) = False Then
                        Return False
                    End If
                    tCampo = Nothing
                Next
                Return True
            Else
                Return False
            End If
        End Function
        '
        Public Function Clonar() As Campos
            Dim tCampos As New Campos, tCampo As Campo
            For Each tCampo In Me.Colección
                tCampos.Agregar(tCampo.Clonar)
            Next
            Return tCampos
        End Function
    End Class

    'Clase Campo.
    Public Class Campo
        Private p_Nombre As String
        Private p_Tipo As Estructuras.CampoTipo
        Private p_Tamaño As Integer
        Public Sub New()
            p_Nombre = ""
            p_Tamaño = 255
            p_Tipo = Estructuras.CampoTipo.Str
        End Sub
        '
        Property Nombre() As String
            Get
                Return p_Nombre
            End Get
            Set(ByVal value As String)
                p_Nombre = value
            End Set
        End Property
        '
        Property Tipo() As Estructuras.CampoTipo
            Get
                Return p_Tipo
            End Get
            Set(ByVal value As Estructuras.CampoTipo)
                p_Tipo = value
            End Set
        End Property
        '
        Property Tamaño() As Integer
            Get
                Return p_Tamaño
            End Get
            Set(ByVal value As Integer)
                p_Tamaño = value
            End Set
        End Property
        '
        Public Function EsIgualA(ByRef tCampo As Campo) As Boolean
            If Me.Nombre = tCampo.Nombre AndAlso Me.Tamaño = tCampo.Tamaño AndAlso Me.Tipo = tCampo.Tipo Then
                Return True
            Else
                Return False
            End If
        End Function
        '
        Public Function Clonar() As Campo
            Dim tCampo As New Campo
            tCampo.Nombre = p_Nombre
            tCampo.Tamaño = p_Tamaño
            tCampo.Tipo = p_Tipo
            Return tCampo
        End Function
    End Class
End Namespace

Espacios de nombres usados en el código de este artículo:

El sistema no requiere de ningún espacio de nombres. Sin embargo, para que funcione correctamente, debe agregar las siguientes referencias COM a su proyecto:

Microsoft ActiveX Data Objects 2.1 Library
Microsoft ADO Ext. 2.8 for DLL and Security

Para hacerlo, vaya al menú Proyecto > Agregar referencia... Una vez allí, vaya a la pestaña COM y busque las referencias y agréguelas.