Serie ficheros virtuales



 
VBA. Ficheros virtuales


VBA. Ficheros virtuales. El núcleo: WRITE y CHAIN

1 Introducción
2 Prototipos de CHAIN, WRITE y NEW
3 Hoja de muestra
4 El código de la hoja de muestra

5 El código de soporte de las funciones
  5.1 Variables globales
  5.2 La función M_NEW
 
 5.3 La función CHAIN
 
5.4 La función SETEQ
  5.5 La función WRITE

  5.6 Las funciones auxiliares
    5.6.1 Ampliación de la memoria de cada fichero (Usando Redim Preserve)
 
   5.6.1.1 Ampliación de la memoria de índices (Interfaz a Redim Preserve en serie de índices)
    5.6.1.2 Ampliación de la memoria de claves y datos (Interfaz a Redim Preserve en serie de claves y datos)

   5.6.2 Código núcleo de la función CHAIN
   5.6.3 Código núcleo de la función WRITE
   5.6.4 El código de insercción en índice (splice), emulación de memmove

6 Fuentes


                                                        _______
 

1 Introducción

Al igual que en C Ficheros virtuales, el  núcleo del sistema  se centra en las instrucciones WRITE y  CHAIN

Simplemente con estas dos funciones se pueden abordar las tareas de caché de datos básico, constituyendo el núcleo central del desarrollo de la aplicación de bases de datos virtuales que se irá extendiendo de forma natural desde ellas.

 Es una tarea que ya se hizo en el blog citado y que ahora se va a replicar para el lenguaje VBA.


                                                        _______



2 Prototipos de CHAIN, WRITE y NEW

Veamos ahora los prototipos de estas funciones, junto con el de la función de generación de un nuevo fichero "M_NEW"

'/*-----------------------------------------------------------------*/
'/* FUNCION....: M_CHAIN                                            */
'/*                                                                 */
'/* DESCRIPCION: Recupera un Item de Memoria por Clave              */
'/*                                                                 */
'/* PARAMETROS.:                                                    */
'/* (entrada) lNIDp: Identificador del Conjunto de Items asociado   */
'/*           sClav: Clave del Item                                 */
'/* (salida ) sDato: Datos del Item                                 */
'/*                                                                 */
'/* RETORNO....:                                                    */
'/*                 0: Error de Proceso (No encontrado, ...)        */
'/*                >0: Indice en memoria-claves del Item encontrado */
'/*                    (formato 1..N)                               */
'/*-----------------------------------------------------------------*/
Function M_CHAIN(lNIDp As Long, sClav As String, sDato As String) As Long

'/*-----------------------------------------------------------------*/
'/* FUNCION....: M_WRITE                                            */
'/*                                                                 */
'/* DESCRIPCION: Salva un Item a memoria                            */
'/*                                                                 */
'/* PARAMETROS.:                                                    */
'/* (entrada) lNIDp: Identificador del Conjunto de Items asociado   */
'/*           sClav: Clave del Item                                 */
'/*           sDato: Datos del Item                                 */
'/*                                                                 */
'/* RETORNO....:                                                    */
'/*              0: Error de Proceso (Memoria out, ya existe...)    */
'/*             >0: Indice de Item-Clave Guardado Satisfactoriamente*/
'/*                    (Formato 1..N)                               */
'/*-----------------------------------------------------------------*/
Function M_WRITE(lNIDp As Long, sClave As String, sDato As String) As Long

'/*-----------------------------------------------------------------*/
'/* FUNCION....: M_NEW                                              */
'/*                                                                 */
'/* DESCRIPCION: Genera un nuevo identificador de conjunto de items,*/
'/*              a utilizar en el resto de servicios.               */
'/*                                                                 */
'/* PARAMETROS.:                                                    */
'/* (entrada) lDimC: Dimensión claves del nuevo grupo de Items      */
'/*           lDimD: Dimension datos  del nuevo grupo de Items      */
'/*                                                                 */
'/* RETORNO....:                                                    */
'/*                 0: Error de Proceso (Memoria agotada, ...)      */
'/*                >0: Nuevo Identificador (NID)                    */
'/*                                                                 */
'/*-----------------------------------------------------------------*/
Function M_NEW(lDimC As Long, lDimD As Long) As Long


                                                        _______

3 Hoja de muestra

Veamos ahora una primera hoja de muestra que utilza estas funciones primarias

 

En esta hoja, al pulsar el botón, se crea un fichero con los parámetros que se indiquen en la línea 12.
(En el ejemplo, longitud de claves 2, longitud de datos 3, el sistema responde con el número de identificación asignado 1).

Luego se graban los 10 datos de las columnas A y B, presentándose el resultado del WRITE en la columna D, el del CHAIN en la columna E y el de los datos recuperados en la columna F.

                                                        _______


Ahora nos centraremos en el código. Veremos que la codificación concreta de las funciones dichas resultará ser como un despliege del código "concentrado" del lenguaje C en el que se basa.

                                                        _______

4 El código de la hoja de muestra


El código consta de una parte dedicada a la construcción de los ítems a grabar y recuperar y de otra del código dedicado a la utilización del WRITE y CHAIN, que es el más relevante de esta hoja de muestra.


Sub M_Pruebas_E()

 Dim i As Long       ' Contador de for
 Dim lResul As Long  ' Control de resultados M
 Dim sDato As String ' Paso auxiliar de datos en M_Chain



 ' Código de construcción de los ítems a grabar y recuperar


 ' Limpia la hoja de muestra

 Sheets("M").Select
 Cells.Select
 Selection.ClearContents


 ' Construye datos

 Range("A1:A10").Select
 Selection.NumberFormat = "@" ' Formato texto en dato a buscar
 Range("B1:B10").Select
 Selection.NumberFormat = "@" ' Formato texto en datos búsqueda


 ' Claves del fichero
 
 Range("A1") = "01"
 Range("A9") = "11"
 Range("A3") = "15"
 Range("A8") = "22"
 Range("A5") = "31"
 Range("A7") = "33"
 Range("A6") = "44"
 Range("A4") = "50"
 Range("A2") = "51"
 Range("A10") = "60"


 ' Datos del fichero
 
 Range("B1") = "101"
 Range("B9") = "111"
 Range("B3") = "115"
 Range("B8") = "122"
 Range("B5") = "131"
 Range("B7") = "133"
 Range("B6") = "144"
 Range("B4") = "150"
 Range("B2") = "151"
 Range("B10") = "160"


 ' Parámetros definición fichero
 
 Range("A12") = 2
 Range("B12") = 3


 ' Desmarcado
 
 Range("H1").Select



 ' Código de muestra de utilización de NEW, CHAIN y WRITE

 
 ' Crea el fichero virtual con NEW si no existía previamente (La variable resultado "lResul" sirve además para evitar presentar resultados espúreos)
 
 lResul = M_CHAIN(1, Range("A1"), sDato)

 If lResul = 0 Then
    Range("C12") = M_NEW(Range("A12"), Range("B12"))
 Else
    Range("C12") = 1
 End If
 
 
 'Graba y recupera datos
 
 For i = 1 To 10
 
 
    ' Graba con WRITE si no se había grabado antes (Para presentar una columna con resultado no nulo)
   
    If lResul = 0 Then
        Range("D" & i) = M_WRITE(Range("C12"), Range("A" & i), Range("B" & i))
    End If
   

   
    ' Recupera con CHAIN
   
    Range("E" & i) = M_CHAIN(Range("C12"), Range("A" & i), sDato)



    ' Si ya había grabado antes, pone en el resultado del WRITE realmente el del CHAIN alternativo
   
    If lResul > 0 Then
        Range("D" & i) = Range("E" & i)
    End If
   

   
    ' Pasa los datos recuperados
   
    Range("F" & i) = sDato

   
 Next i
 
 
End Sub

                                                        _______

5 El código de soporte de las funciones

En cuanto al código de soporte de las funciones, vamos a verlo punto por punto.

En las definiciones, nos encontramos que VBA no permite dimensiones variables en las series de índice múltiple, esto es, no podemos definir una serie doble, supongamos de filas y columnas, de forma que en la primera fila dimensionemos 10 columnas y en la segunda 20 y en la tercera 15, etc.

Por tanto nos vemos obligados a reservar matrices para cada fichero por separado.

La experiencia me muestra que sólo en los trabajos más complejos se alcanza un número efectivo de ficheros virtuales que vaya más allá de un par de docenas, por tanto definiré espacio para un centenar de ficheros a fin de disponer de holgura, utilizando módulos VBA's auxiliares para encapsular los fragmentos de código repetitivos.

Para el lector que conozca el código origen en C expuesto en el blog hermano, la implementación le presentará un aspecto muy familiar, porque se trata de una transcripción fiel de aquel, salvo las concesiones hechas a las limitaciones del lenguaje que obligarán a acudir a algunos artificios de emulación que se irán citando.

El resultado final es la codificación que se presenta extractada en los siguientes epígrafes, y que se puede consultar completa en el enlace del final del capítulo.


                                                        _______

 

5.1 Variables globales

Option Explicit
Option Base 1

'*******************************************************************
' M: Servicio de ítems en Memoria. Modulo base
'*******************************************************************

 
'*-----------------------------------------------------------------*/
'* Variables Globales                                              */
'*-----------------------------------------------------------------*/
Const NO_ERRO As Integer = 0    ' Control de errores de invocación (0/1)
Const lBLOQd As Long = 1000     ' Tamaño bloque para 1ªasignaciónDe memoria(datos)
Const lBLOQd2 As Long = 10000   ' Tamaño bloque para re-asignaciónDeMemoria(datos)
Const lMAXF As Long = 111       ' NºMáximo de ficheros virtuales
Const lMAXNRG As Long = 2500000 ' NºMáximo de registros de cada bloque por dft

Dim lNID As Long                ' Identificador de Conjunto de Items Total (1..N)
Dim lINBS As Long               ' Indice obtenido bajo BSEARCH
Dim lERASE As Long              ' Indice total de ERASES

Dim lINDICES1() As Long         'Soporte índices fichero virtual 1
Dim lINDICES2() As Long         'Soporte índices fichero virtual 2
...
Dim lINDICES111() As Long       'Soporte índices fichero virtual 111

Dim sCLAVES1() As String        'Soporte claves fichero virtual 1
...
Dim sCLAVES111() As String      'Soporte claves fichero virtual 111

Dim sDATOS1() As String         'Soporte datos fichero virtual 1
...
Dim sDATOS111() As String       'Soporte datos fichero virtual 111

Dim lSDimC(111) As Long         ' Dimensiones de claves por cada grupo
Dim lSDimD(111) As Long         ' Dimensiones de datos  por cada grupo
Dim lNITEM(111) As Long         ' Contadores de ítems por grupo
Dim lMaxReg(111) As Long        ' Máximos de elementos por grupo
Dim lBAJAS(111) As Long         ' Id.de bajas pdts.de depurar de memoria * grupo
Dim lERASES(111) As Long        ' Id.de grupos borrados para reutilizar
Dim iSTAT(111) As Integer       ' 0/1 Grupo Activo: 1 en NEW, 0 en DEL

                                                        _______



Con estas variables se implementa el NEW, CHAIN y WRITE como sigue:

5.2 La función M_NEW

'/*-----------------------------------------------------------------*/
'/* FUNCION....: M_NEW                                              */
'/*                                                                 */
'/* DESCRIPCION: Genera un nuevo identificador de conjunto de items,*/
'/*              a utilizar en el resto de servicios.               */
'/*              Interfaz a M_NEWC (Parámetros completos)           */
'/*                                                                 */
'/* PARAMETROS.:                                                    */
'/* (entrada) iDimC: Dimensión claves del nuevo grupo de Items      */
'/*           lDimD: Dimension datos  del nuevo grupo de Items      */
'/*                                                                 */
'/* RETORNO....:                                                    */
'/*                 0: Error de Proceso (Memoria agotada, ...)      */
'/*                >0: Nuevo Identificador (NID)                    */
'/*                                                                 */
'/*-----------------------------------------------------------------*/
Function M_NEW(lDimC As Long, lDimD As Long) As Long

  M_NEW = M_NEWC(lDimC, lDimD, lMAXNRG)
 
End Function
 
'/*-----------------------------------------------------------------*/
'/* FUNCION....: M_NEWC                                             */
'/*                                                                 */
'/* DESCRIPCION: Genera un nuevo identificador de conjunto de items,*/
'/*              a utilizar en el resto de servicios.               */
'/*                                                                 */
'/* PARAMETROS.:                                                    */
'/* (entrada) iDimC: Dimensión claves del nuevo grupo de Items      */
'/*           lDimD: Dimension datos  del nuevo grupo de Items      */
'/*        lMaxNreg: Máximo número de items a generar               */
'/*                                                                 */
'/* RETORNO....:                                                    */
'/*                 0: Error de Proceso (Memoria agotada, ...)      */
'/*                >0: Nuevo Identificador (NID)                    */
'/*                                                                 */
'/*-----------------------------------------------------------------*/
Function M_NEWC(lDimC As Long, lDimD As Long, lMaxNreg As Long) As Long


 ' Inicialización derivada del índice de búsqueda dicotómica (Variable global auxiliar)
 
 lINBS = 0


 ' Control de solicitud erronea
 
 If (lDimC <= 0 Or lDimD <= 0 Or lNID >= lMAXF) Then
 
    M_NEWC = 0
   
    Exit Function
 
 End If
 
 
 
 ' Las reservas como espacio de datos las hará el 1er.write


 ' Reutilización/progreso NID
 
 If lERASE > 0 Then
    lNID = lERASES(lERASE)
 Else
    lNID = lNID + 1
 End If

 
 ' Reserva Dimensiones del NID solicitado
 lSDimC(lNID) = lDimC
 lSDimD(lNID) = lDimD
 iSTAT(lNID) = 1
 lNITEM(lNID) = 0
 lBAJAS(lNID) = 0
 lMaxReg(lNID) = lMaxNreg
 If lMaxReg(lNID) <= 0 Then lMaxReg(lNID) = lMAXNRG
 
 
 ' Progresa reutilización
 
 If lERASE > 0 Then
    lERASES(lERASE) = 0
    lERASE = lERASE - 1
 End If


 ' Devuelve el identificador asignado
 
 M_NEWC = lNID

End Function

                                                        _______



5.3 La función CHAIN
 
La función CHAIN primero distribuye el proceso según el número de fichero y luego ejecuta la función núcleo PrChain.

PrCHAIN utiliza la búsqueda dicotómica para recuperar el ítem buscado, devuelve explícitamente el indice de posición del ítem existente y los datos encontrados, e implícitamente el valor lINBS resultado de la búsqueda dicotómica, que coincidirá con el valor explícito en caso de existencia o si no indicará la posición de inserción para nuevos elementos.

'/*-----------------------------------------------------------------*/
'/* FUNCION....: M_CHAIN                                            */
'/*                                                                 */
'/* DESCRIPCION: Recupera un Item de Memoria por Clave              */
'/*                                                                 */
'/* PARAMETROS.:                                                    */
'/* (entrada) lNIDp: Identificador del Conjunto de Items asociado   */
'/*           sClav: Clave del Item                                 */
'/* (salida ) sDato: Datos del Item                                 */
'/*                                                                 */
'/* RETORNO....:                                                    */
'/*                 0: Error de Proceso (No encontrado, ...)        */
'/*                >0: Indice en memoria-claves del Item encontrado */
'/*                    (formato 1..N)                               */
'/*-----------------------------------------------------------------*/
Function M_CHAIN(lNIDp As Long, sClav As String, sDato As String) As Long

 Dim iComp As Integer
 
 
 ' Inz derivada
 
 lINBS = 0
 
 
 ' Control de solicitud erronea
 
 If (lNIDp <= 0 Or iSTAT(lNIDp) = 0 Or lNITEM(lNIDp) <= 0) Then
 
     M_CHAIN = 0
     Exit Function
    
 End If
 
 
 ' Ejecuta PrCHAIN con el código núcleo sobre el fichero solicitado
 
 Select Case lNIDp
  
   Case 1
     M_CHAIN = PrChain(lNIDp, sCLAVES1, sDATOS1, lINDICES1, lSDimC(lNIDp), lSDimD(lNIDp), sClav, sDato, iComp)

     ...

  
Case 111
     M_CHAIN = PrChain(lNIDp, sCLAVES111, sDATOS111, lINDICES111, lSDimC(lNIDp), lSDimD(lNIDp), sClav, sDato, iComp)
 
 
   Case Else
 
    M_CHAIN = 0
   
 End Select
 

End Function
                                                        _______



5.4 La función SETEQ

La función SETEQ se emplea en el WRITE para determinar si un ítem ya está grabado y para recuperar el índice de inserción de nuevos elementos. Realmente, se trata de un interfaz reducido del CHAIN.

'/*-----------------------------------------------------------------*/
'/* FUNCION....: M_SETEQ                                            */
'/*                                                                 */
'/* DESCRIPCION: Determina la existencia de un Item en Memoria      */
'/*              por Clave                                          */
'/*                                                                 */
'/*              -Para hacer READE, utilizar N_SETEQ                */
'/*                                                                 */
'/* PARAMETROS.:                                                    */
'/* (entrada) lNIDp: Identificador del Conjunto de Items asociado   */
'/*           sClav: Clave del Item                                 */
'/*                                                                 */
'/* RETORNO....:                                                    */
'/*                 0: Error de Proceso (No encontrado, ...)        */
'/*                >0: Indice en memoria-clave del Item encontrado  */
'/*                    (Formato 1..N)                               */
'/*-----------------------------------------------------------------*/
Function M_SETEQ(lNIDp As Long, sClav As String)

 Dim sDato As String ' Aux.soporte M_CHAIN


 ' Control de solicitud erronea
 
 If (lNIDp <= 0 Or iSTAT(lNIDp) = 0 Or lNITEM(lNIDp) <= 0) Then
 
     lINBS = 0
     M_SETEQ = 0
     Exit Function
    
 End If
 
 
 ' Recupera y situa el dato
 
 M_SETEQ = M_CHAIN(lNIDp, sClav, sDato)


End Function

                                                        _______

5.5 La Función WRITE


La función WRITE primero llama a la función SETEQ, para determinar la pre-existencia del ítem proporcionado y obtener la posición de inserción lINBS.

(La variable lINBS se transporta implícitamente -como variable global- desde la ejecución de búsqueda dicotómica que ejecuta el CHAIN embebido en el SETEQ que se llama)

Luego se determina si debe ampliarse el espacio reservado y por último, tras distribuirse según el número de fichero, se llama a la función común PrWrite en donde se ejecuta la incorporación final del nuevo ítem.

'/*-----------------------------------------------------------------*/
'/* FUNCION....: M_WRITE                                            */
'/*                                                                 */
'/* DESCRIPCION: Salva un Item a memoria                            */
'/*                                                                 */
'/* PARAMETROS.:                                                    */
'/* (entrada) lNIDp: Identificador del Conjunto de Items asociado   */
'/*           sClav: Clave del Item                                 */
'/*           sDato: Datos del Item                                 */
'/*                                                                 */
'/* RETORNO....:                                                    */
'/*              0: Error de Proceso (Memoria out, ya existe...)   
*/
'/*             >0: Indice de Item-Clave Guardado Satisfactoriamente*/
'/*                    (Formato 1..N)                               */
'/*-----------------------------------------------------------------*/
Function M_WRITE(lNIDp As Long, sClave As String, sDato As String) As Long

 On Error GoTo EtError
 

 ' Control de solicitud erronea
 
 If (lNIDp <= 0 Or iSTAT(lNIDp) = 0) Then
 
    M_WRITE = 0
    Exit Function
 
 End If
 
 
 
 ' Control de solicitud ya existente
 
 If M_SETEQ(lNIDp, sClave) > 0 Then

    M_WRITE = 0
    Exit Function
 
 End If
 
 
 ' Control/Ampliacion de Datos
 
 If (PrCampDat(lNIDp) = 1) Then
 
    M_WRITE = 0
    Exit Function
 
 End If


 ' Proceso común 
 
 
 Select Case lNIDp

   Case 1
     M_WRITE = PrWrite(lNIDp, sClave, sDato, sCLAVES1, sDATOS1, lINDICES1)
 
     ...

  
Case 111
     M_WRITE = PrWrite(lNIDp, sClave, sDato, sCLAVES111, sDATOS111, lINDICES111)
 
   Case Else
 
    M_WRITE = 0
   
 End Select
 
 
 Exit Function
 
 
' Fin bajo error
 
EtError:
 
  M_WRITE = 0
 
End Function

                                                        _______

5.6 Las funciones auxiliares



Las funciones auxiliares involucradas emulan las funciones de gestión de memoria del lenguaje C (malloc y realloc) que no están disponibles como tales en VBA, y que se centran en su sustitución en las series por la utilización de la instrucciones "Dim" y posteriormente "ReDim Preserve", que permite aumentar el tamaño de una serie manteniendo su contenido anterior.


5.6.1 Ampliación de la memoria de cada fichero (Usando Redim Preserve)

Esta función se ejecuta en el WRITE cuando se alcanza el límite de cada bloque de datos reservado anteriormente. Cuando procede llama a la función de ampliación PrAmpDat que se presenta al final del código de PrCampDat.

'/*-----------------------------------------------------------------*/
'/* FUNCION....: PrCampDat                                          */
'/*                                                                 */
'/* DESCRIPCION: Controla/Amplia memoria de datos en un nuevo bloque*/
'/*              -- USO INTERNO. NO EXPORTABLE --                   */
'/*                                                                 */
'/* PARAMETROS.:                                                    */
'/* (entrada) lNIDp: Identificador del Conjunto de Items a ampliar  */
'/*                                                                 */
'/* RETORNO....:                                                    */
'/*                 0: OK                                           */
'/*                 1: Error de proceso (Memoria Agotada, etc)      */
'/*                                                                 */
'/*-----------------------------------------------------------------*/
Private Function PrCampDat(lNIDp As Long) As Integer

 Dim lSumCtrl As Long ' Control de bloques
 

 ' Primer dimensionamiento
 
 If lNITEM(lNIDp) = 0 Then

    PrCampDat = PrAmplia(lNIDp, 0, lBLOQd)
   
    Exit Function
   
 End If


 ' Control de dimensionamiento en bloques posteriores
 
 If lNITEM(lNIDp) < lBLOQd Then ' En 1er bloque
   
    PrCampDat = NO_ERRO
   
    Exit Function
   
 End If

 If lNITEM(lNIDp) = lBLOQd Then ' Justo al final del 1er bloque
   
    PrCampDat = PrAmplia(lNIDp, lNITEM(lNIDp), lBLOQd2)
   
    Exit Function
   
 End If


 ' Bucle de examen de restos de control
 
 lSumCtrl = lNITEM(lNIDp) ' Inz
 
 Do While lSumCtrl > 0

   lSumCtrl = lSumCtrl - lBLOQd2 ' Resto actual


   ' Ampliación por alcance de punto frontera (Resto cero)
  
   If lSumCtrl = 0 Then
    
     PrCampDat = PrAmplia(lNIDp, lNITEM(lNIDp), lBLOQd2)
   
     Exit Function
   
   End If
 
 Loop


 ' Fin de proceso satisfactorio
 
 PrCampDat = NO_ERRO

End Function

                                                        _______


PrAmplia se ejecuta cuando PrCampDat determina que se ha alcanzado el límite de cada bloque de datos reservado anteriormente. Entonces se encarga de llamar a su vez a la ampliación en índices, claves y datos, que veremos a su vez más tarde.

'*-----------------------------------------------------------------*/
'* FUNCION....: PrAmplia                                           */
'*                                                                 */
'* DESCRIPCION: Amplia memoria de datos en un nuevo bloque         */
'*              -- USO INTERNO. NO EXPORTABLE --                   */
'*                                                                 */
'* PARAMETROS.:                                                    */
'* (entrada) lNIDp: Identificador del Conjunto de Items a ampliar  */
'*                                                                 */
'* RETORNO....:                                                    */
'*                 0: OK                                           */
'*                 1: Error de proceso (Memoria Agotada, etc)      */
'*                                                                 */
'*-----------------------------------------------------------------*/
Private Function PrAmplia(lNIDp As Long, lTamAnt As Long, lBLOQ As Long) As Integer

 Dim lTam As Long  ' lTamAnt + lBLOQ

 On Error GoTo EtError
 
 
 ' Inz & Ctrl

 lTam = lTamAnt + lBLOQ
 
 If lTam > lMaxReg(lNIDp) Then
   
    PrAmplia = 1
    Exit Function

 End If
 
 
 ' Amplia el espacio de índices
 
 PrAmplia = PrAmpInd(lNIDp, lTam)
 If PrAmplia > 0 Then Exit Function
 
 
 ' Amplia el espacio de claves

 PrAmplia = PrAmpClav(lNIDp, lTam)
 If PrAmplia > 0 Then Exit Function
 
 
 ' Amplia el espacio de datos

 PrAmplia = PrAmpDat(lNIDp, lTam)

 Exit Function
 
 
 
 ' Fin bajo error
 
EtError:
 
  PrAmplia = 1
 
End Function
 
                                                        _______


 

5.6.1.1 Ampliación de la memoria de índices (Interfaz a Redim Preserve en serie de índices)

Como en el resto de funciones de detalle de la ampliación, se trata de interfaces a la instrucción de redimensionamiento con preservación del contenido anterior "ReDim Preserve", en este caso aplicada a la serie de índices del fichero en curso

'*-----------------------------------------------------------------*/
'* FUNCION....: PrAmpInd                                           */
'*                                                                 */
'* DESCRIPCION: Amplia memoria de índices lINDICESxx()             */
'*              -- USO INTERNO. NO EXPORTABLE --                   */
'*                                                                 */
'* PARAMETROS.:                                                    */
'* (entrada) lNIDp: Identificador del Conjunto de Items a ampliar  */
'*                                                                 */
'* RETORNO....:                                                    */
'*                 0: OK                                           */
'*                 1: Error de proceso (Memoria Agotada, etc)      */
'*                                                                 */
'*-----------------------------------------------------------------*/
Private Function PrAmpInd(lNIDp As Long, lTam As Long) As Integer

 On Error GoTo EtError
 
 ' Inz
 
 PrAmpInd = NO_ERRO
 
 
 
 ' Amplia el espacio de índices solicitado
 
 Select Case lNIDp
  
   Case 1
     ReDim Preserve lINDICES1(lTam)
    
     ...

   
Case 111
     ReDim Preserve lINDICES111(lTam)

  Case Else
 
   PrAmpInd = 1
 
 End Select
 
 
 Exit Function
 
 
 
 ' Fin bajo error
 
EtError:
 
  PrAmpInd = 1
 
End Function
                                                       
_______ 


5.6.1.2 Ampliación de la memoria de claves y datos (Interfaz a Redim Preserve en serie de claves y datos)

Las funciones PrAmpClav y PrAmpDat son similares a PrAmpInd como podemos ver a continuación, aunque aplicadas a las series de claves y datos sopore del fichero virtual en curso
   
'/*-----------------------------------------------------------------*/
'/* FUNCION....: PrCampDat                                          */
'/*                                                                 */
'/* DESCRIPCION: Controla/Amplia memoria de datos en un nuevo bloque*/
'/*              -- USO INTERNO. NO EXPORTABLE --                   */
'/*                                                                 */
'/* PARAMETROS.:                                                    */
'/* (entrada) lNIDp: Identificador del Conjunto de Items a ampliar  */
'/*                                                                 */
'/* RETORNO....:                                                    */
'/*                 0: OK                                           */
'/*                 1: Error de proceso (Memoria Agotada, etc)      */
'/*                                                                 */
'/*-----------------------------------------------------------------*/
Private Function PrCampDat(lNIDp As Long) As Integer

 Dim lSumCtrl As Long ' Control de bloques
 

 ' Primer dimensionamiento
 
 If lNITEM(lNIDp) = 0 Then

    PrCampDat = PrAmplia(lNIDp, 0, lBLOQd)
   
    Exit Function
   
 End If


 ' Control de dimensionamiento en bloques posteriores
 
 If lNITEM(lNIDp) < lBLOQd Then ' En 1er bloque
   
    PrCampDat = NO_ERRO
   
    Exit Function
   
 End If

 If lNITEM(lNIDp) = lBLOQd Then ' Justo al final del 1er bloque
   
    PrCampDat = PrAmplia(lNIDp, lNITEM(lNIDp), lBLOQd2)
   
    Exit Function
   
 End If


 ' Bucle de examen de restos de control
 
 lSumCtrl = lNITEM(lNIDp) ' Inz
 
 Do While lSumCtrl > 0

   lSumCtrl = lSumCtrl - lBLOQd2 ' Resto actual


   ' Ampliación por alcance de punto frontera (Resto cero)
  
   If lSumCtrl = 0 Then
    
     PrCampDat = PrAmplia(lNIDp, lNITEM(lNIDp), lBLOQd2)
   
     Exit Function
   
   End If
 
 Loop


 ' Fin de proceso satisfactorio
 
 PrCampDat = NO_ERRO

End Function

                                                        _______


5.6.2 Código núcleo de la función CHAIN

PrChain es el código núcleo del CHAIN para un fichero virtual en particular.

Se encarga de llamar a la función de búsqueda dicotómica U_BS y pasar el índice resultado implícitamente en la variable global lINBS y explícitamente en el valor de retorno y en los parámetros dedicados al paso de claves y datos en caso de existencia del ítem solicitado.

'/*-----------------------------------------------------------------*/
'/* FUNCION....: PrCHAIN                                            */
'/*                                                                 */
'/* DESCRIPCION: Común para recuperar un Item de Memoria por Clave  */
'/*                                                                 */
'/* PARAMETROS.:                                                    */
'/* (entrada) lNIDp: Identificador del Conjunto de Items asociado   */
'/*           sClv : S.Claves del fichero solicitado                */
'/*           sDat : S.Datos del fichero solicitado                 */
'/*           lInd : S.Indices direccionamiento                     */
'/*           lDimC: Tamaño ítem de clave                           */
'/*           lDimD: Tamaño ítem de datos                           */
'/*           sClav: Clave del Item                                 */
'/* (salida ) sDato: Datos del Item                                 */
'/*           iComp: Valor resultante comparación - 0 +  < = >      */
'/*                                                                 */
'/* RETORNO....:                                                    */
'/*                 0: Error de Proceso (No encontrado, ...)        */
'/*                >0: Indice en memoria-claves del Item encontrado */
'/*                    (formato 1..N)                               */
'/*-----------------------------------------------------------------*/
Function PrChain(lNIDp As Long, sClv() As String, sDat() As String, lInd() As Long, _
  lDimC As Long, lDimD As Long, sClav As String, sDato As String, iComp As Integer) As Long

 Dim wClav, wClv As String ' Uso de substring de sClav y sClv(i)
 

 ' Inz, incluida lINBS variable índice de localización (De paso implícito)
 
 lINBS = 0
 iComp = -2
 sDato = ""
 
 
 ' Paso a variables de trabajo
 
 wClav = Left(sClav, lDimC)
 
 
 ' Recuperacion de ítem único
 
 If lNITEM(lNIDp) = 1 Then
 
 
    ' Paso a variables de trabajo
    
    wClv = Left(sClv(lInd(1)), lDimD)
 
 
    ' Valor de rango inferior
 
    If wClav < wClv Then
       iComp = -1
       PrChain = 0
       Exit Function
    End If
 
 
    ' Valor coincidente
 
    If wClav = wClv Then
   
       iComp = 0
       sDato = sDat(lInd(1))
       lINBS = 1

       PrChain = 1
      
       Exit Function
      
    End If
 
 
    ' Valor de rango superior

    iComp = 1
    lINBS = 1 ' Como valor más cercano inferior

    PrChain = 0
      
    Exit Function
      
 End If
 


 ' Localización dicotómica especial para M, toma índice en formato 1..N
 
 lINBS = U_BS(sClav, lDimC, lNITEM(lNIDp), lInd, sClv, iComp)
 
 If iComp <> 0 Then
    PrChain = 0
    Exit Function
 End If
 

 ' Pasa datos asociados a localización exacta
 
 sDato = sDat(lInd(lINBS))
 
 PrChain = lINBS
 

End Function
                                                        _______
 

5.6.3 Código núcleo de la función WRITE

PrWrite añade claves y datos al final de las series de soporte e inserta el índice asociado según el resultado de la búsqueda dicotómica

'/*-----------------------------------------------------------------*/
'/* FUNCION....: PrWRITE                                            */
'/*                                                                 */
'/* DESCRIPCION: Núcleo de M_WRITE. Salva un Item a memoria         */
'/*                                                                 */
'/* PARAMETROS.:                                                    */
'/* (entrada) lNIDp: Identificador del Conjunto de Items asociado   */
'/*          sClave: Clave del Item                                 */
'/*           sDato: Datos del Item                                 */
'/*            sClv: Serie claves asociada al fichero virtual       */
'/*            sDat: Serie datos asociada al fichero virtual        */
'/*            sInd: Serie de índices asociada al fichero virtual   */
'/*                                                                 */
'/* RETORNO....:                                                    */
'/*              0: Error de Proceso (Memoria out, ya existe...)    */
'/*             >0: Indice de Item-Clave Guardado Satisfactoriamente*/
'/*                    (Formato 1..N)                               */
'/*-----------------------------------------------------------------*/
Private Function PrWrite(lNIDp As Long, sClave As String, sDato As String, _
                         sClv() As String, sDat() As String, sInd() As Long) As Long


 Dim Erro As Integer ' 0/1 Error de proceso
 

 ' Incrementa contador de Items en el fichero virtual
 
 lNITEM(lNIDp) = lNITEM(lNIDp) + 1
 
 
 ' Paso a Memoria del Item dado
 
 
 ' -Parte de Datos
 
 sDat(lNITEM(lNIDp)) = sDato
 
 
 ' -Parte de clave
 
 sClv(lNITEM(lNIDp)) = sClave
 


 ' -Indice
 

 ' Inserción Unica o Inicial
 
 If lNITEM(lNIDp) = 1 Or lINBS <= 0 Then
 
 
    ' Desplaza índices
 
    Erro = U_InserInd(lNITEM(lNIDp), lINBS + 1, lNITEM(lNIDp), sInd)
       
    If Erro = 1 Then
        
       PrWrite = 0
       Exit Function
           
    End If
     
 
    ' Devuelve índice asociado (en formato 1..n)
   
    PrWrite = 1
   
    Exit Function
 
  End If
 

 ' Nuevo elemento al final del rango de ClavesOrdenadas
 
 If lINBS + 1 >= lNITEM(lNIDp) Then
 
    sInd(lNITEM(lNIDp)) = lNITEM(lNIDp)
       
       
    ' Devuelve índice asociado
   
    PrWrite = lNITEM(lNIDp)
   
    Exit Function
 
 End If



 ' Incorpora el nuevo elemento dentro del rango de claves ordenadas
 
 
 Erro = U_InserInd(lNITEM(lNIDp), lINBS + 1, lNITEM(lNIDp) - 1, sInd)
 

 ' Devuelve índice en formato 1..N
 
 PrWrite = lINBS + 1


End Function

                                                        _______


5.6.4 El código de insercción en índice (splice), emulación de memmove

Por último U_InserInd es el equivalente del memmove que se utilizaba en la versión original escrita en lenguaje C, que en JavaScript se traduciría por la función splice, y que aquí se codifica como

'-----------------------------------------------------------------
' FUNCION....: U_InserInd
'
' DESCRIPCION: Inserta un ítem intermedio en una serie índice
'
' PARAMETROS.:
' (I)       lInd: Valor índice a insertar
'           lPos: Posición de inserción
'           N   : Nºítems actuales
'           sInd: Serie índice objeto de la insercción (Y que acaba pues con N+1 ítems)
'
' RETORNO....:  0/1 error de proceso
'-----------------------------------------------------------------
Function U_InserInd(lInd As Long, lPos As Long, N As Long, sInd() As Long) As Integer
             
 Dim i
As Long       ' Contador de do
 
             
 On Error GoTo EtError


 ' Filtros
 
 If lPos < 1 Then
    U_InserInd = 1
    Exit Function
 End If
 
 If N < lPos Then
    U_InserInd = 1
    Exit Function
 End If

 
 ' Desplazamiento de cola
 
 sInd(N + 1) = sInd(N)
 
 If N > lPos Then
 
    For i = N To lPos Step -1
 
        sInd(i + 1) = sInd(i)
 
    Next i
   
 End If


 ' Insercción
 
 sInd(lPos) = lInd
 
 
 ' Fin de proceso satisfactorio

 U_InserInd = 0

 Exit Function
 
 
 ' Fin de proceso erróneo
 
EtError:
 
 U_InserInd = 1
 
 
End Function
                                                       
_______

 

6 Fuentes

 

En el enlace siguiente se puede acceder al código fuente completo del módulo núcleo de los ficheros virtuales en VBA. Por su parte, puede utilizarse el enlace que sigue para acceder al libro W que recoge los ejemplos asociados a los primeros capítulos del blog. La hoja M del libro W corresponde al capítulo en curso.


                                                        _______