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

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

'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

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

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

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

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

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

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

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

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