フレームワークを活用した応用例の解析スクリプト

'Lunascape Co., LTD. All rights reserved. Option Explicit ' Function create_output_xml_object ' ' 表示内容を格納するXMLオブジェクトを作成します Function create_output_xml_object() Dim xmlObj set xmlObj = CreateObject("Msxml2.DOMDocument") ' XMLを準備 Dim strData strData = "version=""1.0"" encoding=""UTF-16""" Dim oProcessingInstruction Set oProcessingInstruction = xmlObj.createProcessingInstruction("xml", strData) xmlObj.appendChild(oProcessingInstruction) Set create_output_xml_object = xmlObj End Function ' Function main ' ' 広域予報結果を解析します Function main() main = True ' 表示内容を格納するXML Dim xmlOutput set xmlOutput = create_output_xml_object() ' ルートノードを追加 Dim nodeRoot Set nodeRoot = xmlOutput.createElement("root") Set nodeRoot = xmlOutput.appendChild(nodeRoot) ' アイテム用ルートノードを追加 Dim nodeItems Set nodeItems = xmlOutput.createElement("items") Set nodeItems = nodeRoot.appendChild(nodeItems) ' 広域予報をダウンロードするURL Dim strUrl strUrl = "http://weather.livedoor.com/forecast/webservice/rest/v1?day=today&city=63" ' XMLをダウンロード Dim xmlArea Set xmlArea = LunaXmlUtility.LoadXML(strUrl) ' 天気予報要素を取得 Dim oImage Set oImage = xmlArea.selectSingleNode("/lwws/image") ' 最高気温アイテムを追加 Dim nodeForecast Set nodeForecast = xmlOutput.createElement("forecast") nodeForecast.appendChild(oImage.selectSingleNode("title")) nodeForecast.appendChild(oImage.selectSingleNode("link")) nodeForecast.appendChild(oImage.selectSingleNode("url")) nodeForecast.appendChild(oImage.selectSingleNode("width")) nodeForecast.appendChild(oImage.selectSingleNode("height")) nodeItems.appendChild(nodeForecast) ' 予報内容の要素を取得 Dim oTelop Set oTelop = xmlArea.selectSingleNode("/lwws/telop") ' 最高/最低気温を格納しているノード Dim oTemperature Set oTemperature = xmlArea.getElementsByTagName("temperature") Dim nodeTemperature Set nodeTemperature = xmlOutput.createElement("temperature") ' 最高/最低気温を格納しているノード以下の子要素を列挙 Dim XmlNode For Each XmlNode In oTemperature Dim child For Each child In XmlNode.childNodes Dim node If child.tagName = "max" Then For Each node In child.childNodes If node.tagName = "celsius" Then ' 最高気温アイテムを追加 Dim nodeMaxTemp Set nodeMaxTemp = xmlOutput.createElement("max") nodeMaxTemp.text = node.text nodeTemperature.appendChild(nodeMaxTemp) End If Next ElseIf child.tagName = "min" Then For Each node In child.childNodes If node.tagName = "celsius" Then ' 最低気温アイテムを追加 Dim nodeMinTemp Set nodeMinTemp = xmlOutput.createElement("min") nodeMinTemp.text = node.text nodeTemperature.appendChild(nodeMinTemp) End If Next End If Next Next nodeItems.appendChild(nodeTemperature) ' 各地の天気詳細を処理 Dim oPinpoint Set oPinpoint = xmlArea.selectSingleNode("/lwws/pinpoint") nodeItems.appendChild(oPinpoint) ' 解析結果をLunascapeの出力ウィンドウに出力 Lunascape.OutputAddString(xmlOutput.xml) ' XSLスタイルシートを登録 LunaScriptSidebar.SetXsltFileName("forecast.xsl") ' XMLを登録 LunaScriptSidebar.SetXml(xmlOutput.xml) LunaScriptSidebar.Update() End Function ' Function get_title_table Function get_title_table(docForecast, location) Set get_title_table = Nothing ' タイトルの要素を取得 Dim th For Each th In docForecast.getElementsByTagName("th") If th.innerText = location & "の天気" Then Set get_title_table = th.parentElement.parentElement.parentElement Exit For End If Next End Function ' Function pinpoint_title ' ' ピンポイント予報のタイトル情報を解析して ' 情報を登録します。 Function pinpoint_title(url, location, tableTitle, xmlPinpoint, docForecast, nodeItems) pinpoint_title = True Dim thTitle Set thTitle = tableTitle.firstChild.firstChild.firstChild ' 場所の要素を追加 Dim nodeLocation Set nodeLocation = xmlPinpoint.createElement("location") nodeLocation.text = location Set nodeLocation = nodeItems.appendChild(nodeLocation) ' 予報ページの要素を追加 Dim nodeLink Set nodeLink = xmlPinpoint.createElement("link") nodeLink.text = url Set nodeLink = nodeItems.appendChild(nodeLink) ' タイトルの要素を追加 Dim nodeTitle Set nodeTitle = xmlPinpoint.createElement("title") nodeTitle.text = thTitle.innerText Set nodeTitle = nodeItems.appendChild(nodeTitle) ' 予報発表日の要素を追加 Dim nodeDate Set nodeDate = xmlPinpoint.createElement("date") nodeDate.text = thTitle.nextSibling.innerText Set nodeDate = nodeItems.appendChild(nodeDate) End Function ' Class PinpointItem ' ' ピンポイント予報の各種項目を格納するクラスです Class PinpointItem Public Time Public Forecast Public ForecastIcon Public Temperature Public Precipitation Public Humidity Public Winddirection Public WinddirectionIcon Public Windspeed End Class ' Function pinpoint_forecast ' ' ピンポイント地域の時系列予報を解析して ' 情報を登録します。 Function pinpoint_forecast(tablePinpoint, xmlPinpoint, docForecast, nodePinpoint) pinpoint_forecast = True Dim tbodyPinpoint Set tbodyPinpoint = tablePinpoint.firstChild ' 時系列予報を解析 Dim nodeForecastDate Set nodeForecastDate = xmlPinpoint.createElement("date") nodeForecastDate.text = tbodyPinpoint.firstChild.innerText Set nodeForecastDate = nodePinpoint.appendChild(nodeForecastDate) Dim trTodayTimes Set trTodayTimes = tbodyPinpoint.firstChild.nextSibling Dim items items = Array() ReDim Preserve items(trTodayTimes.children.length-1) Dim i ' 時間を列挙して追加 i = 0 Dim childItem For Each childItem In trTodayTimes.children If childItem.innerText <> "時間" Then Dim itemNew Set itemNew = New PinpointItem itemNew.Time = childItem.innerText Set items(i) = itemNew i = i + 1 End If Next Dim trForecastTimes Set trForecastTimes = trTodayTimes.nextSibling ' 天気とアイコンを列挙して追加 i = 0 For Each childItem In trForecastTimes.children If childItem.innerText <> "天気" Then items(i).Forecast = childItem.innerText If IsObject(childItem.firstChild) And _ IsObject(childItem.firstChild.firstChild) And _ UCase(childItem.firstChild.firstChild.tagName) = "IMG" Then items(i).ForecastIcon = childItem.firstChild.firstChild.src End If i = i + 1 End If Next Dim trForecastTemperature Set trForecastTemperature = trForecastTimes.nextSibling ' 気温を列挙して追加 i = 0 For Each childItem In trForecastTemperature.children If childItem.innerText <> "気温" Then items(i).Temperature = childItem.innerText i = i + 1 End If Next Dim trForecastPrecipitation Set trForecastPrecipitation = trForecastTemperature.nextSibling ' 降水量を列挙して追加 i = 0 For Each childItem In trForecastPrecipitation.children If childItem.innerText <> "降水量" Then items(i).Precipitation = childItem.innerText i = i + 1 End If Next Dim trForecastHumidity Set trForecastHumidity = trForecastPrecipitation.nextSibling ' 湿度を列挙して追加 i = 0 For Each childItem In trForecastHumidity.children If childItem.innerText <> "湿度" Then items(i).Humidity = childItem.innerText i = i + 1 End If Next Dim trForecastWinddirection Set trForecastWinddirection = trForecastHumidity.nextSibling ' 風向とアイコンを列挙して追加 i = 0 For Each childItem In trForecastWinddirection.children If childItem.innerText <> "風向" Then items(i).Winddirection = childItem.innerText If IsObject(childItem.firstChild) And _ IsObject(childItem.firstChild.firstChild) And _ UCase(childItem.firstChild.firstChild.tagName) = "IMG" Then items(i).WinddirectionIcon = childItem.firstChild.firstChild.src End If i = i + 1 End If Next Dim trForecastWindspeed Set trForecastWindspeed = trForecastWinddirection.nextSibling ' 風速を列挙して追加 i = 0 For Each childItem In trForecastWindspeed.children If childItem.innerText <> "風速" Then items(i).Windspeed = childItem.innerText i = i + 1 End If Next ' 収集したアイテムを登録 For i = LBound(items) To UBound(items)-1 Dim nodeTodayItem Set nodeTodayItem = xmlPinpoint.createElement("item") Set nodeTodayItem = nodePinpoint.appendChild(nodeTodayItem) ' 時間 Dim nodeTodayTime Set nodeTodayTime = xmlPinpoint.createElement("time") nodeTodayTime.text = items(i).Time Set nodeTodayTime = nodeTodayItem.appendChild(nodeTodayTime) ' 天気 Dim nodeTodayForecast Set nodeTodayForecast = xmlPinpoint.createElement("title") nodeTodayForecast.text = items(i).Forecast Set nodeTodayForecast = nodeTodayItem.appendChild(nodeTodayForecast) ' 天気アイコン Dim nodeTodayForecastImage Set nodeTodayForecastImage = xmlPinpoint.createElement("title_image") nodeTodayForecastImage.text = items(i).ForecastIcon Set nodeTodayForecastImage = nodeTodayItem.appendChild(nodeTodayForecastImage) ' 気温 Dim nodeTodayTemperature Set nodeTodayTemperature = xmlPinpoint.createElement("temperature") nodeTodayTemperature.text = items(i).Temperature Set nodeTodayTemperature = nodeTodayItem.appendChild(nodeTodayTemperature) ' 降水量 Dim nodeTodayPrecipitation Set nodeTodayPrecipitation = xmlPinpoint.createElement("precipitation") nodeTodayPrecipitation.text = items(i).Precipitation Set nodeTodayPrecipitation = nodeTodayItem.appendChild(nodeTodayPrecipitation) ' 湿度 Dim nodeTodayHumidity Set nodeTodayHumidity = xmlPinpoint.createElement("humidity") nodeTodayHumidity.text = items(i).Humidity Set nodeTodayHumidity = nodeTodayItem.appendChild(nodeTodayHumidity) ' 風向 Dim nodeTodayWinddirection Set nodeTodayWinddirection = xmlPinpoint.createElement("winddirection") nodeTodayWinddirection.text = items(i).Winddirection Set nodeTodayWinddirection = nodeTodayItem.appendChild(nodeTodayWinddirection) ' 風向 Dim nodeTodayWinddirectionImage Set nodeTodayWinddirectionImage = xmlPinpoint.createElement("winddirection_image") nodeTodayWinddirectionImage.text = items(i).WinddirectionIcon Set nodeTodayWinddirectionImage = nodeTodayItem.appendChild(nodeTodayWinddirectionImage) ' 風速 Dim nodeTodayWindspeed Set nodeTodayWindspeed = xmlPinpoint.createElement("windspeed") nodeTodayWindspeed.text = items(i).Windspeed Set nodeTodayWindspeed = nodeTodayItem.appendChild(nodeTodayWindspeed) Next End Function ' Function pinpoint_today Function pinpoint_today(tableTitle, xmlPinpoint, docForecast, nodeItems) ' 今日/明日の天気用を追加 Dim nodePinpoint Set nodePinpoint = xmlPinpoint.createElement("forecast") Set nodePinpoint = nodeItems.appendChild(nodePinpoint) ' type="today" Dim attrType Set attrType = xmlPinpoint.createAttribute("type") attrType.text = "today" nodePinpoint.attributes.setNamedItem(attrType) pinpoint_today = pinpoint_forecast(tableTitle.nextSibling, xmlPinpoint, docForecast, nodePinpoint) End Function ' Function pinpoint_tomorrow Function pinpoint_tomorrow(tableTitle, xmlPinpoint, docForecast, nodeItems) ' きょうの生活指数の<TABLE>を探す Dim tableTomorrow Set tableTomorrow = tableTitle.nextSibling Do Set tableTomorrow = tableTomorrow.nextSibling If UCase(tableTomorrow.tagName) = "TABLE" Then If InStr(tableTomorrow.firstchild.firstchild.firstchild.innerText, "明日の天気") Then Exit Do End If End If Loop While IsObject(tableTomorrow) ' 今日/明日の天気用を追加 Dim nodePinpoint Set nodePinpoint = xmlPinpoint.createElement("forecast") Set nodePinpoint = nodeItems.appendChild(nodePinpoint) ' type="tomorrow" Dim attrType Set attrType = xmlPinpoint.createAttribute("type") attrType.text = "tomorrow" nodePinpoint.attributes.setNamedItem(attrType) pinpoint_tomorrow = pinpoint_forecast(tableTomorrow, xmlPinpoint, docForecast, nodePinpoint) End Function ' Function pinpoint_indexes ' ' きょうの生活指数情報を解析して ' 情報を登録します。 Function pinpoint_indexes(tableTitle, xmlPinpoint, docForecast, nodeItems) pinpoint_indexes = True ' きょうの生活指数の<TABLE>を探す Dim tableIndexesTitle Set tableIndexesTitle = tableTitle.nextSibling Do Set tableIndexesTitle = tableIndexesTitle.nextSibling If UCase(tableIndexesTitle.tagName) = "TABLE" Then If InStr(tableIndexesTitle.firstchild.firstchild.firstchild.innerText, "きょうの生活指数") Then Exit Do End If End If Loop While IsObject(tableIndexesTitle) ' きょうの生活指数の要素を追加 Dim nodeIndexes Set nodeIndexes = xmlPinpoint.createElement("indexes") Set nodeIndexes = nodeItems.appendChild(nodeIndexes) If IsObject(tableIndexesTitle) Then Dim tbodyIndexTitle Set tbodyIndexTitle = tableIndexesTitle.firstchild Dim trIndexTitle Set trIndexTitle = tbodyIndexTitle.firstchild ' 発表日時を登録 Dim nodeIndexTime Set nodeIndexTime = xmlPinpoint.createElement("date") nodeIndexTime.text = trIndexTitle.firstchild.nextSibling.innerText Set nodeIndexTime = nodeIndexes.appendChild(nodeIndexTime) End If ' 各種生活指数項目を収集 Dim tableIndexes Set tableIndexes = tableIndexesTitle.nextSibling If IsObject(tableIndexes) Then Dim trIndexItem For Each trIndexItem In tableIndexes.firstChild.children ' きょうの生活指数の要素を追加 Dim nodeIndex Set nodeIndex = xmlPinpoint.createElement("index") Set nodeIndex = nodeIndexes.appendChild(nodeIndex) ' 生活指数項目 Dim nodeIndexTitle Set nodeIndexTitle = xmlPinpoint.createElement("title") nodeIndexTitle.text = trIndexItem.firstChild.innerText Set nodeIndexTitle = nodeIndex.appendChild(nodeIndexTitle) ' 生活指数画像 Dim imgIndex For Each imgIndex In docForecast.getElementsByTagName("img") If trIndexItem.firstChild.nextSibling.contains(imgIndex) Then Dim nodeIndexImage Set nodeIndexImage = xmlPinpoint.createElement("url") nodeIndexImage.text = imgIndex.src Set nodeIndexImage = nodeIndex.appendChild(nodeIndexImage) Exit For End If Next ' 生活指数詳細 Dim nodeIndexDesc Set nodeIndexDesc = xmlPinpoint.createElement("description") nodeIndexDesc.text = trIndexItem.firstChild.nextSibling.nextSibling.innerText Set nodeIndexDesc = nodeIndex.appendChild(nodeIndexDesc) Next End If End Function ' Function pinpoint ' ' ピンポイント予報解析のメイン関数です。 ' 情報登録ノードを準備してタイトル、今日の予報、 ' 明日の予報およびきょうの生活指数情報処理を ' 呼び出します。 ' 最後に、他の予報へのリンク情報も登録します。 Function pinpoint() pinpoint = True Dim strLocation strLocation = LunaScriptSidebar.GetData("CurrentLocation") Dim strUrl strUrl = LunaScriptSidebar.GetData("CurrentUrl") Dim docForecast Set docForecast = LunaHtmlUtility.LoadHTML(strUrl) ' 表示内容を格納するXML Dim xmlPinpoint set xmlPinpoint = create_output_xml_object() ' ルートノードを追加 Dim nodeRoot Set nodeRoot = xmlPinpoint.createElement("root") Set nodeRoot = xmlPinpoint.appendChild(nodeRoot) ' アイテム用ルートノードを追加 Dim nodeItems Set nodeItems = xmlPinpoint.createElement("items") Set nodeItems = nodeRoot.appendChild(nodeItems) Dim tableTitle Set tableTitle = get_title_table(docForecast, strLocation) If IsObject(tableTitle) Then pinpoint_title strUrl, strLocation, tableTitle, xmlPinpoint, docForecast, nodeItems pinpoint_today tableTitle, xmlPinpoint, docForecast, nodeItems pinpoint_tomorrow tableTitle, xmlPinpoint, docForecast, nodeItems pinpoint_indexes tableTitle, xmlPinpoint, docForecast, nodeItems End If ' 各ピンポイントページの情報を追加 ' 広域予報をダウンロードするURL Dim strAreaUrl strAreaUrl = "http://weather.livedoor.com/forecast/webservice/rest/v1?day=tomorrow&city=63" ' XMLをダウンロード Dim xmlArea Set xmlArea = LunaXmlUtility.LoadXML(strAreaUrl) ' 各地の天気詳細を処理 Dim oPinpoint Set oPinpoint = xmlArea.selectSingleNode("/lwws/pinpoint") nodeItems.appendChild(oPinpoint) ' XSLスタイルシートを登録 LunaScriptSidebar.SetXsltFileName("pinpoint.xsl") ' XMLを登録 LunaScriptSidebar.SetXml(xmlPinpoint.xml) LunaScriptSidebar.Update() End Function ' Function change_location ' ' 指定されたピンポイント地域を解析します。 ' 実際の処理はpinpoint関数内でバックグラウンドで ' 行われます。 Function change_location() change_location = False LunaScriptSidebar.BeginThread "forecast.vbs", "pinpoint", "" End Function