'################################################################
'# Wetterdaten lesen #
'################################################################
Const DownloadDest = "http://www.weather365.net/foreign/city6a.php?cityid=35377"
Const LocalFile = "C:\wetter3tg.htm"
Const DownloadType = "binary"
Dim strURL
Dim xmlhttp
Set xmlhttp=CreateObject("MSXML2.XMLHTTP.3.0")
strURL = DownloadDest
xmlhttp.open "GET", strURL, False
xmlhttp.send
If xmlhttp.status = 200 Then
Dim FSO
Set FSO=CreateObject("Scripting.FileSystemObject")
If FSO.FileExists(LocalFile) Then
FSO.DeleteFile LocalFile
End If
Set FSO=Nothing
Dim objStream
Set objStream = CreateObject("ADODB.Stream")
objStream.Type = 1 'adTypeBinary
objStream.Open
objStream.Write xmlhttp.responseBody
objStream.SaveToFile LocalFile
objStream.Close
Set objStream = Nothing
End If
Set xmlhttp=Nothing
'################################################################
'# Daten aus wetter3tg.htm Filtern #
'################################################################
Dim FSO2
Dim indatei
Set FSO2 = CreateObject("Scripting.FileSystemObject")
Set indatei = FSO2.OpenTextFile("C:\wetter3tg.htm",1)
Dim startpos, inzeile, endpos
Do While indatei.AtEndOfStream <> True
startpos = 0
inzeile = LTrim(indatei.ReadLine)
'ort
startpos = InStr(inzeile,"id=ort")
If startpos > 0 Then
startpos = InStr(inzeile,"_blank")
endpos=InStr(startpos+8,inzeile,"<")
SmartTags("wetter.ort") = Mid(inzeile,startpos+8,endpos-startpos-9)
End If
'heute
startpos = InStr(inzeile,"day1a")
If startpos > 0 Then
SmartTags("wetter.tag1_tag") = Mid(inzeile,startpos+7,2)
End If
startpos = InStr(inzeile,"day1b")
If startpos > 0 Then
endpos=InStr(startpos+14,inzeile,Chr(34))
SmartTags("wetter.tag1_wetter") = Mid(inzeile,startpos+14,endpos-startpos-14)
End If
startpos = InStr(inzeile,"day1c")
If startpos > 0 Then
endpos=InStr(inzeile,"°")
SmartTags("wetter.tag1_temax") = Mid(inzeile,startpos+7,endpos-startpos-7)
End If
startpos = InStr(inzeile,"day1d")
If startpos > 0 Then
endpos=InStr(inzeile,"°")
SmartTags("wetter.tag1_temin") = Mid(inzeile,startpos+7,endpos-startpos-7)
End If
'morgen
startpos = InStr(inzeile,"day2a")
If startpos > 0 Then
SmartTags("wetter.tag2_tag") = Mid(inzeile,startpos+7,2)
End If
startpos = InStr(inzeile,"day2b")
If startpos > 0 Then
endpos=InStr(startpos+14,inzeile,Chr(34))
SmartTags("wetter.tag2_wetter") = Mid(inzeile,startpos+14,endpos-startpos-14)
End If
startpos = InStr(inzeile,"day2c")
If startpos > 0 Then
endpos=InStr(inzeile,"°")
SmartTags("wetter.tag2_temax") = Mid(inzeile,startpos+7,endpos-startpos-7)
End If
startpos = InStr(inzeile,"day2d")
If startpos > 0 Then
endpos=InStr(inzeile,"°")
SmartTags("wetter.tag2_temin") = Mid(inzeile,startpos+7,endpos-startpos-7)
End If
'übermorgen
startpos = InStr(inzeile,"day3a")
If startpos > 0 Then
SmartTags("wetter.tag3_tag") = Mid(inzeile,startpos+7,2)
End If
startpos = InStr(inzeile,"day3b")
If startpos > 0 Then
endpos=InStr(startpos+14,inzeile,Chr(34))
SmartTags("wetter.tag3_wetter") = Mid(inzeile,startpos+14,endpos-startpos-14)
End If
startpos = InStr(inzeile,"day3c")
If startpos > 0 Then
endpos=InStr(inzeile,"°")
SmartTags("wetter.tag3_temax") = Mid(inzeile,startpos+7,endpos-startpos-7)
End If
startpos = InStr(inzeile,"day3d")
If startpos > 0 Then
endpos=InStr(inzeile,"°")
SmartTags("wetter.tag3_temin") = Mid(inzeile,startpos+7,endpos-startpos-7)
End If
Loop
Set FSO2=Nothing