讯飞配音使用记录：Excel VBA 编程处理多段短文字配音切分及 Hedit、GoldWave 后期处理、编程合成 WAV 文件

最新推荐文章于 2024-06-09 06:59:02 发布

jessezappy

最新推荐文章于 2024-06-09 06:59:02 发布

阅读量826

点赞数 1

分类专栏：日记音视频处理源码文章标签：语音合成 PCM 切分合成 WAV

本文链接：https://blog.csdn.net/jessezappy/article/details/119247233

版权

日记同时被 3 个专栏收录

32 篇文章 2 订阅

订阅专栏

源码

18 篇文章 0 订阅

订阅专栏

音视频处理

3 篇文章 0 订阅

订阅专栏

1.注册并购买讯飞配音会员

2.选择需要的主播

3.每天可免费配 80 条语音，每条 1 万字（中文）

4.将多段短文字中间插入 1 秒停顿，配音下载，文字少的可直接使用 GoldWave 录音。

5.内容不多的就不说了，下面说下内容多的处理情况：

我需要配的 600 多段短文字，有地名、数字、温馨提示等等，配好后需要将每段声音切分为独立的 WAV 文件便于程序调用，之前尝试过使用“讯飞开放平台”的 TTS 接口，但是里面的可选主播有使用时限限制，而且年费都是 2W 起，用不起。讯飞配音的会员就划算多了，45 元单月，年费也不贵。于是最后决定选择使用讯飞配音来解决需求。

第一次使用时，没注意每天80条的限制，以为是全免费的，于是，写了个小程序，用 SeleniumBasic 控制浏览器，把需要的声音每段自动输入配音下载，结果运行了一阵，发现报错“账户余额不足”，才晓得每天是有 80 条限制的。而我居然一下下就把 80 条、每条一万字的配额用每条七八个字的内容高速消耗完了，后来算了一下，才发现，我的 600 多条内容只有 4000 字不到，免费的一条就可以配完了！！！感觉神傻！傻！傻！

于是采用第二方案，全部整合为一条配音！这样为了节省人力就需要使用编程来对声音文件进行切分。

为了便于程序切分，遂在每段文字之间插入 1 秒的停顿，

配音好的文件下载只能是 MP3 格式，程序处理前，需要将该 MP3 音频文件转换为 PCM 格式的 WAV 或 PCM 文件，为了简化程序处理，还是建议转化一个 PCM 格式文件用于程序切分多段数据，因为 PCM 文件只包含数据，不含文件头，便于程序处理。

rem 可利用 ffmpeg 将下载的 MP3 文件转换为 PCM 格式文件，其中的编码率，声道设置等信息来自 讯飞开放平台 中提供的 js Demo 中给出的设置（讯飞开放平台 的 js demo 返回的配音结果就是 PCM 文件），即： 16位、单声道、16KHz采样率

rem MP3 转 PCM 用讯飞开放平台 Demo 的参数
ffmpeg -y -i test.mp3 -f s16le -ac 1 -ar 16000 -acodec pcm_s16le test.pcm

rem MP3 转 WAV ，得到的文件数据和上面的 PCM 文件一致，说明讯飞配音下载的 MP3 文件格式和讯飞开放平台的设定格式一致。
ffmpeg -y -i test.mp3 test2.wav

在程序中定义整型(Integer)数组，大小为 PCM 文件尺寸除以 2，一次读入整个 PCM 文件：

'---偷懒，使用 Excel 的 VBA 编程处理了，x64 系统不能运行 VB6 恨无奈，又懒得开虚拟机，只是处理数据的发，VBA 在 x64 系统中更简便。

Dim dataBlock() As Integer '这里只处理16位wav数据，不考虑8位，所以写死。
apppath = ActiveWorkbook.Path & "\"
    fp = FreeFile
    fn = apppath & "\test.pcm"
    Open fn For Binary As #fp
        fz = LOF(fp)
        ReDim dataBlock(fz / 2 - 1)
        Get #fp, , dataBlock()
    Close #fp

然后循环判断每个声音数据绝对值是否小于 2 （因配音完毕后，下载的声音文件是 MP3 格式，转换为 PCM 的 WAV 格式后，部分静音数据会解码为 1 或 -1，当然，还有 2 和 -2 如果想扩大判断，也可以改成小于 3），小于 2 的则判定为静音，也就是停顿，然后记录连续的静音数据量，超过 0.845 秒（对于 16KHz 采样率来说也就是判断其超过 14000 个连续静音数据）则判定其为我们插入的 1 秒停顿，然后通过当前数据位置减去上一次记录的起点（初始起点为0）再减去静音数据量，即得到此段声音数据块的大小，然后通过起点设置二进制文件读取位置，从设定位置用数据块大小定义的整型(Integer)数组直接读取 PCM 文件，则得到完整的数据快，将该数据块加上 WAV 文件头（致谢：imxiangzi 的文章：https://blog.csdn.net/imxiangzi/article/details/80265978 ），一起写入新文件（文件名用配音内容分段或其他你感兴趣的名字命名），就得到了完整的 WAV 文件（我偷懒，文件头是从先用 GoldWave 生成的一个 WAV 中读取）：

'--------------定义一下 WAV 文件头
Public Type RIFF
    ID As String * 4    '0x00    4Byte   大端    'RIFF' (0x52494646)
    Size As Long        '0x04    4Byte   小端    fileSize - 8
    Type As String * 4  '0x08    4Byte   大端    'WAVE'(0x57415645)
End Type

Public Type FORMAT
    ID As String * 4        '   0x00    4Byte   大端    'fmt ' (0x666D7420)
    Size  As Long           '   0x04    4Byte   小端    16
    AudioFormat As Integer  '   0x08    2Byte   小端    音频格式
    NumChannels As Integer  '   0x0A    2Byte   小端    声道数
    SampleRate As Long      '   0x0C    4Byte   小端    采样率
    ByteRate As Long        '   0x10    4Byte   小端    每秒数据字节数
    BlockAlign As Integer   '   0x14    2Byte   小端    数据块对齐
    BitsPerSample As Integer '  0x16    2Byte   小端    采样位数
End Type

Public Type data  '-----数据块不在此定义，单独定义，便于将来制作 WAV 连接合成程序
    ID As String * 4    ' 0x00    4Byte   大端    'data' (0x64617461)
    Size As Long        ' 0x04    4Byte   小端    N
End Type

Public Type HP1
    data As String * 14    '0x00    4Byte   大端    Lavf58.29.100
End Type

Public Type HP
    ID As String * 8    '0x00    4Byte   大端    INFOISFT
    Size As Long        '0x04    4Byte   小端
    data As HP1
End Type

Public Type LIST   '-------------ffmpeg 转换出来的 WAV 文件，文件头会多出 LIST 块，所以单独定义个判断下，以免忘记了。
    ID As String * 4    '0x00    4Byte   大端    LIST
    Size As Long        '0x04    4Byte   小端
    data As HP
End Type

Public apppath

Public Sub splitPCM()
    Dim P1 As RIFF, P2 As FORMAT, P3 As data, P2x As LIST
    Dim dataBlock() As Integer '这里只处理16位wav数据，不考虑8位，所以写死。
    Dim P0 As RIFF, AR As Long, i, X, k, n, badN, tmpU, umax, umin
    Dim fn, fp, fz, sptxt, txttemp, txtmp
    Dim startpoint As Long ', SplitPoint As Long   'Nullstartpoint As Long,
    Dim NewPCM() As Integer '这里只处理16位wav数据，不考虑8位，所以写死。
    Dim Headsize As Long, Hsp As Long, Esp As Long
    Dim stxt As String
    X = 14000
    umin = 99999
    umax = 0
    apppath = ActiveWorkbook.Path & "\"
    '--------------------创建头部信息
    fp = FreeFile
    fn = apppath & "\wavhead.wav"
    Open fn For Binary As #fp
        Get #fp, , P1
        Get #fp, , P2
        Get #fp, , P0
        AR = Seek(fp) - 12
        Seek #fp, AR
        If P0.ID = "LIST" Then
            Get #fp, , P2x
        End If
        Get #fp, , P3
        If P2.BlockAlign = 1 Then
            '---------跳转至处理8位进程，此处不处理
            'ReDim dataBlock(1 To P3.Size)
        ElseIf P2.BlockAlign = 2 Then
            'ReDim dataBlock(1 To P3.Size / 2)
        Else
            Close #fp
            MsgBox "不处理32位音频！"
            Exit Sub
        End If
    Close #fp
    Headsize = 12 + 8 + P2.Size + 8
    '-------------------------
    fp = FreeFile
    fn = apppath & "\Out.csv"  '------Wav 文件名清单
    Open fn For Input As #fp
    Do While Not EOF(fp)
        Line Input #fp, txttemp
        txtmp = txtmp & txttemp
    Loop
    Close #fp
    sptxt = Split(txtmp, ",")
'    For i = 0 To UBound(sptxt)  '-------配音内容太多，串进了几个相同的内容，导致文件数量不对，用这里检测才发现
'        stxt = sptxt(i)
'        For k = 0 To UBound(sptxt)
'            If stxt = sptxt(k) And k <> i Then
'                MsgBox "Bad!!!" & i & "," & k
'            End If
'        Next
'    Next
    '- 重复： 1，2，3
    '------------------------
    fp = FreeFile
    fn = apppath & "\test.pcm"
    Open fn For Binary As #fp
        fz = LOF(fp)
        ReDim dataBlock(fz / 2 - 1)
        Get #fp, , dataBlock()
    Close #fp
    tmpU = UBound(dataBlock)
    k = 0
    startpoint = 0
    AR = 1
    n = 0
    Hsp = 0
    Esp = 0
    For i = 0 To UBound(dataBlock)
        'Worksheets("GBN").Cells(Row, 3 + j).Value
        If Abs(dataBlock(i)) < 2 And i < (tmpU - 1000) Then '----同时判断是否已经接近文件尾 1000 数据
            If k = 0 Then If i > 1000 Then i = i - 1000
            k = k + 1
        Else
            
            Worksheets("Sheet1").Cells(3, 3).Value = (i / tmpU)
            If k > X Then
                '------------
'                If n > 585 Then   '检测处理最后一个数据块
'                    n = n
'                End If
                '------------
                If umin > k Then
                    umin = k
                    Worksheets("Sheet1").Cells(2, 4).Value = k
                End If
                If umax < k Then
                    umax = k
                    Worksheets("Sheet1").Cells(2, 5).Value = k
                End If
                Worksheets("Sheet1").Cells(2, 3).Value = k
                '-----------------------切分数据
                '------去掉头尾空白静音
                ReDim NewPCM(i - startpoint - k - 1)
                fp = FreeFile
                fn = apppath & "\test.pcm"
                Open fn For Binary As #fp
                    Seek #fp, AR
                    Get #fp, , NewPCM()
                Close #fp
                '------------写WAV文件
                fp = FreeFile
                fn = apppath & "\wav\" & sptxt(n) & ".wav"
                '------计算文件尺寸参数
                P3.Size = (UBound(NewPCM) + 1) * 2
                AR = i * 2 + 1 ' P3.Size + 1 ' startpoint * 2
                P1.Size = Headsize + P3.Size - 8
                '-----------输出新文件
                Open fn For Output As #fp
                Close #fp
                fp = FreeFile
                Open fn For Binary As #fp
                    Put #fp, , P1
                    Put #fp, , P2
                    Put #fp, , P3
                    Put #fp, , NewPCM()
                Close #fp
                '----------------------
                startpoint = i '去掉头尾空白静音 - SplitPoint + 1
                n = n + 1
                Worksheets("Sheet1").Cells(4, 3).Value = n
            End If
            k = 0
            If (tmpU - i) > 1001 Then
                i = i + 1000
            Else
                Exit For
            End If
        End If
        DoEvents
    Next
    MsgBox "splitX:" & n
End Sub

而后，将当前数据位置设定为下一次读取的起点，继续检索下一个 1 秒静音位置。为保证文件尾部最后一段声音能正确取出，需要判断检索位置是否已经接近文件尾部约1000个数据，是则需要将其作为最后一个块处理。

Loop

至此， PCM 数据全部切分成了 WAV 文件。

而部分声音文件还要进行二次切分，以便合成，而切分位置不固定，而且无特征串可以查找，无法编程处理，因此最后还用到了 GoldWave 对部分文件进行切分：

GoldWave 是一个小巧的功能强大的音频编辑软件，可读写 MP3、WAV、PCM 等多种常见的音频文件：

切分好的 WAV 文件最后用于合成，因此，还需要一个 WAV 合成程序，这里写了个最简单的，用于测试，还未优化为多文件合成，为简化合成程序，合成需要文件的音质参数完全一致，即 FORMAT 块应完全相等，如有不同音质的 WAV 文件，建议使用 GoldWave 先转换为相同音质：

Public Sub d2Wav()
    Dim P1 As RIFF, P2 As FORMAT, P3 As data, P2x As LIST
    Dim dataBlock() As Integer '这里只处理16位wav数据，不考虑8位，所以写死。
    Dim P0 As RIFF, AR As Long, i
    Dim fn, fp, fz, sptxt, txttemp, txtmp
    Dim startpoint As Long ', SplitPoint As Long   'Nullstartpoint As Long,
    Dim NewPCM1() As Integer, NewPCM2() As Integer '这里只处理16位wav数据，不考虑8位，所以写死。
    Dim Headsize As Long
    Dim fnwout, addFn, inWd(1), inFn(1)
    inWd(0) = Worksheets("Sheet1").Cells(7, 3).Value
    inWd(1) = Worksheets("Sheet1").Cells(7, 4).Value
    apppath = ActiveWorkbook.Path & "\"
    
    inFn(0) = apppath & "d\d" & IIf(inWd(0) < 0, "x", "0") & Right("00" & Abs(inWd(0)), 2)
    inFn(1) = apppath & "d\d" & IIf(inWd(1) < 0, "x", "0") & Right("00" & Abs(inWd(1)), 2)
    
            fnwout = apppath & "合成测试\d" & IIf(inWd(0) < 0, "x", "0") & Right("00" & Abs(inWd(0)), 2) & "d" & IIf(inWd(1) < 0, "x", "0") & Right("00" & Abs(inWd(1)), 2) '
            '--------------------读取文件1
            fp = FreeFile
            fn = inFn(0) & ".wav"
            Open fn For Binary As #fp
                Get #fp, , P1
                Get #fp, , P2
                Get #fp, , P0
                AR = Seek(fp) - 12
                Seek #fp, AR
                If P0.ID = "LIST" Then
                    Get #fp, , P2x
                End If
                Get #fp, , P3
                ReDim NewPCM1(P3.Size / 2 - 1)
                Get #fp, , NewPCM1()
            Close #fp
            Headsize = 12 + 8 + P2.Size + 8
            '--------------------读取文件2
            fp = FreeFile
            fn = inFn(1) & ".wav"
            Open fn For Binary As #fp
                Get #fp, , P1
                Get #fp, , P2
                Get #fp, , P0
                AR = Seek(fp) - 12
                Seek #fp, AR
                If P0.ID = "LIST" Then
                    Get #fp, , P2x
                End If
                Get #fp, , P3
                ReDim NewPCM2(P3.Size / 2 - 1)
                Get #fp, , NewPCM2()
            Close #fp
            Headsize = 12 + 8 + P2.Size + 8
            '-------------------------
            '------------写WAV文件
            fp = FreeFile
            fn = fnwout & ".wav"
            '------计算文件尺寸参数
            P3.Size = (UBound(NewPCM1) + 1 + UBound(NewPCM2) + 1) * 2
            P1.Size = Headsize + P3.Size - 8
            '-----------输出新文件
            Open fn For Output As #fp
            Close #fp
            fp = FreeFile
            Open fn For Binary As #fp
                Put #fp, , P1
                Put #fp, , P2
                Put #fp, , P3
                Put #fp, , NewPCM1()
                Put #fp, , NewPCM2()
            Close #fp
            '----------------------
    MsgBox "合成完毕！"
End Sub

PS: Hedit 是一个超小的功能强大的二进制文件查看及编辑器，这里用于分析 WAV 文件头：

最后，我坚持的原则是，软件不管新老、大小、是否有名，功能够用就行，越简单越小的越好！

就比如我上面提到的两个软件：Hedit 和 GoldWav，能用 Hedit 处理的我绝不用 ultraEdit ，能用 GoldWav 处理的我绝不用 Audition ，能用画笔处理的我绝不用 Photoshop ！

jessezappy

关注

1
点赞
踩
1

收藏

觉得还不错? 一键收藏
打赏
0
评论
讯飞配音使用记录：Excel VBA 编程处理多段短文字配音切分及 Hedit、GoldWave 后期处理、编程合成 WAV 文件

1.注册并购买讯飞配音会员2.选择需要的主播3.每天可免费配 80 条语音，每条 1 万字（中文）4.将多段短文字中间插入 1 秒停顿，配音下载，文字少的可直接使用GoldWave 录音。5.内容不多的就不说了，下面说下内容多的处理情况：我需要配的 600 多段短文字，有地名、数字、温馨提示等等，配好后需要将每段声音切分为独立的 WAV 文件便于程序调用，之前尝试过使用“讯飞开放平台”的 TTS 接口，但是里面的可选主播有使用时限限制，而且年费都是 2W 起，用不起。讯飞配音的会员就划.
复制链接

扫一扫