Malicious Office (OOXML) — malware analysis report

Static analysis result for SHA-256 86e1ee168787d975…

MALICIOUS

Office (OOXML)

194.7 KB First seen: 2021-07-10
MD5: 63ed90320c42ff05ae265791ab5197ae SHA-1: 0bf221a2e3aacf6cb18bda2c65a9334dde6324cb SHA-256: 86e1ee168787d97591f3200d7642a06de0c1b2f719753ef5724b87f10bc680bc
178 Risk Score

Malware Insights

MITRE ATT&CK
T1059.005 Visual Basic T1059.003 Windows Command Shell T1204.002 Malicious File

The sample contains VBA macros with Auto_Open and Auto_Close functions, which is a common technique for malicious Office documents. The critical heuristic firing indicates the use of Shell() to execute cmd.exe, suggesting the macro's purpose is to download and execute a secondary payload. The presence of multiple unknown URLs warrants further investigation.

Heuristics 7

  • VBA project inside OOXML medium 5 related findings OOXML_VBA
    Document contains a VBA project — VBA macros present
  • Potential Shell call in VBA critical OLE_VBA_SHELL
    Potential Shell call in VBA
    Matched line in script
        On Error GoTo ShellError
        Shell """" & GetEditorPath() & """ """ & TempPath & FilePrefix & ".tex""", vbNormalFocus
  • CreateObject call high OLE_VBA_CREATEOBJ
    CreateObject call
    Matched line in script
        Const ForReading = 1, ForWriting = 2, ForAppending = 3
        Set fs = CreateObject("Scripting.FileSystemObject")
        If fs.FileExists(TempPath & FilePrefix & ".png") Then
  • cmd.exe reference in VBA high OLE_VBA_CMD
    cmd.exe reference in VBA
    Matched line in script
            ' Output Bounding Box to file and read back in the appropriate information
            RetValConv& = Execute("cmd /C """ & gs_command & """ -q -dBATCH -dNOPAUSE -sDEVICE=bbox " & FilePrefix & ".pdf 2> " & FilePrefix & ".bbx", TempPath, debugMode, TimeOutTime)
            If (RetValConv& <> 0 Or Not fs.FileExists(TempPath & FilePrefix & ".bbx")) Then
  • Auto_Open macro low OLE_VBA_AUTO
    Auto_Open macro
    Matched line in script
    Sub Auto_Open()
        ' Runs when the add-in is loaded
  • Auto_Close macro low OLE_VBA_AUTOCLOSE
    Auto_Close macro
    Matched line in script
    Sub Auto_Close()
        LatexForm.UnInitializeApp
  • Embedded URL info EMBEDDED_URL
    One or more URLs were extracted from the document. The URL itself is not a detection — see the per-URL labels for which channel (macro, JS, link annotation, document body, ...) reached each URL.
    URL http://www.vbaexpress.com/forum/showthread.php?47687-Addpicture-adds-the-picture-to-a-placeholder-rather-as-a-new-shape In document text (OOXML body / shared strings)
    • http://www.vbaexpress.com/forum/showthread.php?37561-Delete-empty-placeholdersIn document text (OOXML body / shared strings)
    • http://www.kbalertz.com/kb_145679.aspxIn document text (OOXML body / shared strings)
    • http://�www.vba��In document text (OOXML body / shared strings)
    • http://www.jonathanleroux.org/software/In document text (OOXML body / shared strings)
    • http://schemas.microsoft.com/office/2009/07/customuiIn document text (OOXML body / shared strings)
    • http://www.mvps.org/access/api/api0004.htmIn document text (OOXML body / shared strings)
    • http://www.mrexcel.com/forum/excel-questions/485489-resize-userform.htmlIn document text (OOXML body / shared strings)
    • http://creativecommons.org/licenses/by-sa/3.0/In document text (OOXML body / shared strings)

Extracted artifacts 2

Files carved from inside the sample during analysis.

FilenameKindSourceSize
macros.bas vba-macro oletools.olevba.extract_macros (decoded VBA source from OOXML) 100232 bytes
SHA-256: 2a2494493fc0cb321176f113f35ad3aa37ef97688a91e7d3fcd4fc2eb6a4c980
Preview script
First 1,000 lines of the extracted script
Attribute VB_Name = "LatexForm"
Attribute VB_Base = "0{350F3B74-370F-48C3-AA3C-0C428920EE45}{6316B514-9BF5-4C86-9E27-97A7CD6F0FB6}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False
Dim RegPath As String
    
Dim LaTexEngineList As Variant
Dim LaTexEngineDisplayList As Variant
Dim UsePDFList As Variant

'Dim NumberOfTemplates As Long
Dim TemplateSortedListString As String
Dim TemplateSortedList() As String
Dim TemplateNameSortedListString As String

Dim theAppEventHandler As New AppEventHandler

Sub InitializeApp()
    Set theAppEventHandler.App = Application
    
    AddMenuItem "New Latex display...", "NewLatexEquation", 18 '226
    AddMenuItem "Edit Latex display...", "EditLatexEquation", 37
    AddMenuItem "Regenerate selected displays...", "RegenerateSelectedDisplays", 19
    AddMenuItem "Settings...", "LoadSetTempForm", 548
    
End Sub

Sub AddMenuItem(itemText As String, itemCommand As String, itemFaceId As Long)
    ' Check if we have already added the menu item
    Dim initialized As Boolean
    Dim bef As Integer
    initialized = False
    bef = 1
    Dim Menu As CommandBars
    Set Menu = Application.CommandBars
    For i = 1 To Menu("Insert").Controls.Count
        With Menu("Insert").Controls(i)
            If .Caption = itemText Then
                initialized = True
                Exit For
            ElseIf InStr(.Caption, "Dia&gram") Then
                bef = i
            End If
        End With
    Next
    
    ' Create the menu choice.
    If Not initialized Then
        Dim NewControl As CommandBarControl
        Set NewControl = Menu("Insert").Controls.Add _
                              (Type:=msoControlButton, _
                               before:=bef, _
                               Id:=itemFaceId)
        NewControl.Caption = itemText
        NewControl.OnAction = itemCommand
        NewControl.Style = msoButton
    End If
End Sub

Sub UnInitializeApp()
    
    RemoveMenuItem "New Latex display..."
    RemoveMenuItem "Edit Latex display..."
    RemoveMenuItem "Regenerate selected displays..."
    RemoveMenuItem "Settings..."

End Sub

Sub RemoveMenuItem(itemText As String)
    Dim Menu As CommandBars
    Set Menu = Application.CommandBars
    For i = 1 To Menu("Insert").Controls.Count
        If Menu("Insert").Controls(i).Caption = itemText Then
            Menu("Insert").Controls(i).Delete
            Exit For
        End If
    Next
    

End Sub


Private Sub ButtonCancel_Click()
    Unload LatexForm
    ' LatexForm.Hide
End Sub


Private Function IsPathWritable(TempPath As String) As Boolean
    FilePrefix = GetFilePrefix()
    
    Dim FName As String
    Dim FHdl As Integer
    FName = TempPath & FilePrefix & ".tmp"
    On Error GoTo TempFolderNotWritable
    FHdl = FreeFile()
    Open FName For Output Access Write As FHdl
    Print #FHdl, "TESTWRITE"
    Close FHdl
    IsPathWritable = True
    Kill FName
    
    On Error GoTo 0
    
    Exit Function

TempFolderNotWritable:
    IsPathWritable = False
End Function

Private Sub WriteLaTeX2File(TempPath As String, FilePrefix As String)
    Const ForReading = 1, ForWriting = 2, ForAppending = 3
    Set fs = CreateObject("Scripting.FileSystemObject")
    If fs.FileExists(TempPath & FilePrefix & ".png") Then
        fs.DeleteFile TempPath + FilePrefix + "*.*" 'Make sure we don't keep old files
    End If
    RegPath = "Software\IguanaTex"
    Dim UseUTF8 As Boolean
    UseUTF8 = GetRegistryValue(HKEY_CURRENT_USER, RegPath, "UseUTF8", True)
    
    If UseUTF8 = False Then
        Set f = fs.CreateTextFile(TempPath + FilePrefix + ".tex", True)
        f.Write TextBox1.Text
        f.Close
    Else
        Dim BinaryStream As Object
        Set BinaryStream = CreateObject("ADODB.stream")
        BinaryStream.Type = 1
        BinaryStream.Open
        Dim adodbStream  As Object
        Set adodbStream = CreateObject("ADODB.Stream")
        With adodbStream
            .Type = 2 'Stream type
            .Charset = "utf-8"
            .Open
            .WriteText TextBox1.Text
            '.SaveToFile TempPath & FilePrefix & ".tex", 2 'Save binary data To disk; problem: this includes a BOM
            ' Workaround to avoid BOM in file:
            .Position = 3 'skip BOM
            .CopyTo BinaryStream
            .Flush
            .Close
        End With
        BinaryStream.SaveToFile TempPath & FilePrefix & ".tex", 2 'Save binary data To disk
        BinaryStream.Flush
        BinaryStream.Close
    End If
    Set fs = Nothing
End Sub

Sub ButtonRun_Click()
    Dim TempPath As String
    'TempPath = GetTempPath()
    If Right(TextBoxTempFolder.Text, 1) <> "\" Then
        TextBoxTempFolder.Text = TextBoxTempFolder.Text & "\"
    End If
    TempPath = TextBoxTempFolder.Text
    
    If Left(TempPath, 1) = "." Then
        Dim sPath As String
        sPath = ActivePresentation.Path
        If Len(sPath) > 0 Then
            If Right(sPath, 1) <> "\" Then
                sPath = sPath & "\"
            End If
            TempPath = sPath & TempPath
        Else
            MsgBox "You need to have saved your presentation once to use a relative path."
            Exit Sub
        End If
    End If
    
    Dim FilePrefix As String
    FilePrefix = GetFilePrefix()
    
    Dim debugMode As Boolean
    If checkboxDebug.Value Then
        debugMode = True
    Else
        debugMode = False
    End If
    
    ' Read settings
    RegPath = "Software\IguanaTex"
    Dim UsePDF As Boolean
    gs_command = GetRegistryValue(HKEY_CURRENT_USER, RegPath, "GS Command", "C:\Program Files (x86)\gs\gs9.15\bin\gswin32c.exe")
    IMconv = GetRegistryValue(HKEY_CURRENT_USER, RegPath, "IMconv", "C:\Program Files\ImageMagick\convert.exe")
    LATEXENGINEID = ComboBoxLaTexEngine.ListIndex
    tex2pdf_command = LaTexEngineList(LATEXENGINEID)
    UsePDF = UsePDFList(LATEXENGINEID)
    
    Dim TimeOutTimeString As String
    Dim TimeOutTime As Long
    TimeOutTimeString = GetRegistryValue(HKEY_CURRENT_USER, RegPath, "TimeOutTime", "20") ' Wait 20 seconds for the processes to complete
    TimeOutTime = val(TimeOutTimeString) * 1000
    
    Dim OutputDpiString As String
    Dim OutputDpi As Long
    OutputDpiString = GetRegistryValue(HKEY_CURRENT_USER, RegPath, "OutputDpi", "1200")
    OutputDpi = val(OutputDpiString)
    
    ' Read current dpi in: this will be used when rescaling and optionally in pdf->png conversion
    dpi = lDotsPerInch
    highdpi_rescaling = 1 ' will be used to account for dvipng's handling of high-dpi displays
        
        
    ' Test if path writable
    If Not IsPathWritable(TempPath) Then
        MsgBox "The temporary folder " & TempPath & " appears not to be writable."
        Exit Sub
    End If
    
    ' Write latex to a temp file
    Call WriteLaTeX2File(TempPath, FilePrefix)
    
    ' Run latex
    Const ForReading = 1, ForWriting = 2, ForAppending = 3
    Set fs = CreateObject("Scripting.FileSystemObject")
    Dim LogFile As Object
    FrameProcess.Visible = True
    
    If UsePDF = True Then
    ' pdf to png route
        If tex2pdf_command = "platex" Then
            OutputExt = ".dvi"
            LabelProcess.Caption = "LaTeX to DVI..."
            FrameProcess.Repaint
        Else
            OutputExt = ".pdf"
            LabelProcess.Caption = "LaTeX to PDF..."
            FrameProcess.Repaint
        End If
        RetVal& = Execute("""" & tex2pdf_command & """ -shell-escape -interaction=batchmode """ + FilePrefix + ".tex""", TempPath, debugMode, TimeOutTime)
        
        If (RetVal& <> 0 Or Not fs.FileExists(TempPath & FilePrefix & OutputExt)) Then
            ' Error in Latex code
            ' Read log file and show it to the user
            If fs.FileExists(TempPath & FilePrefix & ".log") Then
                Set LogFile = fs.OpenTextFile(TempPath + FilePrefix + ".log", ForReading)
                LogFileViewer.TextBox1.Text = LogFile.ReadAll
                LogFile.Close
                LogFileViewer.TextBox1.ScrollBars = fmScrollBarsBoth
                LogFileViewer.Show 1
            Else
                MsgBox tex2pdf_command & " did not return in " & TimeOutTimeString & " seconds and may have hung." & vbNewLine & "Please make sure your code compiles outside IguanaTex."
            End If
            FrameProcess.Visible = False
            Exit Sub
        End If
        
        If tex2pdf_command = "platex" Then
            LabelProcess.Caption = "DVI to PDF..."
            FrameProcess.Repaint
            ' platex actually outputs a DVI file, which we need to convert to PDF (we could go the EPS route, but this blends easier with IguanaTex's existing code)
            RetValConv& = Execute("dvipdfmx -o """ + FilePrefix + ".pdf"" """ & FilePrefix & ".dvi""", TempPath, debugMode, TimeOutTime)
            If (RetValConv& <> 0 Or Not fs.FileExists(TempPath & FilePrefix & ".pdf")) Then
                ' Error in DVI to PDF conversion
                MsgBox "Error while using dvipdm to convert from DVI to PDF."
                FrameProcess.Visible = False
                Exit Sub
            End If
        End If
        
        LabelProcess.Caption = "PDF to PNG..."
        FrameProcess.Repaint
        ' Output Bounding Box to file and read back in the appropriate information
        RetValConv& = Execute("cmd /C """ & gs_command & """ -q -dBATCH -dNOPAUSE -sDEVICE=bbox " & FilePrefix & ".pdf 2> " & FilePrefix & ".bbx", TempPath, debugMode, TimeOutTime)
        If (RetValConv& <> 0 Or Not fs.FileExists(TempPath & FilePrefix & ".bbx")) Then
            ' Error in bounding box computation
            MsgBox "Error while using Ghostscript to compute the bounding box. Is your path correct?"
            FrameProcess.Visible = False
            Exit Sub
        End If
        Dim BBString As String
        BBString = BoundingBoxString(TempPath + FilePrefix + ".bbx")
        
        ' Convert PDF to PNG
        If checkboxTransp.Value = True Then
            PdfPngDevice = "-sDEVICE=pngalpha"
        Else
            PdfPngDevice = "-sDEVICE=png16m"
        End If
        RetValConv& = Execute("""" & gs_command & """ -q -dBATCH -dNOPAUSE " & PdfPngDevice & " -r" & OutputDpiString & " -sOutputFile=""" & FilePrefix & "_tmp.png""" & BBString & " -f """ & TempPath & FilePrefix & ".pdf""", TempPath, debugMode, TimeOutTime)
        If (RetValConv& <> 0 Or Not fs.FileExists(TempPath & FilePrefix & "_tmp.png")) Then
            ' Error in PDF to PNG conversion
            MsgBox "Error while using Ghostscript to convert from PDF to PNG. Is your path correct?"
            FrameProcess.Visible = False
            Exit Sub
        End If
        ' Unfortunately, the resulting file has a metadata DPI of OutputDpi (=1200), not the default screen one (usually 96),
        ' so there is a discrepancy with the dvipng output.
        ' The only workaround I have found so far is to use Imagemagick's convert to change the DPI (but not the pixel size!)
        ' Execute """" & IMconv & """ -units PixelsPerInch """ & FilePrefix & "_tmp.png"" -density " & CStr(dpi) & " """ & FilePrefix & ".png""", TempPath, debugMode
        RetValConv& = Execute("""" & IMconv & """ -units PixelsPerInch """ & FilePrefix & "_tmp.png"" -density " & CStr(dpi) & " """ & FilePrefix & ".png""", TempPath, debugMode, TimeOutTime)
        If (RetValConv& <> 0 Or Not fs.FileExists(TempPath & FilePrefix & ".png")) Then
            ' Error in PDF to PNG conversion
            MsgBox "Error while using ImageMagick to change the PNG DPI. Is your path correct?" & vbNewLine & "The full path is needed to avoid conflict with Windows's built-in convert.exe."
            FrameProcess.Visible = False
            Exit Sub
        End If
        
        ' 'I considered using ImageMagick's convert, but it's extremely slow, and uses ghostscript in the backend anyway
        'PdfPngSwitches = "-density 1200 -trim -transparent white -antialias +repage"
        'Execute IMconv & " " & PdfPngSwitches & " """ & FilePrefix & ".pdf"" """ & FilePrefix & ".png""", TempPath, debugMode
        
    Else
    ' dvi to png route
        LabelProcess.Caption = "LaTeX to DVI..."
        FrameProcess.Repaint
        RetVal& = Execute("pdflatex -shell-escape -output-format dvi -interaction=batchmode """ + FilePrefix + ".tex""", TempPath, debugMode, TimeOutTime)
        If (RetVal& <> 0 Or Not fs.FileExists(TempPath & FilePrefix & ".dvi")) Then
            ' Error in Latex code
            ' Read log file and show it to the user
            If fs.FileExists(TempPath & FilePrefix & ".log") Then
                Set LogFile = fs.OpenTextFile(TempPath + FilePrefix + ".log", ForReading)
                LogFileViewer.TextBox1.Text = LogFile.ReadAll
                LogFile.Close
                LogFileViewer.TextBox1.ScrollBars = fmScrollBarsBoth
                LogFileViewer.Show 1
            Else
                MsgBox "latex did not return in " & TimeOutTimeString & " seconds and may have hung." & vbNewLine & "Please make sure your code compiles outside IguanaTex."
            End If
            FrameProcess.Visible = False
            Exit Sub
        End If
        LabelProcess.Caption = "DVI to PNG..."
        FrameProcess.Repaint
        DviPngSwitches = "-q -D " & OutputDpiString & " -T tight"  ' monitor is 96 dpi or higher; we use OutputDpi (=1200 by default) dpi to get a crisper display, and rescale later on for new displays to match the point size
        If checkboxTransp.Value = True Then
            DviPngSwitches = DviPngSwitches & " -bg Transparent"
        End If
        ' If the user created a .png by using the standalone class with convert, we use that, else we use dvipng
        If Not fs.FileExists(TempPath & FilePrefix & ".png") Then
            RetValConv& = Execute("dvipng " & DviPngSwitches & " -o """ & FilePrefix & ".png"" """ & FilePrefix & ".dvi""", TempPath, debugMode, TimeOutTime)
            If (RetValConv& <> 0 Or Not fs.FileExists(TempPath & FilePrefix & ".png")) Then
                MsgBox "dvipng failed, or did not return in " & TimeOutTimeString & " seconds and may have hung." & vbNewLine & "You may want to try compiling using the PDF->PNG option."
                FrameProcess.Visible = False
                Exit Sub
            End If
        End If
        highdpi_rescaling = 96 / dpi
    End If
    
    FinalFilename = FilePrefix & ".png"
    
    LabelProcess.Caption = "Insert image..."
    FrameProcess.Repaint
    ' Latex run successful.
    ' If we are in Edit mode, store parameters of old image
    Dim PosX As Single
    Dim PosY As Single
    Dim Sel As Selection
    Set Sel = Application.ActiveWindow.Selection
    Dim oldShape As Shape
    IsInGroup = False
    If ButtonRun.Caption = "ReGenerate" Then
        If Sel.ShapeRange.Type = msoGroup Then
            Set oldShape = Sel.ChildShapeRange(1)
            IsInGroup = True
            Dim arr() As Variant ' gather all shapes to be regrouped later on
            j = 0
            Dim s As Shape
            For Each s In Sel.ShapeRange.GroupItems
                If s.Name <> oldShape.Name Then
                    j = j + 1
                    ReDim Preserve arr(1 To j)
                    arr(j) = s.Name
                End If
            Next
            ' Store the group's animation and Zorder info in a dummy object tmpGroup
            Dim oldShapeRange As ShapeRange
            Set oldShapeRange = Sel.ShapeRange
            Dim oldGroup As Shape
            Set oldGroup = oldShapeRange(1)
            Dim tmpGroup As Shape
            Set tmpGroup = ActiveWindow.Selection.SlideRange.Shapes.AddShape(msoShapeDiamond, 1, 1, 1, 1)
            MoveAnimation oldGroup, tmpGroup
            MatchZOrder oldGroup, tmpGroup
            
            ' Tag all elements in the group with their hierarchy level and their name or group name
            Dim MaxGroupLevel As Long
            MaxGroupLevel = TagGroupHierarchy(arr, oldShape.Name)
            
        Else
            Set oldShape = Sel.ShapeRange(1)
        End If
        PosX = oldShape.Left
        PosY = oldShape.Top
    Else
        PosX = 200
        PosY = 200
    End If
    
    
    ' Insert image
    Dim newShape As Shape
    'Set newShape = ActiveWindow.Selection.SlideRange.Shapes.AddPicture(TempPath + FinalFilename, msoFalse, msoTrue, PosX, PosY, -1, -1)
    Set newShape = AddDisplayShape(TempPath + FinalFilename, PosX, PosY)
    ' Resize to the true size of the png file
    newShape.ScaleHeight 1#, msoTrue
    newShape.ScaleWidth 1#, msoTrue
    ' Add tags storing the original height and width, used next time to keep resizing ratio.
    newShape.Tags.Add "ORIGINALHEIGHT", newShape.Height
    newShape.Tags.Add "ORIGINALWIDTH", newShape.Width
    newShape.Tags.Add "OUTPUTDPI", OutputDpi
        
    ' Scale it
    If ButtonRun.Caption <> "ReGenerate" Or CheckBoxReset.Value = True Then
        PointSize = val(textboxSize.Text)
        ScaleFactor = PointSize / 10 * dpi / OutputDpi * highdpi_rescaling  ' 1/10 is for the default LaTeX point size (10 pt)
        newShape.ScaleHeight ScaleFactor, msoTrue
        newShape.ScaleWidth ScaleFactor, msoTrue
        If ButtonRun.Caption = "ReGenerate" Then ' We are editing+resetting size of an old display, we keep rotation
            newShape.Rotation = oldShape.Rotation
        End If
    Else
        ' Handle the case of Texpoint displays
        Dim isTexpoint As Boolean
        isTexpoint = False
        Dim OldDpi As Long
        OldDpi = 1200
        With oldShape.Tags
            For i = 1 To .Count
                If (.Name(i) = "TEXPOINTSCALING") Then
                    isTexpoint = True
                    tScaleWidth = val(.Value(i)) * dpi / OutputDpi * highdpi_rescaling
                End If
                If (.Name(i) = "OUTPUTDPI") Then
                    OldDpi = val(.Value(i))
                End If
            Next
        End With
        If isTexpoint Then
            newShape.LockAspectRatio = msoTrue
            newShape.ScaleWidth tScaleWidth, msoTrue
            newShape.LockAspectRatio = oldShape.LockAspectRatio
            newShape.Rotation = oldShape.Rotation
        Else ' modifying a normal
            HeightOld = oldShape.Height
            WidthOld = oldShape.Width
            oldShape.ScaleHeight 1#, msoTrue
            oldShape.ScaleWidth 1#, msoTrue
            tScaleHeight = HeightOld / oldShape.Height * 960 / OutputDpi ' 0.8=960/1200 is there to preserve scaling of displays created with old versions of IguanaTex
            tScaleWidth = WidthOld / oldShape.Width * 960 / OutputDpi
            With oldShape.Tags
                For i = 1 To .Count
                    If (.Name(i) = "ORIGINALHEIGHT") Then
                        tmpHeight = val(.Value(i))
                        tScaleHeight = HeightOld / tmpHeight * OldDpi / OutputDpi
                    End If
                    If (.Name(i) = "ORIGINALWIDTH") Then
                        tmpWidth = val(.Value(i))
                        tScaleWidth = WidthOld / tmpWidth * OldDpi / OutputDpi
                    End If
                Next
            End With
                        
            newShape.LockAspectRatio = msoFalse
            newShape.ScaleHeight tScaleHeight, msoTrue
            newShape.ScaleWidth tScaleWidth, msoTrue
            newShape.LockAspectRatio = oldShape.LockAspectRatio
            newShape.Rotation = oldShape.Rotation
        End If
    End If
    
    ' Add tags
    newShape.Tags.Add "LATEXADDIN", TextBox1.Text
    newShape.Tags.Add "IguanaTexSize", val(textboxSize.Text)
    newShape.Tags.Add "IGUANATEXCURSOR", TextBox1.SelStart
    newShape.Tags.Add "TRANSPARENCY", checkboxTransp.Value
    newShape.Tags.Add "FILENAME", TextBoxFile.Text
    newShape.Tags.Add "INPUTTYPE", BoolToInt(MultiPage1.Value)
    newShape.Tags.Add "LATEXENGINEID", LATEXENGINEID
    newShape.Tags.Add "TEMPFOLDER", TextBoxTempFolder.Text
    
    ' Copy animation settings and formatting from old image, then delete it
    If ButtonRun.Caption = "ReGenerate" Then
        If IsInGroup Then
            ' Transfer format to new shape
            MatchZOrder oldShape, newShape
            oldShape.PickUp
            newShape.Apply
            oldShape.Delete
            
            ' Get current slide, it will be used to group ranges
            Dim sld As Slide
            Dim SlideIndex As Long
            SlideIndex = ActiveWindow.View.Slide.SlideIndex
            Set sld = ActivePresentation.Slides(SlideIndex)
            Dim newGroup As Shape
            
            ' Group all non-modified elements from old group, plus modified element
            j = j + 1
            ReDim Preserve arr(1 To j)
            arr(j) = newShape.Name
            newShape.Tags.Add "LAYER", 1
            newShape.Tags.Add "SELECTIONNAME", newShape.Name
            
            ' Hierarchically re-group elements
            For Level = 1 To MaxGroupLevel
                Dim CurrentLevelArr() As Variant
                j_current = 0
                For Each n In arr
                    ThisShapeLevel = 0
                    Dim ThisShapeSelectionName As String
                    ThisShapeSelectionName = ""
                    On Error Resume Next
                    With ActiveWindow.Selection.SlideRange.Shapes(n).Tags
                        For i_tag = 1 To .Count
                            If (.Name(i_tag) = "LAYER") Then
                                ThisShapeLevel = val(.Value(i_tag))
                            End If
                            If (.Name(i_tag) = "SELECTIONNAME") Then
                                ThisShapeSelectionName = .Value(i_tag)
                            End If
                        Next
                    End With
                    
                    
                    If ThisShapeLevel = Level Then
                        If j_current > 0 Then
                            If Not IsInArray(CurrentLevelArr, ThisShapeSelectionName) Then
                                j_current = j_current + 1
                                ReDim Preserve CurrentLevelArr(1 To j_current)
                                CurrentLevelArr(j_current) = ThisShapeSelectionName
                            End If
                        Else
                            j_current = j_current + 1
                            ReDim Preserve CurrentLevelArr(1 To j_current)
                            CurrentLevelArr(j_current) = ThisShapeSelectionName
                        End If
                    End If
                Next
                
                If j_current > 1 Then
                    Set newGroup = sld.Shapes.Range(CurrentLevelArr).Group
                    j = j + 1
                    ReDim Preserve arr(1 To j)
                    arr(j) = newGroup.Name
                    newGroup.Tags.Add "SELECTIONNAME", newGroup.Name
                    newGroup.Tags.Add "LAYER", Level + 1
                End If
                
            Next
            
            ' Delete the tags to avoid conflict with future runs
            For Each n In arr
                On Error Resume Next
                    ActiveWindow.Selection.SlideRange.Shapes(n).Tags.Delete ("SELECTIONNAME")
                    ActiveWindow.Selection.SlideRange.Shapes(n).Tags.Delete ("LAYER")
            Next
            
            ' Use temporary group to retrieve the group's original animation and Zorder
            MoveAnimation tmpGroup, newGroup
            MatchZOrder tmpGroup, newGroup
            tmpGroup.Delete
        Else
            MoveAnimation oldShape, newShape
            MatchZOrder oldShape, newShape
            oldShape.PickUp
            newShape.Apply
            oldShape.Delete
        End If
    End If
    
    ' Select the new shape
    newShape.Select
    
    ' Delete temp files if not in debug mode
    If debugMode = False Then fs.DeleteFile TempPath + FilePrefix + "*.*"
    FrameProcess.Visible = False
    Unload LatexForm
Exit Sub

'TempFolderNotWritable:
'    MsgBox "The temporary folder " & TempPath & " appears not to be writable."
    
End Sub

Private Function IsInArray(arr As Variant, valueToCheck As String) As Boolean
    IsInArray = False
    For Each n In arr
        If n = valueToCheck Then
            IsInArray = True
            Exit For
        End If
    Next

End Function

Private Function TagGroupHierarchy(arr As Variant, TargetName As String) As Long
    ' Arr is the list of names of (leaf) elements in this group
    ' TargetName is the display which is being modified. We're going down the branch containing it.
    Dim Sel As Selection
    ActiveWindow.Selection.SlideRange.Shapes(TargetName).Select
    Set Sel = Application.ActiveWindow.Selection
    
    ' This function expects to receive a grouped ShapeRange
    ' We ungroup to reveal the structure at the layer below
    Sel.ShapeRange.Ungroup
    ActiveWindow.Selection.SlideRange.Shapes(TargetName).Select
           
    If Sel.ShapeRange.Type = msoGroup Then
        ' We need to go further down, the element being edited is still within a group
        ' Get the name of the Target group in which it is
        TargetGroupName = Sel.ShapeRange(1).Name
        
        Dim Arr_In() As Variant ' shapes in the same group
        Dim Arr_Out() As Variant ' shapes not in the same group
        
        ' Split range according to whether elements are in the same group or not
        j_in = 0
        j_out = 0
        For Each n In arr
            ActiveWindow.Selection.SlideRange.Shapes(n).Select
            If Sel.ShapeRange.Type = msoGroup Then
                ' object is in group
                If Sel.ShapeRange(1).Name = TargetGroupName Then
                    j_in = j_in + 1
                    ReDim Preserve Arr_In(1 To j_in)
                    Arr_In(j_in) = n
                Else
                    j_out = j_out + 1
                    ReDim Preserve Arr_Out(1 To j_out)
                    Arr_Out(j_out) = n
                End If
            Else ' object not in group, so it can't be in the same group as Target
                j_out = j_out + 1
                ReDim Preserve Arr_Out(1 To j_out)
                Arr_Out(j_out) = n
            End If
        Next
        
        ' Build shape range with all elements in that group, go one level down
        tmp = TagGroupHierarchy(Arr_In, TargetName)
        TagGroupHierarchy = tmp + 1
        
        ' For all elements not in that group, tag them
        For Each n In Arr_Out
            ActiveWindow.Selection.SlideRange.Shapes(n).Select
            ActiveWindow.Selection.SlideRange.Shapes(n).Tags.Add "LAYER", TagGroupHierarchy
            If Sel.ShapeRange.Type = msoGroup Then
                ActiveWindow.Selection.SlideRange.Shapes(n).Tags.Add "SELECTIONNAME", Sel.ShapeRange(1).Name
            Else
                ActiveWindow.Selection.SlideRange.Shapes(n).Tags.Add "SELECTIONNAME", n
            End If
        Next
        
    Else ' we reached the final layer: the element being edited is by itself,
         ' all other elements will need to be handled either through their group
         ' name if in a group, or their name if not
        TagGroupHierarchy = 1
        For Each n In arr
            ActiveWindow.Selection.SlideRange.Shapes(n).Tags.Add "LAYER", TagGroupHierarchy
            ActiveWindow.Selection.SlideRange.Shapes(n).Tags.Add "SELECTIONNAME", n
        Next
    End If


End Function

' Add picture as shape taking care of not inserting it in empty placeholder
Private Function AddDisplayShape(Path As String, PosX As Single, PosY As Single) As Shape
' from http://www.vbaexpress.com/forum/showthread.php?47687-Addpicture-adds-the-picture-to-a-placeholder-rather-as-a-new-shape
' modified based on http://www.vbaexpress.com/forum/showthread.php?37561-Delete-empty-placeholders
    Dim oshp As Shape
    Dim osld As Slide
    On Error Resume Next
    Set osld = ActiveWindow.Selection.SlideRange(1)
    If Err <> 0 Then Exit Function
    On Error GoTo 0
    For Each oshp In osld.Shapes
        If oshp.Type = msoPlaceholder Then
            If oshp.PlaceholderFormat.ContainedType = msoAutoShape Then
                If oshp.HasTextFrame Then
                    If Not oshp.TextFrame.HasText Then oshp.TextFrame.TextRange = "DUMMY"
                End If
            End If
        End If
    Next oshp
    Set AddDisplayShape = osld.Shapes.AddPicture(Path, msoFalse, msoTrue, PosX, PosY, -1, -1)
    For Each oshp In osld.Shapes
        If oshp.Type = msoPlaceholder Then
            If oshp.PlaceholderFormat.ContainedType = msoAutoShape Then
                If oshp.HasTextFrame Then
                    If oshp.TextFrame.TextRange = "DUMMY" Then oshp.TextFrame.DeleteText
                End If
            End If
        End If
    Next oshp
End Function


Private Function BoundingBoxString(BBXFile As String) As String
    Const ForReading = 1
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set txtStream = fso.OpenTextFile(BBXFile, ForReading, False)
    Dim TextSplit As Variant
    Dim OutputDpiString As String
    Dim OutputDpi As Long
    OutputDpiString = GetRegistryValue(HKEY_CURRENT_USER, RegPath, "OutputDpi", "1200")
    OutputDpi = val(OutputDpiString)
    Do While Not txtStream.AtEndOfStream
    tmptext = txtStream.ReadLine
    TextSplit = Split(tmptext, " ")
    If TextSplit(0) = "%%HiResBoundingBox:" Then
        llx = val(TextSplit(1))
        lly = val(TextSplit(2))
        urx = val(TextSplit(3))
        ury = val(TextSplit(4))
        'compute size and offset
        sx = CStr(Round((urx - llx) / 72 * OutputDpi))
        sy = CStr(Round((ury - lly) / 72 * OutputDpi))
        cx = Str(-llx)
        cy = Str(-lly)
    End If
    Loop
    txtStream.Close
    BoundingBoxString = " -g" & sx & "x" & sy & " -c ""<</Install {" & cx & " " & cy & " translate}>> setpagedevice"""
End Function

Private Sub SaveSettings()
    RegPath = "Software\IguanaTex"
    SetRegistryValue HKEY_CURRENT_USER, RegPath, "Transparent", REG_DWORD, BoolToInt(checkboxTransp.Value)
    SetRegistryValue HKEY_CURRENT_USER, RegPath, "Debug", REG_DWORD, BoolToInt(checkboxDebug.Value)
    SetRegistryValue HKEY_CURRENT_USER, RegPath, "PointSize", REG_DWORD, CLng(val(textboxSize.Text))
    SetRegistryValue HKEY_CURRENT_USER, RegPath, "LatexCode", REG_SZ, CStr(TextBox1.Text)
    SetRegistryValue HKEY_CURRENT_USER, RegPath, "LatexCodeCursor", REG_DWORD, CLng(TextBox1.SelStart)
    SetRegistryValue HKEY_CURRENT_USER, RegPath, "LatexFormHeight", REG_DWORD, CLng(LatexForm.Height)
    SetRegistryValue HKEY_CURRENT_USER, RegPath, "LatexFormWidth", REG_DWORD, CLng(LatexForm.Width)
    SetRegistryValue HKEY_CURRENT_USER, RegPath, "Multipage", REG_SZ, MultiPage1.Value
    
End Sub

Private Sub LoadSettings()
    RegPath = "Software\IguanaTex"
    checkboxTransp.Value = CBool(GetRegistryValue(HKEY_CURRENT_USER, RegPath, "Transparent", True))
    checkboxDebug.Value = CBool(GetRegistryValue(HKEY_CURRENT_USER, RegPath, "Debug", False))
    textboxSize.Text = GetRegistryValue(HKEY_CURRENT_USER, RegPath, "PointSize", "20")
    TextBox1.Text = GetRegistryValue(HKEY_CURRENT_USER, RegPath, "LatexCode", "\documentclass{article}" & Chr(13) & "\usepackage{amsmath}" & Chr(13) & "\pagestyle{empty}" & Chr(13) & "\begin{document}" & Chr(13) & Chr(13) & Chr(13) & Chr(13) & Chr(13) & "\end{document}")
    TextBox1.SelStart = GetRegistryValue(HKEY_CURRENT_USER, RegPath, "LatexCodeCursor", 0)
    MultiPage1.Value = GetRegistryValue(HKEY_CURRENT_USER, RegPath, "Multipage", 0)
    TextBox1.Font.Size = val(GetRegistryValue(HKEY_CURRENT_USER, RegPath, "EditorFontSize", "10"))
    TextBoxTempFolder.Text = GetTempPath()
    
    LaTexEngineList = Array("pdflatex", "pdflatex", "xelatex", "lualatex", "platex")
    LaTexEngineDisplayList = Array("latex (DVI->PNG)", "pdflatex (PDF->PNG)", "xelatex (PDF->PNG)", "lualatex (PDF->PNG)", "platex (PDF->PNG)")
    UsePDFList = Array(False, True, True, True, True)
    ComboBoxLaTexEngine.List = LaTexEngineDisplayList
    ComboBoxLaTexEngine.ListIndex = GetRegistryValue(HKEY_CURRENT_USER, RegPath, "LaTeXEngineID", 0)
    
    TemplateSortedListString = GetRegistryValue(HKEY_CURRENT_USER, RegPath, "TemplateSortedList", "0")
    TemplateSortedList = UnpackStringToArray(TemplateSortedListString)
    'NumberOfTemplates = GetRegistryValue(HKEY_CURRENT_USER, RegPath, "NumberOfTemplates", 1)
    TemplateNameSortedListString = GetRegistryValue(HKEY_CURRENT_USER, RegPath, "TemplateNameSortedList", "New Template")
    ComboBoxTemplate.List = UnpackStringToArray(TemplateNameSortedListString)
End Sub

Private Function BoolToInt(val) As Long
    If val Then
        BoolToInt = 1&
    Else
        BoolToInt = 0&
    End If
End Function

Private Sub ButtonTexPath_Click()
    Dim fd As FileDialog
    Set fd = Application.FileDialog(msoFileDialogFilePicker) 'msoFileDialogFolderPicker
    
    Dim vrtSelectedItem As Variant
    fd.AllowMultiSelect = False
    fd.InitialFileName = TextBoxFile.Text
    fd.Filters.Clear
    fd.Filters.Add "Tex Files", "*.tex", 1
    
    If fd.Show = -1 Then
        For Each vrtSelectedItem In fd.SelectedItems
            TextBoxFile.Text = vrtSelectedItem
        Next vrtSelectedItem
    End If

    Set fd = Nothing
    TextBoxFile.SetFocus
End Sub

Private Sub CheckBoxReset_Click()
    If CheckBoxReset.Value = True Then
        textboxSize.Enabled = True
    Else
        textboxSize.Enabled = False
    End If
End Sub

Private Sub ButtonAbout_Click()
    AboutBox.Show 1
End Sub


Private Sub ButtonMakeDefault_Click()
    SaveSettings
    Select Case MultiPage1.Value
        Case 0 ' Direct input
            TextBox1.SetFocus
        Case 1 ' Read from file
            TextBoxFile.SetFocus
        Case Else ' Templates
            TextBoxTemplateCode.SetFocus
    End Select
End Sub

Private Sub CmdButtonExternalEditor_Click()
        
    ' Put the temporary path in the right format
    If Right(TextBoxTempFolder.Text, 1) <> "\" Then
        TextBoxTempFolder.Text = TextBoxTempFolder.Text & "\"
    End If
    Dim TempPath As String
    TempPath = TextBoxTempFolder.Text
    If Left(TempPath, 1) = "." Then
        Dim sPath As String
        sPath = ActivePresentation.Path
        If Len(sPath) > 0 Then
            If Right(sPath, 1) <> "\" Then
                sPath = sPath & "\"
            End If
            TempPath = sPath & TempPath
        Else
            MsgBox "You need to have saved your presentation once to use a relative path."
            Exit Sub
        End If
    End If
    
    Dim FilePrefix As String
    FilePrefix = GetFilePrefix()
    
    ' Test if path writable
    If Not IsPathWritable(TempPath) Then
        MsgBox "The temporary folder " & TempPath & " appears not to be writable."
        Exit Sub
    End If
    
    ' Write latex to a temp file
    Call WriteLaTeX2File(TempPath, FilePrefix)
    
    ' Launch external editor
    On Error GoTo ShellError
    Shell """" & GetEditorPath() & """ """ & TempPath & FilePrefix & ".tex""", vbNormalFocus
    
    ' Show dialog form to reload from file or cancel
    ExternalEditorForm.Show
    Exit Sub
    
ShellError:
    MsgBox "Error Launching External Editor." & vbCrLf & _
        Err.Description, vbOKOnly Or vbExclamation, _
        "Error"
    Exit Sub
End Sub

Private Sub CmdButtonImportCode_Click()
    TextBoxTemplateCode.Text = TextBox1.Text
    TextBoxTemplateCode.SelStart = TextBox1.SelStart
    TextBoxTemplateCode.SetFocus
End Sub

Private Sub CmdButtonLoadTemplate_Click()
    If TextBoxTemplateCode.Text = "" Then
        MsgBox "Please select a template to be loaded"
    Else
        TextBox1.Text = TextBoxTemplateCode.Text
        TextBox1.SelStart = TextBoxTemplateCode.SelStart
        MultiPage1.Value = 0
        Call ToggleInputMode
    End If
End Sub

Private Sub CmdButtonRemoveTemplate_Click()
    Dim RemovedIndex As Long
    RemovedIndex = ComboBoxTemplate.ListIndex
    If ComboBoxTemplate.ListCount > 1 Then
        ' We should also be deleting the registry entry, but well, it does not take much space and will likely get reused anyway
        ComboBoxTemplate.RemoveItem RemovedIndex
        
        ' update the array that contains the sorted list of template IDs
        tmpID = TemplateSortedList(RemovedIndex)
        Dim i As Long
        For i = RemovedIndex To UBound(TemplateSortedList) - 1
            TemplateSortedList(i) = TemplateSortedList(i + 1)
        Next i
        TemplateSortedList(UBound(TemplateSortedList)) = tmpID
        'NumberOfTemplates = NumberOfTemplates - 1
    Else
        ComboBoxTemplate.Clear
        ComboBoxTemplate.AddItem "New Template" 'prepare spot for new template
        ComboBoxTemplate.Text = ""
        'NumberOfTemplates = 1
    End If
    Call UpdateTemplateRegistry
    ComboBoxTemplate.ListIndex = RemovedIndex
    TextBoxTemplateCode.SetFocus
End Sub

Private Sub CmdButtonSaveTemplate_Click()
    ' get the right ID from the array of sorted template IDs
    templateID = TemplateSortedList(ComboBoxTemplate.ListIndex)
    ' add trailing new line if there isn't one: this helps with a bug where text with multi-byte characters gets chopped
    If Not Right(TextBoxTemplateCode.Text, 1) = Chr(13) And Not Right(TextBoxTemplateCode.Text, 1) = Chr(10) Then
        TextBoxTemplateCode.Text = TextBoxTemplateCode.Text & Chr(13)
    End If
    ' build the corresponding registry key string
    ' Save name, code, and LaTeXEngineID
    RegPath = "Software\IguanaTex"
    Dim RegStr As String
    RegStr = "TemplateCode" & templateID
    SetRegistryValue HKEY_CURRENT_USER, RegPath, RegStr, REG_SZ, CStr(TextBoxTemplateCode.Text)
    RegStr = "TemplateCodeSelStart" & templateID
    SetRegistryValue HKEY_CURRENT_USER, RegPath, RegStr, REG_DWORD, CLng(TextBoxTemplateCode.SelStart)
    RegStr = "TemplateLaTeXEngineID" & templateID
    SetRegistryValue HKEY_CURRENT_USER, RegPath, RegStr, REG_DWORD, ComboBoxLaTexEngine.ListIndex
    RegStr = "TemplateTempFolder" & templateID
    SetRegistryValue HKEY_CURRENT_USER, RegPath, RegStr, REG_SZ, CStr(TextBoxTempFolder.Text)
    ' if saved template was the "New Template", prepare new spot for next new template
    If ComboBoxTemplate.ListIndex = ComboBoxTemplate.ListCount - 1 Then
        ComboBoxTemplate.AddItem "New Template"
        'NumberOfTemplates = NumberOfTemplates + 1
        If ComboBoxTemplate.ListCount - 1 > UBound(TemplateSortedList) Then
            ReDim Preserve TemplateSortedList(0 To UBound(TemplateSortedList) + 1) As String
            TemplateSortedList(UBound(TemplateSortedList)) = CStr(ComboBoxTemplate.ListCount - 1)
        End If
    End If
    ComboBoxTemplate.List(ComboBoxTemplate.ListIndex) = TextBoxTemplateName.Text
    Call UpdateTemplateRegistry
    TextBoxTemplateCode.SetFocus
End Sub

Private Sub ComboBoxTemplate_Click()
    TextBoxTemplateName.Text = ComboBoxTemplate.Text
    ' Except for the empty "New Template" slot, get the code and LaTeXEngineID setting from registry
    If ComboBoxTemplate.ListIndex = ComboBoxTemplate.ListCount - 1 Then
        TextBoxTemplateCode.Text = ""
        ComboBoxLaTexEngine.ListIndex = GetRegistryValue(HKEY_CURRENT_USER, RegPath, "LaTeXEngineID", 0)
        TextBoxTempFolder.Text = GetTempPath()
    Else
        ' get the right ID from the array of sorted template IDs
        templateID = TemplateSortedList(ComboBoxTemplate.ListIndex)
        ' build the corresponding registry key string
        RegPath = "Software\IguanaTex"
        Dim RegStr As String
        RegStr = "TemplateCode" & templateID
        TextBoxTemplateCode.Text = GetRegistryValue(HKEY_CURRENT_USER, RegPath, RegStr, "")
        RegStr = "TemplateCodeSelStart" & templateID
        TextBoxTemplateCode.SelStart = GetRegistryValue(HKEY_CURRENT_USER, RegPath, RegStr, 0)
        RegStr = "TemplateLaTeXEngineID" & templateID
        ComboBoxLaTexEngine.ListIndex = GetRegistryValue(HKEY_CURRENT_USER, RegPath, RegStr, GetRegistryValue(HKEY_CURRENT_USER, RegPath, "LaTeXEngineID", 0))
        RegStr = "TemplateTempFolder" & templateID
        TextBoxTempFolder.Text = GetRegistryValue(HKEY_CURRENT_USER, RegPath, RegStr, GetTempPath())
    End If
    TextBoxTemplateCode.SetFocus
End Sub

Private Sub UpdateTemplateRegistry()
    ' update the list of saved templates names in the registry (will be used to initialize combo box content)
    TemplateSortedListString = PackArrayToString(TemplateSortedList)
    SetRegistryValue HKEY_CURRENT_USER, RegPath, "TemplateSortedList", REG_SZ, CStr(TemplateSortedListString)
    ' save the number of templates in registry
    'SetRegistryValue HKEY_CURRENT_USER, RegPath, "NumberOfTemplates", REG_DWORD, CLng(NumberOfTemplates)
    ' save list of template names to registry
    Dim myArray() As String
    ReDim myArray(0 To ComboBoxTemplate.ListCount - 1) As String
    Dim i As Long
    For i = LBound(myArray) To UBound(myArray)
        myArray(i) = ComboBoxTemplate.List(i)
    Next i
    TemplateNameSortedListString = PackArrayToString(myArray)
    SetRegistryValue HKEY_CURRENT_USER, RegPath, "TemplateNameSortedList", REG_SZ, CStr(TemplateNameSortedListString)
End Sub

Private Sub CmdButtonTemplateFontDown_Click()
    If TextBoxTemplateCode.Font.Size > 4 Then
        TextBoxTemplateCode.Font.Size = TextBoxTemplateCode.Font.Size - 1
    End If
End Sub

Private Sub CmdButtonTemplateFontUp_Click()
    If TextBoxTemplateCode.Font.Size < 72 Then
        TextBoxTemplateCode.Font.Size = TextBoxTemplateCode.Font.Size + 1
    End If
End Sub

Private Sub CmdButtonEditorFontDown_Click()
    If TextBox1.Font.Size > 4 Then
        TextBox1.Font.Size = TextBox1.Font.Size - 1
    End If
End Sub

…
vbaProject_00.bin vba-project OOXML VBA project: ppt/vbaProject.bin 513024 bytes
SHA-256: 596e0fd02b9faee2026267e6bc2eade19473b16698489804dd23ecdc04196f9a