Loading bar
<% Option Explicit%><!-- #include file="VejrObj.asp" --><%
Session.LCID=1030
%>
<table border="0" cellpadding="0" cellspacing="0" style="BORDER-COLLAPSE: collapse" width="90%" id="AutoNumber2" bgcolor="">
<tr>
<td ALIGN=center STYLE="border-bottom-style:solid; border-bottom-width:1px;">
<font face="Verdana" size="3" color="#0000FF">
<div id=""><b>Vejret i <%=request.queryString("afd")%></b></div>
</td>
</tr>
</table>
<table border="0" cellpadding="0" cellspacing="0" style="BORDER-COLLAPSE: collapse" width="90%" id="AutoNumber2" bgcolor="#CCCCCC">
<tr>
<td style="width=06%"><b><font face="Verdana" size=2>Land</td>
<td style="width=08%"><b><font face="Verdana" size=2>Station</td>
<td width=02% align=center><b><font face="Verdana" size=1>Udsigt</td>
<td style="width=08%" align=right><b><font size=2>Dag / </td>
<td style="width=05%"><b><font size=2>Nat</td>
<td style="width=05%"><b><font size=2>Fugt.</td>
<td style="width=13%"><b><font size=2>Tryk in / mBar</td>
<td style="width=13%"><b><font size=2>Forhold</td>
<td style="width=04%"><b><font size=2>Vind</td>
<td style="width=05%"><b><font size=2></td>
<td style="width=03%"><b><font size=2></td>
<td style="width=10%"><b><font size=2>Benævnelse</td>
<td style="width=10%" align=right><b><font size=2>Opdateret</td>
</tr>
</table>
<%
dim URLToRSS,MaxNumberOfItems,MainTemplateHeader,MainTemplateFooter,ItemTemplate,ErrorMessage,xmlHttp,RSSXML,xmlDOM
dim RSSItems,RSSItemsCount,j,i,RSSItem,child,RSStitle,RSSlink,RSSdescription,ItemContent,originalString,sted,x
dim temp,luft,tryk,forhold,vind,vindh,tm,vh,natstring,tmp,ntmp,land
' =========== RSS2HTML.ASP for ASP/ASP.NET ==========
' copyright 2005 (c) www.Bytescout.com
' ===============================================
Sub VisVejrStation(vs)
vs=split(vs,",")
' =========== configuration =====================
' ##### URL to RSS Feed to display #########
URLToRSS = "http://www.wunderground.com/auto/rss_full/global/stations/"&vs(1)&".xml?units=both" 'RSS Feed
' URLToRSS = "http://www.wunderground.com/auto/ical/global/stations/06024.ics?units=both" 'iCal Feed
' ##### max number of displayed items #####
MaxNumberOfItems = 2
' ##### Main template constants
MainTemplateHeader = "<table>"
MainTemplateFooter = "</table>"
' #####
' ##### Item template.
' ##### {LINK} will be replaced with item link
' ##### {TITLE} will be replaced with item title
' ##### {DESCRIPTION} will be replaced with item description
ItemTemplate = "<tr><td><b><font size=1><a href=" & """{LINK}""" & ">{TITLE}</a><BR>{DESCRIPTION}</td></tr>"
' ##### Error message that will be displayed if not items etc
ErrorMessage = "Error has occured while trying to process " &URLToRSS & "<BR>Please contact web-master"
' ================================================
Set xmlHttp = Server.CreateObject("MSXML2.XMLHTTP.3.0")
xmlHttp.Open "Get", URLToRSS, false
xmlHttp.Send()
RSSXML = xmlHttp.ResponseText
Set xmlDOM = Server.CreateObject("MSXML2.DomDocument.3.0")
xmlDOM.async = false
xmlDOM.LoadXml(RSSXML)
Set xmlHttp = Nothing ' clear HTTP object
Set RSSItems = xmlDOM.getElementsByTagName("item") ' collect all "items" from downloaded RSS
Set xmlDOM = Nothing ' clear XML
RSSItemsCount = RSSItems.Length-1
' writing Header
if RSSItemsCount > 0 then
' Response.Write MainTemplateHeader
End If
j = -1
For i = 0 To RSSItemsCount
Set RSSItem = RSSItems.Item(i)
for each child in RSSItem.childNodes
Select case lcase(child.nodeName)
case "title"
RSStitle = child.text
if I=0 then
sted=Split(RSStitle,",")
end if
case "link"
RSSlink = child.text
case "description"
RSSdescription = child.text
if I=0 then
originalString=child.text
originalString = Split( originalString,"|")
For x = 0 to Ubound(originalString)
Select case x
case 0
tm= Split(originalString(x),":")
tmp= Split(tm(1),"°")
temp= Split(tmp(1),"/")
If InStr(temp(1),".") > 0 Then
temp(1)=Trim(temp(1)) +" °C."
Else
temp(1)=Trim(temp(1))+".0 °C."
End If
case 1
luft= Split(originalString(x),":")
case 2
tryk= Split(originalString(x),":")
tryk(1)=replace(tryk(1),"hPa","")
tryk(1)=replace(tryk(1),"in","")
case 3
forhold= Split(originalString(x),":")
case 4
originalString(x)=Replace(originalString(x),".",",")
vind= Split(originalString(x),":")
case 5
originalString(x)=Replace(originalString(x),"mph","")
vh=Split(originalString(x),":")
vindh=Split(vh(1),"/")
end select
Next
else
if j=1 then
ntmp = Split(child.text,"/")
tmp=split(ntmp(1),"C.")
natString=trim(tmp(0))+"C."
end if
end if
End Select
next
j = J+1
if J<MaxNumberOfItems then
ItemContent = Replace(ItemTemplate,"{LINK}",RSSlink)
ItemContent = Replace(ItemContent,"{TITLE}",RSSTitle)
' Response.Write Replace(ItemContent,"{DESCRIPTION}",RSSDescription)
ItemContent = ""
End if
Next
If InStr(vindh(0),".") > 0 Then
vindh(0)=Trim(vindh(0))
Else
vindh(0)=Trim(vindh(0))+".0"
End If
' writing Footer
if RSSItemsCount > 0 then
' Response.Write MainTemplateFooter
dim mapinfo
mapinfo=HentGeo(vs(1))&"(Vejrstation:%A0"&sted(0) &_
"%A0%A0%A0%A0%A0Temp:%A0"&Server.UrlEncode(temp(1))&_
"%A0%A0"&translate(forhold(1))&_
"%A0%A0"&vindh(0)&_
"%A0m/s%A0"&BeaufortSkala(vindh(0))&")&z=07"
%>
<table width="90%">
<tr>
<td style="width=06%"><b><font face="Verdana" size=1><I><%=vs(0)%></I></td>
<td style="width=08%" ><a href="http://maps.google.com/maps?q=<%=mapinfo%>" target="_self"><b><font face="Verdana" size=1><%=left(sted(0),12) %></td>
<td width=2% align=center>
<a href="ZVejr.asp?vejrstation=<%=vs(1)%>" target="_self">
<font face="Verdana" size="1" color="#0000FF"><img border=0 src="/Images/Kartei.gif" width="12" height="12" alt="5 Døgns udsigt"></font></a>
</td>
<td style="width=08%" align=right><b><font size=1><%=temp(1)&" / "%></td>
<td style="width=05%" ><b><font size=1><%=Trim(NatString)%></td>
<td style="width=05%" ><b><font size=1><%=luft(1)%></td>
<td style="width=13%" ><b><font size=1><%=tryk(1)%></td>
<td style="width=13%" ><b><font size=1><%=translate(forhold(1))%></td>
<td style="width=04%" ><b><font size=1><%=left(vind(1),6)%></td>
<td style="width=05%" align=right><b><font size=1><%=vindh(0)%></td>
<td style="width=03%" align=center><b><font size=1>m/s</td>
<td style="width=10%" ><b><font size=1><%= BeaufortSkala(vindh(0))%></td>
<td style="width=10%" align=right><b><font size=1><%=right(originalString(6),12)%></td>
</tr>
</table>
<%
else
Response.Write ErrorMessage
End If
End Sub
function translate(fh)
select case trim(fh)
case "Mostly Cloudy"
translate="Delvis Skyet"
case "Partly Cloudy"
translate="Let Skyet"
case "Scattered Clouds"
translate="Spredte Skyer"
case "Light Snow"
translate="Let Sne"
case "Blowing Snow"
translate="Blæsende Sne"
case "Light Rain"
translate="Let Regn"
case "Low Drifting Snow"
translate="Let Snefug"
case "Snow"
translate="Sne"
case "Clear"
translate="Klart"
case "Heavy Snow"
translate="Kraftig Snevejr"
case "Drizzle"
translate="Støvregn"
case "Light Snow Showers"
translate="Lette Sne Byger"
case "Rain"
translate="Regn"
case "Light Rain Showers"
translate="Lette Regn Byger"
case "Heavy Snow Showers"
translate="Kraftige Sne Byger"
case "Light Low Drifting Snow"
translate="Lette Snefog"
case "Snow Showers"
translate="Sne Byger"
case "Light Drizzle"
translate="Let Støvregn"
case "Overcast"
translate="Overskyet"
case else
translate=fh
end select
end function
Function BeaufortSkala(msek)
Dim m
m = CDbl(replace(msek,".",","))
if m < 0.2 then
BeaufortSkala="Stille"
ElseIf m<1.6 then
BeaufortSkala="Næsten stille"
ElseIf m<3.4 then
BeaufortSkala="Svag vind"
ElseIf m<5.5 then
BeaufortSkala="Let vind"
ElseIf m<8.0 then
BeaufortSkala="Jævn vind"
ElseIf m<10.8 then
BeaufortSkala="Frisk vind"
ElseIf m<13.9 then
BeaufortSkala="Hård vind"
ElseIf m<17.2 then
BeaufortSkala="Stiv kuling"
ElseIf m<20.8 then
BeaufortSkala="Hård kuling"
ElseIf m<24.5 then
BeaufortSkala="Stormende kuling"
ElseIf m<28.5 then
BeaufortSkala="Storm"
ElseIf m<32.7 then
BeaufortSkala="Stærk storm"
Else
BeaufortSkala="Orkan"
End If
End Function
land=request.queryString("afd")
if trim(land)="Alle" then
SkrivLand "Danmark"
SkrivLand "Norge"
SkrivLand "Færøerne"
SkrivLand "Tyskland"
SkrivLand "Nederlands"
SkrivLand "Frankrig"
else
Skrivland(land)
end if
Function SkrivLand(land)
Select case trim(land)
case "Danmark"
VisVejrStation("Danmark,01400") 'Ekofisk
VisVejrStation(",06041") 'Skagen
VisVejrStation(",06030") 'Ålborg
VisVejrStation(",06024") 'Thisted
VisVejrStation(",06060") 'Karup
VisVejrStation(",06080") 'Esbjerg
VisVejrStation(",06186") 'København
VisVejrStation(",06190") 'Rønne
SkrivLinie
case "Norge"
VisVejrStation("Norge:,01008") 'Svalbard
VisVejrStation(",01088") 'Vadsø
VisVejrStation(",01026") 'Tromsø
VisVejrStation(",01010") 'Andoya
VisVejrStation(",01217") 'Molde
VisVejrStation(",01223") 'Kristiansund
VisVejrStation(",01210") 'Ålesund
VisVejrStation(",01311") 'Bergen
VisVejrStation(",01415") 'Stavanger
SkrivLinie
case "Færøerne"
VisVejrStation("Faroe:,06011") 'Thorshavn
VisVejrStation("Shetland:,03003") 'Sumburgh
SkrivLinie
case "Tyskland"
VisVejrStation("Tyskland:,10015") 'Helgoland
VisVejrStation(",10147") 'Hamburg
VisVejrStation(",10131") 'Cuxhaven
VisVejrStation(",10129") 'Bremerhaven
VisVejrStation(",10384") 'Berlin
VisVejrStation(",10416") 'Dortmund
VisVejrStation(",10400") 'Duesseldorf
VisVejrStation(",10637") 'Frankfurt
VisVejrStation(",10338") 'Hannover
VisVejrStation(",10727") 'Karlsruhe
VisVejrStation(",10739") 'Stuttgart
VisVejrStation(",10763") 'Nurnberg
VisVejrStation(",10870") 'Muenchen
SkrivLinie
case "Nederlands"
VisVejrStation("Holland:,06235") 'De kooy
VisVejrStation(",06225") 'Ijmuiden
VisVejrStation(",06370") 'Eindhoven
VisVejrStation(",06277") 'Lauwersoog
VisVejrStation("Belgien:,06450") 'Antwerpen
VisVejrStation(",06451") 'Brussels
VisVejrStation(",06407") 'Ostend
SkrivLinie
case "Frankrig"
VisVejrStation("Frankrig:,07002") 'Boulogne
VisVejrStation(",07024") 'Cherbourg
VisVejrStation(",07201") 'Quimper
VisVejrStation(",07222") 'Nantes
VisVejrStation(",07510") 'Bordeaux
VisVejrStation(",07157") 'Paris
VisVejrStation(",07090") 'Metz
VisVejrStation(",07190") 'Strausbourg
VisVejrStation(",07280") 'Dijon
VisVejrStation(",07255") 'Bourges
VisVejrStation(",07630") 'Toulouse
VisVejrStation(",07480") 'Lyon
VisVejrStation(",07650") 'Marseille
SkrivLinie
case else
End Select
End function
sub skrivLinie
%>
<table width="90%">
<td STYLE="border-top-style:solid; border-top-width:1px;"> </td>
</table>
<%
end sub
%>
<br>
<br>
<br>
<%
' VisVejrStationHTML("06024") 'Thisted
VisVejrStationSticker("06024")
%>
<html>
<head>
<meta name="Generator" content="Stone's WebWriter 4">
<meta http-equiv="Content-Language" content="da">
<meta http-equiv="refresh" content="20">
<!-- Minus AutoDato -->
<title>Vejret</title>
<link rel="stylesheet" type="text/css" href="../_themes/sumipntg/sumi1111.css">
<link rel="stylesheet" type="text/css" href="../hesselholt.css">
<%Sub VisVejrStationHTML(vs)%>
<table>
<tr>
<td>
<a href="http://www.wunderground.com/global/stations/<%=vs%>.html?bannertypeclick=bigwx">
<img src="http://banners.wunderground.com/weathersticker/bigwx_both_cond/language/www/global/stations/<%=vs%>.gif" border=0
alt="Click for Vejrudsigt, Denmark Forecast" height=60 width=468></a>
</td>
</tr>
</table>
<%End Sub%>
<br>
<br>
<%Sub VisVejrStationSticker(vs)%>
<table cellpadding="0" cellspacing="0" style="width: 271px; background-color: #FFF; border: 1px solid #999;">
<tr>
<td colspan="2">
<div style="height: 35px;"><a href="http://www.wunderground.com/global/stations/<%=vs%>.html?bannertypeclick=htmlSticker">
<img src="http://banners.wunderground.com/weathersticker/htmlSticker1/language/www/global/stations/<%=vs%>.gif" alt="" height="35" width="271" style="border: 0px;"></a>
</div>
</td>
</tr>
<tr>
<td style="vertical-align: top;">
<div style="width: 101px;"><div style="height: 22px;"> <img src="http://icons-aa.wunderground.com/graphics/smash/htmlsticker/html_linkT.gif" width="101" height="22"> </div>
<div style="font-family: Geneva, Arial, Helvetica, sans-serif; font-size: 10px; background-image: url(http://icons-aa.wunderground.com/graphics/smash/htmlsticker/html_linkBG.gif); text-align: left;">
<div style="padding-left: 10px;"><a href=""></a></div>
<div style="padding-left: 10px;"><a href="http://www.wunderground.com/radar/radblast.asp?ID=XXX®ion=XX&lat=57.20000076&lon=-2.22000003">Local Radar</a></div>
<div style="padding-left: 10px;"><a href="http://www.wunderground.com/global/stations/<%=vs%>.html?bannertypeclick=htmlSticker">Detailed Forecast</a></div>
<div style="height: 12px;"><img src="http://icons-aa.wunderground.com/graphics/smash/htmlsticker/html_linkB.gif" width="101" height="12"></div>
<form action="http://www.wunderground.com/cgi-bin/findweather/getForecast" method="get" target="_blank" style="margin-top: 10px; margin-bottom: 0px; text-align: center;">
<input type="hidden" name="bannertypeclick" value="htmlSticker">
<div> <input name="query" type="text" value="Find Weather" onFocus="this.value=''" style="width: 85px;"></div>
<div style="padding-top: 5px;"><input name="GO" type="submit" value="GO" style="width: 50px; background-color: #008; color: #FFF; font-size: 12px; font-weight: bold; border-top: 1px solid #CCC; border-left: 1px solid #CCC; border-right: 1px solid #000; border-bottom: 1px solid #000;"></div>
</form></div></td><td style="vertical-align: top;">
<div style="height: 139px;">
<a href="http://www.wunderground.com/global/stations/06024.html?bannertypeclick=htmlSticker">
<img src="http://banners.wunderground.com/weathersticker/htmlSticker2_cond/language/www/global/stations/<%=vs%>.gif" alt="" height="139" width="170" style="border: 0px;"></a>
</div>
</td>
</tr>
</table>
<%End Sub
Function HentGeo(vejrstation)
' Program der viser hvordan du får data ud af systemet
dim VejrUdsigt
Set VejrUdsigt=New Vejrmelding
VejrUdsigt.Init(vejrstation)
If VejrUdsigt.Error<>0 then
Response.Write("Fejl ved hentning af vejrdata: " & VejrUdsigt.Error)
Else
If uBound(VejrUdsigt.Dagene)>0 Then
HentGeo=Replace(vejrudsigt.Dagene(0).LangGeo,";",",")
End If
End If
Set vejrudsigt=Nothing
End function
'response.write hentGeo("06024")
%>
Da denne kode henter mange data mangler jeg en loading bar ?
