I am trying to write a vbscript that uses Google speech to the pronunciation of a message.
I have to save the code into notepad ++ with UTF8 encoding without BOM and pronunciation is good, but the display of the message box is not good for accented characters. How to solve this problem ?
Thank you!
Option Explicit
Call Ip_Publique()
'***********************************************************************************************************************************************************
Sub Ip_Publique()
Dim Titre,URL,ie,objFSO,Data,OutPut,objRegex,Match,Matches,ip_public
Dim Message,URLFR
Message = "Vous êtes connecté à internet !" & VbCrlf & "Votre IP Publique est : "
URLFR = "http://translate.google.com/translate_tts?ie=UTF-8&tl=fr&q=" & Message
Titre = "Adresse Ip Publique !"
URL = "http://monip.org"
If OnLine("smtp.gmail.com") = True Then
Set ie = CreateObject("InternetExplorer.Application")
Set objFSO = CreateObject("Scripting.FileSystemObject")
ie.Navigate (URL)
ie.Visible=False
DO WHILE ie.busy
Wscript.Sleep 100
Loop
Data = ie.document.documentElement.innertext
Set objRegex = new RegExp
objRegex.Pattern = "\b([0-9]{1,3}\.){3}[0-9]{1,3}\b"
objRegex.Global = False
objRegex.IgnoreCase = True
Set Matches = objRegex.Execute(Data)
For Each Match in Matches
Call Kill("wmplayer.exe")
Call WmPlaySound(URLFR & Match.Value)
MsgBox Message & Match.Value,64,Titre
Pause(10)
Call Kill("wmplayer.exe")
Next
ie.Quit
Set ie = Nothing
Else
MsgBox "Vérifier votre connexion internet puis re-executer ce script",48,Titre
Exit Sub
End If
End Sub
'************************************************************************************************************************************************************
Function OnLine(strHost)
Dim objPing,z,objRetStatus,PingStatus
Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery("select * from Win32_PingStatus where address = '" & strHost & "'")
z = 0
Do
z = z + 1
For Each objRetStatus In objPing
If IsNull(objRetStatus.StatusCode) Or objRetStatus.StatusCode <> 0 Then
PingStatus = False
Else
PingStatus = True
End If
Next
Call Pause(1)
If z = 4 Then Exit Do
Loop until PingStatus = True
If PingStatus = True Then
OnLine = True
Else
OnLine = False
End If
End Function
'*********************************************************************************************
'Fonction pour ajouter les doubles quotes dans une variable
Function DblQuote(Str)
DblQuote = Chr(34) & Str & Chr(34)
End Function
'**********************************************************************************************
Sub WmPlaySound(MySound)
Dim WshShell
Set WshShell = CreateObject("WScript.Shell")
WshShell.Run "wmplayer "& DblQuote(MySound) &"",0,False
Set WshShell = Nothing
End Sub
'**********************************************************************************************
Sub Kill(Process)
Dim Ws,Command,Execution
Set Ws = CreateObject("WScript.Shell")
Command = "cmd /c Taskkill /F /IM "&Process&""
Execution = Ws.Run(Command,0,True)
End Sub
'**********************************************************************************************
Sub Pause(NSeconds)
Wscript.Sleep(NSeconds*1000)
End Sub
'**********************************************************************************************
OK, i solved it like this and you can give a try and post me your feed back.
The script is saved as ANSI and it worked well for me.
Description :
This script will display three messages box with 3 different languages with Google Voice Speech.
Option Explicit
Call Ip_Publique()
'***********************************************************************************************************************************************************
Sub Ip_Publique()
Dim Titre,URL,ie,objFSO,Data,OutPut,objRegex,Match,Matches,ip_public,IP
Dim MessageEN,MessageFR,MessageAR,URLEN,URLFR,URLAR,Copyright
Copyright = "(2014 © Hackoo)"
MessageEN = "You are connected to the internet !" & VbCrlf & "Your Public IP Adress is "
MessageFR = "Vous êtes connecté à internet !" & VbCrlf & "Votre IP Publique est "
MessageAR = ChrW(1571)&ChrW(1606)&ChrW(1578)&ChrW(32)&ChrW(1605)&ChrW(1578)&ChrW(1589)&ChrW(1604)&_
ChrW(32)&ChrW(1576)&ChrW(1588)&ChrW(1576)&ChrW(1603)&ChrW(1577)&ChrW(32)&ChrW(1575)&ChrW(1604)&ChrW(1573)&_
ChrW(1606)&ChrW(1578)&ChrW(1585)&ChrW(1606)&ChrW(1578)& VbCrlf & "IP "
URLEN = "http://translate.google.com/translate_tts?tl=en&q=" & MessageEN
URLFR = "http://translate.google.com/translate_tts?tl=fr&q=" & MessageFR
URLAR = "http://translate.google.com/translate_tts?ie=UTF-8&tl=ar&q=" & MessageAR
Titre = "Adresse IP Publique " & Copyright
URL = "http://monip.org"
If OnLine("smtp.gmail.com") = True Then
Set ie = CreateObject("InternetExplorer.Application")
Set objFSO = CreateObject("Scripting.FileSystemObject")
ie.Navigate (URL)
ie.Visible=False
DO WHILE ie.busy
Wscript.Sleep 100
Loop
Data = ie.document.documentElement.innertext
Set objRegex = new RegExp
objRegex.Pattern = "\b([0-9]{1,3}\.){3}[0-9]{1,3}\b"
objRegex.Global = False
objRegex.IgnoreCase = True
Set Matches = objRegex.Execute(Data)
For Each Match in Matches
IP = Match.Value
Call NavigateIE(URLEN & IP)
MsgBox MessageEN & IP,64,Titre
Call NavigateIE(URLFR & IP)
MsgBox MessageFR & IP,64,Titre
Call NavigateIE(URLAR & IP)
MsgBox MessageAR & IP,64,Titre
Next
ie.Quit
Set ie = Nothing
Else
MsgBox "Vérifier votre connexion internet puis re-executer ce script",48,Titre
Exit Sub
End If
End Sub
'************************************************************************************************************************************************************
Function OnLine(strHost)
Dim objPing,z,objRetStatus,PingStatus
Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery("select * from Win32_PingStatus where address = '" & strHost & "'")
z = 0
Do
z = z + 1
For Each objRetStatus In objPing
If IsNull(objRetStatus.StatusCode) Or objRetStatus.StatusCode <> 0 Then
PingStatus = False
Else
PingStatus = True
End If
Next
Call Pause(1)
If z = 4 Then Exit Do
Loop until PingStatus = True
If PingStatus = True Then
OnLine = True
Else
OnLine = False
End If
End Function
'*********************************************************************************************
'Fonction pour ajouter les doubles quotes dans une variable
Function DblQuote(Str)
DblQuote = Chr(34) & Str & Chr(34)
End Function
'**********************************************************************************************
Sub Pause(NSeconds)
Wscript.Sleep(NSeconds*1000)
End Sub
'**********************************************************************************************
Sub NavigateIE(URL)
Dim objExplorer
Set objExplorer = CreateObject("InternetExplorer.Application")
with objExplorer
.Navigate(URL)
.Visible = False
end with
End Sub
'**********************************************************************************************
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With