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
|