Split Wav File in VB6 - join

Question

I need help to fix the attached VB6 code which is supposed to take an audio file and split it into 5 equal parts.
This is the way this code should work:
The first part starts from the beginning of Track.wav file.
The second part starts from where the first split part ended.
The third part starts from where the second split part ended.
The fourth part starts from where the third split part ended.
The fifth part starts from where the fourth split part ended.
Essentially each of the file parts is a continuation of the previous part of file split. After the split I have 1.wav, 2.wav, 3.wav. 4.wav and 5.wav all derived from a Track.wav file. The code attached already splits the file into five equal parts but the problem is that all the audio parts are the same as the first part instead of a continuation.
I need help to get this fixed to work as it should in VB6 (not .NET). I'd be grateful for your assistance with this.
Dim Wavlength As Integer
Private Sub Command1_Click()
On Error Resume Next
DoFirstWav
Me.SetFocus
End Sub
Private Sub DoFirstWav()
On Error Resume Next
Dim ByteData() As Byte
Dim FirstWav As Integer
FirstWav = Wavlength / 5
ByteData = ReadFile(App.Path & "\Track.wav", 1, FirstWav & "0000")
Call WriteFile(App.Path & "\Segments\1.wav", ByteData)
DoSecondWav
End Sub
Private Sub DoSecondWav()
On Error Resume Next
Dim ByteData() As Byte
Dim SecondWav As Integer
SecondWav = Wavlength / 5
ByteData = ReadFile(App.Path & "\Track.wav", 1, SecondWav & "0000")
Call WriteFile(App.Path & "\Segments\2.wav", ByteData)
DoThirdWav
End Sub
Private Sub DoThirdWav()
On Error Resume Next
Dim ByteData() As Byte
Dim ThirdWav As Integer
ThirdWav = Wavlength / 5
ByteData = ReadFile(App.Path & "\Track.wav", 1, ThirdWav & "0000")
Call WriteFile(App.Path & "\Segments\3.wav", ByteData)
DoFourthWav
End Sub
Private Sub DoFourthWav()
On Error Resume Next
Dim ByteData() As Byte
Dim FourthWav As Integer
FourthWav = Wavlength / 5
ByteData = ReadFile(App.Path & "\Track.wav", 1, FourthWav & "0000")
Call WriteFile(App.Path & "\Segments\4.wav", ByteData)
DoFifthWav
End Sub
Private Sub DoFifthWav()
On Error Resume Next
Dim ByteData() As Byte
Dim FifthWav As Integer
FifthWav = Wavlength / 5
ByteData = ReadFile(App.Path & "\Track.wav", 1, FifthWav & "0000")
Call WriteFile(App.Path & "\Segments\5.wav", ByteData)
MsgBox "Wav Split Successfully", vbInformation
End
End Sub
Private Function ReadFile(ByVal strFileName As String, Optional ByVal lngStartPos As Long = 1, Optional ByVal lngFileSize As Long = -1) As Byte()
On Error Resume Next
Dim FilNum As Integer
FilNum = FreeFile
Open strFileName For Binary As #FilNum
If lngFileSize = -1 Then
ReDim ReadFile(LOF(FilNum) - lngStartPos)
Else
ReDim ReadFile(lngFileSize - 1)
End If
Get #FilNum, lngStartPos, ReadFile
Close #FilNum
End Function
Private Function WriteFile(ByVal strFileName As String, ByteData() As Byte, Optional ByVal lngStartPos As Long = -1, Optional ByVal OverWrite As Boolean = True)
On Error Resume Next
Dim FilNum As Integer
FilNum = FreeFile
If OverWrite = True And Dir(strFileName) <> "" Then
Kill strFileName
End If
Open strFileName For Binary As #FilNum
If lngStartPos = -1 Then
Put #FilNum, LOF(FilNum) + 1, ByteData
Else
Put #FilNum, l, ByteData
End If
Close #FilNum
End Function
Private Sub Form_Load()
On Error Resume Next
Dim MyInt As Integer
Dim MyByte As Byte
Dim MyStr As String * 4
Dim MyLong As Long
Dim SampleRate, BytesPerSample, FileSize As Long
Open App.Path & "\Track.wav" For Binary Access Read Lock Read As #1
Get #1, , MyStr: Debug.Print "Riff = "; MyStr
Get #1, , MyLong: Debug.Print "File size = "; MyLong
FileSize = MyLong
Get #1, , MyStr: Debug.Print "Wave = "; MyStr
Get #1, , MyStr: Debug.Print "Format = "; MyStr
Get #1, , MyLong: Debug.Print "Any = "; MyLong
Get #1, , MyInt: Debug.Print "formatTag = "; MyInt
Get #1, , MyInt: Debug.Print "Channels = "; MyInt
Get #1, , MyLong: Debug.Print "Samples per Sec = "; MyLong
SampleRate = MyLong
Get #1, , MyInt: Debug.Print "Bytes per Sec = "; MyInt
Get #1, , MyInt: Debug.Print "BlockAlign = "; MyInt
Get #1, , MyInt: Debug.Print "Bytes per Sample = "; MyInt
BytesPerSample = MyInt
Close #1
Wavlength = FileSize / (SampleRate * BytesPerSample)
End Sub

Answer 1

This question is quite involved, particularly if each part needs to be playable. The reason is that each file you create needs to have a valid header record. To complicate it further, it appears a header record may be 44 bytes, 46 bytes, or even other sizes.
I worked out some basic code based on your post that appears to work for the wav file I tested:
Option Explicit
Private Const HEADER_SIZE As Long = 46
Private Const CHUNK_COUNT As Long = 5
Private HeaderData(HEADER_SIZE) As Byte
Private ChunkSize As Long
Private Sub Form_Load()
Dim MyInt As Integer
Dim MyByte As Byte
Dim MyStr As String * 4
Dim MyLong As Long
Dim FileSize As Long
Open App.Path & "\Track.wav" For Binary Access Read Lock Read As #1
Get #1, , MyStr: Debug.Print "Riff = "; MyStr
Get #1, , MyLong: Debug.Print "File size = "; MyLong
Get #1, , MyStr: Debug.Print "Wave = "; MyStr
Get #1, , MyStr: Debug.Print "Format = "; MyStr
Get #1, , MyLong: Debug.Print "Any = "; MyLong
Get #1, , MyInt: Debug.Print "formatTag = "; MyInt
Get #1, , MyInt: Debug.Print "Channels = "; MyInt
Get #1, , MyLong: Debug.Print "Samples per Sec = "; MyLong
Get #1, , MyInt: Debug.Print "Bytes per Sec = "; MyInt
Get #1, , MyInt: Debug.Print "BlockAlign = "; MyInt
Get #1, , MyInt: Debug.Print "Bytes per Sample = "; MyInt
Get #1, , MyInt: Debug.Print "Something = "; MyInt 'for my wave file, I needed 2 extra bytes
Get #1, , MyStr: Debug.Print "SubchunkID = "; MyStr
Get #1, , FileSize: Debug.Print "SubchunkSize = "; FileSize
Get #1, 1, HeaderData 'the size changes depending upon the file
Close #1
ChunkSize = CLng(FileSize / CHUNK_COUNT) 'you might loose some data here
End Sub
Private Sub Command1_Click()
Dim i As Integer
Dim ByteData() As Byte
Dim StartPos As Long
For i = 1 To CHUNK_COUNT
StartPos = HEADER_SIZE + ((i - 1) * ChunkSize)
ByteData = ReadFile(App.Path & "\Track.wav", StartPos, ChunkSize)
Call WriteFile(App.Path & "\Segments\" & i & ".wav", HeaderData, ByteData)
Next
MsgBox "Wav Split Successfully", vbInformation
End
End Sub
Private Function ReadFile(ByVal strFileName As String, ByVal lngStartPos As Long, ByVal lngFileSize As Long) As Byte()
On Error Resume Next
Dim FilNum As Integer
FilNum = FreeFile
ReDim ReadFile(lngFileSize - 1)
Open strFileName For Binary As #FilNum
Get #FilNum, lngStartPos, ReadFile
Close #FilNum
End Function
Private Function WriteFile(ByVal strFileName As String, HeaderData() As Byte, ByteData() As Byte, Optional ByVal OverWrite As Boolean = True)
On Error Resume Next
Dim FilNum As Integer
FilNum = FreeFile
If OverWrite = True And Dir(strFileName) <> "" Then
Kill strFileName
End If
Open strFileName For Binary As #FilNum
Put #FilNum, LOF(FilNum) + 1, HeaderData
Put #FilNum, HEADER_SIZE, ByteData
Close #FilNum
End Function
I eliminated a lot of duplicate code by implementing a For loop. In that loop, I calculate the Start position for the Read, and also pass the header record for the Write.
Again, I stress that this is very basic and will not work for all wav files. You can manually adjust the HEADER_SIZE if it does not work for your file.
Likely the header record needs to be modified to reflect the correct size of the new file, instead of using the header from the original file.
This should get you started.

Answer 2

This is the working code. I'm sure someone may need something like this in future, si thought I'd post it here.
Dim Wavlength As Long
Dim PartLength As Integer
Dim WavHeader() As Byte
Private Sub Command1_Click()
On Error Resume Next
WavHeader = ReadFile(App.Path & "\Track.wav", 1, 320)
PartLength = Wavlength / 6 - 2
DoFirstWav
End Sub
Private Sub DoFirstWav()
On Error Resume Next
Dim ByteData() As Byte
Dim FirstWav As Integer
ByteData = ReadFile(App.Path & "\Track.wav", 1, PartLength & "0000")
Call WriteFile(App.Path & "\Segments\1.wav", ByteData)
DoSecondWav
End Sub
Private Sub DoSecondWav()
On Error Resume Next
Dim ByteData() As Byte
Dim ByteRead() As Byte
Dim SecondWav As Integer
SecondWav = PartLength
ByteRead = ReadFile(App.Path & "\Track.wav", SecondWav & "0000", PartLength & "0000")
ReDim ByteData(UBound(WavHeader) + UBound(ByteRead)) As Byte
For i = 0 To UBound(WavHeader)
ByteData(i) = WavHeader(i)
Next i
For i = 0 To UBound(ByteRead)
ByteData(UBound(WavHeader) + i) = ByteRead(i)
Next i
Call WriteFile(App.Path & "\Segments\2.wav", ByteData)
DoThirdWav
End Sub
Private Sub DoThirdWav()
On Error Resume Next
Dim ByteData() As Byte
Dim ByteRead() As Byte
Dim ThirdWav As Integer
ThirdWav = PartLength * 2 + 1
ByteRead = ReadFile(App.Path & "\Track.wav", ThirdWav & "0000", PartLength & "0000")
ReDim ByteData(UBound(WavHeader) + UBound(ByteRead)) As Byte
For i = 0 To UBound(WavHeader)
ByteData(i) = WavHeader(i)
Next i
For i = 0 To UBound(ByteRead)
ByteData(UBound(WavHeader) + i) = ByteRead(i)
Next i
Call WriteFile(App.Path & "\Segments\3.wav", ByteData)
DoFourthWav
End Sub
Private Sub DoFourthWav()
On Error Resume Next
Dim ByteData() As Byte
Dim ByteRead() As Byte
Dim FourthWav As Integer
FourthWav = PartLength * 3 + 1
ByteRead = ReadFile(App.Path & "\Track.wav", FourthWav & "0000", PartLength & "0000")
ReDim ByteData(UBound(WavHeader) + UBound(ByteRead)) As Byte
For i = 0 To UBound(WavHeader)
ByteData(i) = WavHeader(i)
Next i
For i = 0 To UBound(ByteRead)
ByteData(UBound(WavHeader) + i) = ByteRead(i)
Next i
Call WriteFile(App.Path & "\Segments\4.wav", ByteData)
DoFifthWav
End Sub
Private Sub DoFifthWav()
On Error Resume Next
Dim ByteData() As Byte
Dim ByteRead() As Byte
Dim FifthWav As Integer
FifthWav = PartLength * 4 + 1
ByteRead = ReadFile(App.Path & "\Track.wav", FifthWav & "0000", PartLength & "0000")
ReDim ByteData(UBound(WavHeader) + UBound(ByteRead)) As Byte
For i = 0 To UBound(WavHeader)
ByteData(i) = WavHeader(i)
Next i
For i = 0 To UBound(ByteRead)
ByteData(UBound(WavHeader) + i) = ByteRead(i)
Next i
Call WriteFile(App.Path & "\Segments\5.wav", ByteData)
End Sub
Private Function ReadFile(ByVal strFileName As String, Optional ByVal lngStartPos As Long = 1, Optional ByVal lngFileSize As Long = -1) As Byte()
On Error Resume Next
Dim FilNum As Integer
FilNum = FreeFile
Open strFileName For Binary As #FilNum
If lngFileSize = -1 Then
ReDim ReadFile(LOF(FilNum) - lngStartPos)
Else
ReDim ReadFile(lngFileSize - 1)
End If
Get #FilNum, lngStartPos, ReadFile
Close #FilNum
End Function
Private Function WriteFile(ByVal strFileName As String, ByteData() As Byte, Optional ByVal lngStartPos As Long = -1, Optional ByVal OverWrite As Boolean = True)
On Error Resume Next
Dim FilNum As Integer
FilNum = FreeFile
If OverWrite = True And Dir(strFileName) <> "" Then
Kill strFileName
End If
Open strFileName For Binary As #FilNum
If lngStartPos = -1 Then
Put #FilNum, LOF(FilNum) + 1, ByteData
Else
Put #FilNum, l, ByteData
End If
Close #FilNum
End Function
Private Sub Form_Load()
On Error Resume Next
Dim MyInt As Integer
Dim MyByte As Byte
Dim MyStr As String * 4
Dim MyLong As Long
Dim SampleRate, BytesPerSample, FileSize As Long
Open App.Path & "\Track.wav" For Binary Access Read Lock Read As #1
Get #1, , MyStr: Debug.Print "Riff = "; MyStr
Get #1, , MyLong: Debug.Print "File size = "; MyLong
FileSize = MyLong
Get #1, , MyStr: Debug.Print "Wave = "; MyStr
Get #1, , MyStr: Debug.Print "Format = "; MyStr
Get #1, , MyLong: Debug.Print "Any = "; MyLong
Get #1, , MyInt: Debug.Print "formatTag = "; MyInt
Get #1, , MyInt: Debug.Print "Channels = "; MyInt
Get #1, , MyLong: Debug.Print "Samples per Sec = "; MyLong
SampleRate = MyLong
Get #1, , MyInt: Debug.Print "Bytes per Sec = "; MyInt
Get #1, , MyInt: Debug.Print "BlockAlign = "; MyInt
Get #1, , MyInt: Debug.Print "Bytes per Sample = "; MyInt
BytesPerSample = MyInt
Close #1
Wavlength = FileSize \ (SampleRate * BytesPerSample)
Debug.Print "Wavlength"; Wavlength
End Sub