View Full Version : سوال: لیست کردن لینک های متن
علیرضا.ا
چهارشنبه 10 مهر 1392, 12:36 عصر
سلام
این ماژوال از vb6 هست
کسی میتونه به دات نت تبدیل کنه؟
Public Sub SourceLinksGunner(sContents$, CResult As Collection)
On Error Resume Next
Dim sHRef$, lQutePos&
Dim lLPos&
'Const sLINK$ = "<a href="""
Const sLINK$ = "href="""
Set CResult = New Collection
Do
lLPos& = InStr(lLPos& + 1, sContents$, sLINK$, vbTextCompare)
If lLPos& > 0 Then
lLPos& = lLPos& + Len(sLINK$)
lQutePos& = InStr(lLPos& + 1, sContents$, """")
sHRef$ = Mid(sContents$, lLPos&, lQutePos& - lLPos&)
If sHRef$ > "" Then
CResult.Add sHRef$
End If
End If
Loop Until lLPos& = 0
End Sub
دو تا ارور به تابع instr و اخرین sHRef میده!!!
ممنون
علیرضا.ا
پنج شنبه 11 مهر 1392, 15:19 عصر
نبود؟:ناراحت:
Hossis
پنج شنبه 11 مهر 1392, 20:04 عصر
این کد که کلا ایراد داشت
به جاش من قبلا یک تابع ساخته بودم که لینک ها رو استخراج کرده و اول آنها کد a href رو می گذاشت ، شما می تونید مقدار اضافی رو حذف کرده و لینک های یک متن رو بدست بیارید
Function SetLinks(ByVal htm As String) As String
Dim S, L As Integer
Dim Href,Links As String
Do While S < Len(htm)
Try
S = htm.IndexOf("http://", S)
If S = -1 Then Exit Do
If L = -1 Then
L = htm.IndexOf("<", S)
Else
L = htm.IndexOf(" ", S)
End If
If L < S Then Exit Do
Href = htm.Substring(S, L - S)
links &=href & vbnewline
Catch ex As Exception
End Try
Loop
Return links
End Function
Hossis
پنج شنبه 11 مهر 1392, 20:05 عصر
این هم فراموش نشه که شما باید این خط رو از کد بالا حذف کنید
Href = "<a href=""" & Href & """>"
علیرضا.ا
پنج شنبه 11 مهر 1392, 21:16 عصر
ممنون
چجوری فراخانی میشه؟:متفکر:
Hossis
پنج شنبه 11 مهر 1392, 21:22 عصر
کد قبلی رو اصلاح کردم
نتیجه اش این میشه
Sub TbLinks_Click()
textbox1.text=SetLinks(Context$)
end sub
به جای Context$ شما باید متن ورودی رو بنویسید که عملیات روی اون انجام بشه
علیرضا.ا
پنج شنبه 11 مهر 1392, 22:24 عصر
نشد:متفکر:
Hossis
جمعه 12 مهر 1392, 11:12 صبح
شما متن کانتکست رو بدید تا کدش رو بنویسم
یک راه دیگه استفاده از وب بروسر هست
در این راه، متن رو وارد وب بروزر می کنید و سپس لینکهاش رو استخراج می کنید!
من این تابع رو نوشتم و جواب داد:
Private Function GetLinks(ByVal htm As String)as string
Dim WBB As New WebBrowser
WBB.DocumentText = htm
WBB.Document.DomDocument.open()
WBB.Document.Write(htm)
Dim elmnt As System.Windows.Forms.HtmlElementCollection = WBB.Document.Links
'Dim elmnt As System.Windows.Forms.HtmlElementCollection = WBB.Document.GetElementsByTagName("A")
Dim tx As String
For Each Itm As System.Windows.Forms.HtmlElement In elmnt
tx &= Itm.InnerHtml & vbNewLine
Next
Return tx
End Function
Hossis
جمعه 12 مهر 1392, 11:17 صبح
در کد بالا می توانید خط 6 و 7 رو با هم جابجا کنید و هر دو جواب می دهد
علیرضا.ا
جمعه 12 مهر 1392, 12:02 عصر
متن من یه خط نیس
یه قالب وبلاگه:)
با وب بروزر اگه بخوام انجام بدم از قالب رو دانلود میکنه و دردسر داره....
این ماژوالی که اون بالا دادم از تکست باکس کد رو میگرفت و توی لیست همه ی لینک ها رو لیست میکرد
یه چیزی توی مایه های این میخام.....
Hossis
جمعه 12 مهر 1392, 17:49 عصر
بله متوجهم شما لازم نیست قالب رو دانلود کنید بلکه می تونید متن تکست باکس رو به این تابع بدید خودش کارش رو انجام میده به این صورت:
textbox1.text=GetLinks(textbox1.text)
AliRezaBeytari
جمعه 12 مهر 1392, 18:57 عصر
داداش ، سورسش رو درست کن ! لطفا ! :قلب:
علیرضا.ا
جمعه 12 مهر 1392, 21:15 عصر
داداش ، سورسش رو درست کن ! لطفا ! :قلب:
درسته که...
اگه ج نمیده private بو public کن حل میشه.....
vBulletin® v4.2.5, Copyright ©2000-1403, Jelsoft Enterprises Ltd.