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