25 Ocak 2014 Cumartesi

Visual Basic ile Facebook’da otomatik dürtme kodları

Yazar: Unknown on 12:51 ve 0 Yorum mevcut
Otomatik dürtme, geri dürtme kodları

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>&nbsp;·&nbsp;<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, "*<![CDATA[", "/.mobile-")
If login = "*" Then
faceid.Visible = False
toplamsayfa.Visible = False
Check1.Visible = False
Check2.Visible = False
Command1.Visible = False
MsgBox "'Internet Explorer 8' tarayıcınız ile Facebook TR profilinize giriş yapın, program kapatılıyor", , "Giriş yapılmamış :("
End
Else
faceid.Visible = True
toplamsayfa.Visible = True
Check1.Visible = True
Check2.Visible = True
Command1.Visible = True
Timer4.Enabled = False
MsgBox "Tarayıcınızdan siteye zaten giriş yapılmış, IE'deki varsayılan ayarlar kullanılacak"
End If
End Sub

Private Sub yarbulucu_Timer()
Title = TagYakala(text1.Text, "<title>", "</title>")

If Title = "Facebook" Or Title = "İçerik Bulunamadı" Then
yarimid = yarimid + 1
Do While Inet1.StillExecuting = True
DoEvents
Loop
Inet1.Execute "http://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"

ElseIf Title <> "Facebook" And Title <> "İçerik Bulunamadı" Then
cinsiyet = TagYakala(text1.Text, Text10, Text11)
If cinsiyet = "Erkek" Then
yarimid = yarimid + 1
Do While Inet1.StillExecuting = True
DoEvents
Loop
Inet1.Execute "http://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"

ElseIf cinsiyet = "Kadın" Then
yasadigi_yer = TagYakala(text1.Text, Chr(34) & ">", "</a>'da yaşıyor</span>")
If yasadigi_yer = "Ankara" Then
MsgBox "fak"
Else
yarimid = yarimid + 1
Do While Inet1.StillExecuting = True
DoEvents
Loop
Inet1.Execute "http://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"
End If

Else
yarimid = yarimid + 1
Do While Inet1.StillExecuting = True
DoEvents
Loop
Inet1.Execute "http://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"
End If

Else

End If
End Sub
arama.bas dosyası içeriği:
Attribute VB_Name = "arama"

Public Declare Function GetTickCount Lib "kernel32" () As Long

Public Sub wait(ByVal dblMilliseconds As Double)
    Dim dblStart As Double
    Dim dblEnd As Double
    Dim dblTickCount As Double
    dblTickCount = GetTickCount()
    dblStart = GetTickCount()
    dblEnd = GetTickCount + dblMilliseconds
    Do
    DoEvents
    dblTickCount = GetTickCount()
    Loop Until dblTickCount > dblEnd Or dblTickCount < dblStart
End Sub
Categories:

0 yorum:

Yorum Gönder

Yorumlarınızda lütfen Türkçe ' yi güzel kullanınız.

Bilgili Yayın Yönetimi...

Dikkat ! : Küfür yada uygunsuz içerik içeren yorumlar yasaktır.Bu tür yorumlar site yönetimi tarafından tespit edilip silinmektedir.Fakat gözden kaçan yorumları ctn@turk.tc veya tospmailbomber@gmail.com adreslerinden bizlere iletebilirsiniz.

Kaydol: Kayıt Yorumları (Atom)