Un Gran Proyecto, Paso a Paso

 

Segunda Entrega (1/Mar/97)

Pulsa aquí, para ver la Primera Entrega
Nota: Deberías verla, porque ha habido cambios


Antes de ver el código del formulario de Entrada, necesitamos crear un módulo para las declaraciones globales. Inserta un nuevo módulo y guardalo como:glbNotas.bas
Ahora mismo sólo necesitamos unas variables globales: el nombre del archivo de configuración, el nombre del usuario y la base de datos, posteriormente incluiremos más cosas.

Añade las siguientes líneas:

'--------------------------------------------------------------
'glbNotas   Módulo para las declaraciones globales  (28/Feb/97)
'--------------------------------------------------------------
Option Explicit

Global ficIni As String			    'Archivo de configuración
Global sUsuario As String                   'Nombre del usuario actual
Global sBase As String                      'Nombre de la base

La razón de crear el archivo de configuración como global, es que si quieres cambiar el nombre de este archivo, sólo tendrás que modificar una asignación.

Ahora si podemos ver el código del form de Entrada.

Private Sub Form_Load()
    Dim numBases As Integer
    Dim sBase As String
    Dim sNum As String
    Dim i As Integer
    
    'Archivo de configuración en el directorio de la aplicación
    ficIni = App.Path & "\gsNotas.ini"
    Combo1.Text = ""
    'Nombre del último usuario
    Text1 = LeerIni(ficIni, "General", "Usuario", "")
    'Leer el número de bases creadas
    numBases = Val(LeerIni(ficIni, "General", "NumeroBases"))
    'Comprobar y leer los nombres
    For i = 1 To numBases
        'Si queremos usar más de 99 nombres, añade un cero más
        sNum = "Base" & Format$(i, "00")
        sBase = Trim$(LeerIni(ficIni, "General", sNum))
        If Len(sBase) Then
            'Añadir al combo, si no es una cadena vacía
            Combo1.AddItem sBase
        End If
    Next
    'Si hay datos en el Combo, seleccionar el primero
    If Combo1.ListCount Then
        Combo1.ListIndex = 0
    End If
End Sub



Private Sub cmdAceptar_Click()
    Dim sPath As String                         'path de la base especificada
    Dim sUserPath As String                     'path del usuario
    Dim sUserBase As String                     'nombre de la base del usuario
    Const cMsg = "Seleccionar la base"          'Constante para los MsgBox
    Dim numBases As Integer                     'Número de bases
    Dim sTmp As String                          'varios usos
    Dim i As Integer                            'variable del bucle
    
    'Comprobar si hay datos introducidos
    sUsuario = Trim$(Text1)
    If Len(sUsuario) = 0 Then
        MsgBox "Debes especificar el nombre del usuario.", vbInformation, cMsg
        'Posicionarse en el Text1
        Text1.SetFocus
        Exit Sub
    End If
    sTmp = Trim$(Combo1.Text)
    If Len(sTmp) = 0 Then
        MsgBox "No hay ninguna base de datos seleccionada.", vbInformation, cMsg
        Combo1.SetFocus
        Exit Sub
    End If
    
    'Separar los datos del path y nombre del archivo
    SplitPath sTmp, sPath, sBase
    
    'Comprobar si la base existe en el combo
    '   Si no existe, añadirla al combo
    i = ActualizarLista(sBase, Combo1)
    If i = -1 Then
        'Este caso seguramente nunca se dará, pero...
        MsgBox "Se ha producido un error inesperado al añadir al combo", vbCritical, cMsg
        Unload Me
        End
    End If
    
    'Esta base, hay que buscarla en las del usuario especificado
    'el formato será usuarioXX=path_de_la_base
    sTmp = sUsuario & Format$(i + 1, "00")
    sUserPath = Trim$(LeerIni(ficIni, "General", sTmp, sPath))
    sUserBase = sUserPath & "\" & sBase
    
    'Por si la ruta es errónea
    On Local Error Resume Next
    
    'Comprobar si existe "fisicamente" la base
    If Len(Dir$(sUserBase)) = 0 Then
        'No existe, preguntar si se crea
        If MsgBox("La base especificada no existe." & vbCrLf & "'" & sUserBase & "'" & vbCrLf & "¿Quieres crearla?", vbQuestion + vbYesNo, cMsg) = vbYes Then
            'Crear la base
            CrearBase sUserBase
        Else
            Combo1.SetFocus
            Exit Sub
        End If
    End If
    If Err Then
        MsgBox "Seguramente la ruta especificada, es errónea:" & vbCrLf & "'" & sUserBase & "'", vbInformation, cMsg
        Combo1.SetFocus
        Exit Sub
    End If
    
    'Guardar los datos de configuración
    GuardarIni ficIni, "General", sTmp, sUserPath
    GuardarIni ficIni, "General", "Usuario", sUsuario
    
    numBases = Combo1.ListCount
    GuardarIni ficIni, "General", "NumeroBases", CStr(numBases)
    'Guardar los nombres
    For i = 1 To numBases
        sTmp = "Base" & Format$(i, "00")
        sBase = Combo1.List(i - 1)
        GuardarIni ficIni, "General", sTmp, sBase
    Next
    
    'Asignar el nombre de la base a la variable global
    sBase = sUserBase
    gsNotas.Show
    'Descargar este form
    Unload Me
End Sub



Antes de ver el resto, hagamos un alto en el camino.
Entre otras cosas, porque en el código del botón Aceptar hay tres rutinas que debemos revisar.
La primera es la función ActualizarLista. Ésta función la vamos a declarar Global, ya que su uso nos será de utilidad en el Form principal o en otro, ya veremos.
Así pues, la incluiremos en el módulo global. Abre éste módulo y añade la siguiente declaración en la sección de las Declaraciones: (
fijate que lParam está declarada com Any en lugar de Long)

'Funciones Globales del API
#If Win32 Then
    Declare Function SendMessage Lib "User32" Alias "SendMessageA" _
        (ByVal hWnd As Long, ByVal wMsg As Long, _
         ByVal wParam As Long, lParam As Any) As Long
#Else
    Declare Function SendMessage Lib "User" _
        (ByVal hWnd As Integer, ByVal wMsg As Integer, _
         ByVal wParam As Integer, lParam As Any) As Long
#End If

Esto también lo debes incluir en el módulo global:

Public Function ActualizarLista(sTexto As String, cList As Control) As Long
    'Esta función comprobará si el texto indicado existe en la lista
    'Si no es así, lo añadirá
    'El valor devuelto, será la posición dentro de la lista ó -1 si hay "fallos"
    '
    'Para buscar en el List/combo usaremos una llamada al API
    '(si ya hay una forma de hacerlo, ¿para que re-hacerla?)
    '
    Const CB_FINDSTRINGEXACT = &H158        'Mensaje para los combos
    Const LB_FINDSTRINGEXACT = &H1A2        'Mensaje para las Listas
    Dim L As Long
    
    If cList.ListCount = 0 Then
        'Seguro que no está, así que añadirla
        L = -1
    Else
        'Si el control es un Combo
        If TypeOf cList Is ComboBox Then
            L = SendMessage(cList.hWnd, CB_FINDSTRINGEXACT, -1, ByVal sTexto)
        'Si el control es un list
        ElseIf TypeOf cList Is ListBox Then
            L = SendMessage(cList.hWnd, LB_FINDSTRINGEXACT, -1, ByVal sTexto)
        Else
            'no es un control List o Combo, salir
            ActualizarLista = -1
            Exit Function
        End If
    End If
    
    'Si no está, añadirla
    If L = -1 Then
        L = cList.ListCount
        cList.AddItem sTexto
    End If
    ActualizarLista = L
End Function

Bien, veamos que es lo que nos encontramos aquí.
Esta función hará lo siguiente:
Buscará en la lista de items de un ListBox o ComboBox, la cadena especificada y si no existe, la añadirá, devolviendo posteriormente la posición dentro de la lista.
Realmente cuando se añade un nuevo dato, devuelve la posición del último item.
Esto puede ser un problema si la lista está ordenada.
Para solventarlo, después de añadir el dato, efectúa otra búsqueda llamando recursivamente a la función!

    'Si no está, añadirla
    If L = -1 Then
        'L = cList.ListCount
        cList.AddItem sTexto
	L = ActualizarLista(sTexto, cList)
    End If

En el código final del programa, he incluido ésta última versión.
Fijate que hay dos llamadas a la función SendMessage, una si es un ListBox y otra si es un ComboBox. Además de efectuar una búsqueda "total", es decir que la cadena buscada debe existir completa, aunque el formato de mayúsculas/minúsculas no se tenga en cuenta.
Para buscar sólo una parte, desde el principio, usa las constantes:

Const LB_FINDSTRING = &H18F	'Para el listbox
Const CB_FINDSTRING = &H14C	'Para el combobox

La segunda rutina que te comentaba es: SplitPath y se encarga de "dividir" o seccionar una cadena en la ruta, el nombre del archivo y la extensión, estas dos últimas cosas las he puestos como opcionales, (he dejado el nombre en inglés, porque creo que se entenderá perfectamente el cometido que tiene)
Veamos el código, que debe estar en el módulo global:

Public Sub SplitPath(ByVal sTodo As String, sPath As String, Optional vNombre, Optional vExt)
    '----------------------------------------------------------------
    'Divide el nombre recibido en la ruta, nombre y extensión
    '(c)Guillermo Som, 1997                         ( 1/Mar/97)
    '
    'Esta rutina aceptará los siguientes parámetros:
    'sTodo      Valor de entrada con la ruta completa
    'Devolverá la información en:
    'sPath      Ruta completa, incluida la unidad
    'vNombre    Nombre del archivo incluida la extensión
    'vExt       Extensión del archivo
    '
    'Los parámetros opcionales sólo se usarán si se han especificado
    '----------------------------------------------------------------
    Dim bNombre As Boolean      'Flag para saber si hay que devolver el nombre
    Dim i As Integer
    
    If Not IsMissing(vNombre) Then
        bNombre = True
        vNombre = sTodo
    End If
    
    If Not IsMissing(vExt) Then
        vExt = ""
        i = InStr(sTodo, ".")
        If i Then
            vExt = Mid$(sTodo, i + 1)
        End If
    End If
        
    sPath = ""
    'Asignar el path
    For i = Len(sTodo) To 1 Step -1
        If Mid$(sTodo, i, 1) = "\" Then
            sPath = Left$(sTodo, i - 1)
            'Si hay que devolver el nombre
            If bNombre Then
                vNombre = Mid$(sTodo, i + 1)
            End If
            Exit For
        End If
    Next
End Sub

Un poco de aclaración: Esta rutina recibe una cadena con el nombre completo de la ruta y el archivo y devolverá la ruta y opcionalmente el nombre, (con la extensión incluida), y, (también opcionalmente), la extensión.

La tercera rutina es la que se encargará de crear la base de datos, pero la vamos a dejar para otra ocasión, ya que merece más atención. En principio, sólo tienes que dejar la declaración, para que puedas probar lo que estamos haciendo.

Private Sub CrearBase(sBase As String)
    'Crear la base de datos indicada
    '
    '===POR HACER===
    '
End Sub

Y para poder probarlo, debes especificar el form Entrada como punto de "entrada", valga la redundancia, del programa. Para ello, en el menú Tools, selecciona la opción Options... y en la lengüeta Project selecciona en Startup Form ése formulario.

Para terminar, vamos a ver el resto del código del formulario de Entrada.
En primer lugar ¿que es lo que hay que hacer cuando un form se cierra?

'Código del Formulario Entrada
Private Sub Form_Unload(Cancel As Integer)
    'Liberar memoria
    Set frmEntrada = Nothing
End Sub

Ahora veamos el código del botón Examinar...

Private Sub cmdExaminar_Click()
    'Abrir el control de diálogos comunes y "localizar"
    'los archivos con extensión MDB
    'Seleccionar el fichero en el que se empezará la Busqueda
    
    On Local Error Resume Next
    
    CommonDialog1.DialogTitle = "Seleccionar Base de Datos"
    CommonDialog1.Filter = "Bases (*.mdb)|*.mdb|Todos los archivos (*.*)|*.*"
    CommonDialog1.FilterIndex = 1
    CommonDialog1.CancelError = True
    CommonDialog1.ShowOpen
    If Err Then
        Err = 0
    Else
        Combo1.Text = CommonDialog1.filename
    End If
End Sub

Y por último el botón Cancelar:

Private Sub cmdCancelar_Click()
    'Terminar el programa!!!
    Unload Me
    End
End Sub


Bueno, esto es todo por ahora. (
Si quieres experimentar, fijate que no se hace ninguna comprobación de que la extensión sea correcta en el cmdAceptar)
Mañana más.


Pulsa aquí si quieres bajar los listados de ejemplo y los archivos HTML (gsnotas.zip 21.4 KB)
(Este tamaño variará, según el número de entregas; para saber el tamaño actual, deberías ver la última entrega)