Option Explicit

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

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

  Close intSample1File
  Kill App.Path & "\SAMPLE1.BMP"
  Close intSample2File
  Kill App.Path & "\SAMPLE2.WAV"
  Close intSample3File
  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

  Close intBinaryFile
  cmdCombine.Enabled = False
  cmdExtract.Enabled = True

  Exit Sub

ErrOut:
  MsgBox "Binärdatei kann nicht erstellt werden", _
        vbOKOnly, "Fehler"
End Sub

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 "Falsches Dateiformat", vbOKOnly, "Fehler"
      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
  cmdCombine.Enabled = True
  cmdExtract.Enabled = False

  Exit Sub

ErrOut:
  MsgBox "Binärdatei kann nicht extrahiert werden", _
        vbOKOnly, "Fehler"
End Sub