meteomaps_ru-HTML-meteonava_ru.vbs

'Rem погода по сайту meteonova.ru , данные берем по метеостанциям, коды станций берем с сайта meteomaps.ru
On Error Resume Next
C   = ""
URL = "http://meteomaps.ru/meteostation_codes.html"
CAll    R2(URL,"/",3)
f   = C
If Not CreateObject("Scripting.FileSystemObject").FileExists(f) then
Set IE  = CreateObject("InternetExplorer.Application")  'используем старый метод для скачивания, антивирус надоел на новое реагировать
IE.Navigate URL
While   IE.Busy Or (IE.ReadyState <> 4)
Wend
C   = IE.Document.body.innerHtml
IE.Quit
Set IE  = Nothing
Call    R2(C,"</table",0)(C,"<table ",1)    'вырезаем таблицу из скаченной страницы
C   = "<table " & C & "</table>"
Call    R1(C,Chr(10),"")(C,Chr(13),"")(C," </tr>"&vbCrLf,"")(C," </tr> <tr>  ","</tr>"&vbCrLf&"<tr>")(C,"tbody>","tbody>"&vbCrLf)(C,"  <td>","<td>")
CreateObject("Scripting.FileSystemObject").CreateTextFile(f,True).Write(C).Close
Call    R2(C,"<tbody>",0)
t   = C&"<tbody>"&vbCrLf
C   = ""
U   = "www.meteonova.ru/weather/"
Set tsLog   = CreateObject("Scripting.FileSystemObject").OpenTextFile(f,1)
Do While    Not tsLog.AtEndOfStream
    LineInFile  = tsLog.ReadLine
    i1  = InStr(1,LineInFile,"<tr><td>",1)
    If  i1 <> 0 Then
        sp  = Split(LineInFile,"<tr><td>")
        spp = Split(sp(1),"</td><td>",2)
        C   = C&"<tr><td><a href='https://"&U&spp(0)&"'>"&spp(0)&"</a></td><td>"&spp(1)&vbCrLf
    End If
Loop
Set ts_log  = Nothing
Call    R1(C,"https://"&U&"Синоптический индекс",URL)
CreateObject("Scripting.FileSystemObject").OpenTextFile(f,2,true).WriteLine(t&C)
End If
CreateObject("WScript.Shell").Run f
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