Created
July 4, 2020 16:50
-
-
Save glinares/65e0b1a7ec8338f1cd807be22a33e87a to your computer and use it in GitHub Desktop.
Visual Basic For Applications Air Gap Communication Module (VAC-Parasite)
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Attribute VB_Name = "VAC_Parasite" | |
' VBA AIRGAP COMMUNICATION (VAC-Parasite) MODULE - Color Shapes | |
' Created By: Laughing_Mantis 7.4.2020 | |
' Version 1.0 | |
' This will create a square in the top left of the document that will change colors | |
' in order to communicate via morse code via airgapped machines | |
' BLUE = . | |
' RED = - | |
' GREEN = "_" | |
' BLACK = " " | |
' WHITE = New Character | |
' Depending on your op you can change the following characteristics: | |
' speed of delay | |
' morse code to color values | |
' morse code index | |
' location of visual signal box | |
' Morse Code Tweaked from: https://www.rosettacode.org/wiki/Morse_code#VBA | |
#Const DBGMODE = True | |
Const SEIZUREWARNING = True | |
Const MORSE_ALPHA As String = ".-,-...,-.-.,-..,.,..-.,--.,....,..,.---,-.-,.-..,--,-.,---,.--.,--.-,.-.,...,-,..-,...-,.--,-..-,-.--,--.." | |
Const MORSE_NUMERIC As String = "-----,.----,..---,...--,....-,.....,-....,--...,---..,----." | |
Const DOT As Long = 16711680 | |
Const DASH As Long = 255 | |
Const UNDERSCORE As Long = 65280 | |
Const CHARSPACE As Long = 0 | |
Const NEWCHAR As Long = 16777215 | |
Const PAUSE As Long = 16777215 | |
Const DELAY As Long = 200 | |
Sub Main() | |
Dim Message As String | |
Dim SendNewCharFlag As Boolean | |
Dim SquareSize As Single | |
If SEIZUREWARNING Then | |
If DisplayWarning = 2 Then Exit Sub | |
End If | |
SquareSize = 25 | |
SendNewCharFlag = True | |
Message = ToMorse("Laughing_Mantis") | |
#If DBGMODE = True Then | |
DbgColors | |
If SendNewCharFlag = True Then | |
Debug.Print "Morse Message: " & Message | |
Else | |
Debug.Print "Morse Message: " & Replace(Message, "+", "") | |
End If | |
#End If | |
PlayMorseShape Message, SendNewCharFlag, SquareSize | |
End Sub | |
Public Function DisplayWarning() As Long | |
Dim Message As String | |
Message = "WARNING: This demonstration may potentially trigger seizures for people with photosensitive epilepsy. Viewer discretion is advised" | |
DisplayWarning = MsgBox(Message, vbCritical + vbOKCancel, "Seizure Warning") | |
End Function | |
Public Function ToMorse(Message As String) As String | |
Dim MorseAlpha() As String | |
Dim MorseNumeric() As String | |
Dim MorseCode As String | |
Dim CharAtIndex As Integer | |
MorseAlpha = Split(MORSE_ALPHA, ",") | |
MorseNumeric = Split(MORSE_NUMERIC, ",") | |
Message = UCase(Message) | |
For X = 1 To Len(Message) | |
CharAtIndex = Asc(Mid(Message, X, 1)) | |
Select Case CharAtIndex | |
Case 65 To 90 | |
MorseCode = MorseCode & MorseAlpha(CharAtIndex - 65) & "+" | |
Case 48 To 57 | |
MorseCode = MorseCode & MorseNumeric(CharAtIndex - 48) & "+" | |
Case 32 | |
MorseCode = MorseCode & " " & "+" | |
Case Else | |
MorseCode = MorseCode & "_" & "+" | |
End Select | |
Next | |
ToMorse = MorseCode | |
End Function | |
Public Sub PlayMorseShape(MorseCode As String, Optional NewChars As Boolean = True, Optional Size As Single = 25) | |
ActiveDocument.Shapes.AddShape msoShapeRectangle, 0, 0, Size, Size | |
ActiveDocument.Shapes(1).Line.Weight = 0 | |
If NewChars = False Then | |
MorseCode = Replace(MorseCode, "+", "") | |
End If | |
Dim X As Long | |
For X = 1 To Len(MorseCode) | |
Select Case Mid(MorseCode, X, 1) | |
Case ".": ActiveDocument.Shapes(1).Fill.ForeColor.RGB = DOT | |
Case "-": ActiveDocument.Shapes(1).Fill.ForeColor.RGB = DASH | |
Case "_": ActiveDocument.Shapes(1).Fill.ForeColor.RGB = UNDERSCORE | |
Case " ": ActiveDocument.Shapes(1).Fill.ForeColor.RGB = CHARSPACE | |
Case "+": ActiveDocument.Shapes(1).Fill.ForeColor.RGB = NEWCHAR | |
End Select | |
Sleep (DELAY) | |
ActiveDocument.Shapes(1).Fill.ForeColor.RGB = PAUSE | |
Next | |
ActiveDocument.Shapes(1).Delete | |
End Sub | |
Public Sub PlayMorseScreen(MorseCode As String, Optional NewChars As Boolean = True, Optional Size As Single = 25) | |
Dim OriginalColor As Long | |
OriginalColor = ActiveDocument.Background.Fill.ForeColor.RGB | |
ActiveDocument.ActiveWindow.View.DisplayBackgrounds = True | |
ActiveDocument.Background.Fill.Visible = msoTrue | |
ActiveDocument.Background.Fill.Solid | |
If NewChars = False Then | |
MorseCode = Replace(MorseCode, "+", "") | |
End If | |
Dim X As Long | |
For X = 1 To Len(MorseCode) | |
Select Case Mid(MorseCode, X, 1) | |
Case ".": ActiveDocument.Background.Fill.ForeColor.RGB = DOT | |
Case "-": ActiveDocument.Background.Fill.ForeColor.RGB = DASH | |
Case "_": ActiveDocument.Background.Fill.ForeColor.RGB = UNDERSCORE | |
Case " ": ActiveDocument.Background.Fill.ForeColor.RGB = CHARSPACE | |
Case "+": ActiveDocument.Background.Fill.ForeColor.RGB = NEWCHAR | |
End Select | |
Sleep (DELAY) | |
ActiveDocument.Background.Fill.ForeColor.RGB = PAUSE | |
Next | |
ActiveDocument.Background.Fill.ForeColor.RGB = OriginalColor | |
End Sub | |
Public Function Timestamp() As Currency | |
Timestamp = (Round(Now(), 0) * 24 * 60 * 60 + Timer()) * 1000 | |
End Function | |
Public Sub Sleep(milliseconds As Currency) | |
If milliseconds < 0 Then Exit Sub | |
Dim start As Currency | |
start = Timestamp() | |
While (Timestamp() < milliseconds + start) | |
DoEvents | |
Wend | |
End Sub | |
Sub DbgColors() | |
Dim VARDOT As Long | |
Dim VARDASH As Long | |
Dim VARUNDERSCORE As Long | |
Dim VARCHARSPACE As Long | |
Dim VARNEWCHAR As Long | |
Dim VARPAUSE As Long | |
VARDOT = RGB(0, 0, 255) | |
VARDASH = RGB(255, 0, 0) | |
VARUNDERSCORE = RGB(0, 255, 0) | |
VARCHARSPACE = RGB(0, 0, 0) | |
VARNEWCHAR = RGB(255, 255, 255) | |
VARPAUSE = RGB(255, 255, 255) | |
Debug.Print "CONST DOT As Long = " & CStr(VARDOT) | |
Debug.Print "CONST DASH As Long = " & CStr(VARDASH) | |
Debug.Print "CONST UNDERSCORE As Long = " & CStr(VARUNDERSCORE) | |
Debug.Print "CONST CHARSPACE As Long = " & CStr(VARCHARSPACE) | |
Debug.Print "CONST NEWCHAR As Long = " & CStr(VARNEWCHAR) | |
Debug.Print "CONST PAUSE As Long = " & CStr(VARPAUSE) | |
End Sub | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment