استخراج متن وبسایت از inet

[niksalehi]

سلام عزیزان
من سورس یک وبسایت رو با inet گرفتم

<td class="bb32">hello</td>
حالا چطوری میتونم متن های رو که به این صورت هستن رو استخراج کنم؟ منظورم hello هستش!

[MahmoodGH]

سلام عزیزان
من سورس یک وبسایت رو با inet گرفتم

<td class="bb32">hello</td>
حالا چطوری میتونم متن های رو که به این صورت هستن رو استخراج کنم؟ منظورم hello هستش!

یه لیست باکس بزار روی فرمت با یه تکست باکس که سورس صفحه رو بریزی توش :

Dim a() As String
Dim Item As String
a = Split(Text1, "<td class=""bb32"">")
For i = 1 To UBound(a)
Item = Replace(a(i), "</td>", "")
Item = Replace(Item, vbCrLf, "")
List1.AddItem Item
Next i

[niksalehi]

ممنون اما جواب نداد! راه دیگه ای هست؟

[امین مستانی]

آقای نیک صالحی شما 2 ماه پیش همین سوالو کردید و آقای واژدی جوابتون رو دادن دیگه !!!
واسه چی دوباره میپرسین ؟؟؟

http://barnamenevis.org/showthread.php?352166-%D9%BE%DB%8C%D8%AF%D8%A7-%DA%A9%D8%B1%D8%AF%D9%86-%D9%84%DB%8C%D9%86%DA%A9-%D8%AF%D8%A7%D9%86%D9%84%D9%88%D8%AF-%D8%A7%D8%B2-%D8%B7%D8%B1%DB%8C%D9%81-%D8%B3%D9%88%D8%B1%D8%B3-%D8%B3%D8%A7%DB%8C%D8%AA%D8%9F

[niksalehi]

بـــــــــــــــــله درسته اما هرکاری میکنم نمیـــــــــــتونم متن پست شماره 2 رو استخراج کنم!!!


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


به جای
Const sLINK$ = "href=""" چی بنویسم؟ :)

[امین مستانی]

'

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


Public Sub SourceLinksGunner(sContents$, CResult As Collection)
On Error Resume Next
Dim sHRef$, lQutePos&
Dim lLPos&

Const sLINK$ = """bb32"">"
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

[niksalehi]

عزیز مشکل اینجاس که توی سورس به این صورته:

<td class="bb32">hello</td>
<td class="bb33">hi</td>
<td class="bb42">goodbye</td>
<td class="bb49">bye</td>


یعنی bb33 ثابت نیس که من بخوام با توجه به bb33 متن بعدش رو استحراج کنم!

[امین مستانی]

این رو ببین


Public Sub SourceLinksGunner(sContents$, CResult As Collection)
On Error Resume Next
Dim sHRef$, lQutePos&
Dim lLPos&

sLINK$ = Chr$(34) & ">"
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

[محسن واژدی]

سلام علیکم
با اجازه kokopark عزیز

تابع ویرایش شده زیر را هم بررسی کنید:
Public Sub SourceLinksGunner(sContents$, CResult As Collection)
On Error Resume Next
Dim sHRef$, lQutePos&
Dim lLPos&, lCTgPos&

Const sLINK$ = "class=""bb"
Const sCTg$ = """>"

Set CResult = New Collection
Do
lLPos& = InStr(lLPos& + 1, sContents$, sLINK$, vbTextCompare)

If lLPos& > 0 Then
lCTgPos& = InStr(lLPos& + 1, sContents$, sCTg$, vbTextCompare)

lLPos& = lCTgPos& + Len(sCTg$)

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

موفق باشید