|
|
Imports System
Imports System.IO
Imports System.Text
Imports System.Drawing
Imports System.Threading
Imports System.Reflection
Imports Microsoft.VisualBasic
Imports System.Windows.Forms
Imports System.ComponentModel
Imports System.CodeDom.Compiler
Namespace SelfReplication
Public Class SelfReplication
Inherits Form
Private button1 As Button
Private Function CompileVisualBasic(ByVal strFilePath As String) As Assembly
If strFilePath Is Nothing Then
Return Nothing
End If
Dim sr As New StreamReader(strFilePath)
Dim strSource As String = sr.ReadToEnd()
sr.Close()
Dim cc As CodeDomProvider = New VBCodeProvider()
Dim cp As New CompilerParameters()
For Each assemblyName As AssemblyName In Assembly.GetEntryAssembly().GetReferencedAssemblies()
cp.ReferencedAssemblies.Add(assemblyName.Name + ".dll")
Next
cp.GenerateInMemory = True
Dim cr As CompilerResults = cc.CompileAssemblyFromSource(cp, strSource)
Dim sb As New StringBuilder()
If cr.Errors.HasErrors OrElse cr.Errors.HasWarnings Then
For Each err As CompilerError In cr.Errors
sb.AppendLine(err.ToString())
Next
MessageBox.Show(sb.ToString(), "Error", MessageBoxButtons.OK, MessageBoxIcon.[Error])
Return Nothing
End If
Return cr.CompiledAssembly
End Function
Private Sub Execute(ByVal FilePath As Object)
Dim assembly As Assembly = CompileVisualBasic(TryCast(FilePath, String))
If assembly Is Nothing Then
Return
End If
For Each t As Type In assembly.GetTypes()
Dim info As MethodInfo = t.GetMethod("Main", BindingFlags.[Public] Or BindingFlags.NonPublic Or BindingFlags.[Static])
If info Is Nothing Then
Continue For
End If
Dim parameters As Object() = New Object() {New String() {TryCast(FilePath, String)}}
info.Invoke(Nothing, parameters)
Next
End Sub
Private strFilePath As String
Public Sub New(ByVal strFilePath As String)
Me.strFilePath = strFilePath
Me.button1 = New Button()
Me.button1.Location = New Point(75, 25)
Me.button1.Size = New Size(100, 25)
Me.button1.Text = "Replicate"
AddHandler Me.button1.Click, AddressOf button1_Click
Me.ClientSize = New Size(250, 75)
Me.Controls.Add(Me.button1)
Me.Text = "SelfReplication"
End Sub
Private Sub button1_Click(ByVal sender As Object, ByVal e As EventArgs)
Dim thread As New Thread(New ParameterizedThreadStart(AddressOf Execute))
thread.Name = "Execute"
thread.IsBackground = True
thread.Start(strFilePath)
End Sub
End Class
NotInheritable Class Program
Private Sub New()
End Sub
Public Shared Sub Main(ByVal args As String())
Dim strFilePath As String
If args.Length = 0 Then
Dim strDirectory As String = Path.GetDirectoryName(Assembly.GetExecutingAssembly().Location)
strFilePath = Path.Combine(strDirectory, "SelfReplication.vb")
If Not File.Exists(strFilePath) Then
Dim sw As New StreamWriter(strFilePath)
sw.Write(Program.MYSELF)
sw.Close()
Dim sr As New StreamReader(strFilePath)
Dim strCode As String = String.Empty
Dim line As String = String.Empty
While sr.Peek <> -1
line = sr.ReadLine()
line = line.Replace(Chr(34), Chr(34) & " & Chr(34) & " & Chr(34))
strCode &= Chr(34) & line & Chr(34) & " & Environment.NewLine _" & Environment.NewLine & "& "
End While
sr.Close()
strCode = strCode.Substring(0, strCode.Length - 27)
sr = New StreamReader(strFilePath)
line = sr.ReadToEnd()
sr.Close()
line = line.Replace(line.Substring(line.Length - 26), " = _" & Environment.NewLine & strCode & Environment.NewLine & "End Class" & Environment.NewLine & "End Namespace")
sw = New StreamWriter(strFilePath)
sw.Write(line)
sw.Close()
Return
End If
Else
strFilePath = args(0)
End If
Application.Run(New SelfReplication(strFilePath))
End Sub
Public Shared MYSELF As String = _
"Imports System" & Environment.NewLine _
& "Imports System.IO" & Environment.NewLine _
& "Imports System.Text" & Environment.NewLine _
& "Imports System.Drawing" & Environment.NewLine _
& "Imports System.Threading" & Environment.NewLine _
& "Imports System.Reflection" & Environment.NewLine _
& "Imports Microsoft.VisualBasic" & Environment.NewLine _
& "Imports System.Windows.Forms" & Environment.NewLine _
& "Imports System.ComponentModel" & Environment.NewLine _
& "Imports System.CodeDom.Compiler" & Environment.NewLine _
& "Namespace SelfReplication" & Environment.NewLine _
& "Public Class SelfReplication" & Environment.NewLine _
& "Inherits Form" & Environment.NewLine _
& "Private button1 As Button" & Environment.NewLine _
& "Private Function CompileVisualBasic(ByVal strFilePath As String) As Assembly" & Environment.NewLine _
& "If strFilePath Is Nothing Then" & Environment.NewLine _
& "Return Nothing" & Environment.NewLine _
& "End If" & Environment.NewLine _
& "Dim sr As New StreamReader(strFilePath)" & Environment.NewLine _
& "Dim strSource As String = sr.ReadToEnd()" & Environment.NewLine _
& "sr.Close()" & Environment.NewLine _
& "Dim cc As CodeDomProvider = New VBCodeProvider()" & Environment.NewLine _
& "Dim cp As New CompilerParameters()" & Environment.NewLine _
& "For Each assemblyName As AssemblyName In Assembly.GetEntryAssembly().GetReferencedAssemblies()" & Environment.NewLine _
& "cp.ReferencedAssemblies.Add(assemblyName.Name + " & Chr(34) & ".dll" & Chr(34) & ")" & Environment.NewLine _
& "Next" & Environment.NewLine _
& "cp.GenerateInMemory = True" & Environment.NewLine _
& "Dim cr As CompilerResults = cc.CompileAssemblyFromSource(cp, strSource)" & Environment.NewLine _
& "Dim sb As New StringBuilder()" & Environment.NewLine _
& "If cr.Errors.HasErrors OrElse cr.Errors.HasWarnings Then" & Environment.NewLine _
& "For Each err As CompilerError In cr.Errors" & Environment.NewLine _
& "sb.AppendLine(err.ToString())" & Environment.NewLine _
& "Next" & Environment.NewLine _
& "MessageBox.Show(sb.ToString(), " & Chr(34) & "Error" & Chr(34) & ", MessageBoxButtons.OK, MessageBoxIcon.[Error])" & Environment.NewLine _
& "Return Nothing" & Environment.NewLine _
& "End If" & Environment.NewLine _
& "Return cr.CompiledAssembly" & Environment.NewLine _
& "End Function" & Environment.NewLine _
& "Private Sub Execute(ByVal FilePath As Object)" & Environment.NewLine _
& "Dim assembly As Assembly = CompileVisualBasic(TryCast(FilePath, String))" & Environment.NewLine _
& "If assembly Is Nothing Then" & Environment.NewLine _
& "Return" & Environment.NewLine _
& "End If" & Environment.NewLine _
& "For Each t As Type In assembly.GetTypes()" & Environment.NewLine _
& "Dim info As MethodInfo = t.GetMethod(" & Chr(34) & "Main" & Chr(34) & ", BindingFlags.[Public] Or BindingFlags.NonPublic Or BindingFlags.[Static])" & Environment.NewLine _
& "If info Is Nothing Then" & Environment.NewLine _
& "Continue For" & Environment.NewLine _
& "End If" & Environment.NewLine _
& "Dim parameters As Object() = New Object() {New String() {TryCast(FilePath, String)}}" & Environment.NewLine _
& "info.Invoke(Nothing, parameters)" & Environment.NewLine _
& "Next" & Environment.NewLine _
& "End Sub" & Environment.NewLine _
& "Private strFilePath As String" & Environment.NewLine _
& "Public Sub New(ByVal strFilePath As String)" & Environment.NewLine _
& "Me.strFilePath = strFilePath" & Environment.NewLine _
& "Me.button1 = New Button()" & Environment.NewLine _
& "Me.button1.Location = New Point(75, 25)" & Environment.NewLine _
& "Me.button1.Size = New Size(100, 25)" & Environment.NewLine _
& "Me.button1.Text = " & Chr(34) & "Replicate" & Chr(34) & "" & Environment.NewLine _
& "AddHandler Me.button1.Click, AddressOf button1_Click" & Environment.NewLine _
& "Me.ClientSize = New Size(250, 75)" & Environment.NewLine _
& "Me.Controls.Add(Me.button1)" & Environment.NewLine _
& "Me.Text = " & Chr(34) & "SelfReplication" & Chr(34) & "" & Environment.NewLine _
& "End Sub" & Environment.NewLine _
& "Private Sub button1_Click(ByVal sender As Object, ByVal e As EventArgs)" & Environment.NewLine _
& "Dim thread As New Thread(New ParameterizedThreadStart(AddressOf Execute))" & Environment.NewLine _
& "thread.Name = " & Chr(34) & "Execute" & Chr(34) & "" & Environment.NewLine _
& "thread.IsBackground = True" & Environment.NewLine _
& "thread.Start(strFilePath)" & Environment.NewLine _
& "End Sub" & Environment.NewLine _
& "End Class" & Environment.NewLine _
& "NotInheritable Class Program" & Environment.NewLine _
& "Private Sub New()" & Environment.NewLine _
& "End Sub" & Environment.NewLine _
& "Public Shared Sub Main(ByVal args As String())" & Environment.NewLine _
& "Dim strFilePath As String" & Environment.NewLine _
& "If args.Length = 0 Then" & Environment.NewLine _
& "Dim strDirectory As String = Path.GetDirectoryName(Assembly.GetExecutingAssembly().Location)" & Environment.NewLine _
& "strFilePath = Path.Combine(strDirectory, " & Chr(34) & "SelfReplication.vb" & Chr(34) & ")" & Environment.NewLine _
& "If Not File.Exists(strFilePath) Then" & Environment.NewLine _
& "Dim sw As New StreamWriter(strFilePath)" & Environment.NewLine _
& "sw.Write(Program.MYSELF)" & Environment.NewLine _
& "sw.Close()" & Environment.NewLine _
& "Dim sr As New StreamReader(strFilePath)" & Environment.NewLine _
& "Dim strCode As String = String.Empty" & Environment.NewLine _
& "Dim line As String = String.Empty" & Environment.NewLine _
& "While sr.Peek <> -1" & Environment.NewLine _
& "line = sr.ReadLine()" & Environment.NewLine _
& "line = line.Replace(Chr(34), Chr(34) & " & Chr(34) & " & Chr(34) & " & Chr(34) & " & Chr(34))" & Environment.NewLine _
& "strCode &= Chr(34) & line & Chr(34) & " & Chr(34) & " & Environment.NewLine _" & Chr(34) & " & Environment.NewLine & " & Chr(34) & "& " & Chr(34) & "" & Environment.NewLine _
& "End While" & Environment.NewLine _
& "sr.Close()" & Environment.NewLine _
& "strCode = strCode.Substring(0, strCode.Length - 27)" & Environment.NewLine _
& "sr = New StreamReader(strFilePath)" & Environment.NewLine _
& "line = sr.ReadToEnd()" & Environment.NewLine _
& "sr.Close()" & Environment.NewLine _
& "line = line.Replace(line.Substring(line.Length - 26), " & Chr(34) & " = _" & Chr(34) & " & Environment.NewLine & strCode & Environment.NewLine & " & Chr(34) & "End Class" & Chr(34) & " & Environment.NewLine & " & Chr(34) & "End Namespace" & Chr(34) & ")" & Environment.NewLine _
& "sw = New StreamWriter(strFilePath)" & Environment.NewLine _
& "sw.Write(line)" & Environment.NewLine _
& "sw.Close()" & Environment.NewLine _
& "Return" & Environment.NewLine _
& "End If" & Environment.NewLine _
& "Else" & Environment.NewLine _
& "strFilePath = args(0)" & Environment.NewLine _
& "End If" & Environment.NewLine _
& "Application.Run(New SelfReplication(strFilePath))" & Environment.NewLine _
& "End Sub" & Environment.NewLine _
& "Public Shared MYSELF As String" & Environment.NewLine _
& "End Class" & Environment.NewLine _
& "End Namespace"
End Class
End Namespace
|
By viewing downloads associated with this article you agree to the Terms of Service and the article's licence.
If a file you wish to view isn't highlighted, and is a text file (not binary), please
let us know and we'll add colourisation support for it.
I'm Alphons van der Heijden, living in Lelystad, Netherlands, Europa, Earth. And currently I'm retiring from hard working ( ;- ), owning my own company. Because I'm full of energy, and a little to young to relax ...., I don't sit down, but create and recreate software solutions, that I like. Reinventing the wheel is my second nature. My interest is in the area of Internet technologies, .NET etc. I was there in 1992 when Mosaic came out, and from that point, my life changed dramatically, and so did the world, in fact. (Y)
Submit an article or tip