PACOTE DE ARQUIVOS. DAT!

USUARIO.EXCLUIDOS 19/06/2004 15:42:41
#30364
Como faço para criar um arquivo no qual será guardado outros arquivos nesse arquivo, como se fosse um pack?
CASPEREARK 20/06/2004 01:57:47
#30398 Resposta escolhida
Bom aí vai um exemplo grosseiro, ele cria uma arquivo binário com a combinação de outros arquivos, mas não usa compactação

Se quer algo mais sofisticado, dê uma olhada na seção Código fonte -> Compactação!

Crie dois botões num form! um Chamado cmdCombine e outro cmdExtract!

Na Declarations do form insiria!


Private Type FILEHEADER
    intNumFiles As Integer      
    lngFileSize As Long         
End Type

Private Type INFOHEADER
    lngFileSize As Long         
    lngFileStart As Long      
    strFileName As String * 16 
End Type


no botão cmbCombine insira:


Private Sub cmdCombine_Click()

Dim intSample1File As Integer
Dim intSample2File As Integer
Dim intSample3File As Integer
Dim intBinaryFile As Integer
Dim bytSample1Data() As Byte
Dim bytSample2Data() As Byte
Dim bytSample3Data() As Byte
Dim FileHead As FILEHEADER
Dim InfoHead() As INFOHEADER
Dim lngFileStart As Long

    On Local Error GoTo ErrOut

    intSample1File = FreeFile
    Open App.Path & "\SAMPLE1.BMP" For Binary Access Read Lock Write As intSample1File
    intSample2File = FreeFile
    Open App.Path & "\SAMPLE2.WAV" For Binary Access Read Lock Write As intSample2File
    intSample3File = FreeFile
    Open App.Path & "\SAMPLE3.TXT" For Binary Access Read Lock Write As intSample3File

    ReDim bytSample1Data(LOF(intSample1File) - 1)
    ReDim bytSample2Data(LOF(intSample2File) - 1)
    ReDim bytSample3Data(LOF(intSample3File) - 1)
    

    Get intSample1File, 1, bytSample1Data
    Get intSample2File, 1, bytSample2Data
    Get intSample3File, 1, bytSample3Data
    
   
    Kill App.Path & "\SAMPLE1.BMP"
    
    Kill App.Path & "\SAMPLE2.WAV"
    
    Kill App.Path & "\SAMPLE3.TXT"
  
    FileHead.intNumFiles = 3
    FileHead.lngFileSize = (UBound(bytSample1Data) + 1) + (UBound(bytSample2Data) + 1) + (UBound(bytSample3Data) + 1) + (6) + (FileHead.intNumFiles * 24)
 
    ReDim InfoHead(FileHead.intNumFiles - 1)
    lngFileStart = (6) + (FileHead.intNumFiles * 24) + 1
    InfoHead(0).lngFileSize = UBound(bytSample1Data) + 1
    InfoHead(1).lngFileSize = UBound(bytSample2Data) + 1
    InfoHead(2).lngFileSize = UBound(bytSample3Data) + 1
    InfoHead(0).lngFileStart = lngFileStart
    lngFileStart = lngFileStart + InfoHead(0).lngFileSize
    InfoHead(1).lngFileStart = lngFileStart
    lngFileStart = lngFileStart + InfoHead(1).lngFileSize
    InfoHead(2).lngFileStart = lngFileStart
    InfoHead(0).strFileName = "SAMPLE1.BMP"
    InfoHead(1).strFileName = "SAMPLE2.WAV"
    InfoHead(2).strFileName = "SAMPLE3.TXT"
    

    intBinaryFile = FreeFile
    Open App.Path & "\BINARY.DAT" For Binary Access Write Lock Write As intBinaryFile
    
    Put intBinaryFile, 1, FileHead
    Put intBinaryFile, , InfoHead
    Put intBinaryFile, , bytSample1Data
    Put intBinaryFile, , bytSample2Data
    Put intBinaryFile, , bytSample3Data
    
 
    Exit Sub
    
ErrOut:

    
    MsgBox "Unable to create binary file.", vbOKOnly, "Error"

End Sub


e no Extract:



Private Sub cmdExtract_Click()

Dim i As Integer
Dim intSampleFile As Integer
Dim intBinaryFile As Integer
Dim bytSampleData() As Byte
Dim FileHead As FILEHEADER
Dim InfoHead() As INFOHEADER
    
    On Local Error GoTo ErrOut

   
    intBinaryFile = FreeFile
    Open App.Path & "\BINARY.DAT" For Binary Access Read Lock Write As intBinaryFile
    
   
    Get intBinaryFile, 1, FileHead
    
    
    If LOF(intBinaryFile) <> FileHead.lngFileSize Then
        MsgBox "This is not a valid file format.", vbOKOnly, "Invalid File"
        Exit Sub
    End If
    

    ReDim InfoHead(FileHead.intNumFiles - 1)
    

    Get intBinaryFile, , InfoHead
    
   
    For i = 0 To UBound(InfoHead)
        
        ReDim bytSampleData(InfoHead(i).lngFileSize - 1)
        
        Get intBinaryFile, InfoHead(i).lngFileStart, bytSampleData
        
        intSampleFile = FreeFile
        Open App.Path & "\" & InfoHead(i).strFileName For Binary Access Write Lock Write As intSampleFile
        Put intSampleFile, 1, bytSampleData
        Close intSampleFile
    Next
    

    Close intBinaryFile
    

    Exit Sub

ErrOut:

    MsgBox "Unable to decode binary file.", vbOKOnly, "Error"

End sub


Boa Sorte!
Tópico encerrado , respostas não são mais permitidas
Voltar