Option Explicit

'分割\合并音频文件

'-- 合并文件

'-- 将之前分割出来的 1.mp3 和 2.mp3 合并为 music_new.mp3

Private Sub cmdAddFile_Click()

Dim bytData() As Byte

bytData = ReadFile(App.Path & "\1.mp3")

Call WriteFile(App.Path & "\music_new.mp3", bytData)

bytData = ReadFile(App.Path & "\2.mp3")

Call WriteFile(App.Path & "\music_new.mp3", bytData, , False)

End Sub





'-- 分割文件

'-- 示例将当前目录的 music.mp3 切割为 1.mp3(30000字节) 和 2.mp3(剩余部分)

Private Sub cmdCut_Click()

Dim bytData() As Byte

bytData = ReadFile(App.Path & "\01.mp3", 1, 100000)

Call WriteFile(App.Path & "\1.rmvb", bytData)

bytData = ReadFile(App.Path & "\01.mp3", 100001)

Call WriteFile(App.Path & "\2.rmvb", bytData)

End Sub



Private Function ReadFile(ByVal strFileName As String, Optional ByVal lngStartPos As Long = 1, Optional ByVal lngFileSize As Variant = -1) As Byte()

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, bytData() As Byte, Optional ByVal lngStartPos As Long = -1, Optional ByVal OverWrite As Boolean = True)

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, bytData

Else

Put #FilNum, lngStartPos, bytData

End If

Close #FilNum

End Function

Option Explicit

Private Type RIFFHEADER

    GroupID As String * 4

    Length As Long

    RiffType As String * 4

End Type



Private Type FMT

    ChunkID As String * 4

    ChunkSize As Long

    wFormatTag As Integer

    wChannels As Integer

    dwSamplesPerSec As Long

    dwAvgBytesPerSec As Long

    wBlockAlign As Integer

    wBitsPerSample As Integer

End Type



Private Type DATACHUNK

    ChunkID As String * 4

    ChunkSize As Long

End Type

Private Declare Function sndPlaySound Lib "winmm.dll" Alias _

"sndPlaySoundA" (ByVal lpszSoundName As String, _

ByVal uFlags As Long) As Long



Const SND_SYNC = &H0

Const SND_ASYNC = &H1

Const SND_NODEFAULT = &H2

Const SND_LOOP = &H8

Const SND_NOSTOP = &H10



Private Sub Command1_Click()

    Dim b() As Byte

    Dim fS As Long

    fS = 20000 '声音数据长度

    Dim u As Long

    u = fS - 44

    ReDim b(1 To u)

    Dim i As Integer

    Dim d As Byte

    '产生一些随机数据作为声音数据

    For i = 1 To u

        Randomize

        d = CByte(Rnd() * 255)

        b(i) = d

        DoEvents

    Next i

    makeWavFile fS, b() '写入文件

    MsgBox "OK,Wave file done!"

    

End Sub



Private Sub makeWavFile(ByVal fSize As Long, wavData() As Byte)

    Dim myRiffHeader As RIFFHEADER

    Dim myFMT As FMT

    Dim myDataChunck As DATACHUNK

    

    If fSize < 44 Then Exit Sub

    

    '写Riff头

    With myRiffHeader

        .GroupID = "RIFF"

        .Length = fSize - 8 ' Riff外的其它内容的长度

        .RiffType = "WAVE"

    End With

    

    'format chunk 格式块

    With myFMT

        .ChunkID = "fmt "

        .ChunkSize = 16 '未压缩的文件格式

        .wFormatTag = 1 '未压缩

        .wChannels = 1 '通道数据,此处用音声道

        .dwSamplesPerSec = &H2B11 '每秒钟取样数，有三种11025,22050和44100

        .dwAvgBytesPerSec = .dwSamplesPerSec * .wChannels

        .wBlockAlign = .wChannels * 1 '声道数乘以取样宽(字节数),此处假设为1

        .wBitsPerSample = 8 '每个样本的位数，此处假设为8位，即一个字节

    End With

    

    '数据块

    With myDataChunck

        .ChunkID = "data"

        .ChunkSize = fSize - Len(myRiffHeader) - Len(myFMT) - Len(myDataChunck)

       ' .ChunkSize = fSize - 44

    End With

    Open App.Path & "/test.wav" For Binary As #1

        Put #1, , myRiffHeader

        Put #1, , myFMT

        Put #1, , myDataChunck

        Put #1, , wavData

    Close #1

    

End Sub



Private Sub Command2_Click()

    '播放声音

    Dim Fn As String

    Fn = App.Path & "\test.wav"

    If Dir(Fn) <> "" Then

        Dim sFlags As Long

        sFlags = SND_ASYNC Or SND_NODEFAULT

        sndPlaySound Fn, sFlags

    End If

End Sub