Option Explicit On Option Strict On Imports System.IO Imports System.Text Imports System.Net Imports System.Net.Http Imports System.Runtime.Serialization Imports System.Runtime.Serialization.Json Public Class Form1 Private WithEvents Button1 As New Button Private TextBox1 As New TextBox Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load Me.Text = "VoiceText" Me.TextBox1.Multiline = True Me.TextBox1.Location = New Point(10, 10) Me.TextBox1.Size = New Size(265, 80) Me.TextBox1.Text = "ボイステキストのデモンストレーションです。" Me.Button1.Location = New Point(150, 100) Me.Button1.Size = New Size(120, 30) Me.Button1.Text = "読む" Me.Controls.AddRange({Me.TextBox1, Me.Button1}) End Sub Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click Dim VoiceText1 As New VoiceText VoiceText1.Text = Me.TextBox1.Text Dim VoiceData As Byte() = VoiceText1.GetVoice My.Computer.Audio.Play(VoiceData, AudioPlayMode.Background) End Sub End Class Public Class VoiceText Const API_KEY As String = "xxxxxxxxxxxxxxxx" Const Url As String = "https://api.voicetext.jp/v1/tts" Property Text As String Property Speaker As VTSpeaker = VTSpeaker.Takeru Property Format As VTFormat = VTFormat.Wav Property Emotion As VTEmotion = VTEmotion.Nomal Property EmotionLevel As Integer = 1 Property Pitch As Integer = 100 Property Speed As Integer = 100 Property Volume As Integer = 100 Public Function GetVoice() As Byte() Dim parm As New Dictionary(Of String, String) parm.Add("text", Me._Text) parm.Add("speaker", Me._Speaker.ToString.ToLower) parm.Add("format", Me._Format.ToString.ToLower) parm.Add("pitch", Me._Pitch.ToString) parm.Add("speed", Me._Speed.ToString) parm.Add("volume", Me._Volume.ToString) If {VTSpeaker.Takeru, VTSpeaker.Haruka, VTSpeaker.Hikari, VTSpeaker.Santa, VTSpeaker.Bear}.Contains(Me._Speaker) Then If Me.Emotion <> VTEmotion.Nomal Then parm.Add("emotion", Me._Emotion.ToString.ToLower) parm.Add("emotion_level", Me._EmotionLevel.ToString) End If End If Dim dat As New FormUrlEncodedContent(parm) Dim httpClient As New HttpClient Dim credentials As String = Convert.ToBase64String(Encoding.ASCII.GetBytes(API_KEY & ":")) httpClient.DefaultRequestHeaders.Add("Authorization", "Basic " & credentials) Dim res As HttpResponseMessage = httpClient.PostAsync(Url, dat).Result If res.StatusCode <> HttpStatusCode.OK Then Dim resError As String = res.Content.ReadAsStringAsync.Result Using ms As MemoryStream = New MemoryStream(Encoding.UTF8.GetBytes(resError)) Dim ser As New DataContractJsonSerializer(GetType(VTError)) Dim Err As VTError = DirectCast(ser.ReadObject(ms), VTError) Throw New VTException(res.StatusCode, Err.error.message) End Using End If Dim resData As Byte() = res.Content.ReadAsByteArrayAsync.Result Return resData End Function End Class Public Enum VTSpeaker Show Haruka Hikari Takeru Santa Bear End Enum Public Enum VTFormat Wav Ogg Aac End Enum Public Enum VTEmotion Nomal Happiness Anger Sadness End Enum <DataContract> Public Class VTError <DataMember> Property [error] As VTErrorMessage <DataContract> Public Class VTErrorMessage <DataMember> Property message As String End Class End Class Public Class VTException Inherits InvalidOperationException Property HttpStatusCode As HttpStatusCode Property ErrorMessage As String Sub New(HttpStatusCode As HttpStatusCode, ErrorMessage As String) Me._HttpStatusCode = HttpStatusCode Me._ErrorMessage = ErrorMessage End Sub End Class