بدست آوردن لیست وبلاگها

[Dr Saeed]

با سلام دوستان عزیز

میخوام لیست اسم وبلاگ هارو در بیارم و داخل لیست باکسم بریزم ممنون میشم کمک کنید

لینک صفحه : http://www.rozblog.com/list.php

در ضمن اون قسمت بالا که موضوع بندی شدرو نمیخوام فقط لیست این وبلاگ هایی که زیر اونا قرار گرفته

با سپاس

یا علی

[samiasoft]

با این میتونی ادرسشون رو بدست بیاری

Dim i As Integer


WebBrowser1.Navigate "http://www.rozblog.com/list.php"


Do Until WebBrowser1.ReadyState = READYSTATE_COMPLETE
DoEvents
Loop

For i = 0 To WebBrowser1.Document.links.Length - 1
str = WebBrowser1.Document.links.Item(i)
If Left$(LCase(str), 4) = "http" And InStr(1, LCase(str), ".rozblog.com") > 0 Then
If Not InStr(1, LCase(str), "www.rozblog.com") > 0 Then
List1.AddItem (WebBrowser1.Document.links.Item(i))
End If
End If
Next i

برای بدست اوردن اسمشون هم به نظر من باید سورس صفحه رو بدست بیاری بعد تگی که شامل اسامی وبلاگ هاست بیاری لیست باکس

[Dr Saeed]

با این میتونی ادرسشون رو بدست بیاری

Dim i As Integer


WebBrowser1.Navigate "http://www.rozblog.com/list.php"


Do Until WebBrowser1.ReadyState = READYSTATE_COMPLETE
DoEvents
Loop

For i = 0 To WebBrowser1.Document.links.Length - 1
str = WebBrowser1.Document.links.Item(i)
If Left$(LCase(str), 4) = "http" And InStr(1, LCase(str), ".rozblog.com") > 0 Then
If Not InStr(1, LCase(str), "www.rozblog.com") > 0 Then
List1.AddItem (WebBrowser1.Document.links.Item(i))
End If
End If
Next i

برای بدست اوردن اسمشون هم به نظر من باید سورس صفحه رو بدست بیاری بعد تگی که شامل اسامی وبلاگ هاست بیاری لیست باکس

با سلام داداش کد شما ارور داد

من یه کد زدم درست کار میکنه ولی مقادیر اضافی زیادی توش هست مثلا اون قسمت بالای سایت رو اضافه میکنه و بعضی تگ های دیگه رو هم اضافه میکنه اگه میشه واسم تصحیح کنید واسم این کد رو


Public Sub GetTags(lst As ListBox, wb As WebBrowser)
Dim allCol
Dim TagName As String


lst.Clear


Set allCol = wb.Document.All
allcount = allCol.length


For i = 67 To allcount - 12


TagName = allCol.Item(i).TagName


If TagName = "BR" Or TagName = "SPAN" Then
TagName = Remove
End If


If TagName = "IMG" Or TagName = "A" Then
TagName = allCol.Item(i).href
End If


If TagName = "" Then
TagName = Remove
Else
lstTags.AddItem (TagName)
End If


Next
End Sub
Private Sub Form_Load()
Web1.Navigate2 ("http://www.rozblog.com/list.php")
End Sub


Private Sub Web1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
GetTags lstTags, Web1
Label1.Caption = lstTags.ListCount
End Sub


Private Sub Web1_DownloadBegin()
La.Caption = " ÏÑÍÇá ÈÇѐÒÇÑí áØÝÇ ÕÈÑ ˜äíÏ "
End Sub


Private Sub Web1_DownloadComplete()
La.Caption = " áíÓÊ æÈáǐåÇ ÈÑæÒ ÔÏ "
End Sub

[samiasoft]

کدی که قرار دادم درست بود باید متغییر ها رو. هم خب تعریف میکردی قبش . شاید برا همین ارور داده.

اینو ببین به درستی کار میکنه
http://s5.picofile.com/file/8146203434/rozblog.rar.html