rss readr - خواندن فایل های xml و بیرون کشیدن دیتا از آن

[mazoolagh]

سطح این آموزش بالاتر از متوسط است، لطفا پرسشهای ابتدایی را گوگل کنید!

از آنجا که rss در اصل یک فایل xml هست، باید علاوه بر آشنایی با این نوع فایل، با روش های خواندن فایل از وب و همینجور نحوه پردازش اون آشنا باشین.

دو تاپیک زیر میتونه به شما در فهمیدن کدها کنه:

https://barnamenevis.org/showthread.php?524097

https://barnamenevis.org/showthread.php?546325

[mazoolagh]

برای اینکه با rss آشنا بشین میتونین لینک های زیر رو در مرورگر بازکین و فیلدها رو بررسی کنین:

https://www.isna.ir/rss

https://www.zoomit.ir/feed/

https://digiato.com/feed/

اگر دقت کنید فیلدهای اصلی title و link رو میبینین که اینجا فعلا فقط با این دو سر و کار داریم
برای آشنایی با فیلدها و فرمت rss بهتره rss validator رو گوگل کنین، ولی با مقایسه همین سه لینک بالا هم دیده میشه که بعضی سایتها ممکنه فیلدهای اضافه تعریف کرده باشن یا اینکه دیتا رو attribute بریزن.

به همین خاطر برای هر استخراج دقیق و کامل دیتا از یک rss feed بخصوص، باید براش reader اختصاصی بنویسین،
مگر اینکه مثل اینجا فقط از فیلدهای استاندارد استفاده کرده باشین.

[mazoolagh]

اول یک تابع برای خوندن دیتا xml مینویسیم،
در این تابع url میتونه آدرس یک فایل local یا یک آدرس اینترنتی باشه:

Public Type Response
xml As MSXML2.DOMDocument60
ERROR_MESSAGE As String
End Type

Public Function Read_xml(File_Url As String) As Response
On Error GoTo Error_Handler
Dim REQ As New MSXML2.XMLHTTP60
REQ.Open "GET", File_Url, False
REQ.Send
If REQ.status = 200 Then ' STATUS CODE 200 = OK
Set Read_xml.xml = REQ.responseXML
Else
Set Read_xml.xml = Nothing
Read_xml.ERROR_MESSAGE = " XMLHttpRequest Error = " & REQ.status & vbCrLf & REQ.statusText
End If
Set REQ = Nothing
Exit Function
Error_Handler:
Set Read_xml.xml = Nothing
Read_xml.ERROR_MESSAGE = "Access Error=" & Err.Number & vbCrLf & Err.description
Set REQ = Nothing
End Function

[mazoolagh]

یک فرم با یک listbox میسازیم و با استفاده از تابع بالا در یک حلقه تمام item ها رو در اون میریزیم:

Option Compare Database
Option Explicit
Const url_isna As String = "https://www.isna.ir/rss"
Const url_zoomit As String = "https://www.zoomit.ir/feed/"
Const url_digiato As String = "https://digiato.com/feed/"

Private Sub Read_RSS(url As String)
items_list.RowSource = ""
Dim rr As Response
rr = Read_xml(url)
If rr.xml Is Nothing Then
MsgBox rr.ERROR_MESSAGE
Exit Sub
End If
Dim items As MSXML2.IXMLDOMNodeList
Dim item As MSXML2.IXMLDOMNode
Set items = rr.xml.selectNodes("//item")
For Each item In items
Me.items_list.AddItem item.selectSingleNode("title").Text & ";" & item.selectSingleNode("link").Text
Next item
End Sub

Private Sub BTN_digiato_Click()
Read_RSS (url_digiato)
End Sub

Private Sub BTN_isna_Click()
Read_RSS (url_isna)
End Sub

Private Sub BTN_zoomit_Click()
Read_RSS (url_zoomit)
End Sub

Private Sub items_list_DblClick(Cancel As Integer)
DoCmd.OpenForm "Browser", , , , , acDialog, items_list.Column(1)
End Sub

[mazoolagh]

نتیجه کار:

151344

[mazoolagh]

یک فرم دیگه با یک web browser control میسازیم و با double click روی هر item مقدار link رو بعنوان آدرس براش میفرستیم:

Private Sub Form_Open(Cancel As Integer)
Me.wb.ControlSource = "=""" & Me.OpenArgs & """"
End Sub

[mazoolagh]

فرم مرورگر:

151345

[mazoolagh]

برنامه نمونه:

[محمد رضا بهبودی]

با سلام و احترام
ممنون از آموزش بسیار عالی جنابعالی
امیدوارم موفق و پیروز باشید . لطفا در صورت امکان در خصوص کالر پیکر هم راهنمائی بفرمائید .