Una clase para gestionar datos. Servidor de datos DLL ActiveX

A continuacin se describen las funciones que gestionarn el manejo de la base de datos y coordinarn la normativa de la empresa. Estas funciones sern accesibles desde cualquier programa cliente que lo precise.

.AbrirConexion

Descripcin: Abre una conexin con la base de datos con los parmetros establecidos en la propiedad CadenaConexion.

Cdigo:

' ***************************************************
' Abrir una conexin con bases de datos.
' ***************************************************
Public Function AbrirConexion() As Boolean
    On Error GoTo ErrorConexion
        Set Conexion = New ADODB.Connection
        
        Conexion.CursorLocation = adUseClient
        Conexion.Open CadenaConexion
    On Error GoTo 0
    
    HayConexionAbierta = True
    
SalirAbrirConexion:
    Exit Function
    
ErrorConexion:
    RaiseEvent MGError(200, "Error al abrir conexin. " 
    + vbCrLf + Str$(Err.Number) + " - " + Err.Description)
    Resume SalirAbrirConexion
End Function

.AbrirSeleccion

Descripcin: Abre una seleccin, (siempre y cuando haya una conexin abierta).

Cdigo:

' ***************************************************
' Abrir tabla o seleccin de datos.
' ***************************************************
' Parmetros :
'   TablaSeleccion  : Nombre de la tabla o instruccin SQL
'   TipoCursor      : Tipo de cursor.
'   TipoApertura    : Modo de apertura.
' ***************************************************
Public Function AbrirSeleccion(TablaSeleccion As String, TipoCursor As CursorTypeEnum, 
		TipoApertura As LockTypeEnum) As Long
    If HaySeleccionAbierta Then ' Si ya hay una seleccin abierta. Debe cerrarse antes.
        RaiseEvent MGError(120, "Ya hay una seleccin abierta.")
    Else ' Ok. Abrir seleccin.
        If HayConexionAbierta Then ' Hay una conexin abierta.
            On Error GoTo ErrorAbrirSeleccion
                ' Abre el recordset.
                Set Datos = New ADODB.Recordset
                Datos.Open TablaSeleccion, Conexion, TipoCursor, TipoApertura
                
                AbrirSeleccion = Datos.RecordCount
            On Error GoTo 0
            
            HaySeleccionAbierta = True
        Else ' No hay una conexin abierta. No se puede abrir la seleccin.
            RaiseEvent MGError(110, "No hay una conexin abierta.")
            AbrirSeleccion = -1
            HaySeleccionAbierta = False
        End If
    End If
    
SalirAbrirSeleccion:
    Exit Function
    
ErrorAbrirSeleccion:
    RaiseEvent MGError(205, "Error al abrir la seleccin." + vbCrLf + Str$(Err.Number) 
    + " - " + Err.Description)
    HaySeleccionAbierta = False
    Resume SalirAbrirSeleccion
End Function

.AddCadenaConexin

Descripcin: Aade los parametros necesarios para luego abrir una conexin.

Cdigo:

' ***************************************************
' Activa una cadena de conexin.
' ***************************************************
' Parmetros :
'   TipoConexion : Establece el tipo de conexin.
'                  Conexiones disponibles en la
'                  enumeracin MGADBaseConexion
' ***************************************************
Public Sub AddCadenaConexion(ByVal TipoConexion As MGADBaseConexion)
    If HayConexionAbierta Then
        RaiseEvent MGError(100, "Hay una conexin abierta. 
		No puede manipular las propiedades de origen de los datos.")
    Else
        Select Case TipoConexion
            Case bcJet ' Cadena de conexin con OLEDB.Jet
                If Len(DBNombreDBDSN) = 0 Then ' La ruta completa est en DBDIRMDB
                    mvarCadenaConexion = "Provider=Microsoft.Jet.OLEDB.4.0;Password=" 
                    + DBPassword + ";User ID=" + DBUser + ";Data Source=" + DBDirMDB
                Else ' La ruta de la base de datos est en DBDIRMDB y DBNombreDBDSN
                    mvarCadenaConexion = "Provider=Microsoft.Jet.OLEDB.4.0;Password=" 
                    + DBPassword + ";User ID=" + DBUser + ";Data Source=" + DBDirMDB 
                    + "\" + DBNombreDBDSN
                End If
            Case bcDSN ' Cadena de conexin con DSN.
                mvarCadenaConexion = "DSN=" + DBNombreDBDSN + ";UID=" + DBUser 
                + ";PWD=" + DBPassword
        End Select
    End If
End Sub

.AddModRegEmpresa

Descripcin: Aade o, si el registro existe, modifica un registro de empresa en la base de datos de prueba.

Cdigo:

' ***************************************************
' Aade o modifica un registro de empresa.
' Si el registro existe lo modifica, si no existe lo aade.
' ***************************************************
' Parmetros :
'   re : Registro de empresa.
' ***************************************************
Public Function AddModRegEmpresa(re As MGADRegEmpresas) As Boolean
    Dim Comando As ADODB.Recordset
    
    If VerificarRegEmpresa(re) Then
        AddModRegEmpresa = True
    
        On Error GoTo ErrorAddModRegEmpresa
            ' Busca si el registro de la empresa ya existe.
            Set Comando = New ADODB.Recordset
            Comando.Open "SELECT * FROM Empresas WHERE CodEmpresa = " & 
            re.CodEmpresa, Conexion, adOpenForwardOnly, adLockReadOnly
    
            If Comando.RecordCount > 0 Then ' El registro existe.
                ' Modificacin del registro.
                Conexion.Execute "UPDATE Empresas SET CodEmpresa = " & re.CodEmpresa & ", 
                Nombre = '" + re.Nombre + "', Direccion1 = '" + re.Direccion1 + "', 
                Direccion2 = '" + re.Direccion2 + "', Direccion3 = '" + re.Direccion3 + "', 
                ContadorRecibos = " & re.ContadorRecibos & ", RegMercantil = '" + 
                re.RegMercantil + "' WHERE CodEmpresa = " & re.CodEmpresa
            Else ' El registro no existe.
                ' Add registro.
                Conexion.Execute "INSERT INTO Empresas (CodEmpresa, Nombre, Direccion1, 
                Direccion2, Direccion3, ContadorRecibos, RegMercantil) VALUES 
                (" & re.CodEmpresa & ", '" + re.Nombre + "', '" + re.Direccion1 
                + "', '" + re.Direccion2 + "', '" + re.Direccion3 + "', " & re.ContadorRecibos 
                & ", '" + re.RegMercantil + "')"
            End If
                    
            RefrescaSeleccion
        On Error GoTo 0
    Else ' Alguno de los campos de la empresa no es correcto.
        AddModRegEmpresa = False
    End If

SalirAddModRegEmpresa:
    Set Comando = Nothing
    Exit Function
    
ErrorAddModRegEmpresa:
    AddModRegEmpresa = False
    RaiseEvent MGError(300, "El registro no ha podido aadirse o modificarse." 
    + vbCrLf + Str$(Err.Number) + " - " + Err.Description)
    Resume SalirAddModRegEmpresa
End Function

.BuscarRegistro

Descripcin: Busca un registro por el filtro y en el modo especificados.

Cdigo:

' ***************************************************
' Buscar registro.
' ***************************************************
' Parmetros :
'   Condicion    : Condicin de bsqueda.
'   TipoBusqueda : Tipo de busqueda segn MGADTiposBusqueda
' ***************************************************
Public Function BuscarRegistro(Condicion As String, TipoBusqueda As MGADTiposBusqueda) As Boolean
    Dim tb As SearchDirectionEnum ' Tipo de bsqueda.
    
    BuscarRegistro = True
    If HaySeleccionAbierta Then
        On Error GoTo ErrorBuscar
            ' Buscar desde el inicio?
            Select Case TipoBusqueda
                Case tbInicio ' Buscar desde el inicio.
                    On Error Resume Next
                        Datos.MoveFirst
                    On Error GoTo 0
                    tb = adSearchForward
                Case tbSiguiente ' Buscar siguiente.
                    tb = adSearchForward
                Case tbAnterior ' Buscar anterior.
                    tb = adSearchBackward
            End Select
            
            ' Bsqueda.
            Datos.Find Condicion, , tb
            
            If Datos.EOF Then ' Si llega al final de la seleccin es que 
					no ha hallado el registro buscado.
                RaiseEvent MGError(160, "El registro no ha sido hallado.")
                BuscarRegistro = False
            End If
        On Error GoTo 0
    Else ' No hay una seleccin abierta. No puede buscar.
        RaiseEvent MGError(120, "No hay una seleccin abierta.")
    End If

SalirBuscar:
    Exit Function
    
ErrorBuscar:
    BuscarRegistro = False
    RaiseEvent MGError(150, "Error al buscar en la seleccin." + vbCrLf + Str$(Err.Number) 
    + " - " + Err.Description)
    Resume SalirBuscar
End Function

.CerrarConexion

Descripcin: Cierra la seleccin y la conexin abiertas. Previo al cierre de la clase en el cliente.

Cdigo:

' ***************************************************
' Cerrar la conexin con bases de datos.
' ***************************************************
Public Function CerrarConexion() As Boolean
    On Error Resume Next
        Datos.Close
        Set Datos = Nothing
    On Error GoTo ErrorCerrarConexion
        Conexion.Close
        Set Conexion = Nothing
    On Error GoTo 0
    
    HaySeleccionAbierta = False
    HayConexionAbierta = False
    
SalirCerrarConexion:
    Exit Function
    
ErrorCerrarConexion:
    RaiseEvent MGError(210, "Error al cerrar conexin. " + vbCrLf + Str$(Err.Number) 
    + " - " + Err.Description)
    Resume SalirCerrarConexion
End Function

.DatoCampo

Descripcin: Devuelve el dato del campo especificado.

Cdigo:

' ***************************************************
' Devuelve el dato al que apunta el cursor del campo
' solicitado.
' ***************************************************
' Parmetros :
'   Campo : Indice o literal del campo a recuperar.
' ***************************************************
Public Function DatoCampo(Campo) As Variant
    If HaySeleccionAbierta Then
        On Error GoTo ErrorDatoCampo
            If Not IsNull(Datos.Fields(Campo).Value) Then 
				' Si el campo no es nulo devuelve su contenido.
                DatoCampo = Datos.Fields(Campo).Value
            Else ' El campo es nulo. Devuelve una cadena vacia.
                DatoCampo = ""
            End If
        On Error GoTo 0
    Else ' No hay una seleccin abierta.
        RaiseEvent MGError(120, "No hay una seleccin abierta.")
    End If
    
SalirDatoCampo:
    Exit Function
    
ErrorDatoCampo:
    DatoCampo = ""
    RaiseEvent MGError(170, "Error al obtener el dato de un campo del registro actual." 
    + vbCrLf + Str$(Err.Number) + " - " + Err.Description)
    Resume SalirDatoCampo
End Function

.EliminarRegistro

Descripcin: Elimina el registro al que apunta el cursor de la seleccin o por sentencia SQL.

Cdigo:

' ***************************************************
' Eliminar registro.
' Si Condicion = "" borra el registro actual.
' ***************************************************
' Parmetros :
'   SQLCondicion : OPCIONAL. Eliminar por SQL.
' ***************************************************
Public Function EliminarRegistro(Optional SQLCondicion As String) As Boolean
    EliminarRegistro = True
    
    On Error GoTo ErrorEliminarRegistro
        If Len(SQLCondicion) = 0 Then ' Borrar registro actual.
            Datos.Delete adAffectCurrent
        Else ' Borrar por la condicion.
            Conexion.Execute SQLCondicion
        End If
        RefrescaSeleccion
    On Error GoTo 0
    
SalirEliminarRegistro:
    Exit Function
    
ErrorEliminarRegistro:
    EliminarRegistro = False
    RaiseEvent MGError(310, "No puede eliminarse el/los registro(s)." 
    + vbCrLf + Str$(Err.Number) + " - " + Err.Description)
    Resume SalirEliminarRegistro
End Function

.MoverAnterior, MoverFinal, MoverInicio y MoverSiguiente

Descripcin: Mueve el cursor de la seleccin.

Cdigo:

Slo MoverInicio.

' ***************************************************
' Mover al primer registro.
' ***************************************************
Public Sub MoverInicio()
    If HaySeleccionAbierta Then
        On Error GoTo ErrorMover
            Datos.MoveFirst
        On Error GoTo 0
    Else
        RaiseEvent MGError(120, "No hay una seleccin abierta.")
    End If

SalirMover:
    Exit Sub
    
ErrorMover:
    RaiseEvent MGError(140, "Error al mover en la seleccin." + vbCrLf 
    + Str$(Err.Number) + " - " + Err.Description)
    Resume SalirMover
End Sub

.RefrescaSeleccion

Descripcin: Refresca la seleccin actual, (Requery).

Cdigo:

' ***************************************************
' Refresca la seleccin actual.
' ***************************************************
Public Function RefrescaSeleccion() As Boolean
    If HaySeleccionAbierta Then
        On Error GoTo ErrorRefrescar
            Datos.Requery
        On Error GoTo 0
    Else
        RaiseEvent MGError(120, "No hay una seleccin abierta.")
    End If
    
SalirRefrescar:
    Exit Function
    
ErrorRefrescar:
    RaiseEvent MGError(130, "Error al refrescar la seleccin." + vbCrLf 
    + Str$(Err.Number) + " - " + Err.Description)
    Resume SalirRefrescar
End Function

.VerificarRegEmpresa

Descripcin: Verifica la integridad y validez de los datos de una empresa. Esta funcin se ejecuta automticamente antes del alta o modificar la empresa. Ejemplo de normativa de la empresa.

Cdigo:

' ***************************************************
' Verificar validez de los campos de Empresa.
' ***************************************************
' Parmetros :
'   re : Registro de empresa.
' ***************************************************
Public Function VerificarRegEmpresa(re As MGADRegEmpresas) As Boolean
    VerificarRegEmpresa = True
    With re
        If .CodEmpresa <= 0 Or .ContadorRecibos < 0 Or .Direccion1 = "" Or 
		.Direccion2 = "" Or .Direccion3 = "" Or .Nombre = "" Then
            ' Hubo un error en la cumplimentacin de la ficha de empresa.
            VerificarRegEmpresa = False
            RaiseEvent MGError(1000, "Alguno de los campos de la empresa no es correcto.")
        End If
    End With
End Function

COMPARTE ESTE ARTÍCULO

ENVIAR A UN AMIGO
COMPARTIR EN FACEBOOK
COMPARTIR EN TWITTER
COMPARTIR EN GOOGLE +
¡SÉ EL PRIMERO EN COMENTAR!
Conéctate o Regístrate para dejar tu comentario.