Forum
Aktif konular
Üyeler
Kurallar
Arama
Tahribat.com Forumları 
Visual Basic - Basic - PicBasic ve Türevleri 
Facebook Otomatik Dürtme Kodları(VB6) Facebook Otomatik Dürtme Kodları(VB6)
-
Otomatik dürtme, geri dürtme
Form1.frm dosyası içeriği
VERSION 5.00 Object = "{48E59290-9880-11CF-9754-00AA00C00908}#1.0#0"; "MSINET.OCX" Begin VB.Form Form1 BorderStyle = 1 'Fixed Single Caption = "Face Dürtüğü v2" ClientHeight = 2520 ClientLeft = 45 ClientTop = 375 ClientWidth = 5925 Icon = "Form1.frx":0000 LinkTopic = "Form1" MaxButton = 0 'False ScaleHeight = 2520 ScaleWidth = 5925 StartUpPosition = 3 'Windows Default Begin VB.TextBox Text11 Height = 285 Left = 2280 TabIndex = 27 Text = "</div></td></tr>" Top = 4080 Width = 1455 End Begin VB.TextBox Text10 Height = 285 Left = 360 TabIndex = 26 Text = "<div class=""mfsm"">Cinsiyet:</div></td><td valign=""top""><div class=""mfsm"">" Top = 4080 Width = 1815 End Begin VB.Frame Frame3 Caption = "Rus ruleti" Height = 1335 Left = 120 TabIndex = 20 Top = 2760 Width = 5655 Begin VB.Timer yarbulucu Enabled = 0 'False Interval = 2000 Left = 2040 Top = 600 End Begin VB.ComboBox dili Height = 315 Left = 240 TabIndex = 25 Text = "Dili" Top = 840 Width = 1095 End Begin VB.CheckBox Check4 Alignment = 1 'Right Justify Caption = "Erkek bul" Height = 195 Left = 240 TabIndex = 24 Top = 600 Width = 1095 End Begin VB.CheckBox Check3 Alignment = 1 'Right Justify Caption = "Dişi bul" Height = 195 Left = 240 TabIndex = 23 Top = 360 Width = 1095 End Begin VB.CommandButton Command3 Caption = "Bul yarimi" Height = 855 Left = 2640 TabIndex = 22 Top = 360 Width = 2775 End Begin VB.Label Label2 Height = 255 Left = 120 TabIndex = 21 Top = 360 Width = 2895 End End Begin VB.TextBox Text9 Height = 285 Left = 360 TabIndex = 19 Text = """>kaldır</a>" Top = 5880 Width = 2655 End Begin VB.TextBox Text8 Height = 285 Left = 360 TabIndex = 18 Text = """>Geri dürt</a> · <a class=""sec"" href=""/a/notifications.php?" Top = 5520 Width = 3615 End Begin VB.TextBox Text7 Height = 285 Left = 360 TabIndex = 17 Text = "class=""mfss fcg""><a class=""sec"" href=""/a/notifications.php?poke=" Top = 5160 Width = 3615 End Begin VB.Frame Frame2 Caption = "Otomatik geri dürt" Height = 855 Left = 120 TabIndex = 14 Top = 1560 Width = 5655 Begin VB.Timer geridurt Enabled = 0 'False Interval = 2000 Left = 2280 Top = 600 End Begin VB.CommandButton Command2 Caption = "Geri dürt" Height = 255 Left = 240 TabIndex = 16 Top = 360 Width = 5175 End Begin VB.Label Label1 Height = 255 Left = 120 TabIndex = 15 Top = 360 Width = 2895 End End Begin VB.Frame Frame1 Caption = "Otomatik dürt" Height = 1095 Left = 120 TabIndex = 8 Top = 240 Width = 5655 Begin VB.Timer Timer3 Enabled = 0 'False Interval = 500 Left = 1800 Top = 840 End Begin VB.CommandButton Command1 Caption = "Dürtmeye başla" Height = 615 Left = 3240 TabIndex = 13 Top = 240 Width = 2175 End Begin VB.Timer Timer1 Enabled = 0 'False Interval = 3000 Left = 840 Top = 840 End Begin VB.TextBox toplamsayfa Height = 285 Left = 2520 TabIndex = 12 Text = "50" ToolTipText = "Kaç arkadaşı var / Kaç kişi dürtülecek ?" Top = 240 Width = 495 End Begin VB.Timer Timer2 Enabled = 0 'False Interval = 6000 Left = 1320 Top = 840 End Begin VB.TextBox faceid Height = 285 Left = 240 TabIndex = 11 Text = "100002626375938" ToolTipText = "Arkadaşlarını dürteceğiniz ortak arkadaşınızın idi?" Top = 240 Width = 2175 End Begin VB.CheckBox Check1 Caption = "Erkekleri" Height = 195 Left = 240 TabIndex = 10 Top = 600 Width = 1335 End Begin VB.CheckBox Check2 Caption = "Dişileri" Height = 195 Left = 1560 TabIndex = 9 Top = 600 Value = 1 'Checked Width = 1335 End End Begin VB.Timer Timer4 Interval = 3000 Left = 6360 Top = 480 End Begin VB.TextBox Text6 Height = 285 Left = 3480 TabIndex = 7 Text = """>D" Top = 6600 Width = 2295 End Begin VB.TextBox Text5 Height = 285 Left = 360 TabIndex = 6 Text = "Ekle</a><br /><a href=""" Top = 6600 Width = 2895 End Begin VB.TextBox Text4 Height = 285 Left = 3360 TabIndex = 5 Text = "</div>" Top = 6120 Width = 2175 End Begin VB.TextBox Text3 Height = 495 Left = 360 TabIndex = 4 Text = "<div class=""mfsm"">Cinsiyet:</div></td><td valign=""top""><div class=""mfsm"">" Top = 6120 Width = 2895 End Begin VB.TextBox sayfano Height = 285 Left = 9120 TabIndex = 3 Text = "0" Top = 120 Width = 375 End Begin VB.ListBox linkler Height = 2985 Left = 6360 TabIndex = 2 Top = 4320 Width = 4455 End Begin VB.TextBox Text2 Height = 285 Left = 240 TabIndex = 1 Text = "Text1" Top = 4680 Width = 3855 End Begin VB.TextBox text1 Height = 3975 Left = 6720 MultiLine = -1 'True ScrollBars = 2 'Vertical TabIndex = 0 Text = "Form1.frx":78D2 Top = 0 Width = 6375 End Begin InetCtlsObjects.Inet Inet1 Left = 8640 Top = 1800 _ExtentX = 1005 _ExtentY = 1005 _Version = 393216 Protocol = 4 URL = "http://" End End Attribute VB_Name = "Form1" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long Dim linksayisi As Integer Dim geridurtulen Dim yarimid Private Sub Combo2_Change() End Sub Private Sub Command1_Click() Do While Inet1.StillExecuting = True DoEvents Loop Inet1.Execute "http://m.facebook.com/friends.php?id=" & faceid.Text & "&q&f=" & sayfano.Text & "&refid=5", "GET", , "User-Agent: Mozilla/5.0 (SymbianOS/9.1; U; en-us) AppleWebKit/413 (KHTML, like Gecko) Safari/413 " & vbCrLf & " Content-Type: application/x-www-form-urlencoded" Timer1.Enabled = True Timer3.Enabled = True End Sub Private Sub Command2_Click() geridurt.Enabled = True End Sub Private Sub Command3_Click() Me.Caption = Hour(Now) & Minute(Now) & Second(Now) Inet1.Execute "m.facebook.com/profile.php?id=" & yarimid & "&v=info", "GET", , "User-Agent: Mozilla/5.0 (SymbianOS/9.1; U; en-us) AppleWebKit/413 (KHTML, like Gecko) Safari/413 " & vbCrLf & " Content-Type: application/x-www-form-urlencoded" yarbulucu.Enabled = True End Sub Private Sub Form_Load() 'WebBrowser1.Navigate "http://m.facebook.com" Inet1.Execute "http://m.facebook.com", "GET", , "User-Agent: Mozilla/5.0 (SymbianOS/9.1; U; en-us) AppleWebKit/413 (KHTML, like Gecko) Safari/413 " & vbCrLf & " Content-Type: application/x-www-form-urlencoded" 'ShellExecute 0, vbNullString, "http://tdsoftware.tr.cx", vbNullString, vbNullString, vbNormalFocus End Sub Sub linkyakala() 'javascript veya http varsa ekleme On Error Resume Next Dim link As String Dim sol, sag For i = 1 To Len(text1) sol = 0 sag = 0 If LCase(Mid(text1, i, 9)) = "<a href=" & Chr(34) Then sol = i + 6 For j = sol To Len(text1) If Mid(text1, j, 2) = Chr(34) & " " Or Mid(text1, j, 2) = Chr(34) & ">" Then sag = j Exit For End If Next j End If If sol <> 0 And sag <> 0 Then link = Mid(text1.Text, sol, sag - sol) If link <> "#" And LCase(Left(link, 15)) = "f=" & Chr(34) & "/profile.php" And LCase(Left(link, 6)) <> "http:/" And LCase(Left(link, 10)) <> "javascript" Then Dim listede_varmi As Boolean listede_varmi = False For i5 = 0 To (linkler.ListCount - 1) If link = linkler.List(i5) Then listede_varmi = True Exit For End If Next i5 If listede_varmi = False Then link = Replace$(link, "f=" & Chr(34), "") linkler.AddItem link Else End If End If End If Next i End Sub Function TagYakala(veri As String, tagb As String, tags As String) On Error Resume Next On Local Error Resume Next arrs = Split(veri, tagb) arrB = Split(arrs(1), tags) TagYakala = arrB(0) End Function Private Sub geridurt_Timer() durtgeri = TagYakala(text1.Text, Text7.Text, Text8.Text) durtgeri = Replace$(durtgeri, "amp;", "") durtsil = TagYakala(text1.Text, Text8.Text, Text9.Text) durtsil = Replace$(durtsil, "amp;", "") If Text2.Text = "http://m.facebook.com/a/notifications.php?" Then geridurt.Enabled = False If geridurtulen = 1 Then MsgBox "Dürtülecek kişi bulunamadı" Else MsgBox "Geri dürtülen kişi sayısı: " & geridurtulen End If Else Do While Inet1.StillExecuting = True DoEvents Loop Inet1.Execute "http://m.facebook.com/a/notifications.php?poke=" & durtgeri, "GET", , "User-Agent: Mozilla/5.0 (SymbianOS/9.1; U; en-us) AppleWebKit/413 (KHTML, like Gecko) Safari/413 " & vbCrLf & " Content-Type: application/x-www-form-urlencoded" wait 500 Do While Inet1.StillExecuting = True DoEvents Loop Inet1.Execute "http://m.facebook.com/a/notifications.php?" & durtsil, "GET", , "User-Agent: Mozilla/5.0 (SymbianOS/9.1; U; en-us) AppleWebKit/413 (KHTML, like Gecko) Safari/413 " & vbCrLf & " Content-Type: application/x-www-form-urlencoded" geridurtulen = geridurtulen + 1 End If End Sub Private Sub Inet1_StateChanged(ByVal State As Integer) On Error Resume Next Dim vtData As Variant Dim strData As String Dim bDone As Boolean Dim arr() As String Dim i As Integer Select Case State Case icError ' 11 '// In case of error, return ResponseCode and ResponseInfo. vtData = Inet1.ResponseCode & " - " & Inet1.ResponseInfo Case icResponseCompleted ' 12 bDone = False '// Get first chunk. vtData = Inet1.GetChunk(1024, icString) DoEvents Do While Not bDone strData = strData & vtData '// Get next chunk. vtData = Inet1.GetChunk(1024, icString) DoEvents If Len(vtData) = 0 Then bDone = True End If Loop Me.text1.Text = Replace(strData, vbLf, vbCrLf) If InStr(1, Me.text1.Text, "Lookup Results") > 0 Then MsgBox "yes, query success" End If Text2.Text = Inet1.Object End Select End Sub Private Sub Timer1_Timer() If Text2.Text = "http://m.facebook.com/friends.php?id=" & faceid.Text & "&q&f=" & sayfano.Text & "&refid=5" Then linkyakala Me.Caption = "Face Dürtüğü v2" & "(Kişiler ayıklanıyor '" & linkler.ListCount & "')" sayfano = sayfano + 10 Do While Inet1.StillExecuting = True DoEvents Loop Inet1.Execute "http://m.facebook.com/friends.php?id=" & faceid.Text & "&q&f=" & sayfano.Text & "&refid=5", "GET", , "User-Agent: Mozilla/5.0 (SymbianOS/9.1; U; en-us) AppleWebKit/413 (KHTML, like Gecko) Safari/413 " & vbCrLf & " Content-Type: application/x-www-form-urlencoded" End If If sayfano = toplamsayfa Then Do While Inet1.StillExecuting = True DoEvents Loop Inet1.Execute "http://m.facebook.com" & linkler.List(0) & "&sk=info", "GET", , "User-Agent: Mozilla/5.0 (SymbianOS/9.1; U; en-us) AppleWebKit/413 (KHTML, like Gecko) Safari/413 " & vbCrLf & " Content-Type: application/x-www-form-urlencoded" Timer2.Enabled = True Timer1.Enabled = False End If End Sub Private Sub Timer2_Timer() ' If linkler.ListCount = 0 Then Timer2.Enabled = False Me.Caption = "Face Dürtüğü v2" MsgBox "Dürtme işlemi tamamlandı" End If If Text2.Text = "http://m.facebook.com" & linkler.List(0) & "&sk=info" Then Title = TagYakala(text1.Text, "<title>", "</title>") Me.Caption = "Face Dürtüğü v2" & "(Kişiler dürtülüyor '" & linkler.ListCount & "')" erkekmi = TagYakala(text1.Text, Text3.Text, Text4.Text) If erkekmi = "Erkek" Then If Check1.Value = 1 Then Me.Caption = "Face Dürtüğü v2" & "(Kişiler dürtülüyor '" & linkler.ListCount & "')(" & Title & ")" durtmelinki = TagYakala(text1.Text, Text5.Text, Text6.Text) durtmelinki = Replace$(durtmelinki, "amp;", "") Inet1.Execute "http://m.facebook.com" & durtmelinki, "GET", , "User-Agent: Mozilla/5.0 (SymbianOS/9.1; U; en-us) AppleWebKit/413 (KHTML, like Gecko) Safari/413 " & vbCrLf & " Content-Type: application/x-www-form-urlencoded" Do While Inet1.StillExecuting = True DoEvents Loop linkler.RemoveItem 0 Inet1.Execute "http://m.facebook.com" & linkler.List(0) & "&sk=info", "GET", , "User-Agent: Mozilla/5.0 (SymbianOS/9.1; U; en-us) AppleWebKit/413 (KHTML, like Gecko) Safari/413 " & vbCrLf & " Content-Type: application/x-www-form-urlencoded" Else Do While Inet1.StillExecuting = True DoEvents Loop linkler.RemoveItem (0) Inet1.Execute "http://m.facebook.com" & linkler.List(0) & "&sk=info", "GET", , "User-Agent: Mozilla/5.0 (SymbianOS/9.1; U; en-us) AppleWebKit/413 (KHTML, like Gecko) Safari/413 " & vbCrLf & " Content-Type: application/x-www-form-urlencoded" End If Else If Check2.Value = 1 Then Me.Caption = "Face Dürtüğü v2" & "(Kişiler dürtülüyor '" & linkler.ListCount & "')(" & Title & ")" durtmelinki = TagYakala(text1.Text, Text5.Text, Text6.Text) durtmelinki = Replace$(durtmelinki, "amp;", "") Do While Inet1.StillExecuting = True DoEvents Loop Inet1.Execute "http://m.facebook.com" & durtmelinki, "GET", , "User-Agent: Mozilla/5.0 (SymbianOS/9.1; U; en-us) AppleWebKit/413 (KHTML, like Gecko) Safari/413 " & vbCrLf & " Content-Type: application/x-www-form-urlencoded" Do While Inet1.StillExecuting = True DoEvents Loop linkler.RemoveItem 0 Inet1.Execute "http://m.facebook.com" & linkler.List(0) & "&sk=info", "GET", , "User-Agent: Mozilla/5.0 (SymbianOS/9.1; U; en-us) AppleWebKit/413 (KHTML, like Gecko) Safari/413 " & vbCrLf & " Content-Type: application/x-www-form-urlencoded" Else Do While Inet1.StillExecuting = True DoEvents Loop linkler.RemoveItem (0) Inet1.Execute "http://m.facebook.com" & linkler.List(0) & "&sk=info", "GET", , "User-Agent: Mozilla/5.0 (SymbianOS/9.1; U; en-us) AppleWebKit/413 (KHTML, like Gecko) Safari/413 " & vbCrLf & " Content-Type: application/x-www-form-urlencoded" End If End If Else Do While Inet1.StillExecuting = True DoEvents Loop Inet1.Execute "http://m.facebook.com" & linkler.List(0) & "&sk=info", "GET", , "User-Agent: Mozilla/5.0 (SymbianOS/9.1; U; en-us) AppleWebKit/413 (KHTML, like Gecko) Safari/413 " & vbCrLf & " Content-Type: application/x-www-form-urlencoded" End If End Sub Private Sub Timer3_Timer() blokmu = TagYakala(text1.Text, "<title>Engel", " D") blokmu2 = TagYakala(text1.Text, "<title>You’re ", "emporarily") If blokmu = "!" Or blokmu2 = "T" Then Me.Caption = "Face Dürtüğü v2" & "(Yakalandık)" MsgBox "Arkadaşlarını dürtmen, bu özelliği sürekli kötüye kullandığın için engellendi. Bu engelleme, birkaç saatten birkaç güne kadar sürebilir. Bu özelliği kullanmana yeniden izin verildiğinde lütfen dikkatli ol. Kötüye kullanmaya devam edersen, hesabın kalıcı olarak kapatılabilir. Daha fazla bilgi için lütfen SSS sayfasını ziyaret et.", , "Saygılar :D" Timer1.Enabled = False Timer2.Enabled = False Timer3.Enabled = False End If End Sub Private Sub Timer4_Timer() login = TagYakala(text1.Text, "*<
Kısayol
Şikayet
Özel Mesaj
Alıntı yap
Toplam Hit: 3607 Toplam Mesaj: 8
Cevapla