下面串代码更快更更好!
call 文字朗读("最大支持1024个汉字朗读")
Sub 文字朗读(tex)
//固定函数,不懂不要修改。
//tok信息
Call Plugin.File.CreateFolder("C:\懒人调试\配置文件\临时语音")
grant_type = "client_credentials"//必须参数,固定为“client_credentials”
client_id = "gVVwMryyMeIevPxtAMxQYCnf"//必须参数,应用的 API Key
client_secret = "EOL8aAuRcYM2BgIBbgACCMqZ7r6S3kcu"//必须参数,应用的 Secret Key
tok_url = "https://openapi.baidu.com/oauth/2.0/token?"
tok_url = tok_url & "grant_type=" & grant_type & "&client_id=" & client_id & "&client_secret=" & client_secret
//api信息
api_url = "http://tsn.baidu.com/text2audio?"
lan = "zh"//必填 语言选择,填写zh
tok = 获取TOK(tok_url)//必填 开放平台获取到的开发者 access_token
ctp = 1//必填 客户端类型选择,web端填写1
cuid = Plugin.Sys.GetHDDSN()//必填 用户唯一标识,用来区分用户,填写机器 MAC 地址或 IMEI 码,长度为60以内
spd = 5//选填 语速,取值0-9,默认为5中语速
pit = 5//选填 音调,取值0-9,默认为5中语调
vol = 9//选填 音量,取值0-9,默认为5中音量
per = 0//选填 发音人选择,取值0-1, 0为女声,1为男声,默认为女声
api_url = api_url&"tex="&tex&"&lan="&lan&"&tok="&tok&"&ctp="&ctp&"&cuid="&cuid&"&spd="&spd&"&pit="&pit&"&per="&per
Call 语音播放(api_url)
End Sub
Function 获取TOK(xmlUrl)
//固定函数,不懂不要修改。
Set xmlHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
xmlHttp.Open "Get", xmlUrl, False
xmlHttp.Send
xmlBody = xmlHttp.ResponseBody
Set xmlHttp = Nothing
获得网页源文件 = ""
Set ObjStream = CreateObject("Adodb.Stream")
With ObjStream
.Type = 1
.Mode = 3
.Open
.Write xmlBody
.Position = 0
.Type = 2
.Charset = "UTF-8"
BytesToBstr = .ReadText
.Close
End With
Set ObjStream = Nothing
获取TOK = 解析JSON(BytesToBstr, "access_token")
End Function
ExitScript
Function 解析JSON(str, key)
//固定函数,不懂不要修改。
Dim i, v
解析JSON = ""
str = Replace(str, "{", "")
str = Replace(str, "}", "")
str = Replace(str, Chr(34), "")
obj = Split(str, ",")
For i = 0 To UBound(obj)
v = Split(obj(i), ":")
If v(0) = key Then
解析JSON = v(1)
Exit For
End If
Next
End Function
Sub 语音播放(url)
//固定函数,不懂不要修改。
Dim fso, MyFile
Set fso = CreateObject("Scripting.FileSystemObject")
// tmpFile = fso.GetTempName
返回值 = Lib.算法.随机取姓名()
tmpFile = "C:\懒人调试\配置文件\临时语音\" & 返回值 & ".tmp"//临时语音文件存放,请软件加载时清空此文件夹
Call 文件下载(url, tmpFile)
Call Plugin.Media.Play(tmpFile)
End Sub
Sub 文件下载(url, path)
//固定函数,不懂不要修改。
Dim xmlHttp, xmlBody, xmlUrl
If InStr(url, "http://") = 0 Then
xmlUrl = "http://" & url
Else
xmlUrl = url
End if
Set xmlHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
xmlHttp.Open "Get", xmlUrl, False
xmlHttp.Send
xmlBody = xmlHttp.ResponseBody
Set xmlHttp = Nothing
Set ObjStream = CreateObject("Adodb.Stream")
With ObjStream
.Type = 1
.Mode = 3
.Open
.Write xmlBody
.SaveToFile path, 2
End With
Set ObjStream = Nothing
End Sub