[سعود]

اخواني الاعزاء .. لدي هذا الكود

كود :

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

ادري ان الكود طويل لكن ارجو النظر فيه ومعرفة لماذا يتم فقط تعديل اخر رابط بالصفحة
يعني لو لدينا صفحة فيها عدة روابط للمرفقات فانه بناء على هذا الكود يتم استبدال اخر رابط ولو لم يوجد الا مرفق واحد يتم العمل
كيف اعدل على الكود ليتم العمل بشكل صحيح
يعني اظن ولا ادري انه لغز بسيط بالنسبة لكم لكنه اتعبني

[الشاكي لله]

أخي سعود ما أقول إلا انك معقد نفسك بالRegas

لو استعملت طريقتي كنت ريحت نفسك

[سعود]

إقتباس :لو استعملت طريقتي كنت ريحت نفسك

بس ياخوي الاداة ليست مرنة او اني لم اتمكن من تطويعها

[الشاكي لله]

(14-10-13, 01:33 AM)سعود كتب :

إقتباس :لو استعملت طريقتي كنت ريحت نفسك

بس ياخوي الاداة ليست مرنة او اني لم اتمكن من تطويعها

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

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


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

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



1
http://vb4arb.com/vb/showthread.php?tid=...41#pid1541

2
http://vb4arb.com/vb/showthread.php?tid=...61#pid1761

3
http://vb4arb.com/vb/showthread.php?tid=...24#pid2524


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

--

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

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

[سعود]

عدلت بالكود وصار العكس يحمل اول مرفق ويستبدل الرابط

---

صدقني كلها سوى بالصعوبة

---

بعدين الرابط اللي هنا
http://vb4arb.com/vb/showthread.php?tid=...61#pid1761
هذا لو صار الرابط كله معلوم
لكن لو حبيت العملية تتم بشكل اوتوماتيكي اظن ستحتاج .....

[الشاكي لله]

(14-10-13, 02:21 AM)سعود كتب : عدلت بالكود وصار العكس يحمل اول مرفق ويستبدل الرابط

---

صدقني كلها سوى بالصعوبة

---

بعدين الرابط اللي هنا
http://vb4arb.com/vb/showthread.php?tid=...61#pid1761
هذا لو صار الرابط كله معلوم
لكن لو حبيت العملية تتم بشكل اوتوماتيكي اظن ستحتاج .....

اي رابط قصدك

تدري .. انا اسحب ايدي من هالموضوع .. اتعقدت نفسيا !!!

لحد الان من موضوعك الاول انا موفاهم ويش قاعد تسوي !!

[sooriaty03]

السلام عليكم ورحمة الله وبركاته

أخي سعود
الكود بالفعل معقد جدا
خلينا نحله سوى ببساطة
أولا نريد تعريف Regex للبحث عن المرفقات فيجب أن نصيغ جملة الشرط

هذا كود المرفقات

كود :

<a href="[align=left]attachment.php?aid=304[/align]" target="_blank">SaveAttachment.zip</a>

نأتي لصيغة الـ Regex

كود :

attachment\.php\?aid=[0-9]{1,}" target="_blank">

ثانيا بعد وضع قاعدة Regex ، نقوم بعمل حلقة تكرارية للبحث في كامل الكود بالكود التالي

كود :

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)
'
'
'
'
Next

ثالثا/ داخل الحلقة التكرارية نقوم باستخلاص الروابط - إن وجدت - طبعا نحن لا يهمنا إلا النص التالي

كود :

attachment.php?aid=304

وطريقة استخلاصه تكون بهذا الكود

كود :

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

الآن نقوم بتحميل المرفق بعد إضافة إليه النص http://vb4arb.com/vb/

وأخيرا نأتي إلى استبدال الرابط داخل صفحة الانترنت برابط المرفق على الجهاز
على فرض أننا قمنا بتسمية المرفق s.zip فنكتب

كود :

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

فيصبح الكود النهائي

كود :

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

[سعود]

بارك الله فيك اخوي
هل يمكن اسم المرفق لتكتمل مع رابط المرفق

[sooriaty03]

السلام عليكم ورحمة الله وبركاته

تفضل أخي
هذا كود الدالة

كود :

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

بالتوفيق