Printable View
سطح این آموزش بالاتر از متوسط است، لطفا پرسشهای ابتدایی را گوگل کنید!
از آنجا که rss در اصل یک فایل xml هست، باید علاوه بر آشنایی با این نوع فایل، با روش های خواندن فایل از وب و همینجور نحوه پردازش اون آشنا باشین.
دو تاپیک زیر میتونه به شما در فهمیدن کدها کنه:
https://barnamenevis.org/showthread.php?524097
https://barnamenevis.org/showthread.php?546325
برای اینکه با rss آشنا بشین میتونین لینک های زیر رو در مرورگر بازکین و فیلدها رو بررسی کنین:
https://www.isna.ir/rss
https://www.zoomit.ir/feed/
https://digiato.com/feed/
اگر دقت کنید فیلدهای اصلی title و link رو میبینین که اینجا فعلا فقط با این دو سر و کار داریم
برای آشنایی با فیلدها و فرمت rss بهتره rss validator رو گوگل کنین، ولی با مقایسه همین سه لینک بالا هم دیده میشه که بعضی سایتها ممکنه فیلدهای اضافه تعریف کرده باشن یا اینکه دیتا رو attribute بریزن.
به همین خاطر برای هر استخراج دقیق و کامل دیتا از یک rss feed بخصوص، باید براش reader اختصاصی بنویسین،
مگر اینکه مثل اینجا فقط از فیلدهای استاندارد استفاده کرده باشین.
اول یک تابع برای خوندن دیتا 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
یک فرم با یک 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
نتیجه کار:
ضمیمه 151344
یک فرم دیگه با یک web browser control میسازیم و با double click روی هر item مقدار link رو بعنوان آدرس براش میفرستیم:
Private Sub Form_Open(Cancel As Integer)
Me.wb.ControlSource = "=""" & Me.OpenArgs & """"
End Sub
فرم مرورگر:
ضمیمه 151345
برنامه نمونه:
با سلام و احترام
ممنون از آموزش بسیار عالی جنابعالی
امیدوارم موفق و پیروز باشید . لطفا در صورت امکان در خصوص کالر پیکر هم راهنمائی بفرمائید .