View Full Version : بدست آوردن لیست وبلاگها
Dr Saeed
پنج شنبه 24 مهر 1393, 03:14 صبح
با سلام دوستان عزیز
میخوام لیست اسم وبلاگ هارو در بیارم و داخل لیست باکسم بریزم ممنون میشم کمک کنید
لینک صفحه : http://www.rozblog.com/list.php
در ضمن اون قسمت بالا که موضوع بندی شدرو نمیخوام فقط لیست این وبلاگ هایی که زیر اونا قرار گرفته
با سپاس
یا علی
samiasoft
پنج شنبه 24 مهر 1393, 12:05 عصر
با این میتونی ادرسشون رو بدست بیاری
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
پنج شنبه 24 مهر 1393, 14:25 عصر
با این میتونی ادرسشون رو بدست بیاری
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
پنج شنبه 24 مهر 1393, 15:52 عصر
کدی که قرار دادم درست بود باید متغییر ها رو. هم خب تعریف میکردی قبش . شاید برا همین ارور داده.
اینو ببین به درستی کار میکنه
http://s5.picofile.com/file/8146203434/rozblog.rar.html
vBulletin® v4.2.5, Copyright ©2000-1403, Jelsoft Enterprises Ltd.