خطأ بسيط لا اعلم مغزاه - نسخة قابلة للطباعة

خطأ بسيط لا اعلم مغزاه - نسخة قابلة للطباعة

+- منتدى فيجوال بيسك لكل العرب | منتدى المبرمجين العرب (http://vb4arb.com/vb)
+-- قسم : قسم لغة الفيجوال بيسك VB.NET (http://vb4arb.com/vb/forumdisplay.php?fid=182)
+--- قسم : قسم اسئلة VB.NET (http://vb4arb.com/vb/forumdisplay.php?fid=183)
+--- الموضوع : خطأ بسيط لا اعلم مغزاه (/showthread.php?tid=27762)

خطأ بسيط لا اعلم مغزاه - ابو روضة - 02-12-18

كود :

Dim url As String = "https://www.alukah.net/fatawa_counsels/3002/"

        Dim wc As New WebClient

        wc.Encoding = Encoding.UTF8

        Dim html As String = wc.DownloadString(url)

        Dim doc As New HtmlAgilityPack.HtmlDocument

        doc.LoadHtml(html)

        For Each n As HtmlAgilityPack.HtmlNode In doc.DocumentNode.SelectNodes("//table[@class='table']/tr[1]/td[1]/a/id")

            dataGridView1.Rows.Add(n.Attributes("href").Value.ToString(), n.InnerText.Trim)

            Me.Text = dataGridView1.RowCount

        Next

يحدث ايرو من url ولا اعلم لماذا

RE: خطأ بسيط لا اعلم مغزاه - rmnr - 03-12-18

أضف user-agent

كود :

Dim wc As New WebClient

wc.Headers.Add("user-agent", "Mozilla/5.0")

تمنياتي للجميع بالتوفيق

RE: خطأ بسيط لا اعلم مغزاه - ابو روضة - 03-12-18

(03-12-18, 12:48 AM)rmnr كتب : أضف user-agent

كود :

Dim wc As New WebClient wc.Headers.Add("user-agent", "Mozilla/5.0")

تمنياتي للجميع بالتوفيق

أيضا يظهر خطأ اخى لكن هذه المرة فى الكود

RE: خطأ بسيط لا اعلم مغزاه - rmnr - 03-12-18

لا أتعامل مع المكتبة HtmlAgilityPack تعاملي فقط مع Regex

لتجربة الكود
أنشئ مشروع جديد وأضف DataGridView وButton

سيظهر في عنوان الفورم عداد للصفحات التي قيد القراءة
وبعد الإنتهاء، قم بالنقر على أي سطر لفتح الموضوع في المتصفح الإفتراضي لديك

كود :

Imports System.Net

Imports System.Text

Imports System.Text.RegularExpressions

Public Class Form1

    Dim data As New List(Of row)

    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click

        Dim url As String = "https://www.alukah.net/fatawa_counsels/3002/"

        Dim wc As New WebClient

        wc.Headers.Add("user-agent", "Mozilla/5.0")

        wc.Encoding = Encoding.UTF8

        Dim html As String = wc.DownloadString(url)

        Dim totalpages As Integer = Val(Regex.Match(html, "(?<=Title=""\d+""\>)\d+?(?=</a>\n)").Value)

        For i = 1 To totalpages

            wc = New WebClient

            wc.Headers.Add("user-agent", "Mozilla/5.0")

            wc.Encoding = Encoding.UTF8

            html = wc.DownloadString(url & "Page/" & i & "/")

            Me.Text = i & " / " & totalpages

            Dim m As MatchCollection = Regex.Matches(html, "<tr\sclass=""table-[row|alt].+?title=""(.+?)"".+?href=""(.+?)"".+?<td>(.+?)</td>.+?</tr>", RegexOptions.Singleline)

            For Each a As Match In m

                Dim r As New row

                r.Index = data.Count + 1

                r.Title = a.Groups(1).Value.ToString.Trim

                r.Auth = a.Groups(3).Value.ToString.Trim

                r.Link = "https://www.alukah.net/" & a.Groups(2).Value.ToString.Trim

                data.Add(r)

            Next

        Next

        Me.DataGridView1.DataSource = data

    End Sub

    Private Sub DataGridView1_CellContentClick(sender As Object, e As DataGridViewCellEventArgs) Handles DataGridView1.CellContentClick

        Process.Start(Me.DataGridView1.CurrentRow.Cells(3).Value)

    End Sub

End Class

Class row

    Property Index As Integer 'مجرد ظهر ترقيم للأسطر

    Property Title As String

    Property Auth As String

    Property Link As String

End Class

تمنياتي للجميع بالتوفيق

RE: خطأ بسيط لا اعلم مغزاه - ابو روضة - 03-12-18

(03-12-18, 02:11 AM)rmnr كتب : لا أتعامل مع المكتبة HtmlAgilityPack تعاملي فقط مع Regex

لتجربة الكود
أنشئ مشروع جديد وأضف DataGridView وButton

سيظهر في عنوان الفورم عداد للصفحات التي قيد القراءة
وبعد الإنتهاء، قم بالنقر على أي سطر لفتح الموضوع في المتصفح الإفتراضي لديك

كود :

Imports System.Net Imports System.Text Imports System.Text.RegularExpressions Public Class Form1 Dim data As New List(Of row) Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click Dim url As String = "https://www.alukah.net/fatawa_counsels/3002/" Dim wc As New WebClient wc.Headers.Add("user-agent", "Mozilla/5.0") wc.Encoding = Encoding.UTF8 Dim html As String = wc.DownloadString(url) Dim totalpages As Integer = Val(Regex.Match(html, "(?<=Title=""\d+""\>)\d+?(?=</a>\n)").Value) For i = 1 To totalpages wc = New WebClient wc.Headers.Add("user-agent", "Mozilla/5.0") wc.Encoding = Encoding.UTF8 html = wc.DownloadString(url & "Page/" & i & "/") Me.Text = i & " / " & totalpages Dim m As MatchCollection = Regex.Matches(html, "<tr\sclass=""table-[row|alt].+?title=""(.+?)"".+?href=""(.+?)"".+?<td>(.+?)</td>.+?</tr>", RegexOptions.Singleline) For Each a As Match In m Dim r As New row r.Index = data.Count + 1 r.Title = a.Groups(1).Value.ToString.Trim r.Auth = a.Groups(3).Value.ToString.Trim r.Link = "https://www.alukah.net/" & a.Groups(2).Value.ToString.Trim data.Add(r) Next Next Me.DataGridView1.DataSource = data End Sub Private Sub DataGridView1_CellContentClick(sender As Object, e As DataGridViewCellEventArgs) Handles DataGridView1.CellContentClick Process.Start(Me.DataGridView1.CurrentRow.Cells(2).Value) End Sub End Class Class row Property Index As Integer 'مجرد ظهر ترقيم للأسطر Property Title As String Property Auth As String Property Link As String End Class

تمنياتي للجميع بالتوفيق

الله يكرمك أخى ماشاء الله عليك مميز ودماغك حلوة...

وللعلم الكود بطئ بعض الشيئ وحينما يجلب الاسماء لا يفتح الروابط لكن كتر ألف خيرك والله

دائما تعبك معايا...

RE: خطأ بسيط لا اعلم مغزاه - rmnr - 03-12-18

اعتذر تم التحديث، (تم تغيير رقم Cells من 2 إلى 3 في حدث النقر على السطر)

البطئ يكون بسبب سرعة النت

جزاك الله خير

RE: خطأ بسيط لا اعلم مغزاه - ابو روضة - 03-12-18

(03-12-18, 02:25 AM)rmnr كتب : اعتذر تم التحديث، (تم تغيير رقم Cells من 2 إلى 3 في حدث النقر على السطر)

البطئ يكون بسبب سرعة النت

جزاك الله خير

جزاك الله خيرا أخى ولا يهمك يا استاذى.....