لیست کردن لینک های متن

[علیرضا.ا]

سلام

این ماژوال از 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 میده!!!
ممنون

[علیرضا.ا]

نبود؟:ناراحت:

[Hossis]

این کد که کلا ایراد داشت
به جاش من قبلا یک تابع ساخته بودم که لینک ها رو استخراج کرده و اول آنها کد 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]

این هم فراموش نشه که شما باید این خط رو از کد بالا حذف کنید
Href = "<a href=""" & Href & """>"

[علیرضا.ا]

ممنون
چجوری فراخانی میشه؟:متفکر:

[Hossis]

کد قبلی رو اصلاح کردم
نتیجه اش این میشه

Sub TbLinks_Click()
textbox1.text=SetLinks(Context$)
end sub

به جای Context$ شما باید متن ورودی رو بنویسید که عملیات روی اون انجام بشه

[علیرضا.ا]

نشد:متفکر:

[Hossis]

شما متن کانتکست رو بدید تا کدش رو بنویسم
یک راه دیگه استفاده از وب بروسر هست
در این راه، متن رو وارد وب بروزر می کنید و سپس لینکهاش رو استخراج می کنید!

من این تابع رو نوشتم و جواب داد:

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]

در کد بالا می توانید خط 6 و 7 رو با هم جابجا کنید و هر دو جواب می دهد

[علیرضا.ا]

متن من یه خط نیس
یه قالب وبلاگه:)
با وب بروزر اگه بخوام انجام بدم از قالب رو دانلود میکنه و دردسر داره....
این ماژوالی که اون بالا دادم از تکست باکس کد رو میگرفت و توی لیست همه ی لینک ها رو لیست میکرد
یه چیزی توی مایه های این میخام.....

[Hossis]

بله متوجهم شما لازم نیست قالب رو دانلود کنید بلکه می تونید متن تکست باکس رو به این تابع بدید خودش کارش رو انجام میده به این صورت:
textbox1.text=GetLinks(textbox1.text)

[AliRezaBeytari]

داداش ، سورسش رو درست کن ! لطفا ! :قلب:

[علیرضا.ا]

داداش ، سورسش رو درست کن ! لطفا ! :قلب:

درسته که...
اگه ج نمیده private بو public کن حل میشه.....