'"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
