[كود] كيف يتم التعديل على كل الروابط وليس اخر رابط موجود

كود :

If My.Computer.FileSystem.FileExists(lbldir.Text & "threads\thread_" & a & ".htm") = False Then

                Dim inputString As String = page

                'كود فحص النص عن الروابط

                Dim regex As New Regex("(<a href=)(.*)(</a>)", RegexOptions.IgnoreCase)

                Dim amatch As Match = Nothing

                Dim col As MatchCollection = regex.Matches(inputString)

                Dim nat As String = ""

                Dim ma As String = ""

                For Each amatch In col

                    'ان عادت الجملة for بنتيجة يكون التالي:

                    'اذا احتوى الرابط على رابط مرفق وهو attachment.php"aid=

                    If amatch.ToString.Contains("attachment.php?aid=") Then

                        'نكتب رابط جديد بحيث يحوي فقط اسم الملف المرفق لانه يتم تحميله مع الصفحة بنفس المجلد

                        nat = "<a href=" & afn & ">" & afn & "</a>"

                        'اسناد نتيجة الفحص لمتغير جديد

                        ma = amatch.ToString

                        ' MsgBox(afn)

                    End If

                Next

                Dim nm As String = ""

                If ma.ToString.Contains("attachment.php?aid=") Then

                    'ان احتوى نتيجة الفحص على رابط مرفق يتم الاستبدال مع رابط جديد الذي يحوي فقط اسم الملف المرفق

                    nm = page.Replace(ma, nat)

                Else

                    'او يسند له بدوت تغيير

                    nm = page

                End If

                '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>                                                 'هذا هو محتوى الصفحة بعد عمل التعديل لرابط المرفق

                My.Computer.FileSystem.WriteAllText(lbldir.Text & "threads\thread_" & a & ".htm", nm, False, encoding:=System.Text.Encoding.Default)

                p1.Value += 1

                lbl.Text += 1

                lblurl.Text = st.Text & "showthread.php?tid=" & a

                a -= 1

            Else

                p1.Value += 1

                lbl.Text += 1

                lblurl.Text = st.Text & "showthread.php?tid=" & a

                a -= 1

            End If

(14-10-13, 01:33 AM)سعود كتب :
إقتباس :لو استعملت طريقتي كنت ريحت نفسك
بس ياخوي الاداة ليست مرنة او اني لم اتمكن من تطويعها

هل مرنة بشكل كبير

وانا اتعامل معاها منذ زمنرطويل فيما يخص Html

شوف هذي الردود الى كتبتها كلها اعتمدت على الاداة

لو اني استخدمت الRegex كان الكود صار طويل ونتيجته غير مضمونة

1
http://vb4arb.com/vb/showthread.php?tid=299&pid=1541#pid1541

2
http://vb4arb.com/vb/showthread.php?tid=379&pid=1761#pid1761

3
http://vb4arb.com/vb/showthread.php?tid=530&pid=2524#pid2524

شوف الردود وعطني رايك (هل يمكنك عمل هذه البرامج بكود قصير باستعمال Regex ؟)

--

بأكواد بسيطة يمكنني عمل استخلاص واستبدال وتعديل مااريده من صفحة html

فلا تقارن regex ب HtmlAligityPack من ناحية التعامل Html

كود :

Dim Reg As System.Text.RegularExpressions.Regex = New System.Text.RegularExpressions.Regex("attachment\.php\?aid=[0-9]{1,}"" target=""_blank"">")

        For Each Reg0 As System.Text.RegularExpressions.Match In Reg.Matches(html)

            Dim AttachLink As String = html.Substring(Reg0.Index, Reg0.Length).Split("""")(0)

            'تنزيل المرفق

            AttachDownload(AttachLink)

            html = html.Replace(AttachLink, "s.zip")

        Next

كود :

Private Function AttachDownload(ByVal URL As String) As String

        Try

re:

            URL = "http://vb4arb.com/vb/" & URL

            'بدء اتصال جديد

            Dim Req As Net.HttpWebRequest = Net.HttpWebRequest.Create(URL)

            Dim Res As Net.HttpWebResponse

            'محتوى الكوكيز

            Req.Headers.Add("cookie", "محتوى الكوكيز")

            Res = Req.GetResponse

            Dim FileName As String = Res.Headers("Content-Disposition")

            If InStr(FileName, "filename") Then FileName = Strings.Right(FileName, FileName.Length - InStr(FileName, "=")) Else FileName = ""

            FileName = Replace(FileName, """", "")

            Res.Close()

            If Not FileName = Nothing AndAlso FileName.Trim <> "" Then

                'هذه الخطوة لفك ترميز اللغة

                Dim b() As Byte = (From C As Char In FileName.ToCharArray Select CByte(AscW(C))).ToArray

                FileName = System.Text.Encoding.UTF8.GetString(b)

                Dim client As New Net.WebClient

                client.Encoding = System.Text.Encoding.Default

                client.Headers.Add("cookie", "محتوى الكوكيز")

                client.DownloadFile(URL, "files\" & FileName)

                Return FileName

            Else

                'My.Computer.FileSystem.WriteAllText("log.txt", "File " & Id & " Not Found" & vbNewLine, True)

            End If

        Catch ex As Exception

            If ex.ToString.ToLower.Contains("not found") Then

            Else

                GoTo re

            End If

            MsgBox(ex.Message)

        End Try

        Return ""

End Function

كود :

Dim Reg As System.Text.RegularExpressions.Regex = New System.Text.RegularExpressions.Regex("attachment\.php\?aid=[0-9]{1,}"" target=""_blank"">")

        For Each Reg0 As System.Text.RegularExpressions.Match In Reg.Matches(html)

            Dim AttachLink As String = html.Substring(Reg0.Index, Reg0.Length).Split("""")(0)

            html = html.Replace(AttachLink, AttachDownload(AttachLink))

        Next