Attribute VB_Name = "Recursos"
Option Explicit

Private Const DELIM_CMP = """"
Private Const SEPAR_CMP = ","

Public Const VS_IMAGEN = 1              ' tipo de recurso para imágenes
Public Const VS_SONIDO = 2              ' tipo de recurso para sonidos
Public Const VS_FUENTE = 3              ' tipo de recurso para fuentes (TTF)
Public Const VS_CABFUENTE = 4           ' tipo de recurso auxiliar para fuentes (TTF)
                                        ' (aquí guardamos el nombre original del fichero TTF)
Public Const VS_VOC = 5                 ' tipo de recurso para guardar vocabulario
Public Const VS_LOC = 6                 ' tipo de recurso para guardar localidades
Public Const VS_OBJ = 7                 ' tipo de recurso para guardar objetos
Public Const VS_PSI = 8                 ' tipo de recurso para guardar PSIs
Public Const VS_CABMOD = 9              ' tipo de recurso para guardar cabecera de módulos
Public Const VS_MOD = 10                ' tipo de recurso para guardar módulos

Public Const BLORB_FORM = "FORM"
Public Const BLORB_ID = "IFRS"
Public Const BLORB_IND = "RIdx"
Public Const BLORB_IMAGEN = "Pict"
Public Const BLORB_SONIDO = "Snd "
Public Const BLORB_JPEG = "JPEG"
Public Const BLORB_PNG = "PNG "

Public Const CODIGO_RES = 255           ' para codificar los recursos

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Declare Function CreateScalableFontResource Lib "gdi32" Alias "CreateScalableFontResourceA" (ByVal fHidden As Long, ByVal lpszResourceFile As String, ByVal lpszFontFile As String, ByVal lpszCurrentPath As String) As Long
Public Declare Function AddFontResource Lib "gdi32" Alias "AddFontResourceA" (ByVal lpFileName As String) As Long
Public Declare Function RemoveFontResource Lib "gdi32" Alias "RemoveFontResourceA" (ByVal lpFileName As String) As Long

Type Recurso
    Tipo As Byte
    id As Integer
    Pos As Long
    Tam As Long
End Type

Type RecursoBlorb
    Tipo As Integer     ' VS_IMAGEN, VS_SONIDO
    id As Long
    Fich As String
End Type

' La estructura del fichero de recursos es:
'
'   Nº Recursos     (Long)
'   Recurso1        (Recurso)
'   Recurso2        (Recurso)
'   ...
'   RecursoN        (Recurso)
'   -------------------------
'   Datos recursos

' La estructura del fichero BLORB es:
'
'   CABECERA:
'
'     "FORM"                                    (4 bytes)
'     longitud = (long. fichero - 8)
'     "IFRS"                                    (4 bytes)
'
'   INDICE DE RECURSOS:
'
'     "RIdx"                                    (4 bytes)
'     long = 4 + (nº recursos * 12)             (4 bytes)
'     nº recursos                               (4 bytes)
'     --- RES1 ---
'     tipo ("Pict", "Snd ", "Exec")             (4 bytes)
'     id (nº de recurso)                        (4 bytes)
'     inicio (pos. respecto inicio fichero)     (4 bytes)
'     --- RES2 ---
'     ...
'
'   DATOS RECURSOS:
'
'     "PNG " o "JPEG"                           (4 bytes)
'     longitud (longitud datos)                 (4 bytes)
'     (datos...)                                (n bytes)
'
'     "AIFF" o "MOD " o "SONG"                  (4 bytes)
'     longitud (longitud datos)                 (4 bytes)
'     (datos...)                                (n bytes)

' convierte un nº en una matriz de bytes
Private Sub LongToBytes(ByRef B() As Byte, ByRef n As Long)

    ReDim B(LenB(n) - 1)
    CopyMemory B(0), n, LenB(n)

End Sub

' convierte un nº en una matriz de bytes
Private Sub LongToBytes2(ByRef B() As Byte, ByRef n As Long)
    Dim X As Byte
    
    ReDim B(LenB(n) - 1)
    CopyMemory B(0), n, LenB(n)
    
    X = B(3)
    B(3) = B(0)
    B(0) = X
    X = B(2)
    B(2) = B(1)
    B(1) = X

End Sub

' convierte una matriz de bytes en un nº entero
Private Function BytesToLong(B() As Byte) As Long
    Dim n As Long

    CopyMemory n, B(0), LenB(n)
    BytesToLong = n

End Function

' convierte una cadena en una matriz de bytes
Private Sub StringToBytes(ByRef B() As Byte, ByVal s As String)
    Dim i As Long

    If Len(s) = 0 Then
        ReDim B(0)
        B(0) = 0
        Exit Sub
    End If

    ReDim B(Len(s) - 1)
    For i = 1 To Len(s)
        B(i - 1) = CByte(Asc(Mid(s, i, 1)))
    Next

End Sub

' lee la cabecera del fichero de recursos
' si hay error devuelve una matriz con un elemento cuyo 'ID' es -1
Private Function LeeCabRes(F As Win32File) As Recurso()
    Dim R() As Recurso
    Dim B() As Byte
    Dim i As Long, lNumRes As Long, lTamResBytes As Long
    
    On Error GoTo Error_LeeCabRes
    
    ' leemos el nº de entradas en la tabla de recursos
    i = LenB(lNumRes)
    ReDim B(i - 1)
    B = F.ReadBytes(i)
    lNumRes = BytesToLong(B)
    
    If lNumRes > 0 Then
        lTamResBytes = LenB(R(0))
        ReDim B(lTamResBytes - 1)
        ' leemos la tabla de recursos
        ReDim R(lNumRes - 1)
        For i = 0 To lNumRes - 1
            B = F.ReadBytes(lTamResBytes)
            CopyMemory R(i), B(0), lTamResBytes
        Next
    End If
    
    LeeCabRes = R
    Exit Function

Error_LeeCabRes:
    ReDim R(0)
    R(0).Tipo = -1
    LeeCabRes = R
End Function

' carga un recurso del fichero de recursos y lo devuelve como una matriz de bytes
' ej: Recurso = CargaRecurso("VS.DLL",1,VS_IMAGEN)
Public Function CargaRecurso(ByVal sFichRes As String, ByVal lIDRes As Long, _
  ByVal lTipoRes As Long) As Byte()
    Dim FichRes As New Win32File
    Dim B() As Byte
    Dim R() As Recurso
    Dim i As Long
    
    ReDim B(0)
    B(0) = 0
    
    On Error GoTo Error_CargaRes2
    FichRes.OpenFile sFichRes, True
    On Error GoTo Error_CargaRes1
    
    ' leemos la cabecera del fichero de recursos
    R = LeeCabRes(FichRes)
    If R(0).id = -1 Then
        GoTo Error_CargaRes1
    End If
    
    ' buscamos el recurso
    For i = 0 To UBound(R)
        If R(i).Tipo = lTipoRes And R(i).id = lIDRes Then
            ' cargamos los datos del recurso
            FichRes.SeekAbsolute 0
            FichRes.SeekAbsolute R(i).Pos
            B = FichRes.ReadBytes(R(i).Tam)
            Exit For
        End If
    Next
    
    FichRes.CloseFile
    CargaRecurso = B
    Exit Function

Error_CargaRes1:
    FichRes.CloseFile
Error_CargaRes2:
    ReDim B(0)
    B(0) = 0
End Function

' añade un recurso al fichero de recursos, devuelve True si pudo o False si error
' el recurso se obtiene desde memoria
' se crea un fichero temporal que sobreescribirá al original
' ej: NuevoRecursoMem "VS.DLL",1,VS_IMAGEN,B
Public Function NuevoRecursoMem(ByVal sFichRes As String, ByVal lIDRes As Long, _
  ByVal lTipoRes As Long, Res() As Byte) As Boolean
    Dim FichRes As New Win32File
    Dim R() As Recurso
    Dim B() As Byte
    Dim sFichResTmp As String
    Dim i As Long, lNumRes As Long, lTamResBytes As Long

    ' si el fichero de recursos no existe lo creamos y añadimos el recurso
    If Not ExisteFichero(sFichRes) Then
        On Error GoTo Error_NuevoRecurso2
        FichRes.NewFile sFichRes
        On Error GoTo Error_NuevoRecurso1
        
        ' guardamos el nº de recursos
        lNumRes = 1
        LongToBytes B, lNumRes
        FichRes.WriteBytes B
    
        ' guardamos la cabecera
        ReDim R(0)
        lTamResBytes = LenB(R(0))
        R(0).Tipo = lTipoRes
        R(0).id = lIDRes
        R(0).Tam = UBound(Res) + 1
        R(0).Pos = LenB(lNumRes) + lTamResBytes
        ReDim B(lTamResBytes - 1)
        CopyMemory B(0), R(0), lTamResBytes
        FichRes.WriteBytes B
        
        ' guardamos el recurso
        FichRes.WriteBytes Res
        FichRes.CloseFile
        NuevoRecursoMem = True
        Exit Function
    End If

    sFichResTmp = ""

    On Error GoTo Error_NuevoRecurso2
    FichRes.OpenFile sFichRes, False
    On Error GoTo Error_NuevoRecurso1
    ' leemos la cabecera del fichero de recursos
    R = LeeCabRes(FichRes)
    If R(0).id = -1 Then
        GoTo Error_NuevoRecurso1
    End If
    FichRes.CloseFile

    ' comprobamos si ya existe, en cuyo caso salimos con error
    For i = 0 To UBound(R)
        If R(i).Tipo = lTipoRes And R(i).id = lIDRes Then
            NuevoRecursoMem = False
            Exit Function
        End If
    Next

    ' añadimos datos del nuevo recurso a la cabecera
    i = UBound(R) + 1
    ReDim Preserve R(i)
    R(i).Tipo = lTipoRes
    R(i).id = lIDRes
    R(i).Tam = UBound(Res) + 1
    R(i).Pos = R(i - 1).Pos + R(i - 1).Tam
    
    ' ajustamos las posiciones de los recursos existentes ya que hemos añadido
    ' una nueva entrada a la cabecera
    lTamResBytes = LenB(R(0))
    For i = 0 To UBound(R)
        R(i).Pos = R(i).Pos + lTamResBytes
    Next
    
    ' creamos fichero temporal que luego pasará a ser el original
    sFichResTmp = sFichRes & ".TMP"
    On Error GoTo Error_NuevoRecurso2
    FichRes.NewFile sFichResTmp
    On Error GoTo Error_NuevoRecurso1
    
    ' guardamos el nº de recursos
    lNumRes = UBound(R) + 1
    LongToBytes B, lNumRes
    FichRes.WriteBytes B
    
    ' guardamos la cabecera
    ReDim B(lTamResBytes - 1)
    For i = 0 To lNumRes - 1
        CopyMemory B(0), R(i), lTamResBytes
        FichRes.WriteBytes B
    Next
    
    ' leemos los recursos originales y los copiamos al fichero temporal
    For i = 0 To lNumRes - 2
        B = CargaRecurso(sFichRes, R(i).id, R(i).Tipo)
        '''If UBound(B) = 0 Then
        '''    GoTo Error_NuevoRecurso1
        '''End If
        FichRes.WriteBytes B
    Next
    
    ' guardamos el nuevo recurso
    FichRes.WriteBytes Res
    FichRes.CloseFile
    On Error GoTo Error_NuevoRecurso2
    
    ' copiamos el fichero temporal sobre el original y borramos el temporal
    FileCopy sFichResTmp, sFichRes
    Kill sFichResTmp
    
    NuevoRecursoMem = True
    Exit Function

Error_NuevoRecurso1:
    On Error Resume Next
    FichRes.CloseFile
    If sFichResTmp <> "" Then
        Kill sFichResTmp
    End If
Error_NuevoRecurso2:
    NuevoRecursoMem = False
End Function

' añade un recurso al fichero de recursos, devuelve True si pudo o False si error
' el recurso se obtiene desde un fichero
' ej: NuevoRecurso "VS.DLL",1,VS_IMAGEN,"c:\imag.jpg"
Public Function NuevoRecurso(ByVal sFichRes As String, ByVal lIDRes As Long, _
  ByVal lTipoRes As Long, ByVal sFich As String) As Boolean
    Dim FichRes As New Win32File
    Dim B() As Byte

    On Error GoTo Error_NuevoRecurso2
    FichRes.OpenFile sFich, True
    On Error GoTo Error_NuevoRecurso1
    B = FichRes.ReadBytes(FichRes.Size)
    FichRes.CloseFile

    NuevoRecurso = NuevoRecursoMem(sFichRes, lIDRes, lTipoRes, B)
    Exit Function
    
Error_NuevoRecurso1:
    On Error Resume Next
    FichRes.CloseFile
Error_NuevoRecurso2:
    NuevoRecurso = False
End Function

' carga un recurso de imagen y lo devuelve como objeto Picture
Public Function CargaResImagen(ByVal sFichRes As String, ByVal lIDRes As Long) As IPictureDisp
    Dim Fich As New Win32File
    Dim B() As Byte
    Dim sFich As String
    
    sFich = FichTemp(DirTemp, "IMG")
    If sFich = "" Then
        Set CargaResImagen = Nothing
        Exit Function
    End If
    
    B = CargaRecurso(sFichRes, lIDRes, VS_IMAGEN)
    If UBound(B) = 0 Then
        Set CargaResImagen = Nothing
        Exit Function
    End If
    
    On Error GoTo Error_CargaRes2
    Fich.NewFile sFich
    On Error GoTo Error_CargaRes1
    Fich.WriteBytes B
    Fich.CloseFile
    Set CargaResImagen = LoadPicture(sFich)
    
    On Error Resume Next
    Kill sFich
    Exit Function

Error_CargaRes1:
    On Error Resume Next
    Fich.CloseFile
    Kill sFich
Error_CargaRes2:
    Set CargaResImagen = Nothing
End Function

' carga un recurso de sonido y lo devuelve el nombre del fichero dónde lo ha dejado
' o cadena vacía si error
Public Function CargaResSonido(ByVal sFichRes As String, ByVal lIDRes As Long) As String
    Dim Fich As New Win32File
    Dim B() As Byte
    Dim sFich As String
    
    sFich = FichTemp(DirTemp, "SND")
    If sFich = "" Then
        GoTo Error_CargaResSonido2
    End If
    
    B = CargaRecurso(sFichRes, lIDRes, VS_SONIDO)
    If UBound(B) = 0 Then
        GoTo Error_CargaResSonido1
    End If
    
    On Error GoTo Error_CargaResSonido2
    Fich.NewFile sFich
    On Error GoTo Error_CargaResSonido1
    Fich.WriteBytes B
    Fich.CloseFile
    CargaResSonido = sFich
    Exit Function

Error_CargaResSonido1:
    On Error Resume Next
    Fich.CloseFile
    Kill sFich
Error_CargaResSonido2:
    CargaResSonido = ""
End Function

' añade una fuente al sistema
' el parámetro 'sFnt' puede ser el nombre de un fichero de fuentes o de
' la forma "#nnnnn" en cuyo caso se cargará la fuente desde el fichero de recursos
' devuelve False si hubo errores
Public Function CargaResFuente(ByVal sFichRes As String, ByVal sFnt As String) As Boolean
    Dim Fich As New Win32File
    Dim B() As Byte
    Dim s As String, sFich As String, sFichCab As String, sRuta As String, _
      sDirFuentes As String
    Dim i As Long, lIDRes As Long

    ' directorio donde guardaremos los ficheros de fuentes
    sDirFuentes = DirWindows & "Fonts\"

    If Left(sFnt, 1) = "#" Then
        If Len(sFnt) < 2 Then
            CargaResFuente = False
            Exit Function
        End If
        s = Right(sFnt, Len(sFnt) - 1)
        lIDRes = CLng(s)
        
        ' primero recuperamos el nombre original del fichero TTF
        B = CargaRecurso(sFichRes, lIDRes, VS_CABFUENTE)
        If UBound(B) > 0 Then
            sFich = ""
            For i = 0 To UBound(B)
                sFich = sFich & Chr(CLng(B(i)))
            Next
            sFich = sDirFuentes & sFich
        Else
            CargaResFuente = False
            Exit Function
        End If
        
        ' comprobamos si el fichero ya existe (en este caso suponemos que
        ' el tipo de letra ya está instalado)
        If ExisteFichero(sFich) Then
            CargaResFuente = True
            Exit Function
        End If
        
        B = CargaRecurso(sFichRes, lIDRes, VS_FUENTE)
        If UBound(B) > 0 Then
            On Error GoTo Error_CargarFuente2
            Fich.NewFile sFich
            On Error GoTo Error_CargarFuente1
            Fich.WriteBytes B
            Fich.CloseFile
            On Error GoTo Error_CargarFuente2
        Else
            CargaResFuente = False
            Exit Function
        End If
    Else
        sFich = sFnt
        ' copiamos el fichero pero sólo si no existe ya en el destino
        On Error Resume Next
        s = NombreFich(sFich)
        s = sDirFuentes & s
        If ExisteFichero(s) Then
            CargaResFuente = False
            Exit Function
        Else
            FileCopy sFich, s
            If Err.Number <> 0 Then
                CargaResFuente = False
                Exit Function
            End If
        End If
        ' guardamos la ruta real del fichero copiado
        sFich = s
    End If
    
    ' creamos el fichero de cabecera
    sRuta = RutaFich(sFich) & "\"
    sFich = NombreFich(sFich)
    ' nombre del fichero de cabecera (cambiamos la extensión por .FOT)
    i = InStrRev(sFich, ".")
    If i > 1 Then
        s = Left(sFich, i - 1)
        sFichCab = s & ".FOT"
    Else
        sFichCab = sFich & ".FOT"
    End If
    CreateScalableFontResource 0, sRuta & sFichCab, sFich, sRuta
    
    ' añadimos la fuente
    If AddFontResource(sRuta & sFich) = 0 Then
        ' si falló al añadir fuente, borramos los ficheros
        On Error Resume Next
        Kill sRuta & sFich
        Kill sRuta & sFichCab
    End If
    
    ' notificamos que hay una nueva fuente en el sistema
    ' a todas las ventanas...
    SendMessage HWND_BROADCAST, WM_FONTCHANGE, 0, 0
    DoEvents
    ' ...y a las "pantallas" (por si acaso)
    If EstaCargado(frmVis) Then
        SendMessage frmVis.hwnd, WM_FONTCHANGE, 0, 0
        DoEvents
        For i = 0 To frmVis.Pantalla.Count - 1
            SendMessage frmVis.Pantalla(i).hwnd, WM_FONTCHANGE, 0, 0
            DoEvents
        Next
    End If
    
    ' eliminamos el fichero FOT
    On Error Resume Next
    Kill sRuta & sFichCab
    
    CargaResFuente = True
    Exit Function

Error_CargarFuente1:
    On Error Resume Next
    Fich.CloseFile
Error_CargarFuente2:
    CargaResFuente = False
End Function

' guarda la tabla de vocabulario en un recurso, devuelve False si error
Public Function GuardarVocabularioRes(ByVal sDLLRes As String) As Boolean
    Dim B() As Byte
    Dim i As Long
    Dim s As String

    On Error GoTo Error_GuardarVoc

    ' si está vacío el vocabulario deja en blanco
    If Not bHayVoc Then
        ReDim B(0)
        B(0) = 0
    Else
        s = ""
        For i = 0 To UBound(Vocabulario)
            s = s & "*" & Vocabulario(i).Palabra & vbCrLf
            s = s & " =" & Vocabulario(i).Tipo & vbCrLf
            s = s & " +" & Vocabulario(i).Sinonimo & vbCrLf
        Next
        Codifica s, CODIGO_RES
        ReDim B(Len(s) - 1)
        For i = 1 To Len(s)
            B(i - 1) = CByte(Asc(Mid(s, i, 1)))
        Next
    End If
    
    GuardarVocabularioRes = NuevoRecursoMem(sDLLRes, 1, VS_VOC, B)
    Exit Function
    
Error_GuardarVoc:
    GuardarVocabularioRes = False
End Function

' guarda la tabla de localidades en un recurso, devuelve False si error
Public Function GuardarLocalidadesRes(ByVal sDLLRes As String) As Boolean
    Dim B() As Byte
    Dim i As Long, j As Long, n As Long
    Dim s As String

    On Error GoTo Error_GuardarLoc
    s = ""
    
    ' propiedades de usuario
    If HayPropUsrLoc Then
        For i = NUM_LOCPROP_PREDEF To UBound(LocProp)
            s = s & DELIM_CMP & CStr(LocProp(i).Tipo) & DELIM_CMP & SEPAR_CMP & _
              DELIM_CMP & LocProp(i).Nombre & DELIM_CMP & SEPAR_CMP & vbCrLf
        Next
    End If

    ' si está vacia la tabla de localidades
    If Not bHayLoc Then
        ReDim B(0)
        B(0) = 0
    Else
        For i = 0 To UBound(Localidades)
            s = s & "*" & Localidades(i).Nombre & vbCrLf
            s = s & "{" & CStr(Len(Localidades(i).DescCorta)) & "}" & Localidades(i).DescCorta & vbCrLf
            s = s & "{" & CStr(Len(Localidades(i).DescLarga)) & "}" & Localidades(i).DescLarga & vbCrLf
            s = s & IIf(Localidades(i).Iluminada, PROP_ACTIV, PROP_DESACTIV) & vbCrLf
            s = s & IIf(Localidades(i).Exterior, PROP_ACTIV, PROP_DESACTIV) & vbCrLf
            s = s & "{" & CStr(Len(Localidades(i).Grafico)) & "}" & Localidades(i).Grafico & vbCrLf
            s = s & "{" & CStr(Len(Localidades(i).Sonido)) & "}" & Localidades(i).Sonido & vbCrLf
            '''s = s & "{" & CStr(Len(Localidades(i).Usuario)) & "}" & Localidades(i).Usuario & vbCrLf
            
            ' conexiones
            n = UBound(Localidades(i).Conexiones)
            s = s & "%" & n & vbCrLf
            For j = 0 To n
                s = s & Localidades(i).Conexiones(j).Localidad & "#" & _
                  Localidades(i).Conexiones(j).Verbo & "#" & _
                  IIf(Localidades(i).Conexiones(j).Abierta, "S", "N") & vbCrLf
            Next
            
            ' si hay propiedades definidas por el usuario las guardamos
            If HayPropUsrLoc Then
                For j = 0 To UBound(Localidades(i).PropUsr)
                    s = s & "{" & CStr(Len(Localidades(i).PropUsr(j))) & "}" & Localidades(i).PropUsr(j) & vbCrLf
                Next
                For j = j To UBound(LocProp) - NUM_LOCPROP_PREDEF
                    s = s & "{0}" & vbCrLf
                Next
            End If
                        
            s = s & CStr(Localidades(i).X) & "," & CStr(Localidades(i).Y) & vbCrLf
        Next
        Codifica s, CODIGO_RES
        ReDim B(Len(s) - 1)
        For i = 1 To Len(s)
            B(i - 1) = CByte(Asc(Mid(s, i, 1)))
        Next
    End If
    
    GuardarLocalidadesRes = NuevoRecursoMem(sDLLRes, 1, VS_LOC, B)
    Exit Function
    
Error_GuardarLoc:
    GuardarLocalidadesRes = False
End Function

' guarda la tabla de objetos en un recurso, devuelve False si error
Public Function GuardarObjetosRes(ByVal sDLLRes As String) As Boolean
    Dim B() As Byte
    Dim i As Long, j As Long
    Dim s As String

    On Error GoTo Error_GuardarObj
    s = ""

    ' propiedades de usuario
    If HayPropUsrObj Then
        For i = NUM_OBJPROP_PREDEF To UBound(ObjProp)
            s = s & DELIM_CMP & CStr(ObjProp(i).Tipo) & DELIM_CMP & SEPAR_CMP & _
              DELIM_CMP & ObjProp(i).Nombre & DELIM_CMP & SEPAR_CMP & vbCrLf
        Next
    End If

    ' si está vacia la tabla de objetos
    If Not bHayObj Then
        ReDim B(0)
        B(0) = 0
    Else
        For i = 0 To UBound(Objetos)
            s = s & "*" & Objetos(i).Nombre & vbCrLf
            s = s & "+" & Objetos(i).Adjetivo & vbCrLf
            s = s & "{" & CStr(Len(Objetos(i).DescCorta)) & "}" & Objetos(i).DescCorta & vbCrLf
            s = s & "{" & CStr(Len(Objetos(i).DescLarga)) & "}" & Objetos(i).DescLarga & vbCrLf
            s = s & Objetos(i).Peso & vbCrLf
            s = s & Objetos(i).Tam & vbCrLf
            s = s & Objetos(i).TipoContenedor & vbCrLf
            s = s & Objetos(i).Contenedor & vbCrLf
            s = s & Objetos(i).Propiedades & vbCrLf
            s = s & "{" & CStr(Len(Objetos(i).Grafico)) & "}" & Objetos(i).Grafico & vbCrLf
            s = s & "{" & CStr(Len(Objetos(i).Sonido)) & "}" & Objetos(i).Sonido & vbCrLf
            '''s = s &  "{" & CStr(Len(Objetos(i).Usuario)) & "}" & Objetos(i).Usuario & vbCrLf
            
            ' si hay propiedades definidas por el usuario las guardamos
            If HayPropUsrObj Then
                For j = 0 To UBound(Objetos(i).PropUsr)
                    s = s & "{" & CStr(Len(Objetos(i).PropUsr(j))) & "}" & Objetos(i).PropUsr(j) & vbCrLf
                Next
                For j = j To UBound(ObjProp) - NUM_OBJPROP_PREDEF
                    s = s & "{0}" & vbCrLf
                Next
            End If
        Next
        Codifica s, CODIGO_RES
        ReDim B(Len(s) - 1)
        For i = 1 To Len(s)
            B(i - 1) = CByte(Asc(Mid(s, i, 1)))
        Next
    End If
    
    GuardarObjetosRes = NuevoRecursoMem(sDLLRes, 1, VS_OBJ, B)
    Exit Function

Error_GuardarObj:
    GuardarObjetosRes = False
End Function

' guarda la tabla de PSIs en un recurso, devuelve False si error
Public Function GuardarPSIsRes(ByVal sDLLRes As String) As Boolean
    Dim B() As Byte
    Dim i As Long, j As Long
    Dim s As String

    On Error GoTo Error_GuardarPSIs
    s = ""
    
    ' propiedades de usuario
    If HayPropUsrPSI Then
        For i = NUM_PSIPROP_PREDEF To UBound(PSIProp)
            s = s & DELIM_CMP & CStr(PSIProp(i).Tipo) & DELIM_CMP & SEPAR_CMP & _
              DELIM_CMP & PSIProp(i).Nombre & DELIM_CMP & SEPAR_CMP & vbCrLf
        Next
    End If

    ' si está vacia la tabla de PSIs
    If Not bHayPSI Then
        ReDim B(0)
        B(0) = 0
    Else
        For i = 0 To UBound(PSIs)
            s = s & "*" & PSIs(i).Nombre & vbCrLf
            s = s & "+" & PSIs(i).Adjetivo & vbCrLf
            s = s & "{" & CStr(Len(PSIs(i).DescCorta)) & "}" & PSIs(i).DescCorta & vbCrLf
            s = s & "{" & CStr(Len(PSIs(i).DescLarga)) & "}" & PSIs(i).DescLarga & vbCrLf
            s = s & PSIs(i).Peso & vbCrLf
            s = s & PSIs(i).Tam & vbCrLf
            s = s & PSIs(i).Localidad & vbCrLf
            s = s & PSIs(i).Propiedades & vbCrLf
            s = s & "{" & CStr(Len(PSIs(i).Grafico)) & "}" & PSIs(i).Grafico & vbCrLf
            s = s & "{" & CStr(Len(PSIs(i).Sonido)) & "}" & PSIs(i).Sonido & vbCrLf
            '''s = s & "{" & CStr(Len(PSIs(i).Usuario)) & "}" & PSIs(i).Usuario & vbCrLf
            
            ' si hay propiedades definidas por el usuario las guardamos
            If HayPropUsrPSI Then
                For j = 0 To UBound(PSIs(i).PropUsr)
                    s = s & "{" & CStr(Len(PSIs(i).PropUsr(j))) & "}" & PSIs(i).PropUsr(j) & vbCrLf
                Next
                For j = j To UBound(PSIProp) - NUM_PSIPROP_PREDEF
                    s = s & "{0}" & vbCrLf
                Next
            End If
        Next
        Codifica s, CODIGO_RES
        ReDim B(Len(s) - 1)
        For i = 1 To Len(s)
            B(i - 1) = CByte(Asc(Mid(s, i, 1)))
        Next
    End If
    
    GuardarPSIsRes = NuevoRecursoMem(sDLLRes, 1, VS_PSI, B)
    Exit Function
    
Error_GuardarPSIs:
    GuardarPSIsRes = False
End Function

' guarda los módulos en un recurso, devuelve False si error
Public Function GuardarModulosRes(ByVal sDLLRes As String) As Boolean
    Dim B() As Byte
    Dim iFich As Integer
    Dim i As Long, j As Long
    Dim s As String, sFich As String, sLin As String

    On Error GoTo Error_GuardarMod2

    If Not bHayModulos Then
        ReDim B(0)
        B(0) = 0
        GuardarModulosRes = NuevoRecursoMem(sDLLRes, 1, VS_CABMOD, B)
        Exit Function
    End If
    
    ' cabecera
    s = ""
    For i = 0 To UBound(ListaMod)
        s = s & """" & ListaMod(i).Nombre & """;""" & ListaMod(i).Fichero & """;" & vbCrLf
    Next
    Codifica s, CODIGO_RES
    ReDim B(Len(s) - 1)
    For i = 1 To Len(s)
        B(i - 1) = CByte(Asc(Mid(s, i, 1)))
    Next
    If Not NuevoRecursoMem(sDLLRes, 1, VS_CABMOD, B) Then
        GuardarModulosRes = False
        Exit Function
    End If
    
    ' módulos
    For i = 0 To UBound(ListaMod)
        sFich = ListaMod(i).Fichero
        iFich = FreeFile
        Open sFich For Input As #iFich
        On Error GoTo Error_GuardarMod1
        
        s = ""
        Do While Not EOF(iFich)
            Line Input #iFich, sLin
            
            ' reformatea la línea y le quita los comentarios
            sLin = LimpiaLinea(sLin)
            sLin = QuitaComentLin(sLin)
            If sLin <> "" Then
                s = s & sLin & vbCrLf
            End If
        Loop
        
        Close #iFich
        On Error GoTo Error_GuardarMod2
        Codifica s, CODIGO_RES
        ReDim B(Len(s) - 1)
        For j = 1 To Len(s)
            B(j - 1) = CByte(Asc(Mid(s, j, 1)))
        Next
        If Not NuevoRecursoMem(sDLLRes, i, VS_MOD, B) Then
            GuardarModulosRes = False
            Exit Function
        End If
    Next
    
    GuardarModulosRes = True
    Exit Function

Error_GuardarMod1:
    Close #iFich
Error_GuardarMod2:
    GuardarModulosRes = False
End Function

' separa una línea (hasta vbCrLf) de una cadena, devuelve la línea y la cadena
' original sin la línea
Private Function SeparaLin(ByRef s As String) As String
    Dim sLin As String
    Dim i As Long, j As Long
    
    i = InStr(s, vbCrLf)
    If i > 1 Then
        sLin = Left(s, i - 1)
        j = Len(s) - Len(sLin) - Len(vbCrLf)
        If j > 0 Then
            s = Right(s, j)
        Else
            s = ""
        End If
    Else
        '''sLin = s
        '''s = ""
        sLin = ""
        If Len(s) > Len(vbCrLf) Then
            s = Right(s, Len(s) - Len(vbCrLf))
        Else
            s = ""
        End If
    End If

    SeparaLin = sLin

End Function

' función genérica para leer las descripciones cortas o largas de los objetos,
' localidades, etc...
Private Function LeeDescripcionRes(ByRef s As String) As String
    Dim c As String, c1 As String, sDesc As String
    Dim i As Long, lCar As Long
    
    sDesc = ""
    
    c = SeparaLin(s)
    i = InStr(c, "}")
    If i = 0 Then
        LeeDescripcionRes = ""
        Exit Function
    End If
    
    c1 = Mid(c, 2, i - 2)
    lCar = CLng(c1) - (Len(c) - i)
    sDesc = Mid(c, i + 1)

    Do While lCar > 0
        c = SeparaLin(s)
        sDesc = sDesc & vbCrLf & c
        lCar = lCar - Len(c) - 2
    Loop

    LeeDescripcionRes = sDesc

End Function

' lee las conexiones de una localidad desde un recurso, devuelve False si error
Private Function LeeConexionesRes(ByRef s As String, Conex() As Conexion) As Boolean
    Dim c As String, sLoc As String, sVerbo As String, sAbierta As String
    Dim i As Long, j As Long, k As Long, n As Long

    On Error GoTo Error_LeeConex

    c = SeparaLin(s)
    n = CLng(Mid(c, 2))
    
    ReDim Conex(n)
    
    For i = 0 To n
        c = SeparaLin(s)
                        
        ' separa los campos de la conexión
        ' puede tener 2 campos: LOCALIDAD#VERBO
        ' o 3 campos: LOCALIDAD#VERBO#ABIERTA
        j = InStr(c, "#")
        If j > 0 Then
            sLoc = Left(c, j - 1)
            
            k = InStr(j + 1, c, "#")
            If k = 0 Then
                sVerbo = Mid(c, j + 1)
                sAbierta = "S"
            Else
                sVerbo = Mid(c, j + 1, k - j - 1)
                sAbierta = Mid(c, k + 1)
            End If
            Conex(i).Localidad = sLoc
            Conex(i).Verbo = sVerbo
            Conex(i).Abierta = IIf(sAbierta = "S", True, False)
        End If
    Next
    
    LeeConexionesRes = True
    Exit Function
    
Error_LeeConex:
    LeeConexionesRes = False
    Exit Function
End Function

' carga el vocabulario desde un recurso, devuelve False si error
Public Function CargarVocabularioRes(ByVal sDLLRes As String) As Boolean
    Dim B() As Byte
    Dim n As Long
    Dim c As String, sLin As String

    On Error GoTo Error_CargarVoc

    B = CargaRecurso(sDLLRes, 1, VS_VOC)
    If UBound(B) = 0 Then
        CargarVocabularioRes = True
        Exit Function
    End If
    
    CopiaByteString B, c
    Codifica c, CODIGO_RES

    n = 0
    ReDim Vocabulario(0)
    bHayVoc = False

    Do While Len(c) > 0
        ReDim Preserve Vocabulario(n)
        
        sLin = SeparaLin(c)
        Vocabulario(n).Palabra = Mid(sLin, 2)
        sLin = SeparaLin(c)
        Vocabulario(n).Tipo = CInt(Mid(sLin, 3))
        sLin = SeparaLin(c)
        Vocabulario(n).Sinonimo = Mid(sLin, 3)
         
        n = n + 1
    Loop

    If n > 0 Then
        bHayVoc = True
    End If
    CargarVocabularioRes = True
    Exit Function

Error_CargarVoc:
    ReDim Vocabulario(0)
    bHayVoc = False
    CargarVocabularioRes = False
End Function

' carga la tabla de localidades desde un recurso, devuelve False si error
Public Function CargarLocalidadesRes(ByVal sDLLRes As String) As Boolean
    Dim Conex() As Conexion
    Dim B() As Byte
    Dim i As Long, j As Long, n As Long
    Dim c As String, sLin As String, sTipo As String, sNombre As String

    On Error GoTo Error_CargarLoc
    PropiedadesLocalidades

    B = CargaRecurso(sDLLRes, 1, VS_LOC)
    If UBound(B) = 0 Then
        CargarLocalidadesRes = True
        Exit Function
    End If
    
    CopiaByteString B, c
    Codifica c, CODIGO_RES
    
    ' propiedades de usuario
    sLin = SeparaLin(c)
    If Left(sLin, 1) <> "*" Then
        ' si no hay propiedades predefinidas cogemos
        ' como índice -1 para que luego al incrementarse
        ' empiece en 0, en otro caso cogemos el índice
        ' del último elemento de la lista
        If LocProp(0).Nombre = "" Then
            n = -1
        Else
            n = UBound(LocProp)
        End If
        
        Do While True
            n = n + 1
            ReDim Preserve LocProp(n)
            
            sTipo = SeparaCampo(sLin, 1, DELIM_CMP, SEPAR_CMP)
            sNombre = SeparaCampo(sLin, 2, DELIM_CMP, SEPAR_CMP)
            LocProp(n).Tipo = CInt(sTipo)
            LocProp(n).Nombre = UCase(sNombre)
        
            sLin = SeparaLin(c)
            If Left(sLin, 1) = "*" Then
                Exit Do
            End If
        Loop
    End If
    
    n = 0
    ReDim Localidades(0)
    bHayLoc = False
    Do While Len(c) > 0
        ReDim Preserve Localidades(n)
        
        Localidades(n).Nombre = Mid(sLin, 2)
        Localidades(n).DescCorta = LeeDescripcionRes(c)
        Localidades(n).DescLarga = LeeDescripcionRes(c)
        sLin = SeparaLin(c)
        Localidades(n).Iluminada = IIf(sLin = PROP_ACTIV, True, False)
        sLin = SeparaLin(c)
        Localidades(n).Exterior = IIf(sLin = PROP_ACTIV, True, False)
        Localidades(n).Grafico = LeeDescripcionRes(c)
        Localidades(n).Sonido = LeeDescripcionRes(c)
        '''Localidades(n).Usuario = LeeDescripcionRes(c)
        
        If Not LeeConexionesRes(c, Conex) Then
            GoTo Error_CargarLoc
        End If
        j = UBound(Conex)
        ReDim Localidades(n).Conexiones(j)
        For i = 0 To j
            Localidades(n).Conexiones(i).Localidad = Conex(i).Localidad
            Localidades(n).Conexiones(i).Verbo = Conex(i).Verbo
            Localidades(n).Conexiones(i).Abierta = Conex(i).Abierta
        Next
                
        ' si hay propiedades definidas por el usuario las cargamos
        If HayPropUsrLoc Then
            ReDim Localidades(n).PropUsr(UBound(LocProp) - NUM_LOCPROP_PREDEF)
            For i = 0 To UBound(Localidades(n).PropUsr)
                Localidades(n).PropUsr(i) = LeeDescripcionRes(c)
            Next
        Else
            ReDim Localidades(n).PropUsr(0)
        End If
        
        sLin = SeparaLin(c)
        i = InStr(sLin, ",")
        If i > 0 Then
            Localidades(n).X = CLng(Left(sLin, i - 1))
            Localidades(n).Y = CLng(Mid(sLin, i + 1))
        End If
        
        n = n + 1
        If Len(c) > 0 Then
            sLin = SeparaLin(c)
        End If
    Loop

    If n > 0 Then
        bHayLoc = True
    End If
    CargarLocalidadesRes = True
    Exit Function

Error_CargarLoc:
    ReDim Localidades(0)
    bHayLoc = False
    CargarLocalidadesRes = False
End Function

' carga la tabla de objetos desde un recurso, devuelve False si erro
Public Function CargarObjetosRes(ByVal sDLLRes As String) As Boolean
    Dim B() As Byte
    Dim i As Long, n As Long
    Dim c As String, sLin As String, sTipo As String, sNombre As String

    On Error GoTo Error_CargarObj
    PropiedadesObjetos
    
    B = CargaRecurso(sDLLRes, 1, VS_OBJ)
    If UBound(B) = 0 Then
        CargarObjetosRes = True
        Exit Function
    End If
    
    CopiaByteString B, c
    Codifica c, CODIGO_RES
    
    ' propiedades de usuario
    sLin = SeparaLin(c)
    If Left(sLin, 1) <> "*" Then
        ' si no hay propiedades predefinidas cogemos
        ' como índice -1 para que luego al incrementarse
        ' empiece en 0, en otro caso cogemos el índice
        ' del último elemento de la lista
        If ObjProp(0).Nombre = "" Then
            n = -1
        Else
            n = UBound(ObjProp)
        End If

        Do While True
            n = n + 1
            ReDim Preserve ObjProp(n)
            
            sTipo = SeparaCampo(sLin, 1, DELIM_CMP, SEPAR_CMP)
            sNombre = SeparaCampo(sLin, 2, DELIM_CMP, SEPAR_CMP)
            ObjProp(n).Tipo = CInt(sTipo)
            ObjProp(n).Nombre = UCase(sNombre)
        
            sLin = SeparaLin(c)
            If Left(sLin, 1) = "*" Then
                Exit Do
            End If
        Loop
    End If
   
    n = 0
    ReDim Objetos(0)
    bHayObj = False
    Do While Len(c) > 0
        ReDim Preserve Objetos(n)
        
        Objetos(n).Nombre = Mid(sLin, 2)
        sLin = SeparaLin(c)
        Objetos(n).Adjetivo = Mid(sLin, 2)
        Objetos(n).DescCorta = LeeDescripcionRes(c)
        Objetos(n).DescLarga = LeeDescripcionRes(c)
        sLin = SeparaLin(c)
        Objetos(n).Peso = CLng(sLin)
        sLin = SeparaLin(c)
        Objetos(n).Tam = CLng(sLin)
        sLin = SeparaLin(c)
        Objetos(n).TipoContenedor = CInt(sLin)
        sLin = SeparaLin(c)
        Objetos(n).Contenedor = sLin
        sLin = SeparaLin(c)
        Objetos(n).Propiedades = sLin
        Objetos(n).Grafico = LeeDescripcionRes(c)
        Objetos(n).Sonido = LeeDescripcionRes(c)
        '''Objetos(n).Usuario = LeeDescripcionRes(c)
        
        ' si hay propiedades definidas por el usuario las cargamos
        If HayPropUsrObj Then
            ReDim Objetos(n).PropUsr(UBound(ObjProp) - NUM_OBJPROP_PREDEF)
            For i = 0 To UBound(Objetos(n).PropUsr)
                Objetos(n).PropUsr(i) = LeeDescripcionRes(c)
            Next
        Else
            ReDim Objetos(n).PropUsr(0)
        End If
                
        n = n + 1
        If Len(c) > 0 Then
            sLin = SeparaLin(c)
        End If
    Loop

    If n > 0 Then
        bHayObj = True
    End If
    
    CargarObjetosRes = True
    Exit Function

Error_CargarObj:
    ReDim Objetos(0)
    bHayObj = False
    CargarObjetosRes = False
End Function

' carga la tabla de PSIs desde un recurso, devuelve False si error
Public Function CargarPSIsRes(ByVal sDLLRes As String) As Boolean
    Dim B() As Byte
    Dim i As Long, n As Long
    Dim c As String, sLin As String, sTipo As String, sNombre As String

    On Error GoTo Error_CargarPSIs
    PropiedadesPSIs
    
    B = CargaRecurso(sDLLRes, 1, VS_PSI)
    If UBound(B) = 0 Then
        CargarPSIsRes = True
        Exit Function
    End If
    
    CopiaByteString B, c
    Codifica c, CODIGO_RES
    
    ' propiedades de usuario
    sLin = SeparaLin(c)
    If Left(sLin, 1) <> "*" Then
        ' si no hay propiedades predefinidas cogemos
        ' como índice -1 para que luego al incrementarse
        ' empiece en 0, en otro caso cogemos el índice
        ' del último elemento de la lista
        If PSIProp(0).Nombre = "" Then
            n = -1
        Else
            n = UBound(PSIProp)
        End If

        Do While True
            n = n + 1
            ReDim Preserve PSIProp(n)
            
            sTipo = SeparaCampo(sLin, 1, DELIM_CMP, SEPAR_CMP)
            sNombre = SeparaCampo(sLin, 2, DELIM_CMP, SEPAR_CMP)
            PSIProp(n).Tipo = CInt(sTipo)
            PSIProp(n).Nombre = UCase(sNombre)
        
            sLin = SeparaLin(c)
            If Left(sLin, 1) = "*" Then
                Exit Do
            End If
        Loop
    End If

    n = 0
    ReDim PSIs(0)
    bHayPSI = False
    Do While Len(c) > 0
        ReDim Preserve PSIs(n)
        
        PSIs(n).Nombre = Mid(sLin, 2)
        sLin = SeparaLin(c)
        PSIs(n).Adjetivo = Mid(sLin, 2)
        PSIs(n).DescCorta = LeeDescripcionRes(c)
        PSIs(n).DescLarga = LeeDescripcionRes(c)
        sLin = SeparaLin(c)
        PSIs(n).Peso = CLng(sLin)
        sLin = SeparaLin(c)
        PSIs(n).Tam = CLng(sLin)
        sLin = SeparaLin(c)
        PSIs(n).Localidad = sLin
        sLin = SeparaLin(c)
        PSIs(n).Propiedades = sLin
        PSIs(n).Grafico = LeeDescripcionRes(c)
        PSIs(n).Sonido = LeeDescripcionRes(c)
        '''PSIs(n).Usuario = LeeDescripcionRes(c)
        
        ' si hay propiedades definidas por el usuario las cargamos
        If HayPropUsrPSI Then
            ReDim PSIs(n).PropUsr(UBound(PSIProp) - NUM_PSIPROP_PREDEF)
            For i = 0 To UBound(PSIs(n).PropUsr)
                PSIs(n).PropUsr(i) = LeeDescripcionRes(c)
            Next
        Else
            ReDim PSIs(n).PropUsr(0)
        End If

        n = n + 1
        If Len(c) > 0 Then
            sLin = SeparaLin(c)
        End If
    Loop

    If n > 0 Then
        bHayPSI = True
    End If
    CargarPSIsRes = True
    Exit Function

Error_CargarPSIs:
    ReDim PSIs(0)
    bHayPSI = False
    CargarPSIsRes = False
End Function

' carga los módulos desde un recurso, devuelve False si error
Public Function CargarModulosRes(ByVal sDLLRes As String) As Boolean
    Dim B() As Byte
    Dim i As Long
    Dim c As String, sNombre As String, sFichero As String, _
      sLin As String, sScript As String

    On Error GoTo Error_CargarMod

    ' cabecera
    B = CargaRecurso(sDLLRes, 1, VS_CABMOD)
    If UBound(B) = 0 Then
        GoTo Error_CargarMod
    End If
    
    CopiaByteString B, c
    Codifica c, CODIGO_RES

    i = 0
    ReDim ListaMod(0)
    Do While Len(c) > 0
        sLin = SeparaLin(c)
        ' si encontramos un línea en blanco es que no hay módulos
        If sLin = "" Then
            ReDim ListaMod(0)
            bHayModulos = False
            CargarModulosRes = True
            Exit Function
        Else
            ReDim Preserve ListaMod(i)
            sNombre = SeparaCampo(sLin, 1, """", ";")
            sFichero = SeparaCampo(sLin, 2, """", ";")
            ListaMod(i).Nombre = sNombre
            ListaMod(i).Fichero = sFichero
            i = i + 1
        End If
    Loop

    ' si hay módulos los cargamos
    If i > 0 Then
        ReDim Lineas(0)
        ReDim Procedimientos(0)
        bHayProc = False
        For i = 0 To UBound(ListaMod)
            B = CargaRecurso(sDLLRes, i, VS_MOD)
            If B(0) = 0 Then
                GoTo Error_CargarMod
            End If
            CopiaByteString B, c
            Codifica c, CODIGO_RES
            sScript = c
            If SeparaLineas(ListaMod(i).Nombre, sScript) <> "" Then
                GoTo Error_CargarMod
            End If
        Next
        bHayModulos = True
    End If
    
    CargarModulosRes = True
    Exit Function

Error_CargarMod:
    ReDim ListaMod(0)
    bHayModulos = False
    CargarModulosRes = False
End Function

' compila una lista de recursos a formato BLORB
' devuelve False si error
Public Function CompilaRecursosBlorb(ByVal sFichRes As String, Recursos() As RecursoBlorb) As Boolean
    Dim FichRes As New Win32File, FichDatos As New Win32File
    Dim B() As Byte
    Dim Inicio() As Long
    Dim i As Long, lNumRes As Long, lLongitud As Long, lInicio As Long, lTamRecurso As Long
    Dim sTipo As String, sSubTipo As String, sExt As String
    
    Screen.MousePointer = vbHourglass
    
    On Error GoTo Error_Compila3
    
    lNumRes = UBound(Recursos) + 1
    FichRes.NewFile sFichRes

    On Error GoTo Error_Compila2

    ' --- CABECERA ---
    StringToBytes B, BLORB_FORM
    FichRes.WriteBytes B
    
    ' tamaño del fichero - 8 (lo inicializamos con un valor y al final lo actualizaremos)
    LongToBytes2 B, 0
    FichRes.WriteBytes B
    
    StringToBytes B, BLORB_ID
    FichRes.WriteBytes B
    
    ' --- INDICE ---
    StringToBytes B, BLORB_IND
    FichRes.WriteBytes B
    ' longitud (4 + (nº recursos * 12))
    lLongitud = 4 + (lNumRes * 12)
    LongToBytes2 B, lLongitud
    FichRes.WriteBytes B
    ' nº de recursos
    LongToBytes2 B, lNumRes
    FichRes.WriteBytes B
    ' datos de índice de cada recurso
    For i = 0 To UBound(Recursos)
        ' tipo
        Select Case Recursos(i).Tipo
            Case VS_IMAGEN
                sTipo = BLORB_IMAGEN
            Case VS_SONIDO
                sTipo = BLORB_SONIDO
        End Select
        StringToBytes B, sTipo
        FichRes.WriteBytes B
        
        ' número de recurso
        LongToBytes2 B, Recursos(i).id
        FichRes.WriteBytes B
        
        ' inicio (lo inicializamos con un valor, luego en una 2ª pasada lo actualizaremos)
        LongToBytes2 B, 0
        FichRes.WriteBytes B
    Next
    
    ' --- RECURSOS ---
    ReDim Inicio(UBound(Recursos))
    For i = 0 To UBound(Recursos)
        ' guardamos la posicion de inicio del recurso
        Inicio(i) = FichRes.Size
               
        ' tipo
        sExt = UCase(ExtensionFich(Recursos(i).Fich))
        Select Case sExt
            Case "JPG", "JPEG"
                sTipo = BLORB_JPEG
            Case "PNG"
                sTipo = BLORB_PNG
        End Select
        StringToBytes B, sTipo
        FichRes.WriteBytes B
               
        ' leemos el fichero con los datos del recurso y lo guardamos
        FichDatos.OpenFile Recursos(i).Fich, True
        
        ' longitud
        lTamRecurso = FichDatos.Size
        LongToBytes2 B, lTamRecurso
        FichRes.WriteBytes B
        
        ' datos
        On Error GoTo Error_Compila1
        B = FichDatos.ReadBytes(lTamRecurso)
        FichDatos.CloseFile
        On Error GoTo Error_Compila2
        FichRes.WriteBytes B
        ' si el tamaño del recurso es impar lo ajustamos
        If (lTamRecurso And 1) = 1 Then
            ReDim B(0)
            B(0) = 0
            FichRes.WriteBytes B
        End If
    Next
    
    ' actualizamos las posiciones de inicio de los recursos
    For i = 0 To UBound(Inicio)
        ' desplazamiento, desde el inicio del fichero, del campo 'inicio' del recurso 'i'
        lInicio = 24 + ((i * 12) + 8)
    
        FichRes.SeekAbsolute lInicio
        LongToBytes2 B, Inicio(i)
        FichRes.WriteBytes B
    Next

    ' actualizamos el tamaño del fichero
    lLongitud = FichRes.Size - 8
    FichRes.SeekAbsolute 4
    LongToBytes2 B, lLongitud
    FichRes.WriteBytes B

    FichRes.CloseFile
    Screen.MousePointer = vbDefault
    CompilaRecursosBlorb = True
    Exit Function

Error_Compila1:
    FichDatos.CloseFile
Error_Compila2:
    FichRes.CloseFile
Error_Compila3:
    Screen.MousePointer = vbDefault
    CompilaRecursosBlorb = False
End Function

' copia una matriz de bytes en una cadena
Private Sub CopiaByteString(ByRef B() As Byte, ByRef s As String)
    Dim lTam As Long
    
    lTam = UBound(B) + 1
    s = Space(lTam)

    CopyMemory ByVal s, B(0), lTam

End Sub