[HTA] create an MP3 sound file of typed text

Anything VBScript-related, including Windows Script Host, WMI, ADSI, and more.
Forum rules
Do not post any licensing information in this forum.

Any code longer than three lines should be added as code using the 'Select Code' dropdown menu or attached as a file.
Locked
User avatar
hackoo
Posts: 103
Joined: Sat Jan 22, 2011 12:27 am

[HTA] create an MP3 sound file of typed text

Post by hackoo » Mon Oct 14, 2013 5:32 pm

A Brazilian friend introduced this code:
[HTA] create an MP3 sound file of typed text
So I added a function to save Text2Speech MP3 and in the following languages​​:
  • French
    English
    Arabic
    Spanish
    Portuguese
    German
So my problem is that the sound is not recorded in Arabic format
So Please how to fix this issue ?
Thank you !
VBScript Code
Double-click the code block to select all.
<!D<!DOCTYPE HTML>
<!--
Comentário:
http://bbat.forumeiro.com/
http://dbatchscript.forumeiros.com/
-->
<html>
<head>
<title>Texto2som</title>
 
<HTA:APPLICATION
    ID="objDBatch-SOM"
    icon="SndVol.exe"
    APPLICATIONNAME="Texto2som"
    SCROLL="no"
    navigable="no"
    selection="no"
    showintaskbar="yes"
    singleinstance="no"
    innerborder="no"
    maximizebutton="yes"
    minimizebutton="yes"
    border="dialog"
    borderstyle="normal"
    caption="yes"
    contextMenu="no"
    sysmenu="yes"
    WINDOWSTATE="maximize"
>
<style type="text/css">
<!--
body {
   margin-left: 0px;
   margin-top: 0px;
   margin-right: 0px;
   margin-bottom: 0px;
   text-align: left;
   background-color: #000000;
}
-->
</style>
 
</head>
<body>
 
<td width="50%" valign="top">
 <font color=silver> Texto: Digite o texto para ouvir</font>
<br>
<FONT SIZE=2><B><I>Choose a Language</I></B></FONT><BR>
<select size="1" name="DropDown1" onChange="RunDropChange()">
<option value="Français-French">Français-French</option>
<option value="Anglais-English">Anglais-English</option>
<option value="Arabe-Arabic">Arabe-Arabic</option>
<option value="Espagnol">Espagnol</option>
<option value="Portugais">Portugais</option>
<option value="Allemand-Germany">Allemand-Germany</option>
</select>
<input name="txtFile" type="text" id="txtFile" size="95%" Value="Bonjour tous le monde !">
<INPUT TYPE="BUTTON" NAME="BtnPlay" VALUE="Ouvir" OnClick="StartMeUp()">
<INPUT TYPE="BUTTON" NAME="BtnStop" VALUE="Parar" OnClick="ShutMeDown()">
<INPUT TYPE="BUTTON" NAME="BtnAbout" VALUE="Sobre" OnClick="AboutMeUp()">
<INPUT TYPE="BUTTON" NAME="BtnSave" VALUE="Save it as MP3 File" OnClick="Save2MP3()">
</td></br>
<object classid="clsid:6BF52A52-394A-11D3-B153-00C04F79FAA6" id="WindowsMediaPlayer" width="100%" height="90%">
<param name="rate" value="1">
<param name="balance" value="0">
<param name="currentPosition" value="0">
<param name="defaultFrame" value="">
<param name="playCount" value="1">
<param name="autoStart" value="0">
<param name="currentMarker" value="0">
<param name="invokeURLs" value="-1">
<param name="baseURL" value="">
<param name="volume" value="100">
<param name="mute" value="0">
<param name="uiMode" value="mone">
<param name="stretchToFit" value="1">
<param name="windowlessVideo" value="-1">
<param name="enabled" value="-1">
<param name="enableContextMenu" value="-1">
<param name="fullScreen" value="0">
<param name="SAMIStyle" value="">
<param name="SAMILang" value="">
<param name="SAMIFilename" value="">
<param name="captioningID" value="">
<param name="enableErrorDialogs" value="1">
<param name="_cx" value="5292">
<param name="_cy" value="1561">
</object>
 
<SCRIPT TYPE="text/Vbscript">
Function StartMeUp()
     If DropDown1.Value = "Français-French" Then
         WindowsMediaPlayer.URL = "http://translate.google.com/translate_t ... 8&tl=fr&q=" + txtFile.value
         WindowsMediaPlayer.controls.play()
     End If
 
    If DropDown1.Value = "Anglais-English" Then
          WindowsMediaPlayer.URL = "http://translate.google.com/translate_t ... 8&tl=en&q=" + txtFile.value
          WindowsMediaPlayer.controls.play()
    End If
 
    If DropDown1.Value = "Arabe-Arabic" Then
          WindowsMediaPlayer.URL = "http://translate.google.com/translate_t ... 8&tl=ar&q=" + txtFile.value
          WindowsMediaPlayer.controls.play()
    End If
 
    If DropDown1.Value = "Espagnol" Then
          WindowsMediaPlayer.URL = "http://translate.google.com/translate_t ... 8&tl=es&q=" + txtFile.value
          WindowsMediaPlayer.controls.play()
    End If
 
    If DropDown1.Value = "Portugais" Then
          WindowsMediaPlayer.URL = "http://translate.google.com/translate_t ... 8&tl=pt&q=" + txtFile.value
          WindowsMediaPlayer.controls.play()
    End If
 
    If DropDown1.Value = "Allemand-Germany" Then
          WindowsMediaPlayer.URL = "http://translate.google.com/translate_t ... 8&tl=de&q=" + txtFile.value
          WindowsMediaPlayer.controls.play()
    End If
End Function
 
Function ShutMeDown()
    WindowsMediaPlayer.controls.stop()
End Function
 
Function AboutMeUp()
    MsgBox "Texto2som criado pelo Delmar Grande (2013)"&vbCr&_
    "Adding Function to save Text2Speech as MP3 File in French and English by Hackoo",64,"Texto2som criado pelo Delmar Grande and Hackoo (2013)"
End Function
 
 
Function Download2MP3(URL,strHDLocation)
Set objXMLHTTP = CreateObject("Microsoft.XMLHTTP")
objXMLHTTP.Open "GET", URL, False
objXMLHTTP.Send
Set objStream = createobject("Adodb.Stream")
objStream.type = 1
objStream.open
objStream.write objXMLHTTP.responseBody
objStream.savetofile strHDLocation, 2
objStream.close
set objStream = nothing
Set objXMLHTTP = Nothing
End Function
 
Sub RunDropChange
Msgbox "You Selected Option" & " " & DropDown1.Value, 64,"Dropdown Menu OnChange"
End Sub
 
Function Save2MP3()
Dim save
If DropDown1.Value = "Français-French" Then
Save = Download2MP3("http://translate.google.com/translate_t ... 8&tl=fr&q=" & txtFile.value,"c:\Text2speech-fr.mp3")
Save2MP3 = save
MsgBox "Enregistré avec succés dans c:\Text2speech-fr.mp3",64,"Enregistré avec succées !"
End If
 
If DropDown1.Value = "Anglais-English" Then
Save = Download2MP3("http://translate.google.com/translate_t ... 8&tl=en&q=" & txtFile.value,"c:\Text2speech-en.mp3")
Save2MP3 = save
MsgBox "Enregistré avec succés dans c:\Text2speech-en.mp3",64,"Enregistré avec succées !"
End If
 
If DropDown1.Value = "Arabe-Arabic" Then
Save = Download2MP3("http://translate.google.com/translate_t ... 8&tl=ar&q=" & txtFile.value,"c:\Text2speech-ar.mp3")
Save2MP3 = save
MsgBox "Enregistré avec succés dans c:\Text2speech-ar.mp3",64,"Enregistré avec succées !"
End If
 
If DropDown1.Value = "Espagnol" Then
Save = Download2MP3("http://translate.google.com/translate_t ... 8&tl=es&q=" & txtFile.value,"c:\Text2speech-es.mp3")
Save2MP3 = save
MsgBox "Enregistré avec succés dans c:\Text2speech-es.mp3",64,"Enregistré avec succées !"
End If
 
If DropDown1.Value = "Portugais" Then
Save = Download2MP3("http://translate.google.com/translate_t ... 8&tl=pt&q=" & txtFile.value,"c:\Text2speech-pt.mp3")
Save2MP3 = save
MsgBox "Enregistré avec succés dans c:\Text2speech-pt.mp3",64,"Enregistré avec succées !"
End If
 
If DropDown1.Value = "Allemand-Germany" Then
Save = Download2MP3("http://translate.google.com/translate_t ... 8&tl=de&q=" & txtFile.value,"c:\Text2speech-de.mp3")
Save2MP3 = save
MsgBox "Enregistré avec succés dans c:\Text2speech-de.mp3",64,"Enregistré avec succées !"
End If
End Function
</script>
</body>
</html>

Locked