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 !
VBScript Code
Double-click the code block to select all.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_t ... 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 '**********************************************************************************************