Una clase para gestionar datos. Servidor de datos DLL ActiveX

A continuaci�n se describen las funciones que gestionar�n el manejo de la base de datos y coordinar�n la normativa de la empresa. Estas funciones ser�n accesibles desde cualquier programa cliente que lo precise.

.�AbrirConexion

Descripci�n: Abre una conexi�n con la base de datos con los par�metros establecidos en la propiedad CadenaConexion.

C�digo:

' ***************************************************
' Abrir una conexi�n 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 conexi�n. " 
    + vbCrLf + Str$(Err.Number) + " - " + Err.Description)
    Resume SalirAbrirConexion
End Function

.�AbrirSeleccion

Descripci�n: Abre una selecci�n, (siempre y cuando haya una conexi�n abierta).

C�digo:

' ***************************************************
' Abrir tabla o selecci�n de datos.
' ***************************************************
' Par�metros :
'   TablaSeleccion  : Nombre de la tabla o instrucci�n 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 selecci�n abierta. Debe cerrarse antes.
        RaiseEvent MGError(120, "Ya hay una selecci�n abierta.")
    Else ' Ok. Abrir selecci�n.
        If HayConexionAbierta Then ' Hay una conexi�n 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 conexi�n abierta. No se puede abrir la selecci�n.
            RaiseEvent MGError(110, "No hay una conexi�n abierta.")
            AbrirSeleccion = -1
            HaySeleccionAbierta = False
        End If
    End If
    
SalirAbrirSeleccion:
    Exit Function
    
ErrorAbrirSeleccion:
    RaiseEvent MGError(205, "Error al abrir la selecci�n." + vbCrLf + Str$(Err.Number) 
    + " - " + Err.Description)
    HaySeleccionAbierta = False
    Resume SalirAbrirSeleccion
End Function

.�AddCadenaConexi�n

Descripci�n: A�ade los parametros necesarios para luego abrir una conexi�n.

C�digo:

' ***************************************************
' Activa una cadena de conexi�n.
' ***************************************************
' Par�metros :
'   TipoConexion : Establece el tipo de conexi�n.
'                  Conexiones disponibles en la
'                  enumeraci�n MGADBaseConexion
' ***************************************************
Public Sub AddCadenaConexion(ByVal TipoConexion As MGADBaseConexion)
    If HayConexionAbierta Then
        RaiseEvent MGError(100, "Hay una conexi�n abierta. 
		No puede manipular las propiedades de origen de los datos.")
    Else
        Select Case TipoConexion
            Case bcJet ' Cadena de conexi�n 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 conexi�n con DSN.
                mvarCadenaConexion = "DSN=" + DBNombreDBDSN + ";UID=" + DBUser 
                + ";PWD=" + DBPassword
        End Select
    End If
End Sub

.�AddModRegEmpresa

Descripci�n: A�ade o, si el registro existe, modifica un registro de empresa en la base de datos de prueba.

C�digo:

' ***************************************************
' A�ade o modifica un registro de empresa.
' Si el registro existe lo modifica, si no existe lo a�ade.
' ***************************************************
' Par�metros :
'   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.
                ' Modificaci�n 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 a�adirse o modificarse." 
    + vbCrLf + Str$(Err.Number) + " - " + Err.Description)
    Resume SalirAddModRegEmpresa
End Function

.�BuscarRegistro

Descripci�n: Busca un registro por el filtro y en el modo especificados.

C�digo:

' ***************************************************
' Buscar registro.
' ***************************************************
' Par�metros :
'   Condicion    : Condici�n de b�squeda.
'   TipoBusqueda : Tipo de busqueda seg�n MGADTiposBusqueda
' ***************************************************
Public Function BuscarRegistro(Condicion As String, TipoBusqueda As MGADTiposBusqueda) As Boolean
    Dim tb As SearchDirectionEnum ' Tipo de b�squeda.
    
    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
            
            ' B�squeda.
            Datos.Find Condicion, , tb
            
            If Datos.EOF Then ' Si llega al final de la selecci�n 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 selecci�n abierta. No puede buscar.
        RaiseEvent MGError(120, "No hay una selecci�n abierta.")
    End If

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

.�CerrarConexion

Descripci�n: Cierra la selecci�n y la conexi�n abiertas. Previo al cierre de la clase en el cliente.

C�digo:

' ***************************************************
' Cerrar la conexi�n 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 conexi�n. " + vbCrLf + Str$(Err.Number) 
    + " - " + Err.Description)
    Resume SalirCerrarConexion
End Function

.�DatoCampo

Descripci�n: Devuelve el dato del campo especificado.

C�digo:

' ***************************************************
' Devuelve el dato al que apunta el cursor del campo
' solicitado.
' ***************************************************
' Par�metros :
'   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 selecci�n abierta.
        RaiseEvent MGError(120, "No hay una selecci�n 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

Descripci�n: Elimina el registro al que apunta el cursor de la selecci�n o por sentencia SQL.

C�digo:

' ***************************************************
' Eliminar registro.
' Si Condicion = "" borra el registro actual.
' ***************************************************
' Par�metros :
'   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

Descripci�n: Mueve el cursor de la selecci�n.

C�digo:

S�lo 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 selecci�n abierta.")
    End If

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

.�RefrescaSeleccion

Descripci�n: Refresca la selecci�n actual, (Requery).

C�digo:

' ***************************************************
' Refresca la selecci�n 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 selecci�n abierta.")
    End If
    
SalirRefrescar:
    Exit Function
    
ErrorRefrescar:
    RaiseEvent MGError(130, "Error al refrescar la selecci�n." + vbCrLf 
    + Str$(Err.Number) + " - " + Err.Description)
    Resume SalirRefrescar
End Function

.�VerificarRegEmpresa

Descripci�n: Verifica la integridad y validez de los datos de una empresa. Esta funci�n se ejecuta autom�ticamente antes del alta o modificar la empresa. Ejemplo de normativa de la empresa.

C�digo:

' ***************************************************
' Verificar validez de los campos de Empresa.
' ***************************************************
' Par�metros :
'   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 cumplimentaci�n 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

COMPARTIR EN FACEBOOK
COMPARTIR EN TWITTER
COMPARTIR EN LINKEDIN
COMPARTIR EN WHATSAPP