join - 在 VB6 中拆分 Wav 文件

Question

我需要帮助修复附加的 VB6 代码，该代码应该将音频文件分成 5 个相等的部分。

这是这段代码应该工作的方式:

第一部分从 Track.wav 文件的开头开始。
第二部分从第一个分割部分结束的地方开始。
第三部分从第二部分结束的地方开始。
第四部分从第三部分结束的地方开始。
第五部分从第四部分结束的地方开始。

基本上每个文件部分都是文件拆分前一部分的延续。拆分后我有 1.wav、2.wav、3.wav。 4.wav 和 5.wav 均源自 Track.wav 文件。附加的代码已经将文件分成五个相等的部分，但问题是所有音频部分都与第一部分相同，而不是延续。

我需要帮助才能使其在 VB6(不是 .NET)中正常工作。如果您对此提供帮助，我将不胜感激。

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

这个问题相当复杂，特别是如果每​​个部分都需要可播放。原因是您创建的每个文件都需要有一个有效的标题记录。更复杂的是，头记录可能是 44 字节、46 字节，甚至其他大小。

我根据您的帖子制定了一些基本代码，这些代码似乎适用于我测试的 wav 文件:

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

我通过实现 For 消除了很多重复的代码环形。在该循环中，我计算读取的起始位置，并传递写入的 header 记录。

再次强调，这是非常基本的，不适用于所有 wav 文件。如果它不适用于您的文件，您可以手动调整 HEADER_SIZE。

可能需要修改标题记录以反射(reflect)新文件的正确大小，而不是使用原始文件中的标题。

这应该让你开始。