Option Explicit
Private Sub ConvertXML(strURL As String)
' strURL เพื่อกำหนดตำแหน่งของไฟล์ XML เช่น
' strURL = "http://www.rssthai.com/rss/it.xml"
' หรือใช้ ASP/PHP Script ที่สามารถอ่านจากฐานข้อมูลแล้วสร้างไฟล์เป็น XML ออกมาก็ได้ ... ข้อมูลมันก็ UpToDate
' strURL = "http://www.g2gnet.com/news/rss.asp"
' หากไม่ได้ต่อกับอินเทอร์เน็ต ก็สามารถจำลองการใช้งานบนเครื่องได้ด้วยน่ะครับ เช่น ...
' strURL = "http://localhost/ชื่อไฟล์ XML"
' งานนี้ต้องการ DOM (Document Object Model) Component
' ซึ่ง Component ตัวนี้ จะประกอบไปด้วย
' Nodes - IXMLDOMNode
' NodeLists - IXMLDOMNodeList
' Elements - IXMLDOMElement
' Attributes - IXMLDOMattribute
Dim xmlDom As New MSXML2.DOMDocument40
Dim nodeCol, oNode, oChildNode
Set xmlDom = New MSXML2.DOMDocument40
' ตั้งค่าคุณสมบัติให้กับเอกสาร (Run Time)
xmlDom.async = False
xmlDom.validateOnParse = False
xmlDom.resolveExternals = False
' เมื่อเริ่มต้นการทำงานผ่าน Remote Server
xmlDom.setProperty "ServerHTTPRequest", True
' กำหนดเอกสารปลายทางที่จะอ่าน
xmlDom.Load (strURL)
' เอาไว้สำหรับการเก็บค่า Tag ของ HTML ทั้งหมด
Dim strTag As String
' เก็บ Link หน้าที่จะไป
Dim strLink As Boolean
' ส่วนของ Title (หัวข้อข่าว)
Dim strTitle As String
' วันที่ของการเผยแพร่ข่าว
Dim strPubdate As String
' รายละเอียดของข่าว
Dim strDescription As String
' เริ่มต้นการแปลงร่าง XML มาเป็น HTML
' ทดสอบก่อนว่าเอกสารที่รับมามีรูปแบบ XML หรือไม่ (ลักษณะของต้นไม้กลับหัวนั่นแหละครับ)
If Not xmlDom.documentElement Is Nothing Then
Set nodeCol = xmlDom.documentElement.selectNodes("channel/item")
' เริ่มต้นการสร้าง Tag โดยผมให้ตาราง (Table) เป็นตัวคลุมเนื้อหาข่าวสารทั้งหมด
' ใครสามารถอ่าน/เขียน HTML Tag ... ย่อมได้เปรียบครับ ...
strTag = strTag & ("<table width=100% border=0 cellpadding=3 cellspacing=0 bordercolor=#000000>")
' เริ่มต้นไล่ตาม Element
' แต่ละวงรอบของ FOR คือ การสร้าง 1 แถว (TR) และ 1 หลัก (TD) ของตาราง (TABLE) น่ะครับ
For Each oNode In nodeCol
' เพิ่มแถว <tr> และ หลัก <td> สำหรับ HTML Tag
strTag = strTag & ("<tr><td>")
strTag = strTag & ("<div align='left'>" & vbCrLf)
' ทดสอบว่ามีรายการ Link เข้ามาหรือไม่
Set oChildNode = oNode.selectSingleNode("link")
If Not oChildNode Is Nothing Then
' หากต้องการเปิด Browser หน้าใหม่
'strTag = strTag & ("<a href='" & oChildNode.Text & "' target='_blank'>")
' เปิด Browser หน้าเดิมของมันนี่แหละ
' ผมยังไม่ปิด Tag ในส่วนนี้ เพราะต้องการทำลิ้งค์ใส่ไว้ให้กับ Title
strTag = strTag & ("<a href='" & oChildNode.Text & "' target='_self'>")
strLink = True
Else
strLink = False
End If
' หัวเรื่อง (Title)
Set oChildNode = oNode.selectSingleNode("title")
If Not oChildNode Is Nothing Then
strTitle = oChildNode.Text
strTitle = Replace(strTitle, "'", "'")
strTitle = Replace(strTitle, "&", "&")
strTitle = Replace(strTitle, vbCrLf, "<br>")
strTag = strTag & ("" & strTitle & "")
End If
' ถ้าหากมี Link
If strLink = True Then
' ปิด Link ด้วย tag </a>
strTag = strTag & ("</a><br>" & vbCrLf)
End If
' รายละเอียดของข่าว (Description)
Set oChildNode = oNode.selectSingleNode("description")
If Not oChildNode Is Nothing Then
strDescription = oChildNode.Text
strDescription = Replace(strDescription, "![CDATA[", "'")
strDescription = Replace(strDescription, "]]", "'")
strDescription = Replace(strDescription, vbCrLf, "<br>")
strTag = strTag & ("" & strDescription & "")
End If
' วันที่ (PubDate)
Set oChildNode = oNode.selectSingleNode("pubDate")
If Not oChildNode Is Nothing Then
strPubdate = oChildNode.Text
strPubdate = Replace(strPubdate, "'", "'")
strPubdate = Replace(strPubdate, "&", "&")
strPubdate = Replace(strPubdate, vbCrLf, "<br>")
strTag = strTag & ("" & strPubdate & "</div></td></tr>" & vbCrLf)
End If
' การอ่านค่าอื่นๆเข้ามา ก็เช่นเดียวกันครับ ... จบ
Next
' ปิดตารางด้วย Tag </table>
strTag = strTag & ("</table>")
End If
' เมื่อได้ข้อมูล HTML Tag มาแล้ว ... (มันก็ Text ดีๆนี่แหละครับ)
' ก็ทำการจับยัดใส่เข้าไปไว้ในไฟล์ ... RSSFeed.html ... เหมือนบันทึกไฟล์ข้อมูลปกติ
' เพราะ HTML Tag มันก็คือ Text File ... แต่มีรูปแบบมาตรฐานในตัวมันเพื่อนำไปเปิดดูตาม Browser ต่างๆ
Open App.Path & "\RSSFeed.html" For Output As #1
Print #1, strTag
Close #1
' ให้ Web Browser ของเรา (webXML) ชี้ไปที่หน้าเว็บ RSSFeed.html
webXML.Navigate App.Path & ("\RSSFeed.html")
' หากกำหนดแบบนี้คุณจะได้เอกสาร XML แบบเพียวๆเลยครับ (โซดาไม่ต้อง ... เหอๆๆๆๆ)
'webXML.Navigate strURL
End Sub
Private Sub cboAddress_KeyPress(KeyAscii As Integer)
If Trim(cboAddress.Text) = "" Or Len(Trim$(cboAddress.Text)) = 0 Then Exit Sub
If KeyAscii = vbKeyReturn Then
cboAddress.AddItem cboAddress.Text
Call ConvertXML(cboAddress.Text)
End If
End Sub
Private Sub Form_Load()
Me.Move (Screen.Width - Width) \ 2, (Screen.Height - Height) \ 2
' สมมุติตัวอย่างแล้วกัน และ
' เป็นโปรแกรมทดสอบ ดังนั้นกรุณาพิมพ์ขึ้นต้นด้วย http:// ก่อนให้ครบด้วยน่ะครับ
cboAddress.Text = "http://www.g2gnet.com/News/rss.asp"
' หรือใช้ไฟล์ XMLTest.xml ทดสอบแบบ Off Line ก็ได้ครับ ... หากไม่ได้ต่อเน็ต หรือ จำลอง Server ไว้
'cboAddress.Text = App.Path & "\XMLTest.xml"
' กำหนดเป็นหน้าเว็บที่ว่างเปล่าไว้ก่อนครับ ... ทำไมเหรอ ...
' ก็ขืนไม่ให้ตัว Web Browser มีอะไรมารองรับมันๆก็จะช้า จะอืดน่ะซิครับ ... แบบนี้ชายไม่ชอบเลย 55555+
webXML.Navigate App.Path & "\Blank.html"
End Sub
|