人気ブログランキング | 話題のタグを見る

WSHで作るRSSアグリゲータ

 今時はRSSでサイト更新のチェックをやってる方は多いと思うが、RSSの走りの頃に「アグリゲータやRSSニュースリーダのタグイをいちいちクライアントに入れるのもウザい」→「Webページにしてしまえ」という甚だ安直な発想の元作成したASP(マイクロソフトのCGIプログラム用のスクリプト環境)プログラムがあったので、キモのところをWSHに焼きなおして晒しておく。

 かなり古いシロモノなので、今ではほとんど意味がないと思うがどなたかの参考にでもなれば幸いである。

 プログラムの中でWindowsからhttpアクセスを行わせるために、ServerXMLHTTPを使っている。これはWindowsXPあたりは標準で入っていると思うが、古めの2000だと入ってないかも。
ServerXMLHTTP に関してよく寄せられる質問 (FAQ) 文書番号290761

 それと、Proxyを踏んでいるときには、Proxycfg.exeで設定しないとダメなので注意されたい。
[INFO] ServerXMLHTTP が動作するにはプロキシ構成ユーティリティを使用する文書番号 : 289481

 サンプルではcnetジャパンのRSSを読んで、html文書に整形してエコー表示する。ファイルにリダイレクトするなり、FileSystemObject使うように改造してファイルに吐くなりご自由に。

 元々のASPではオンデマンドで照会してブラウザに返していたが、こういうものはやはりWSHで、定期的にスケジューラから動かす的な使い方の方がいいだろう。




' ======================================================================
' インチキ RSSニュースアグリゲータ(news aggregator)
' by SIGNAL9
' 要:MSXML2.ServerXMLHTTP --- ProxyCfgでの設定が必要
' ======================================================================
Option Explicit

Dim Result

'Result = RSS2HTML("http://www.atmarkit.co.jp/rss/rss2dc.xml")
Result = RSS2HTML("http://japan.cnet.com/rss/index.rdf")

Wscript.Echo "<html><body>" & Result & "</body></html>"

' ======================================================================
Function RSS2HTML( URL )
Dim objXMLHTTP
Dim objXMLDoc
Dim Nodes, Node

RSS2HTML = ""

'-------------------------------------------------------
' ServerXMLHTTPで、ターゲットのRSSドキュメントを取得する。
'-------------------------------------------------------
Set objXMLHTTP = Createobject("MSXML2.ServerXMLHTTP")
objXMLHTTP.Open "GET", URL,false
objXMLHTTP.setRequestHeader "Content-Type", "text/xml"
objXMLHTTP.send

'-------------------------------------------------------
' 取得したRSSドキュメントをXMLDOMでパースする。
'-------------------------------------------------------
Set objXMLDoc = CreateObject("Microsoft.XMLDOM")
'非同期
objXMLDoc.async = False

' サーバがvalidなRSSを送ってくれる前提で、検証をネグる。
' そのほうが速いし、RSS0.91などで、DTDがロードできない
' 場合もあるので。
objXMLDoc.validateOnParse = False
objXMLDoc.resolveExternals = False

objXMLDoc.loadXML objXMLHTTP.responseText

If objXMLDoc.parseError.errorcode<>0 Then
RSS2HTML = "RSS パースエラー:" & objXMLDoc.parseError.reason
Else

' タイトル部 ---ここではいちおうhtml形式のタグ付けて
Set Nodes = objXMLDoc.selectNodes("//channel")
' channelのツリーを取って
For Each Node In Nodes ' 子ノードから値を得る。
RSS2HTML = RSS2HTML & _
"<a href=""" & _
CheckOutNodeText( Node, "link" ) & _
""">" & _
CheckOutNodeText( Node, "title" ) & _
"</a> 更新日付: " & _
CheckOutNodeText( Node, "dc:date" ) & _
"<br>" &_
CheckOutNodeText( Node, "description" ) & _
"<br>" & vbCrLf
Next

' 明細部
Set Nodes = objXMLDoc.selectNodes("//item")
' itemのツリーを取って
For Each Node In Nodes ' 子ノードから値を得る。
RSS2HTML = RSS2HTML & _
"<a href=""" & _
CheckOutNodeText( Node, "link" ) & _
""">" & _
CheckOutNodeText( Node, "title" ) & _
"</a><br>" & _
CheckOutNodeText( Node, "description" ) & _
"<br>" & vbCrLf
Next
End If
End Function
'--------------------------------------
' 指定ノードのTextを返す。ノードがなければ
' 空文字を返す
'--------------------------------------
Function CheckOutNodeText( ByRef Node, nodename )
Dim wkObj
Set wkObj = Node.selectSingleNode(nodename)
If (wkObj Is Nothing) Then
CheckOutNodeText = ""
Else
CheckOutNodeText = wkObj.Text
End If
End Function

by SIGNAL-9 | 2005-04-19 15:52 | TIPSとかKludgeとか
<< ドコモの委託先企業社員を逮捕―... 中国は世界最大のネット検閲国家 >>