[VBS] Google Speech

Version imprimable

[VBS] Google Speech

:salut:
Je veux réaliser un VBScript Google Speech, mais j'ai quelques problèmes avec ce code :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
input = InputBox("Indiquez un texte à lire","Indiquez un texte à lire")
 
HTTPDownload "http://translate.google.com/translate_tts?ie=UTF-8&tl=fr&q=" &input,"c:\Gspeak.mp3" 
 
Sub HTTPDownload(strFileURL,strHDLocation)
'MsgBox "http://translate.google.com/translate_tts?ie=UTF-8&tl=fr&q=" &input
    Set Ws = CreateObject("WScript.Shell")
    Set objXMLHTTP = CreateObject("MSXML2.XMLHTTP")
    objXMLHTTP.open "GET", strFileURL, false
    objXMLHTTP.send()
If objXMLHTTP.Status = 200 Then
Set objADOStream = CreateObject("ADODB.Stream")
objADOStream.Open
objADOStream.Type = 1 'adTypeBinary
objADOStream.Write objXMLHTTP.ResponseBody
objADOStream.Position = 0    'Set the stream position to the start
Set objFSO = Createobject("Scripting.FileSystemObject")
If objFSO.Fileexists(strHDLocation) Then objFSO.DeleteFile strHDLocation
Set objFSO = Nothing
objADOStream.SaveToFile strHDLocation
objADOStream.Close
Set objADOStream = Nothing
End If
Set objXMLHTTP = Nothing 
Ws.Run strHDLocation
Set WS = Nothing
End Sub

Donc, je reçois cette erreur :

Citation:

Ligne 10 Caract :5
The system cannot locate the resource specified
Code : 800C0005
msxml3.dll

Alors je cherche à améliorer ce code ou bien peut-être vous me suggérer d'autres méthodes pour atteindre mon but
:merci:

:salut:
Bon j'ai fait avec une autre méthode mais ce n'est pas exactement ce que je souhaite faire :( car je veux bien récupérer le fichier .mp3 en l’enregistrant sur mon disque dur or avec ce code juste il me lit le texte sans enregistrement :cry:
Code:

1 2 3 4 5 6 7 8 9 10 11 Function URL(adress) Set ie = CreateObject("InternetExplorer.Application") ie.Navigate(adress) ie.Visible=false DO While ie.busy WScript.Sleep 20 Loop URL = ie.document.documentElement.innertext end Function input = InputBox("Indiquez un texte à lire","Indiquez un texte à lire") URL"http://translate.google.com/translate_tts?ie=UTF-8&tl=fr&q=" &input
Est-ce-qu'il y a une méthode ou une astuce pour récupérer le fichier .mp3
:merci:

09/04/2012, 18h58
tsuji

J'ai fait un test simple et le premier script devrait marcher pour un texte simple. Pourtant, comme principle, il faut faire un encodage d'input tout de même pour être plus correct?

Code:

HTTPDownload "http://translate.google.com/translate_tts?ie=UTF-8&tl=fr&q=" & escape(input),"c:\Gspeak.mp3"

Avec js, on a encodeURIComponent() à notre disposition, pas en vbs: dont on utilise escape() comme un proxy rapide.

Citation:

Envoyé par tsuji

J'ai fait un test simple et le premier script devrait marcher pour un texte simple. Pourtant, comme principle, il faut faire un encodage d'input tout de même pour être plus correct?

Code:

HTTPDownload "http://translate.google.com/translate_tts?ie=UTF-8&tl=fr&q=" & escape(input),"c:\Gspeak.mp3"

Avec js, on a encodeURIComponent() à notre disposition, pas en vbs: dont on utilise escape() comme un proxy rapide.

:salut: voila j'ai un peu avancé dans le script mais je ne sais pas pourquoi parfois ça marche et parfois ne marche pas surtout pour Text2speech-ar.mp3 :koi:
Testé sur un Windows XP Pro SP3

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
Title = "Text2Speech Powered by © Google"
inputLang = InputBox("Indiquez la Langue :"&vbcr& "- 1 pour Français "&vbcr& "- 2 pour Anglais "&vbcr& "- 3 العربية",Title,"1")
Set ws = CreateObject("wscript.shell")
set fso = CreateObject("scripting.FileSystemObject")
select case inputLang
case 1
input = InputBox("Indiquez un texte à lire",Title,"Salut tout le Monde!") ' French
MsgBox "http://translate.google.com/translate_tts?ie=UTF-8&tl=en&q=" &Escape(input)
URL"http://translate.google.com/translate_tts?ie=UTF-8&tl=fr&q=" &Escape(input)
Download2MP3 "http://translate.google.com/translate_tts?ie=UTF-8&tl=fr&q=" &Escape(input),"c:\Text2speech-fr.mp3"
If fso.FileExists("c:\Text2speech-fr.mp3") Then
ws.run "wmplayer.exe c:\Text2speech-fr.mp3",0,True
TerminateProcess "iexplore.exe"
TerminateProcess "wmplayer.exe"
end if
case 2
input = InputBox("Enter text to speech",Title,"Hello World") 'English
MsgBox "http://translate.google.com/translate_tts?ie=UTF-8&tl=en&q=" &Escape(input)
URL"http://translate.google.com/translate_tts?ie=UTF-8&tl=en&q=" &Escape(input)
Download2MP3 "http://translate.google.com/translate_tts?ie=UTF-8&tl=en&q=" &Escape(input),"c:\Text2speech-en.mp3"
If fso.FileExists("c:\Text2speech-en.mp3") Then
ws.run "wmplayer.exe c:\Text2speech-en.mp3",0,True
TerminateProcess "iexplore.exe"
TerminateProcess "wmplayer.exe"
end if
Case 3
input = InputBox("أدخل النص للخطاب",Title,"199") ' Arabic
MsgBox "http://translate.google.com/translate_tts?ie=UTF-8&tl=en&q=" &Escape(input)
URL"http://translate.google.com/translate_tts?ie=UTF-8&tl=ar&q=" &Escape(input)
Download2MP3 "http://translate.google.com/translate_tts?ie=UTF-8&tl=ar&q=" &Escape(input),"c:\Text2speech-ar.mp3"
If fso.FileExists("c:\Text2speech-ar.mp3") Then
ws.run "wmplayer.exe c:\Text2speech-ar.mp3",0,True
TerminateProcess "iexplore.exe"
TerminateProcess "wmplayer.exe"
end if
end select
 
 
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
 
Function URL(adress)
Set ie = CreateObject("InternetExplorer.Application") 
ie.Navigate(adress) 
ie.Visible=False
DO While ie.busy
WScript.Sleep 20
Loop
end Function
 
Sub TerminateProcess(App)
Ws.Run "cmd /C taskkill /f /im "&App&"",0,TRUE
End Sub
 
Function Escape(str)
Dim strNocode,out,Car,i
strNocode = "*+-./0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ_abcdefghijklmnopqrstuvwxyz"
out = ""
If Len(str) > 0 Then
 str = Replace(str, " ", "+")
 For i = 1 To Len(str)
  Car = Mid(str, i, 1)
  If InStr(strNocode, Car) Then
    out = out & Car
  Else
    out = out & "%" & Hex(Asc(Car))
  End If
 Next 
End If
Escape = out
End Function

[0] Je ne suis pas trop impressionné Escape() specialisée de cette façon: il vaut mieux laisser la fonction built-in telle quelle et elle est sufficente pour le cas ici besoin. Ou bien utilsez un variant de nom pour ce cas?

[1] Pour la présence des caractères avec l'encodage plus haut que 127, il faut faire un effort de plus pour quelque peu "tricher" le sysème d'y croire comme cas normaux. Voice un rendrement de cette fonction pour y arriver.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 function convert_utf8_encoded(s) 'put to convert a string internally ucs encoded to utf-8 encoded "string" dim ostream, barr, s_encoded, i set ostream=createobject("adodb.stream") with ostream .mode=3 'adModeReadWrite .open .type=2 'adTypeText .charset="utf-8" .writetext s '.flush .position=0 .type=1 'adTypeBinary .position=3 'passing by utf-8 3-byte bom barr=.read(-1) 'adReadAll=-1 .close s_encoded="" for i=1 to lenb(barr) s_encoded = s_encoded & chr(ascb(midb(barr, i, 1))) next end with set ostream=nothing convert_utf8_encoded=s_encoded end function
[1.1] Partout receuillant l'input, on le fait convertir et puis continue le travail.
Code:

1 2 3 4 5 'the same for all cases of select input = InputBox("Indiquez un texte à lire",Title,"Salut tout le Monde!") ' French input = convert_utf8_encoded(input) MsgBox "http://translate.google.com/translate_tts?ie=UTF-8&tl=en&q=" &Escape(input) 'etc...
Comme ça je crois bien il doit marcher dans "tous" les cas.

:merci: tsuji pour votre intervention et dans la même occasion j'ai trouvé aussi une solution en Autoit

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
#include <Sound.au3>
 
$input = InputBox("Que dire?","Indiquez un texte à lire")
if @error then exit
 
$input = _URIEncode($input)
 
InetGet("http://translate.google.com/translate_tts?ie=UTF-8&tl=fr&q=" & $input,@TempDir & "\temp.mp3",1)
 
$sound = _SoundOpen(@TempDir & "\temp.mp3")
_SoundPlay($sound,1)
_SoundClose($sound)
 
Func _URIEncode($sData)
    ; Prog@ndy
    Local $aData = StringSplit(BinaryToString(StringToBinary($sData,4),1),"")
    Local $nChar
    $sData=""
    For $i = 1 To $aData[0]
        ConsoleWrite($aData[$i] & @CRLF)
        $nChar = Asc($aData[$i])
        Switch $nChar
            Case 45, 46, 48 To 57, 65 To 90, 95, 97 To 122, 126
                $sData &= $aData[$i]
            Case 32
                $sData &= "+"
            Case Else
                $sData &= "%" & Hex($nChar,2)
        EndSwitch
    Next
    Return $sData
EndFunc