MeteoMaps_ru.vbs

'Сделаем на всякий случай перезапуск в кодовой странице ОС из ДОС
If  Lcase(Right(Wscript.FullName, 12)) =    "\cscript.exe" Then
    CreateObject("Wscript.Shell").Run "wscript.exe " & Chr(34) & Wscript.ScriptFullName & Chr(34)
    Wscript.Quit
End If
On Error Resume Next
URL = "http://meteomaps.ru/meteostation_codes.html"
Set IE  = CreateObject("InternetExplorer.Application")
IE.Navigate URL
While   IE.Busy Or (IE.ReadyState <> 4)     'ждём, пока страница загрузиться
Wend    'DoEvents
C   = IE.Document.body.innerHtml        'считываем HTML код веб-страницы в текстовую переменную
IE.Quit
Set IE  = Nothing
'Файл начинается с 3 символов [EF BB BF], которые превращают его в двоичный, поэтому просто вырезаем таблицу и получаем только текст для сохранения в файл
Call    R2(C,"</table",0)(C,"<table ",1)    'вырезаем таблицу
C   = "<table " & C & "</table"     'здесь восстанавливаем теговую структуру таблицы
CreateObject("Scripting.FileSystemObject").CreateTextFile("f.htm",True).Write(C).Close 'сохраним таблицу в виде файла
'удаляем теги и спецсимволы, между столбцами вставляем разделитель |
Call    R1(C,Chr(10),"")(C,Chr(13),"")(C,"</tr>","</tr>"&vbCrLf)(C,"<tr>  <td>","")(C,"</td>  <td>","|")(C,"</td> </tr>","")(C," </tr>"&vbCrLf,"")
f   = "C.txt"   'файл для работы
CreateObject("Scripting.FileSystemObject").CreateTextFile(f,True).Write(C).Close
'MsgBox "The End":Wscript.Quit          'Для отладки прерываем работу
t1  = InputBox("Введите Ваш город","Город","Брянск")
Set tsLog   = CreateObject("Scripting.FileSystemObject").OpenTextFile(f,1)
Do While    Not tsLog.AtEndOfStream
    LineInFile  = Trim(tsLog.ReadLine)
    i1  = InStr(1,LineInFile,t1,1)
    If  i1 <> 0 Then
        out = out&LineInFile&vbCrLf
        M   = Split(LineInFile,"|")
        CreateObject("WScript.Shell").Run "https://www.meteonova.ru/weather/"&M(0)  'откроем страницу с погодой в данной точке по сайту meteonova.ru
        CreateObject("WScript.Shell").Run "https://www.meteonova.ru/speech/forecast_"&M(0)&"_0.mp3" 'откроем страницу с погодой в данной точке по сайту meteonova.ru
        WScript.Sleep   1000*1
    End If
Loop
CreateObject("Scripting.FileSystemObject").OpenTextFile(f,2,true).WriteLine (out)
'CreateObject("WScript.Shell").Run "f.html"
MsgBox "The End."
Function R1 (Cc,x,y)
    C     = Replace(Cc,x,y)
    Set R1 = GetRef("R1")
End Function
Function R2 (Cc,x,y)
    C     = Split(Cc,x)(y)
    Set R2 = GetRef("R2")
End Function