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

[maxtools]

با سلام

دوستان سورس وبلاگ های بروز میهن بلاگ رو در وی بی 6 خواستم .

[parselearn]

Private Sub Command1_Click()

s = GetUrlSource("http://www.mihanblog.com/")
d1 = InStr(1, s, "<div class=" & Chr(34) & "webList clearfix" & Chr(34) & ">")
s = Mid(s, d1, 12000)

s = Replace(s, "http://static.mihanblog.com/", "")
s = Replace(s, "</div>", "")
s = Replace(s, "<div class=" & Chr(34) & "webList_thumb" & Chr(34) & ">", "")
s = Replace(s, "<div class=" & Chr(34) & "webList_slogan" & Chr(34) & ">", "")
s = Replace(s, "<div class=" & Chr(34) & "clearfix webList_row" & Chr(34) & ">", "")
s = Replace(s, "<img src=" & Chr(34) & "http://", "")

On Error Resume Next
Do
d1 = InStr(1, s, ".mihanblog.com")
s1 = Mid(s, d1 - 40, 60)
's1 = Replace(s1, Chr(47) & Chr(47), "")
d2 = InStr(1, s1, "http:")
s2 = Mid(s1, d2, Len(s1) - d2 + 1)
s2 = Replace(s2, "http:", "")
s2 = Replace(s2, Chr(47), "")
s2 = Replace(s2, vbCrLf, "")
d1 = InStr(1, s2, Chr(39))
s1 = Mid(s2, 1, d1 - 1)
List1.AddItem s1

s = Right(s, Len(s) - d1)
If List1.List(List1.ListCount - 1) = "" Then GoTo s:
Loop Until (Len(s) < 34)

s:

Call RemoveSimilar
Call RemoveSimilar
Call RemoveSimilar


End Sub

Private Sub RemoveSimilar()
For i = 0 To List1.ListCount
For j = 0 To List1.ListCount
If i <> j Then
If List1.List(i) = List1.List(j) Then
List1.RemoveItem (j)
End If
End If
Next j
Next i
End Sub


البته به فكر ساختن اسپمر براي ميهن بلاگ نباشيد چون در صورت ارسال كامنتهاي پي در پي ip بلوك ميشه!

[maxtools]

تشکر دوست عزیز فقط می تونی سورسش رو برام بزاری دانلود کنم .

یک دنیا ممنون می شم .

[parselearn]

سورس رو كه براتون گذاشتم

تابع GetUrlSource از آدرس زير دريافت كنيد
http://barnamenevis.org/showthread.php?236704-%D9%BE%D9%8A%D8%AF%D8%A7-%D9%83%D8%B1%D8%AF%D9%86-%D8%AA%D8%B5%D8%A7%D9%88%D9%8A%D8%B1-%D8%AF%D8%B1-%D9%8A%D9%83-%D8%B5%D9%81%D8%AD%D9%87

[alnajon]

Private Sub Command1_Click()

s = GetUrlSource("http://www.mihanblog.com/")
d1 = InStr(1, s, "<div class=" & Chr(34) & "webList clearfix" & Chr(34) & ">")
s = Mid(s, d1, 12000)

s = Replace(s, "http://static.mihanblog.com/", "")
s = Replace(s, "</div>", "")
s = Replace(s, "<div class=" & Chr(34) & "webList_thumb" & Chr(34) & ">", "")
s = Replace(s, "<div class=" & Chr(34) & "webList_slogan" & Chr(34) & ">", "")
s = Replace(s, "<div class=" & Chr(34) & "clearfix webList_row" & Chr(34) & ">", "")
s = Replace(s, "<img src=" & Chr(34) & "http://", "")

On Error Resume Next
Do
d1 = InStr(1, s, ".mihanblog.com")
s1 = Mid(s, d1 - 40, 60)
's1 = Replace(s1, Chr(47) & Chr(47), "")
d2 = InStr(1, s1, "http:")
s2 = Mid(s1, d2, Len(s1) - d2 + 1)
s2 = Replace(s2, "http:", "")
s2 = Replace(s2, Chr(47), "")
s2 = Replace(s2, vbCrLf, "")
d1 = InStr(1, s2, Chr(39))
s1 = Mid(s2, 1, d1 - 1)
List1.AddItem s1

s = Right(s, Len(s) - d1)
If List1.List(List1.ListCount - 1) = "" Then GoTo s:
Loop Until (Len(s) < 34)

s:

Call RemoveSimilar
Call RemoveSimilar
Call RemoveSimilar


End Sub

Private Sub RemoveSimilar()
For i = 0 To List1.ListCount
For j = 0 To List1.ListCount
If i <> j Then
If List1.List(i) = List1.List(j) Then
List1.RemoveItem (j)
End If
End If
Next j
Next i
End Sub


البته به فكر ساختن اسپمر براي ميهن بلاگ نباشيد چون در صورت ارسال كامنتهاي پي در پي ip بلوك ميشه!

سلام خدمت شما . ببخشید میدونم اینجا بخش سی شارپ نیست ولی شما میتونید سورس این کد رو به زبان سی شارپ هم تهیه کنید و بذارید ؟ خیلی ممنون

[محسن واژدی]

سلام خدمت شما . ببخشید میدونم اینجا بخش سی شارپ نیست ولی شما میتونید سورس این کد رو به زبان سی شارپ هم تهیه کنید و بذارید ؟ خیلی ممنون
سلام،
چون نتیجه نهایی کدهای C# است باید در تالار مربوطه مطرح شود

موفق باشید