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