Reply to thread

Message

<blockquote data-quote="cheezey" data-source="post: 72133" data-attributes="member: 10350">BBC weather imagesAs a subject (not a guest) of Her Majesty I am:<ol>
<li data-xf-list-type="ol"> Obsessed with the weather forecast</li>
<li data-xf-list-type="ol"> Genetically programmed to understand the BBC weather maps</li>
</ol>That said, when I came to program up the MP Weather plugin with the images from the BBC website I found that they don't have static names, they change with the time of day, this isn't very MP friendly.&nbsp; I mailed the BBC about this (and a couple of other things <img src="data:image/gif;base64,R0lGODlhAQABAIAAAAAAAP///yH5BAEAAAAALAAAAAABAAEAAAIBRAA7" class="smilie smilie--sprite smilie--sprite11" alt=":rolleyes:" title="Roll Eyes&nbsp; &nbsp; :rolleyes:" loading="lazy" data-shortname=":rolleyes:" /> ) and got a reply saying . . . . mmmmm . . . . . we're looking at a few things.So while they look at a few things, I scripted up the retrieval of the BBC weather images for my own personal use.&nbsp; This script can take two parameters, that of the region you want the maps for, if you don't use a parameter you'll get the UK country maps (you can find the available regions in the comments of the code below), the second parameter is the path to where you want to save your images .&nbsp; You just need to then configure the MP weather plugin to load the images from your selected path.I have this script running as a scheduled task every 30mins to keep the images updated.If you want to use it:<ol>
<li data-xf-list-type="ol">Save this code as C:\GetBBCWeatherImages.vbs</li>
<li data-xf-list-type="ol">Schedule wscript.exe C:\GetBBCWeatherImages.vbs &lt;REGION&gt; &lt;PATH&gt; - optional</li>
</ol>
e.g. For the North East of England images and to save to C:\Temp you schedule 
wscript.exe C:\GetBBCWeatherImages.vbs NE C:\Temp

e.g. For Northern Europe and to save to the root of C:\ you schedule 
wscript.exe C:\GetBBCWeatherImages.vbs NEURI have pasted this code into a PHP box as the CODE box didn't like my CrLf and formatted it as one big block of text and the QUOTE box removed my Tabs.[php]'=========================================================================='' VBScript Source File -- Created with SAPIEN Technologies PrimalScript 4.0'' NAME: GetBBCWeatherImages.vbs'' AUTHOR: Cheezey' DATE&nbsp; : 20/08/2006'' COMMENT: Grabs BBC weather images, gets the nearest image to the current'&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; time, saves the images in the root of C:\ if not otherwise'&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; specified'' USAGE: cscript //nologo GetBBCWeatherImages.vbs &lt;REGION&gt; &lt;PATH&gt;''&nbsp; &nbsp; &nbsp; &nbsp; &lt;REGION&gt; is optional but can accept the following'&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; uk = United Kingdom (Default)'&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; ci = Channel Islands'&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; e&nbsp; = England East'&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; m&nbsp; = England Midlands'&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; ne = England North East'&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; nw = England North West'&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; ni = Northern Ireland'&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; ss = Scotland South'&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; sn = Scotland North'&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; s&nbsp; = England South'&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; se = England South East'&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; sw = England South West'&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; wl = Wales'&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; neur = Europe - North'&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; eeur = Europe - Mediterranean and East'&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; weur = Europe - West and Canary Islands'&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; mide = Middle East'&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; ausa = Australasia'&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; cam&nbsp; = America - Central'&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; nam&nbsp; = America - North'&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; sam&nbsp; = America - South'&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; easia = Asia - East'&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; sasia = Asia - South'&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; seasia = Asia - South East''&nbsp; &nbsp; &nbsp; &nbsp;&nbsp; &lt;PATH&gt; is optional, it's where you want to save the files To'&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;&nbsp; including, it defaults to C:\'' DATE&nbsp; &nbsp; &nbsp; &nbsp; ACTION' 20/08/06&nbsp; &nbsp; Created' 28/08/06&nbsp; &nbsp; Updated to work with world regions' 28/08/06&nbsp; &nbsp; Fixed bug where images before 10am (double figures) weren't'&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;&nbsp; saved - DOH!!' 28/08/06&nbsp; &nbsp; Added the debug &amp; error handling''==========================================================================Option ExplicitOn Error Resume Next'==========================================================================' Initialise debug'==========================================================================Dim Debug : Debug = False'==========================================================================' Initialise objects'==========================================================================Dim oXMLSet oXML&nbsp; = CreateObject(&quot;Microsoft.XMLHTTP&quot;)Dim oArgsSet oArgs = WScript.ArgumentsDim oFSSet oFS&nbsp;&nbsp; = CreateObject(&quot;Scripting.FileSystemObject&quot;)'==========================================================================' Initialise variables'==========================================================================Dim sRegion&nbsp;&nbsp; : sRegion = &quot;uk&quot;Dim sURLp&nbsp; &nbsp;&nbsp; : sURLp&nbsp;&nbsp; = &quot;http://www.bbc.co.uk/weather/charts/&quot;Dim sArea&nbsp; &nbsp;&nbsp; : sArea&nbsp;&nbsp; = &quot;uk&quot;Dim sPath&nbsp; &nbsp;&nbsp; : sPath&nbsp;&nbsp; = &quot;c:\&quot;'==========================================================================' Set the region &amp; area using the parameter passed in, default to uk / uk'==========================================================================If oArgs.Count = 1 Or oArgs.Count = 2 Then&nbsp; &nbsp; sRegion = LCase(oArgs(0))&nbsp; &nbsp; Select Case sRegion&nbsp; &nbsp; &nbsp; &nbsp; Case &quot;uk&quot;, &quot;ci&quot;, &quot;e&quot;, &quot;m&quot;, &quot;ne&quot;, &quot;nw&quot;, &quot;ni&quot;, &quot;ss&quot;, &quot;ns&quot;, &quot;s&quot;, &quot;se&quot;, &quot;sw&quot;, &quot;wl&quot;&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; sArea = &quot;uk&quot;&nbsp; &nbsp; &nbsp; &nbsp; Case &quot;neur&quot;, &quot;eeur&quot;, &quot;weur&quot;, &quot;mide&quot;, &quot;ausa&quot;, &quot;cam&quot;, &quot;sam&quot;, &quot;easia&quot;, &quot;sasia&quot;, &quot;seasia&quot;&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; sArea = &quot;world&quot;&nbsp; &nbsp; &nbsp; &nbsp; Case Else&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; sArea = &quot;uk&quot;&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; sRegion = &quot;uk&quot;&nbsp; &nbsp; End SelectEnd IfsURLp&nbsp;&nbsp; = sURLp &amp; sArea &amp; &quot;/&quot;'==========================================================================' See if the path has been passed in, otherwise default to c:\'==========================================================================If oArgs.Count = 2 Then&nbsp; &nbsp; sPath = LCase(oArgs(1))&nbsp; &nbsp; If Not Right(sPath,1) = &quot;\&quot; Then sPath = sPath &amp; &quot;\&quot;&nbsp; &nbsp; If Not oFS.FolderExists(sPath) Then sPath = &quot;c:\&quot;End If'==========================================================================' Initialise yet more variables'==========================================================================Dim sURLDim sRain&nbsp; &nbsp;&nbsp; : sRain&nbsp; &nbsp;&nbsp; = sRegion &amp; &quot;_rain_&quot;Dim sCloud&nbsp; &nbsp; : sCloud&nbsp; &nbsp; = sRegion &amp; &quot;_cloud_&quot;Dim sTemp&nbsp; &nbsp;&nbsp; : sTemp&nbsp; &nbsp;&nbsp; = sRegion &amp; &quot;_temperature_&quot;Dim sWind&nbsp; &nbsp;&nbsp; : sWind&nbsp; &nbsp;&nbsp; = sRegion &amp; &quot;_wind_&quot;Dim sPressure : sPressure = sRegion &amp; &quot;_pressure_&quot;Dim sSummary&nbsp; : sSummary&nbsp; = sRegion &amp; &quot;_summary_&quot;Dim sVisSat&nbsp;&nbsp; : sVisSat&nbsp;&nbsp; = &quot;uk_visiblesatellite_&quot;'==========================================================================' The BBC uses yymmddhh as their format for the weather image filenames' so get these in the correct format i.e. 2 char strings'==========================================================================Dim yy, mm, dd, td, yd, hh, mn&nbsp; &nbsp; yy = Padnum(2,CInt(Right(CStr(Year(Now())),2)))&nbsp; &nbsp; mm = Padnum(2,CInt(Month(Now())))&nbsp; &nbsp; dd = Padnum(2,CInt(Day(Now())))&nbsp; &nbsp; td = Padnum(2,CInt(Day(Now())+1))&nbsp; &nbsp; yd = Padnum(2,CInt(Day(Now())-1))&nbsp; &nbsp; hh = Padnum(2,CInt(Hour(Now())))&nbsp; &nbsp; mn = Padnum(2,CInt(Minute(Now())))&nbsp; &nbsp; '==========================================================================' Try and get all the images'==========================================================================GetImage sRain&nbsp; &nbsp;&nbsp; &amp; &quot;.jpg&quot;, sRainCheckForError(&quot;Error getting rain image.&quot;)GetImage sCloud&nbsp; &nbsp; &amp; &quot;.jpg&quot;, sCloudCheckForError(&quot;Error getting cloud image.&quot;)GetImage sTemp&nbsp; &nbsp;&nbsp; &amp; &quot;.jpg&quot;, sTempCheckForError(&quot;Error getting temperature image.&quot;)GetImage sWind&nbsp; &nbsp;&nbsp; &amp; &quot;.jpg&quot;, sWindCheckForError(&quot;Error getting wind image.&quot;)GetImage sPressure &amp; &quot;.jpg&quot;, sPressureCheckForError(&quot;Error getting pressure image.&quot;)GetImage sSummary&nbsp; &amp; &quot;.jpg&quot;, sSummaryCheckForError(&quot;Error getting summary image.&quot;)'==========================================================================' Only get the visible satellite image if the region is in the uk, 'Cos' that's all they do'==========================================================================If sArea = &quot;uk&quot; Then &nbsp; &nbsp; GetImage sVisSat &amp; &quot;.jpg&quot;, sVisSat&nbsp; &nbsp; CheckForError(&quot;Error getting satellite image.&quot;)End If'==========================================================================' Tidy up'==========================================================================Set oXML&nbsp; = NothingSet oArgs = NothingSet oFS&nbsp;&nbsp; = Nothing'==========================================================================' Subs &amp; Functions'==========================================================================Sub GetImage(strFilename, strType)&nbsp; &nbsp; Dim i, j, k, l&nbsp; &nbsp; '==========================================================================&nbsp; &nbsp; ' If minutes are greater than 30 (i.e. nearer the next hour) then add one&nbsp; &nbsp; ' to start at the next hour&nbsp; &nbsp; '==========================================================================&nbsp; &nbsp; If CInt(mn) &lt; 31 Then&nbsp; &nbsp; &nbsp; &nbsp; i = CInt(hh)&nbsp; &nbsp; &nbsp; &nbsp; Else&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; i = CInt(hh) + 1&nbsp; &nbsp; End If&nbsp; &nbsp; '==========================================================================&nbsp; &nbsp; ' Nothing was found in the previous loop so check the whole day (24 - 0)&nbsp; &nbsp; ' If no image is found, the next loops will check tomorrow or yesterday&nbsp; &nbsp; '==========================================================================&nbsp; &nbsp; k = 25&nbsp; &nbsp; l = 99&nbsp; &nbsp; For j = 0 To 24&nbsp; &nbsp; &nbsp; &nbsp; sURL = sURLp &amp; strType &amp; Cstr(yy) &amp; Cstr(mm) &amp; CStr(dd) &amp; Padnum(2, j) &amp; &quot;.jpg&quot;&nbsp; &nbsp; &nbsp; &nbsp; oXML.open &quot;GET&quot;, sURL, False&nbsp; &nbsp; &nbsp; &nbsp; oXML.send&nbsp; &nbsp; &nbsp; &nbsp; If oXML.status = &quot;200&quot; Then&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; '==========================================================================&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; ' Do a bit of jiggery pokery to get the image with the time nearest to the&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; ' current time&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; '==========================================================================&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; If Abs(i - j) &lt; k Then &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; k = Abs(i - j)&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; l = j&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; End If&nbsp; &nbsp; &nbsp; &nbsp; End If&nbsp; &nbsp; Next&nbsp; &nbsp; sURL = sURLp &amp; strType &amp; Cstr(yy) &amp; Cstr(mm) &amp; Cstr(dd) &amp; Padnum(2, l) &amp; &quot;.jpg&quot;&nbsp; &nbsp; oXML.open &quot;GET&quot;, sURL, False&nbsp; &nbsp; oXML.send&nbsp; &nbsp; If oXML.status = &quot;200&quot; Then&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; '==========================================================================&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; ' We've found a good image so save it&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; '==========================================================================&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; SaveBinaryData sPath &amp; strFilename, oXML.responseBody&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; Exit Sub&nbsp; &nbsp; End IfEnd SubFunction SaveBinaryData(FileName, ByteArray)&nbsp; &nbsp; Const adTypeBinary = 1&nbsp; &nbsp; Const adSaveCreateOverWrite = 2&nbsp; &nbsp; '==========================================================================&nbsp; &nbsp; ' Create Stream object&nbsp; &nbsp; '==========================================================================&nbsp; &nbsp; Dim BinaryStream&nbsp; &nbsp; Set BinaryStream = CreateObject(&quot;ADODB.Stream&quot;)&nbsp; &nbsp; '==========================================================================&nbsp; &nbsp; 'Specify stream type - we want to save binary data.&nbsp; &nbsp; '==========================================================================&nbsp; &nbsp; BinaryStream.Type = adTypeBinary&nbsp; &nbsp; &nbsp; &nbsp; '==========================================================================&nbsp; &nbsp; ' Open the stream and write binary data to the object&nbsp; &nbsp; '==========================================================================&nbsp; &nbsp; BinaryStream.Open&nbsp; &nbsp; BinaryStream.Write ByteArray&nbsp; &nbsp; '==========================================================================&nbsp; &nbsp; ' Save binary data to disk&nbsp; &nbsp; '==========================================================================&nbsp; &nbsp; BinaryStream.SaveToFile FileName, adSaveCreateOverWrite&nbsp; &nbsp; End FunctionFunction Padnum(intLength, intNumber)&nbsp; &nbsp; Dim iLen : iLen = Len(CStr(intNumber))&nbsp; &nbsp; If iLen &lt; intLength Then&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; Padnum = String(intLength - iLen, &quot;0&quot;) &amp; CStr(intNumber)&nbsp; &nbsp; &nbsp; &nbsp; Else&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; Padnum = CStr(intNumber)&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; End If&nbsp; &nbsp; End Function &nbsp; &nbsp; Sub CheckForError(strMsg)&nbsp; &nbsp; If Err.Number &lt;&gt; 0 Then&nbsp; &nbsp; &nbsp; &nbsp; If Debug = True Then&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; Dim fDebug&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; Set fDebug = oFS.CreateTextFile(&quot;c:\GetBBCWeatherImages.vbs.ERRORS.txt&quot;, True)&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; fDebug.WriteLine(String(78,&quot;*&quot;))&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; fDebug.WriteLine(Now() &amp; &quot; : &quot; &amp; strMsg)&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; fDebug.WriteLine(String(78,&quot;*&quot;))&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; fDebug.WriteLine(&quot;Error number : &quot; &amp; CStr(Err.Number))&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; fDebug.WriteLine(&quot;Error source : &quot; &amp; Err.Source)&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; fDebug.WriteLine(&quot;Error text&nbsp;&nbsp; : &quot; &amp; Err.Description)&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; fDebug.Close&nbsp; &nbsp; &nbsp; &nbsp; End If&nbsp; &nbsp; &nbsp; &nbsp; WScript.Quit(1)&nbsp; &nbsp; End IfEnd Sub[/php]</blockquote>

[QUOTE="cheezey, post: 72133, member: 10350"] [b]BBC weather images[/b] As a subject (not a guest) of Her Majesty I am: [list=1] [*] Obsessed with the weather forecast [*] Genetically programmed to understand the BBC weather maps [/list] That said, when I came to program up the MP Weather plugin with the images from the BBC website I found that they don't have static names, they change with the time of day, this isn't very MP friendly. I mailed the BBC about this (and a couple of other things :rolleyes: ) and got a reply saying . . . . mmmmm . . . . . we're looking at a few things. So while they look at a few things, I scripted up the retrieval of the BBC weather images for my own personal use. This script can take two parameters, that of the region you want the maps for, if you don't use a parameter you'll get the UK country maps (you can find the available regions in the comments of the code below), the second parameter is the path to where you want to save your images . You just need to then configure the MP weather plugin to load the images from your selected path. I have this script running as a scheduled task every 30mins to keep the images updated. If you want to use it: [list=1] [*]Save this code as C:\GetBBCWeatherImages.vbs [*]Schedule wscript.exe C:\GetBBCWeatherImages.vbs <REGION> <PATH> - optional [/list] [indent]e.g. For the North East of England images and to save to C:\Temp you schedule wscript.exe C:\GetBBCWeatherImages.vbs NE C:\Temp e.g. For Northern Europe and to save to the root of C:\ you schedule wscript.exe C:\GetBBCWeatherImages.vbs NEUR[/indent] [I]I have pasted this code into a PHP box as the CODE box didn't like my CrLf and formatted it as one big block of text and the QUOTE box removed my Tabs.[/I] [php] '========================================================================== ' ' VBScript Source File -- Created with SAPIEN Technologies PrimalScript 4.0 ' ' NAME: GetBBCWeatherImages.vbs ' ' AUTHOR: Cheezey ' DATE : 20/08/2006 ' ' COMMENT: Grabs BBC weather images, gets the nearest image to the current ' time, saves the images in the root of C:\ if not otherwise ' specified ' ' USAGE: cscript //nologo GetBBCWeatherImages.vbs <REGION> <PATH> ' ' <REGION> is optional but can accept the following ' uk = United Kingdom (Default) ' ci = Channel Islands ' e = England East ' m = England Midlands ' ne = England North East ' nw = England North West ' ni = Northern Ireland ' ss = Scotland South ' sn = Scotland North ' s = England South ' se = England South East ' sw = England South West ' wl = Wales ' neur = Europe - North ' eeur = Europe - Mediterranean and East ' weur = Europe - West and Canary Islands ' mide = Middle East ' ausa = Australasia ' cam = America - Central ' nam = America - North ' sam = America - South ' easia = Asia - East ' sasia = Asia - South ' seasia = Asia - South East ' ' <PATH> is optional, it's where you want to save the files To ' including, it defaults to C:\ ' ' DATE ACTION ' 20/08/06 Created ' 28/08/06 Updated to work with world regions ' 28/08/06 Fixed bug where images before 10am (double figures) weren't ' saved - DOH!! ' 28/08/06 Added the debug & error handling ' '========================================================================== Option Explicit On Error Resume Next '========================================================================== ' Initialise debug '========================================================================== Dim Debug : Debug = False '========================================================================== ' Initialise objects '========================================================================== Dim oXML Set oXML = CreateObject("Microsoft.XMLHTTP") Dim oArgs Set oArgs = WScript.Arguments Dim oFS Set oFS = CreateObject("Scripting.FileSystemObject") '========================================================================== ' Initialise variables '========================================================================== Dim sRegion : sRegion = "uk" Dim sURLp : sURLp = "http://www.bbc.co.uk/weather/charts/" Dim sArea : sArea = "uk" Dim sPath : sPath = "c:\" '========================================================================== ' Set the region & area using the parameter passed in, default to uk / uk '========================================================================== If oArgs.Count = 1 Or oArgs.Count = 2 Then sRegion = LCase(oArgs(0)) Select Case sRegion Case "uk", "ci", "e", "m", "ne", "nw", "ni", "ss", "ns", "s", "se", "sw", "wl" sArea = "uk" Case "neur", "eeur", "weur", "mide", "ausa", "cam", "sam", "easia", "sasia", "seasia" sArea = "world" Case Else sArea = "uk" sRegion = "uk" End Select End If sURLp = sURLp & sArea & "/" '========================================================================== ' See if the path has been passed in, otherwise default to c:\ '========================================================================== If oArgs.Count = 2 Then sPath = LCase(oArgs(1)) If Not Right(sPath,1) = "\" Then sPath = sPath & "\" If Not oFS.FolderExists(sPath) Then sPath = "c:\" End If '========================================================================== ' Initialise yet more variables '========================================================================== Dim sURL Dim sRain : sRain = sRegion & "_rain_" Dim sCloud : sCloud = sRegion & "_cloud_" Dim sTemp : sTemp = sRegion & "_temperature_" Dim sWind : sWind = sRegion & "_wind_" Dim sPressure : sPressure = sRegion & "_pressure_" Dim sSummary : sSummary = sRegion & "_summary_" Dim sVisSat : sVisSat = "uk_visiblesatellite_" '========================================================================== ' The BBC uses yymmddhh as their format for the weather image filenames ' so get these in the correct format i.e. 2 char strings '========================================================================== Dim yy, mm, dd, td, yd, hh, mn yy = Padnum(2,CInt(Right(CStr(Year(Now())),2))) mm = Padnum(2,CInt(Month(Now()))) dd = Padnum(2,CInt(Day(Now()))) td = Padnum(2,CInt(Day(Now())+1)) yd = Padnum(2,CInt(Day(Now())-1)) hh = Padnum(2,CInt(Hour(Now()))) mn = Padnum(2,CInt(Minute(Now()))) '========================================================================== ' Try and get all the images '========================================================================== GetImage sRain & ".jpg", sRain CheckForError("Error getting rain image.") GetImage sCloud & ".jpg", sCloud CheckForError("Error getting cloud image.") GetImage sTemp & ".jpg", sTemp CheckForError("Error getting temperature image.") GetImage sWind & ".jpg", sWind CheckForError("Error getting wind image.") GetImage sPressure & ".jpg", sPressure CheckForError("Error getting pressure image.") GetImage sSummary & ".jpg", sSummary CheckForError("Error getting summary image.") '========================================================================== ' Only get the visible satellite image if the region is in the uk, 'Cos ' that's all they do '========================================================================== If sArea = "uk" Then GetImage sVisSat & ".jpg", sVisSat CheckForError("Error getting satellite image.") End If '========================================================================== ' Tidy up '========================================================================== Set oXML = Nothing Set oArgs = Nothing Set oFS = Nothing '========================================================================== ' Subs & Functions '========================================================================== Sub GetImage(strFilename, strType) Dim i, j, k, l '========================================================================== ' If minutes are greater than 30 (i.e. nearer the next hour) then add one ' to start at the next hour '========================================================================== If CInt(mn) < 31 Then i = CInt(hh) Else i = CInt(hh) + 1 End If '========================================================================== ' Nothing was found in the previous loop so check the whole day (24 - 0) ' If no image is found, the next loops will check tomorrow or yesterday '========================================================================== k = 25 l = 99 For j = 0 To 24 sURL = sURLp & strType & Cstr(yy) & Cstr(mm) & CStr(dd) & Padnum(2, j) & ".jpg" oXML.open "GET", sURL, False oXML.send If oXML.status = "200" Then '========================================================================== ' Do a bit of jiggery pokery to get the image with the time nearest to the ' current time '========================================================================== If Abs(i - j) < k Then k = Abs(i - j) l = j End If End If Next sURL = sURLp & strType & Cstr(yy) & Cstr(mm) & Cstr(dd) & Padnum(2, l) & ".jpg" oXML.open "GET", sURL, False oXML.send If oXML.status = "200" Then '========================================================================== ' We've found a good image so save it '========================================================================== SaveBinaryData sPath & strFilename, oXML.responseBody Exit Sub End If End Sub Function SaveBinaryData(FileName, ByteArray) Const adTypeBinary = 1 Const adSaveCreateOverWrite = 2 '========================================================================== ' Create Stream object '========================================================================== Dim BinaryStream Set BinaryStream = CreateObject("ADODB.Stream") '========================================================================== 'Specify stream type - we want to save binary data. '========================================================================== BinaryStream.Type = adTypeBinary '========================================================================== ' Open the stream and write binary data to the object '========================================================================== BinaryStream.Open BinaryStream.Write ByteArray '========================================================================== ' Save binary data to disk '========================================================================== BinaryStream.SaveToFile FileName, adSaveCreateOverWrite End Function Function Padnum(intLength, intNumber) Dim iLen : iLen = Len(CStr(intNumber)) If iLen < intLength Then Padnum = String(intLength - iLen, "0") & CStr(intNumber) Else Padnum = CStr(intNumber) End If End Function Sub CheckForError(strMsg) If Err.Number <> 0 Then If Debug = True Then Dim fDebug Set fDebug = oFS.CreateTextFile("c:\GetBBCWeatherImages.vbs.ERRORS.txt", True) fDebug.WriteLine(String(78,"*")) fDebug.WriteLine(Now() & " : " & strMsg) fDebug.WriteLine(String(78,"*")) fDebug.WriteLine("Error number : " & CStr(Err.Number)) fDebug.WriteLine("Error source : " & Err.Source) fDebug.WriteLine("Error text : " & Err.Description) fDebug.Close End If WScript.Quit(1) End If End Sub [/php] [/QUOTE]

Verification