VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "cCacheMD"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Objeto responsável por carregar o Meta-Dado do cache
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

' Guarda o nome do objeto
Private Const ST_MY_NAME As String = "cCacheMD"

' Seta o tamanho do bloco de dados
Private Const LN_BLOCK_SIZE As Long = 1024

' Tamanhos interno do pacote
Private Const IT_HEAD_FILENAME As Integer = 259
Private Const IT_HEAD_METADATA As Integer = 757
Private Const IT_TAIL_METADATA As Integer = 1020

' Tipo Início de meta-dado
Private Type MD_HEAD
    lnSize As Long
    lnNext As Long
    stFileName As String * IT_HEAD_FILENAME
    stData As String * IT_HEAD_METADATA
End Type

' Tipo continuação de meta-dado
Private Type MD_TAIL
    lnNext As Long
    stData As String * IT_TAIL_METADATA
End Type

' Guarda o endereço do arquivo cache meta-dado
Private st_FileAddress As String

' Guarda o handle do arquivo de cache meta-dado
Private it_File As Integer

' Guarda se tem algum arquivo em aberto
Private bl_FileOpen As Boolean


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Propriedades para o arquivo
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Property Get FileAddress() As String
    
    ' Retorna
    FileAddress = st_FileAddress
End Property

Public Property Let FileAddress(stInput As String)
    On Error GoTo ErrTreat:
    
    ' Verifica se já tem algum arquivo em aberto
    If bl_FileOpen Then
        
        ' Fecha o arquivo
        Close it_File
    End If
    
    ' Guarda novo arquivo
    st_FileAddress = stInput
    
    ' Seta um novo handle
    it_File = FreeFile
    
    ' Tenta abrir o arquivo
    Open st_FileAddress For Binary Access Read Write As it_File
    
    ' Seta que possui arquivo aberto
    bl_FileOpen = True
    
    Exit Property
ErrTreat:
    
    ' Seta que não possui arquivo em aberto
    bl_FileOpen = False
    
    LogErrMessage Err.Description, ST_MY_NAME + ".FileAddress [let]", stInput
End Property


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Verifica se o endereço pertence ao arquivo
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function IsFile(lnAddress As Long, stFileName As String) As Boolean
    On Error GoTo ErrTreat:
    Dim lnFilePos As Long
    Dim vtBuff() As Byte
    Dim mdHead As MD_HEAD
    
    ' Inicia retorno
    IsFile = False
    
    ' Verifica se há arquivo aberto
    If bl_FileOpen Then
        
        ' Calcula a posição no arquivo
        lnFilePos = ((lnAddress - 1) * LN_BLOCK_SIZE) + 1
        
        ' Verifica se o arquivo possui tal posição
        If (LOF(it_File) >= (lnFilePos + LN_BLOCK_SIZE - 1)) Then
            
            ' Lê dados
            vtBuff = ReadFile(lnFilePos, LN_BLOCK_SIZE)
            
            ' Copia para estrutura de dados
            CopyMemory mdHead, vtBuff(0), LN_BLOCK_SIZE
            
            ' Verifica se o nome do arquivo bate com o passado
            If (GetStrHash(stFileName, IT_HEAD_FILENAME) = mdHead.stFileName) Then
                
                ' Retona que sim
                IsFile = True
            End If
        End If
    End If
    
    ' Libera buffer
    Erase vtBuff()
    
    Exit Function
ErrTreat:
    LogErrMessage Err.Description, ST_MY_NAME + ".IsFile", lnAddress
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Lê do cache
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function GetData(lnAddress As Long) As String
    On Error GoTo ErrTreat:
    Dim lnFilePos As Long, lnNextAddress As Long
    Dim vtBuff() As Byte
    Dim stAux As String
    Dim mdHead As MD_HEAD, mdTail As MD_TAIL
    
    ' Verifica se há arquivo aberto
    If bl_FileOpen Then
            
        ' Calcula a posição no arquivo
        lnFilePos = ((lnAddress - 1) * LN_BLOCK_SIZE) + 1
        
        ' Verifica se o arquivo possui tal posição
        If (LOF(it_File) >= (lnFilePos + LN_BLOCK_SIZE - 1)) Then
            
            ' Lê dados
            vtBuff = ReadFile(lnFilePos, LN_BLOCK_SIZE)
            
            ' Copia para estrutura de dados
            CopyMemory mdHead, vtBuff(0), LN_BLOCK_SIZE
                
            ' Seta retorno
            stAux = mdHead.stData
            
            ' Seta próximo endereço
            lnNextAddress = mdHead.lnNext
            
            ' Enquanto tiver endereços para ler
            While (lnNextAddress > LN_NO_ADDRESS)
                
                ' Calcula a posição no arquivo
                lnFilePos = ((lnNextAddress - 1) * LN_BLOCK_SIZE) + 1
                
                ' Verifica se o arquivo possui tal posição
                If (LOF(it_File) >= (lnFilePos + LN_BLOCK_SIZE - 1)) Then
                    
                    ' Lê dados
                    vtBuff = ReadFile(lnFilePos, LN_BLOCK_SIZE)
                    
                    ' Copia para estrutura de dados
                    CopyMemory mdTail, vtBuff(0), LN_BLOCK_SIZE
                    
                    ' Concatena com o retorno
                    stAux = stAux + mdTail.stData
                    
                    ' Seta próximo endereço
                    lnNextAddress = mdTail.lnNext
                
                Else
                    
                    ' Seta que não há mais retornos
                    lnNextAddress = LN_NO_ADDRESS
                End If
            Wend
            
            ' Verifica se o tamanho lido é maior que o tamanho do arquivo
            If (Len(stAux) > mdHead.lnSize) Then
                
                ' Retira restante
                stAux = Mid(stAux, 1, mdHead.lnSize)
            End If
            
            ' Verifica se o tamanho lido é idêntido que o tamanho do arquivo
            If (Len(stAux) = mdHead.lnSize) Then
            
                ' Retorna
                GetData = stAux
            Else
                
                ' Retorna nada
                GetData = ST_INVALID_VALUE
            End If
        Else
            
            ' Retorna nada
            GetData = ST_INVALID_VALUE
        End If
    Else
        
        ' Retorna nada
        GetData = ST_INVALID_VALUE
    End If
    
    ' Libera buffer
    Erase vtBuff()
    
    Exit Function
ErrTreat:
    LogErrMessage Err.Description, ST_MY_NAME + ".GetData", lnAddress
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Grava no cache (retorna o primeiro endereço usado)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function SetData(vtlnAddress() As Long, stFileName As String, stData As String) As Long
    On Error GoTo ErrTreat:
    Dim lnFilePos As Long
    Dim lnAddress As Long, lnNextAddress As Long
    Dim vtBuff() As Byte, stAux As String
    Dim mdHead As MD_HEAD, mdTail As MD_TAIL
    
    ' Verifica se há arquivo aberto
    If bl_FileOpen Then
        
        ' Copia entrada
        stAux = stData
        
        ' Se há dados para gravar
        If (Len(stAux) > 0) Then
    
            ' Inicia buff
            ReDim vtBuff(LN_BLOCK_SIZE - 1)
            
            ' Pega o próximo endereço de arquivo
            lnAddress = GetNextFreeAddress(vtlnAddress())
            
            ' Inicia retorno
            SetData = lnAddress
            
            ' Seta o nome do arquivo
            mdHead.stFileName = GetStrHash(stFileName, IT_HEAD_FILENAME)
            
            ' Seta o tamanho do arquivo
            mdHead.lnSize = Len(stAux)
            
            ' Verifica se o arquivo é maior que o pacote do header
            If (Len(stAux) > IT_HEAD_METADATA) Then
                
                ' Serapa em pacote menor
                mdHead.stData = Mid(stAux, 1, IT_HEAD_METADATA)
                stAux = Mid(stAux, IT_HEAD_METADATA + 1)
                
                ' Pega o próximo endereço do próximo pacote
                lnNextAddress = GetNextFreeAddress(vtlnAddress, 1)
                
                ' Seta endereço
                mdHead.lnNext = lnNextAddress
            Else
                
                ' Seta como sendo o pacote inteiro
                mdHead.stData = stAux
                stAux = vbNullString
                
                ' Seta que não há próximo pacote
                mdHead.lnNext = LN_NO_ADDRESS
                lnNextAddress = LN_NO_ADDRESS
            End If
            
            ' Transfere para o buff
            CopyMemory vtBuff(0), mdHead, LN_BLOCK_SIZE
            
            ' Calcula a posição no arquivo
            lnFilePos = ((lnAddress - 1) * LN_BLOCK_SIZE) + 1
            
            ' Grava no arquivo
            WriteFile lnFilePos, vtBuff()
            
            ' Enquanto houver mais dados para serem gravados
            While (lnNextAddress <> LN_NO_ADDRESS)
                
                ' Guarda endereço
                lnAddress = lnNextAddress
                
                ' Verifica se o arquivo é maior que o pacote do header
                If (Len(stAux) > IT_TAIL_METADATA) Then
                    
                    ' Serapa em pacote menor
                    mdTail.stData = Mid(stAux, 1, IT_TAIL_METADATA)
                    stAux = Mid(stAux, IT_TAIL_METADATA + 1)
                    
                    ' Pega o próximo endereço do próximo pacote
                    lnNextAddress = GetNextFreeAddress(vtlnAddress, 1)
                    
                    ' Seta endereço
                    mdTail.lnNext = lnNextAddress
                Else
                    
                    ' Seta como sendo o pacote inteiro
                    mdTail.stData = stAux
                    stAux = vbNullString
                    
                    ' Seta que não há próximo pacote
                    mdTail.lnNext = LN_NO_ADDRESS
                    lnNextAddress = LN_NO_ADDRESS
                End If
                
                ' Transfere para o buff
                CopyMemory vtBuff(0), mdTail, LN_BLOCK_SIZE
                
                ' Calcula a posição no arquivo
                lnFilePos = ((lnAddress - 1) * LN_BLOCK_SIZE) + 1
                
                ' Grava no arquivo
                WriteFile lnFilePos, vtBuff()
            Wend
        Else
            
            ' Retorna inválido
            SetData = LN_INVALID_VALUE
        End If
    Else
        
        ' Retorna inválido
        SetData = LN_INVALID_VALUE
    End If
    
    ' Libera buff
    Erase vtBuff()
    
    Exit Function
ErrTreat:
    
    ' Retorna inválido
    SetData = LN_INVALID_VALUE
    LogErrMessage Err.Description, ST_MY_NAME + ".SetData", stFileName
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Retorna o próximo endereço livre no arquivo
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Function GetNextFreeAddress(vtlnAddress() As Long, Optional lnNext As Long = 0) As Long
    Dim lnAux As Long
    On Error GoTo ErrTreat:
    
    ' Tenta encontrar no vetor
    lnAux = ReturnCell(vtlnAddress(), IT_INVALID_VALUE)
    
    ' Verifica se não retornou
    If (lnAux = IT_INVALID_VALUE) Then
        
        ' Retorna a próxima posição do arquivo
        lnAux = Int(LOF(it_File) / LN_BLOCK_SIZE) + 1 + lnNext
    End If
    
    ' Retorna
    GetNextFreeAddress = lnAux
    
    Exit Function
ErrTreat:
    LogErrMessage Err.Description, ST_MY_NAME + ".GetNextFreeAddress"
    
    ' Retorna a próxima posição do arquivo
    On Error Resume Next
    lnAux = Int(LOF(it_File) / LN_BLOCK_SIZE) + 1 + lnNext
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Deleta do cache, retorna um vetor de endereços liberados
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub DelData(lnAddress As Long, vtlnAddress() As Long)
On Error GoTo ErrTreat:
    Dim lnFilePos As Long, lnNextAddress As Long
    Dim vtBuff() As Byte
    Dim itFreedSize As Integer
    Dim mdHead As MD_HEAD, mdTail As MD_TAIL
    
    ' Inicia variáveis
    itFreedSize = VtSize(vtlnAddress)
    
    ' Verifica se há arquivo aberto
    If bl_FileOpen Then
        
        ' Calcula a posição no arquivo
        lnFilePos = ((lnAddress - 1) * LN_BLOCK_SIZE) + 1
        
        ' Verifica se o arquivo possui tal posição
        If (LOF(it_File) >= (lnFilePos + LN_BLOCK_SIZE - 1)) Then
            
            ' Lê dados
            vtBuff = ReadFile(lnFilePos, LN_BLOCK_SIZE)
            
            ' Copia para estrutura de dados
            CopyMemory mdHead, vtBuff(0), LN_BLOCK_SIZE
                
            ' Redimenciona vetor de livres
            ReDim Preserve vtlnAddress(itFreedSize)
            
            ' Adiciona endereço
            vtlnAddress(itFreedSize) = lnAddress
            
            ' Incrementa contador
            itFreedSize = itFreedSize + 1
            
            ' Seta próximo endereço
            lnNextAddress = mdHead.lnNext
            
            ' Enquanto tiver endereços para ler
            While (lnNextAddress > LN_NO_ADDRESS)
                
                ' Redimenciona vetor de livres
                ReDim Preserve vtlnAddress(itFreedSize)
                
                ' Adiciona endereço
                vtlnAddress(itFreedSize) = lnNextAddress
                
                ' Incrementa contador
                itFreedSize = itFreedSize + 1
                
                ' Calcula a posição no arquivo
                lnFilePos = ((lnNextAddress - 1) * LN_BLOCK_SIZE) + 1
                
                ' Verifica se o arquivo possui tal posição
                If (LOF(it_File) >= (lnFilePos + LN_BLOCK_SIZE)) Then
                    
                    ' Lê dados
                    vtBuff = ReadFile(lnFilePos, LN_BLOCK_SIZE)
                    
                    ' Copia para estrutura de dados
                    CopyMemory mdTail, vtBuff(0), LN_BLOCK_SIZE
                    
                    ' Seta próximo endereço
                    lnNextAddress = mdTail.lnNext
                
                Else
                    
                    ' Seta que não há mais retornos
                    lnNextAddress = LN_NO_ADDRESS
                End If
            Wend
        End If
    End If
    
    ' Libera vetor
    Erase vtBuff()
    
    Exit Sub
ErrTreat:
    LogErrMessage Err.Description, ST_MY_NAME + ".DelData", lnAddress
End Sub


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Retorna a leitura do arquivo num vetor
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Function ReadFile(lnFilePos As Long, Optional lnBuffSize As Long = LN_NO_ADDRESS) As Byte()
    On Error GoTo ErrTreat:
    Dim vtAux() As Byte
    
    ' Verifica se o tamanho do buff não fora definido
    If (lnBuffSize = LN_NO_ADDRESS) Then
        
        ' Define o tamanho do buff
        lnBuffSize = LOF(it_File) - lnFilePos + 1
    End If
    
    ' Redimenciona o vetor
    ReDim vtAux(lnBuffSize - 1)
    
    ' Executa a leitura
    Get it_File, lnFilePos, vtAux()
    
    ' Retorna
    ReadFile = vtAux
    
    ' Libera vetor auxiliar
    Erase vtAux()
    
    Exit Function
ErrTreat:
    LogErrMessage Err.Description, ST_MY_NAME + ".ReadFile", CStr(lnFilePos) + ST_ERR_SEP + CStr(lnBuffSize)
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Grava no arquivo a partir do vetor
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub WriteFile(lnFilePos As Long, vtFile() As Byte)
    On Error GoTo ErrTreat:
    
    
    ' Executa gravação
    Put it_File, lnFilePos, vtFile()
    
    Exit Sub
ErrTreat:
    LogErrMessage Err.Description, ST_MY_NAME + ".WriteFile", CStr(lnFilePos)
End Sub


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Tratamentos para quando inicia / finaliza a classe
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub Class_Initialize()

    ' Seta endereço do arquivo
    st_FileAddress = vbNullString
    
    ' Inicia variáveis
    bl_FileOpen = False
End Sub

Private Sub Class_Terminate()
    
    ' Verifica se foi carregado algum arquivo
    If bl_FileOpen Then
        
        ' Fecha o arquivo
        Close it_File
        
        ' Seta que não tem mais arquivo aberto
        bl_FileOpen = False
    End If
End Sub