Spam Bot + Source [VB6]

[reenoX]

Well this is my first Bot.
It is completly written in Visual Basic 6 and based on the API Function SendMessage(). I decided to make the source public so people can learn how to write their own Bots.

Features:
Nearly all the Features which Shadowfrenchs Spambot has except the Save/Load Function [I will add this later .. im too lazy now]

.exe & source: w3 Spam.zip 

[VirusTotalResults]

[Edit1]: Added the Save/Load Function

[t0pcraft-]

yes, we all will download a .zip file from some newb with 1 post

and btw: the virus scan doesn't say anything

[reenoX]

Im gonna upload a video for you

[t0pcraft-]

why don't you just post the source code here, or at least upload it in another format (txt or w/e)?

[reenoX]

Originally Posted by t0pcraft-

why don't you just post the source code here, or at least upload it in another format (txt or w/e)?

Make a new project and choose standart exe. Call the Form frmMain or something like that. Then add 3 Checkboxes (CheckT1, CheckT2, CheckT3), 3 Labels (Set their caption to Text1, Text2, Text3), 6 Textboxes (3 for the Messages (txt1, txt2, txt3) and 3 for the Messages Interval (txtInterval1, txtInterval2, txtInterval3), 1 Command Button (Name it cmdSend and set the commands caption to "Start Spam"), 3 Timers and at least another Label (Name it lblStatus). And dont forget to set up a menu (1HeadMenu (Caption = "File", the Name isnt important), 2SubMenus (Caption of the first submenu = "Load Settings" and set the Name = mnuLoad, Caption of the second submenu = "Save Settings" and set the Name = mnuSave)

So here is the Code for the MainForm:

 
Private Const WM_KEYDOWN As Long = &H100
Private Const WM_CHAR As Long = &H102
Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" ( _
     ByVal lpClassName As String, _
     ByVal lpWindowName As String) As Long
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" ( _
     ByVal hwnd As Long, _
     ByVal wMsg As Long, _
     ByVal wParam As Long, _
     ByRef lParam As Any) As Long
Private Sub Form_Load()
Dim lhwnd As Long
lhwnd = FindWindow(vbNullString, "Warcraft III")
If lhwnd = 0 Then
lblStatus.Caption = "Warcraft III Not Found"
ElseIf lhwnd <> 0 Then
lblStatus.Caption = "Not Activated"
cmdSpam.Enabled = True
End If
End Sub
Private Sub cmdSpam_Click()
If cmdSpam.Caption = "Start Spam" Then
cmdSpam.Caption = "Stop Spam"
timSpam1.Interval = txtInterval1.Text * 1000
timSpam2.Interval = txtInterval2.Text * 1000
timSpam3.Interval = txtInterval3.Text * 1000
timSpam1.Enabled = True
timSpam2.Enabled = True
timSpam3.Enabled = True
lblStatus.Caption = "Activated"
If CheckT1.Value = vbUnchecked And CheckT2.Value = vbUnchecked And CheckT3.Value = vbUnchecked Then
lblStatus.Caption = "No Message Selected"
timSpam1.Enabled = False
timSpam2.Enabled = False
timSpam3.Enabled = False
cmdSpam.Caption = "Start Spam"
End If
If CheckT1.Value = vbChecked And timSpam1.Enabled = True Then
txt1.Enabled = False
End If
If CheckT2.Value = vbChecked And timSpam2.Enabled = True Then
txt2.Enabled = False
End If
If CheckT3.Value = vbChecked And timSpam3.Enabled = True Then
txt3.Enabled = False
End If
ElseIf cmdSpam.Caption = "Stop Spam" Then
cmdSpam.Caption = "Start Spam"
timSpam1.Enabled = False
timSpam2.Enabled = False
timSpam3.Enabled = False
txt1.Enabled = True
txt2.Enabled = True
txt3.Enabled = True
lblStatus.Caption = "Not Activated"
End If
End Sub
Private Sub mnuLoad_Click()
LoadSettings
End Sub
Private Sub mnuSave_Click()
SaveSettings
End Sub
Private Sub timSpam1_Timer()
If CheckT1.Enabled = True Then
SendText (txt1)
End If
End Sub
Private Sub timSpam2_Timer()
If CheckT2.Enabled = True Then
SendText (txt2)
End If
End Sub
Private Sub timSpam3_Timer()
If CheckT3.Enabled = True Then
SendText (txt3)
End If
End Sub
Private Function SendText(Text As String)
Dim X As Integer
Dim a As String
Dim lhwnd As Long
lhwnd = FindWindow(vbNullString, "Warcraft III")
For i = 1 To Len(Text)
   a = Mid(Text, i, 1)
   X = Asc(a)
   SendMessage lhwnd, WM_CHAR, X, &H0
 Next i
 SendMessage lhwnd, WM_KEYDOWN, 13, &H0
End Function
Private Function LoadSettings()
Dim xCheck1 As Integer, xCheck2 As Integer, xCheck3 As Integer
Dim xInterval1 As Integer, xInterval2 As Integer, xInterval3 As Integer
Dim xMessage1 As String, xMessage2 As String, xMessage3 As String
xCheck1 = ReadIniValue(App.Path & "\Settings.ini", "SETTINGS", "Check1")
xCheck2 = ReadIniValue(App.Path & "\Settings.ini", "SETTINGS", "Check2")
xCheck3 = ReadIniValue(App.Path & "\Settings.ini", "SETTINGS", "Check3")
xInterval1 = ReadIniValue(App.Path & "\Settings.ini", "SETTINGS", "Interval1")
xInterval2 = ReadIniValue(App.Path & "\Settings.ini", "SETTINGS", "Interval2")
xInterval3 = ReadIniValue(App.Path & "\Settings.ini", "SETTINGS", "Interval3")
xMessage1 = ReadIniValue(App.Path & "\Settings.ini", "SETTINGS", "Message1")
xMessage2 = ReadIniValue(App.Path & "\Settings.ini", "SETTINGS", "Message2")
xMessage3 = ReadIniValue(App.Path & "\Settings.ini", "SETTINGS", "Message3")
CheckT1.Value = xCheck1
CheckT2.Value = xCheck2
CheckT3.Value = xCheck3
txtInterval1.Text = xInterval1
txtInterval2.Text = xInterval2
txtInterval3.Text = xInterval3
txt1.Text = xMessage1
txt2.Text = xMessage2
txt3.Text = xMessage3
End Function
Private Function SaveSettings()
WriteIniValue App.Path & "\Settings.ini", "SETTINGS", "Check1", CheckT1.Value
WriteIniValue App.Path & "\Settings.ini", "SETTINGS", "Check2", CheckT2.Value
WriteIniValue App.Path & "\Settings.ini", "SETTINGS", "Check3", CheckT3.Value
WriteIniValue App.Path & "\Settings.ini", "SETTINGS", "Interval1", txtInterval1.Text
WriteIniValue App.Path & "\Settings.ini", "SETTINGS", "Interval2", txtInterval2.Text
WriteIniValue App.Path & "\Settings.ini", "SETTINGS", "Interval3", txtInterval3.Text
WriteIniValue App.Path & "\Settings.ini", "SETTINGS", "Message1", txt1.Text
WriteIniValue App.Path & "\Settings.ini", "SETTINGS", "Message2", txt2.Text
WriteIniValue App.Path & "\Settings.ini", "SETTINGS", "Message3", txt3.Text
End Function

Now make a new Module and copy this text into it (This are the two functions you need to read an .ini file and write in it)

Public Function ReadIniValue(INIpath As String, KEY As String, Variable As String) As String
Dim NF As Integer
Dim Temp As String
Dim LcaseTemp As String
Dim ReadyToRead As Boolean
 
AssignVariables:
        NF = FreeFile
        ReadIniValue = ""
        KEY = "[" & LCase$(KEY) & "]"
        Variable = LCase$(Variable)
EnsureFileExists:
    Open INIpath For Binary As NF
    Close NF
    SetAttr INIpath, vbArchive
LoadFile:
    Open INIpath For Input As NF
    While Not EOF(NF)
    Line Input #NF, Temp
    LcaseTemp = LCase$(Temp)
    If InStr(LcaseTemp, "[") <> 0 Then ReadyToRead = False
    If LcaseTemp = KEY Then ReadyToRead = True
    If InStr(LcaseTemp, "[") = 0 And ReadyToRead = True Then
        If InStr(LcaseTemp, Variable & "=") = 1 Then
            ReadIniValue = Mid$(Temp, 1 + Len(Variable & "="))
            Close NF: Exit Function
            End If
        End If
    Wend
    Close NF
End Function
Public Function WriteIniValue(INIpath As String, PutKey As String, PutVariable As String, PutValue As String)
Dim Temp As String
Dim LcaseTemp As String
Dim ReadKey As String
Dim ReadVariable As String
Dim LOKEY As Integer
Dim HIKEY As Integer
Dim KEYLEN As Integer
Dim VAR As Integer
Dim VARENDOFLINE As Integer
Dim NF As Integer
Dim X As Integer
AssignVariables:
    NF = FreeFile
    ReadKey = vbCrLf & "[" & LCase$(PutKey) & "]" & Chr$(13)
    KEYLEN = Len(ReadKey)
    ReadVariable = Chr$(10) & LCase$(PutVariable) & "="
 
EnsureFileExists:
    Open INIpath For Binary As NF
    Close NF
    SetAttr INIpath, vbArchive
 
LoadFile:
    Open INIpath For Input As NF
    Temp = Input$(LOF(NF), NF)
    Temp = vbCrLf & Temp & "[]"
    Close NF
    LcaseTemp = LCase$(Temp)
 
LogicMenu:
    LOKEY = InStr(LcaseTemp, ReadKey)
    If LOKEY = 0 Then GoTo AddKey:
    HIKEY = InStr(LOKEY + KEYLEN, LcaseTemp, "[")
    VAR = InStr(LOKEY, LcaseTemp, ReadVariable)
    If VAR > HIKEY Or VAR < LOKEY Then GoTo AddVariable:
    GoTo RenewVariable:
 
AddKey:
        Temp = Left$(Temp, Len(Temp) - 2)
        Temp = Temp & vbCrLf & vbCrLf & "[" & PutKey & "]" & vbCrLf & PutVariable & "=" & PutValue
        GoTo TrimFinalString:
 
AddVariable:
        Temp = Left$(Temp, Len(Temp) - 2)
        Temp = Left$(Temp, LOKEY + KEYLEN) & PutVariable & "=" & PutValue & vbCrLf & Mid$(Temp, LOKEY + KEYLEN + 1)
        GoTo TrimFinalString:
 
RenewVariable:
        Temp = Left$(Temp, Len(Temp) - 2)
        VARENDOFLINE = InStr(VAR, Temp, Chr$(13))
        Temp = Left$(Temp, VAR) & PutVariable & "=" & PutValue & Mid$(Temp, VARENDOFLINE)
        GoTo TrimFinalString:
TrimFinalString:
        Temp = Mid$(Temp, 2)
        Do Until InStr(Temp, vbCrLf & vbCrLf & vbCrLf) = 0
        Temp = Replace(Temp, vbCrLf & vbCrLf & vbCrLf, vbCrLf & vbCrLf)
        Loop
 
        Do Until Right$(Temp, 1) > Chr$(13)
        Temp = Left$(Temp, Len(Temp) - 1)
        Loop
 
        Do Until Left$(Temp, 1) > Chr$(13)
        Temp = Mid$(Temp, 2)
        Loop
 
OutputAmendedINIFile:
        Open INIpath For Output As NF
        Print #NF, Temp
        Close NF
 
End Function

Oh and dont forget to add a .ini file (Name must be Settings.ini) into your w3 Spam folder with the following Text:

 
[SETTINGS]
Message3=
Message2=
Message1=
Interval3=1
Interval2=1
Interval1=1
Check3=0
Check2=0
Check1=0

[risker]

t0p got owned >.>

[dog_keeper]

ahahahaha

[t0pcraft-]

lol why?

do you want to download a virus?

[reenoX]

Originally Posted by t0pcraft-

lol why?

do you want to download a virus?

Oh my god .. how retarded are you? It is no fucking virus.

[Tyrande]

Hmm, true reenoX. it works .. that's cool.. abit outdated but it works... not like shadow french, and the other spambot(s).. Ty very much