MALICIOUS
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_VBADocument contains a VBA project — VBA macros present
-
Potential Shell call in VBA critical OLE_VBA_SHELLPotential Shell call in VBAMatched line in script
On Error GoTo ShellError Shell """" & GetEditorPath() & """ """ & TempPath & FilePrefix & ".tex""", vbNormalFocus -
CreateObject call high OLE_VBA_CREATEOBJCreateObject callMatched 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_CMDcmd.exe reference in VBAMatched 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_AUTOAuto_Open macroMatched line in script
Sub Auto_Open() ' Runs when the add-in is loaded -
Auto_Close macro low OLE_VBA_AUTOCLOSEAuto_Close macroMatched line in script
Sub Auto_Close() LatexForm.UnInitializeApp -
Embedded URL info EMBEDDED_URLOne 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.
| Filename | Kind | Source | Size |
|---|---|---|---|
macros.bas |
vba-macro | oletools.olevba.extract_macros (decoded VBA source from OOXML) | 100232 bytes |
SHA-256: 2a2494493fc0cb321176f113f35ad3aa37ef97688a91e7d3fcd4fc2eb6a4c980 |
|||
Preview scriptFirst 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 |
|||
Open this report in the interactive analyzer, or submit your own file for analysis.