VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "ClsDataPack"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
'--------------------------------------
'Autor:     Leandro Ascierto
'Web:       www.leandroascierto.com.ar
'Date       09/05/2011
'--------------------------------------

Private Const FILE_SIGNATURE As String = &H5044

Private Type FileHeather
    Signature   As Integer
    ItemCount   As Long
    DataPoint   As Long
End Type

Private Type DataItem
    sName As String * 255
    DataPoint As Long
    DataSize As Long
End Type

Private FH          As FileHeather
Private DI()        As DataItem
Private FFile       As Integer
Private cKeysIndex  As Collection
Private cKeysName   As Collection
Private m_Path      As String

Public Property Let Path(ByVal sPath As String)
    Dim i As Long
    Dim sName As String
    
    FFile = FreeFile
    Set cKeysIndex = New Collection
    Set cKeysName = New Collection
    
    If Len(Dir(sPath)) Then
        Open sPath For Binary As #FFile
        Get #FFile, 1, FH
        If FH.Signature <> FILE_SIGNATURE Then
            Close #FFile
            FFile = 0
            Err.Raise 4
        Else
            If FH.ItemCount > 0 Then
                ReDim DI(0 To FH.ItemCount - 1)
                Get #FFile, FH.DataPoint, DI
                For i = 0 To UBound(DI)
                    sName = StripNull(DI(i).sName)
                    If Len(sName) Then
                        cKeysName.Add sName, sName
                        cKeysIndex.Add i, sName
                    End If
                Next
            End If
            
        End If
    Else
        Open sPath For Binary As #FFile
        With FH
            .Signature = FILE_SIGNATURE
            .DataPoint = Len(FH) + 1
            .ItemCount = 0
        End With
        ReDim DI(0)
        Put #FFile, 1, FH
        Put #FFile, FH.DataPoint, DI
    End If
    m_Path = sPath
End Property

Public Property Get Path() As String
    Path = m_Path
End Property

Public Property Get FileSize() As Long
    FileSize = LOF(FFile)
End Property

Public Function Add(ByVal vKey As String, ByRef ArrBytes() As Byte) As Boolean
    On Error GoTo ErrHandler
    
    cKeysName.Add vKey, vKey
    cKeysIndex.Add FH.ItemCount, vKey
    
    ReDim Preserve DI(FH.ItemCount)
    
    With DI(FH.ItemCount)
        .DataPoint = FH.DataPoint
        .DataSize = UBound(ArrBytes)
        .sName = vKey & String(255 - Len(vKey), 0)
    End With
    
    With FH
        .ItemCount = .ItemCount + 1
        Put #FFile, .DataPoint, ArrBytes()
        .DataPoint = .DataPoint + UBound(ArrBytes) + 1
        Put #FFile, .DataPoint, DI()
    End With
    
    Put #FFile, 1, FH
    
    Add = True
ErrHandler:
    
End Function

Public Function KeyExist(vKey As Variant) As Boolean
    Dim i As Long
    For i = 1 To cKeysName.Count
        If StrComp(cKeysName.Item(i), vKey, vbTextCompare) = 0 Then
            KeyExist = True: Exit For
        End If
    Next
End Function

Private Function StripNull(ByVal sName As String) As String
    StripNull = Left$(sName, InStr(sName, Chr$(0)) - 1)
End Function

Public Function GetData(ByVal vKey As Variant, ByRef ArrBytes() As Byte) As Boolean
    On Error GoTo ErrHandler
    Dim Index As Long
    Index = cKeysIndex(vKey)
    ReDim ArrBytes(DI(Index).DataSize)
    Get #FFile, DI(Index).DataPoint, ArrBytes
    GetData = True
ErrHandler:
    
End Function

Public Property Get Items() As Collection
    Set Items = cKeysName
End Property

Public Function Remove(ByVal vKey As Variant) As Boolean
    On Error GoTo ErrHandler
    Dim Index As Long
    Index = cKeysIndex(vKey)
    cKeysIndex.Remove vKey
    cKeysName.Remove vKey
    DI(Index).sName = String(255, 0)
    Put #FFile, 1, FH
    Put #FFile, FH.DataPoint, DI()
    Remove = True
ErrHandler:
    
End Function

Public Function Compact() As Boolean
On Error GoTo ErrHandler
    Dim FF As Integer
    Dim i As Long
    Dim Index As Long
    Dim ArrBytes() As Byte
    Dim tDataItem() As DataItem
     
     
    If cKeysName.Count = 0 Then Exit Function
     
    FF = FreeFile
    
    Open m_Path & ".bak" For Binary As #FF
    
    With FH
        .Signature = FILE_SIGNATURE
        .ItemCount = cKeysName.Count
        .DataPoint = Len(FH) + 1
    End With
    
    ReDim tDataItem(FH.ItemCount - 1)
    
    For i = 1 To cKeysName.Count

        Me.GetData cKeysName(i), ArrBytes
        With tDataItem(i - 1)
            .DataPoint = FH.DataPoint
            .DataSize = UBound(ArrBytes)
            .sName = cKeysName(i) & String(255 - Len(cKeysName(i)), 0)
        End With
        Put #FF, FH.DataPoint, ArrBytes()
        FH.DataPoint = FH.DataPoint + UBound(ArrBytes) + 1
    
    Next

    Put #FF, 1, FH
    Put #FF, FH.DataPoint, tDataItem()

    Close #FF
    Close #FFile
    
    Kill m_Path
    Name m_Path & ".bak" As m_Path
    Me.Path = m_Path
    Compact = True
ErrHandler:

End Function

Private Sub Class_Terminate()
    If FFile Then Close #FFile
End Sub
