Malicious Office (OOXML) — malware analysis report

Static analysis result for SHA-256 205bad51f2a98f98…

MALICIOUS

Office (OOXML)

1.20 MB First seen: 2015-02-05
MD5: d1fd22e4219b9874f6c5ffd84b8d63c0 SHA-1: ede79d0e320dd75cc0c42914592489c288092b55 SHA-256: 205bad51f2a98f984112a989c43c996dff6a632eab212d30c20240691305ed47
588 Risk Score

Malware Insights

MITRE ATT&CK
T1059.005 Visual Basic T1105 Ingress Tool Transfer

The sample is a malicious Office document containing VBA macros. Critical heuristics indicate the use of WScript.Shell, URLDownloadToFile, and an obfuscated auto-exec loader designed to download and execute a second-stage payload. The VBA script itself contains API calls for timer manipulation and path retrieval, suggesting complex execution logic. The ClamAV detection 'Doc.Dropper.Generic-6834355-0' further confirms its malicious nature as a dropper.

Heuristics 14

  • ClamAV: Doc.Dropper.Generic-6834355-0 critical CLAMAV_DETECTION
    ClamAV detected this file as malware: Doc.Dropper.Generic-6834355-0
  • VBA project inside OOXML medium 10 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
        tempInternetFolder = getRegUserString("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders\Cache")
  • WScript.Shell usage critical OLE_VBA_WSCRIPT
    WScript.Shell usage
    Matched line in script
        Set wsh = CreateObject("WScript.Shell")
  • URLDownloadToFile in VBA critical OLE_VBA_DOWNLOAD
    URLDownloadToFile in VBA
    Matched line in script
    Public Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
  • VBA property-stored shellcode loader critical OLE_VBA_PROPERTY_SHELLCODE_LOADER
    VBA auto-exec macro takes the address (VarPtr) of a byte buffer decoded from a document property, marks memory executable (VirtualProtect/VirtualAlloc), and transfers control through a callback API (e.g. SetTimer/EnumWindows). The payload is hidden in the document properties rather than the macro source — the SVCReady loader pattern, a native shellcode runner rather than a parser CVE.
    Matched line in script
    Public Declare PtrSafe Function SetTimer Lib "user32" (ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
  • Obfuscated auto-exec VBA loader critical OLE_VBA_OBFUSCATED_AUTOEXEC_LOADER
    Auto-exec VBA reconstructs strings with a heavy custom decoder (numeric char-array, repeated hex-string decode, or junk-token Replace removal) and feeds them to a COM-instantiation or execution sink. This obfuscated-loader shape keeps CreateObject/Shell/URL indicators out of the macro source.
    Matched line in script
            Set fso = CreateObject("Scripting.FileSystemObject")
  • CreateObject call high OLE_VBA_CREATEOBJ
    CreateObject call
    Matched line in script
            Set fso = CreateObject("Scripting.FileSystemObject")
  • VBA p-code auto-exec with execution tokens high OLE_VBA_PCODE_AUTOEXEC_EXEC
    Compiled VBA/cache stream contains an auto-execution token together with shell/download/object-execution tokens. This catches p-code-only or source-extraction-failure macro documents where visible source is unavailable.
  • AutoOpen macro low OLE_VBA_AUTOOPEN
    AutoOpen macro
    Matched line in script
    Attribute VB_Name = "AutoOpen"
  • Auto_Open macro low OLE_VBA_AUTO
    Auto_Open macro
    Matched line in script
    Sub Auto_Open()
  • Auto_Close macro low OLE_VBA_AUTOCLOSE
    Auto_Close macro
    Matched line in script
    Sub Auto_Close()
  • Suspicious extracted artifact high EXTRACTED_FILE_STATIC_TRIAGE
    One or more files extracted from inside this sample matched static suspicious-content checks such as script obfuscation, encoded payload blobs, packed data, or execution/download terms.
  • 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://Motobit.cz Referenced by macro
    • http://www.qtm.net/~davidcReferenced by macro
    • http://www.wotsit.orgReferenced by macro
    • http://www.frez.co.ukReferenced by macro
    • http://qvidian.com/communityReferenced by macro
    • http://localhost/Qvidian/Qvidian.asmxReferenced by macro
    • http://qvidian.com/webservices/Referenced by macro
    • http://qvidian.com/communityAReferenced by macro
    • http://�qvidian��Referenced by macro
    • http://localhost/Qvidian/Qvidian.asmx�Referenced by macro
    • http://qvidian.com/webservices/�������Referenced by macro
    • http://schemas.microsoft.com/office/2006/01/customuiReferenced by macro
    • http://www.w3.org/2001/XMLSchemaReferenced by macro
    • http://www.w3.org/2001/XMLSchema-instanceReferenced by macro
    • http://schemas.xmlsoap.org/soap/envelope/Referenced by macro

Extracted artifacts 2

Files carved from inside the sample during analysis.

FilenameKindSourceSize
macros.bas🔏 SignedVBA project digital signature
Covers VBA source only — not the compiled p-code. A digital signature does not by itself mean the macro is safe.		 vba-macro oletools.olevba.extract_macros (decoded VBA source from OOXML) 705593 bytes
SHA-256: 6f82ec7fa7965995ddd96d09a434149a3c670fa65be01ac354815565e69afdaf
Detection
ClamAV: No threats found
Obfuscation or payload: likely
Carved artifact contains 2 eval/decoder/string-building token(s).
Preview script
First 1,000 lines of the extracted script
Attribute VB_Name = "modTools"
Option Explicit

#If Win64 Then
Private Declare PtrSafe Function GetLongPathName Lib "kernel32" Alias _
    "GetLongPathNameA" (ByVal lpszShortPath As String, _
    ByVal lpszLongPath As String, ByVal cchBuffer As Long) As Long
Public Declare PtrSafe Function GetActiveWindow Lib "user32" () As LongPtr
Public Declare PtrSafe Function SetTimer Lib "user32" (ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
Public Declare PtrSafe Function KillTimer Lib "user32" (ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr) As Long

Public TimerID As LongPtr
#Else
Private Declare Function GetLongPathName Lib "kernel32" Alias _
    "GetLongPathNameA" (ByVal lpszShortPath As String, _
    ByVal lpszLongPath As String, ByVal cchBuffer As Long) As Long
Public Declare Function GetActiveWindow Lib "user32" () As Long
Public Declare Function SetTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Public Declare Function KillTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long

Public TimerID As Long
#End If
Public SubmitFileID As String
Public TimerCounter As Long

Public Function GetLongPath(ByVal shortPath As String) As String
    Dim buffer As String
    Dim size As Integer
   
    buffer = Space(256)
    size = GetLongPathName(shortPath, buffer, Len(buffer))
    GetLongPath = Left(Trim(buffer), size)
End Function

Public Sub InitiateBuild()
    Set buildDocument = ActivePresentation
    RunBuild
End Sub

Public Function GetSlideID() As String
    GetSlideID = CStr(ActiveWindow.View.Slide.slideIndex)
End Function

Public Function GetShapeID() As String
    Dim bFound As Boolean
    Dim oSlide As Slide
    Dim oShape As Shape
    Dim iFoundCount As Integer
    iFoundCount = 0
    bFound = False
    If Not Application.ActiveWindow.Selection Is Nothing Then
        If Application.ActiveWindow.Selection.Type = 3 Then 'PpSelectionType.ppSelectionText
            If Left(Application.ActiveWindow.Selection.ShapeRange.Name, 5) <> "SANT_" Then
                Application.ActiveWindow.Selection.ShapeRange.Name = "SANT_" & 1 & "_" & CDbl(Now())
            Else
                'Check if any other shapes in this presentation have the same name.
                For Each oSlide In Application.ActiveWindow.Presentation.Slides
                    For Each oShape In oSlide.Shapes
                        If oShape.Name = Application.ActiveWindow.Selection.ShapeRange.Name Then
                            iFoundCount = iFoundCount + 1
                        End If
                    Next oShape
                Next oSlide
                If iFoundCount > 1 Then
                    'More than one shape has this same name, rename it.
                    Application.ActiveWindow.Selection.ShapeRange.Name = "SANT_" & 1 & "_" & CDbl(Now())
                End If
            End If
            GetShapeID = Application.ActiveWindow.Selection.ShapeRange.Name
            bFound = True
        End If
    End If
    
    If Not bFound Then
        MsgBox "You must select a text shape to assign a source."
    End If
End Function


Public Function GetShapeIDString(ByRef thisDoc As Presentation) As String
    On Error GoTo ErrorHandler
    Dim oSlide As Slide
    Dim oShape As Shape
    Dim sNames() As String
    
    Dim shpCnt As Integer
    shpCnt = 0
    
    For Each oSlide In thisDoc.Slides
        For Each oShape In oSlide.Shapes
            If Left(oShape.Name, 5) = "SANT_" Then
                shpCnt = shpCnt + 1
                If shpCnt > 1 Then
                    ReDim Preserve sNames(UBound(sNames) + 1)
                Else
                    ReDim Preserve sNames(0)
                End If
                sNames(UBound(sNames)) = "'" & oShape.Name & "'"
            End If
        Next oShape
    Next oSlide
    
    GetShapeIDString = Join(sNames, ", ")
    
    Exit Function
    
    
ErrorHandler:
    GetShapeIDString = ""
End Function

Public Function GetSubSectionID(ByRef thisDoc As Presentation) As Long
    On Error GoTo ErrorHandler
    GetSubSectionID = CLng(modDocProperties.GetPropertyText("SubSectionID", thisDoc))
    Exit Function
ErrorHandler:
    GetSubSectionID = -1
End Function

Public Function GetMiscFileID(ByRef thisDoc As Presentation) As String
    On Error GoTo ErrorHandler
    GetMiscFileID = modDocProperties.GetPropertyText("MiscFileID", thisDoc)
    Exit Function
ErrorHandler:
    GetMiscFileID = ""
End Function

Public Function GetContentID(ByRef thisDoc As Presentation) As String
    On Error GoTo ErrorHandler
    GetContentID = modDocProperties.GetPropertyText("ContentID", thisDoc)
    Exit Function
ErrorHandler:
    GetContentID = ""
End Function

Public Function GetContentIDs(ByRef thisDoc As Presentation) As String
    On Error GoTo ErrorHandler
    Dim ContentIDList As String
    'Dim bk As Bookmark
    'For Each bk In thisDoc.Bookmarks
    '    If InStr(1, bk.Name, "ContentExport_") > 0 Then
    '        If ContentIDList = "" Then
    '            ContentIDList = Replace(bk.Name, "ContentExport_", "")
    '        Else
    '            ContentIDList = ContentIDList & "," & Replace(bk.Name, "ContentExport_", "")
    '        End If
    '    End If
    'Next bk
    GetContentIDs = ContentIDList
    Exit Function
ErrorHandler:
    GetContentIDs = ""
End Function

Public Function GetSearchText() As String
    'If ActiveWindow.Selection.Start = ActiveWindow.Selection.End Then
    '    Dim bm As Bookmark
    '    Set bm = modTools.GetCurrentSantBookmark(ActivePresentation, ActiveWindow)
    '    If TypeName(bm) <> "Nothing" Then
    '        SelectTextOfBookmark bm
    '    ElseIf Selection.Information(wdWithInTable) Then
    '        ActiveWindow.Selection.Expand wdRow
    '    Else
    '        ActiveWindow.Selection.Expand wdParagraph
    '    End If
    'End If
    'GetSearchText = ActiveWindow.Selection.Text
    GetSearchText = "Hello ducky"
End Function

Public Function GetTemplateMode(ByRef thisDoc As Presentation) As String
    GetTemplateMode = GetPropertyText("SantTemplateMode", thisDoc)
End Function


Public Sub CopyAndClose(ByVal sCopyCloseMode As String)
    
    On Error GoTo ErrorHandler
    
    ActiveWindow.Activate
    ActiveWindow.Presentation.Slides.Range.Copy

    Select Case sCopyCloseMode
        Case "SantCopyAndOpen"
            MsgBox "Your content has been placed on the Office clipboard. When finished using clipboard content, please close this PowerPoint session."
            ActiveWindow.Presentation.Saved = True
        
        Case Else
            MsgBox "Your content has been placed on the Windows clipboard."
            CloseDoc
    End Select
    
    Exit Sub

ErrorHandler:
    If Err.Number = 58 Then 'File already exists
        MsgBox "The " & Chr(34) & "Save to Clipboard" & Chr(34) & " operation failed." & vbCrLf & vbCrLf & _
                "Download the PowerPoint file and perform a copy and paste operation to complete action.", , AppTitle
    Else
'        MsgBox Err.Number & ": " & Err.description
    End If
    
    Exit Sub
End Sub

'Called from page, which displays its own message and closes PowerPoint.
Public Function CopyExternal() As Boolean
    On Error GoTo EH
    
    ActiveWindow.Presentation.Slides.Range.Copy
    
    CopyExternal = True
    
    Exit Function

EH:
    If Err.Number = 58 Then 'File already exists
        MsgBox "The " & Chr(34) & "Save to Clipboard" & Chr(34) & " operation failed." & vbCrLf & vbCrLf & _
                "Download the PowerPoint file and perform a copy and paste operation to complete action.", , AppTitle
        CopyExternal = False
    Else
'        MsgBox Err.Number & ": " & Err.description
    End If
End Function

Public Sub ShowWaitForm()
    frmWait.Show
End Sub

Public Sub HideWaitForm()
    On Error Resume Next
    Unload frmWait
End Sub

Public Function GetFileSystemObject() As Object
    If TypeName(fso) = "Nothing" Then
        Set fso = CreateObject("Scripting.FileSystemObject")
    End If
    Set GetFileSystemObject = fso
End Function

Public Function ShowFinishedForm()

   frmFinished.Show

End Function


Public Sub GraphicEditReplace(FindString As String, ReplaceFile As String)
   Dim oSld As Slide

   With ActivePresentation

   On Error Resume Next
'   Debug.Print "GraphicEditReplace. FindString='" & FindString & "'"
'   Debug.Print "GraphicEditReplace. ReplaceFile='" & ReplaceFile & "'"

   If FileExists(ReplaceFile) Then
        For Each oSld In .Slides
           ReplaceInShaped oSld.Shapes, FindString, ReplaceFile
        Next oSld
        If .SlideMaster Is Not Null Then
            ReplaceInShaped .SlideMaster.Shapes, FindString, ReplaceFile
        End If
        If .HasTitleMaster Then
            ReplaceInShaped .TitleMaster.Shapes, FindString, ReplaceFile
        End If
        If .HandoutMaster Is Not Null Then
            ReplaceInShaped .HandoutMaster.Shapes, FindString, ReplaceFile
        End If
        If .NotesMaster Is Not Null Then
            ReplaceInShaped .NotesMaster.Shapes, FindString, ReplaceFile
        End If
   End If

   End With

   EditReplace FindString, "", "text"

'   Debug.Print "GraphicEditReplace. Out."
End Sub

Public Sub ReplaceInShaped(shapeCollection As Shapes, FindString As String, ReplaceFile As String)
    Dim oShp As Shape
    Dim oTxtRng As TextRange
    
    For Each oShp In shapeCollection
       If oShp.HasTextFrame Then
          If oShp.TextFrame.HasText Then
              Set oTxtRng = oShp.TextFrame.TextRange
              If InStr(oTxtRng.Text, FindString) > 0 Then
                  shapeCollection.AddPicture ReplaceFile, msoFalse, msoCTrue, oShp.Left, oShp.Top
                  
                  oShp.Delete
              Else
                  'just ignore edit replaces that are mixed with other text here...we clear them out with the EditReplace call
                  'at the end of the function.

                  'we might want to warn about this, but for now, just ignore.
'                         Debug.Print "GraphicEditReplace. Ignoring..."
              End If

          End If
       End If
    Next oShp
End Sub

Public Function ReplaceTextInRange(oTxtRng As TextRange, FindString As String, ReplaceString As String) As Boolean
    Dim oTmpRng As TextRange
    
    ReplaceTextInRange = False
    
    Set oTmpRng = oTxtRng.Replace(FindWhat:=FindString, _
               Replacewhat:=ReplaceString, WholeWords:=False)
    Do While Not oTmpRng Is Nothing
        ReplaceTextInRange = True
        
        If oTmpRng.Start + oTmpRng.Length >= oTxtRng.Length Then
          Exit Do
        End If

        Set oTmpRng = oTxtRng.Replace(FindWhat:=FindString, _
                                   Replacewhat:=ReplaceString, _
                                   after:=oTmpRng.Start + oTmpRng.Length, _
                                   WholeWords:=False)
    Loop
End Function


Public Function DoER(oSld As Slide, FindString As String, ReplaceString As String, DataType As String) As Boolean
    Dim oShp As Shape
    Dim bReplaced As Boolean
    
    bReplaced = False

    For Each oShp In oSld.Shapes
        bReplaced = bReplaced Or ReplaceInShape(oShp, FindString, ReplaceString)
    Next oShp
    
    DoER = bReplaced
    
End Function

Public Function ReplaceInShape(ByRef oShp As Shape, sFind As String, sReplace As String) As Boolean
    Dim oTxtRng As TextRange
    Dim oTmpRng As TextRange
    Dim iRow As Integer
    Dim iCol As Integer
    Dim bReplaced As Boolean
    
    bReplaced = False
    
    If oShp.HasTextFrame Then
        ' replace in TextFrame
        Set oTxtRng = oShp.TextFrame.TextRange
        bReplaced = bReplaced Or ReplaceTextInRange(oTxtRng, sFind, sReplace)
    
    ElseIf oShp.HasTable Then
        'replace in table
         For iRow = 1 To oShp.Table.Rows.count
            For iCol = 1 To oShp.Table.Columns.count
               Set oTxtRng = oShp.Table.Cell(iRow, iCol).Shape.TextFrame.TextRange
               bReplaced = bReplaced Or ReplaceTextInRange(oTxtRng, sFind, sReplace)
            Next
        Next
    
    Else
        'replace in group/diagram/smartart
        '2003
        'If oShp.HasDiagram Or oShp.Type = 6 Then
        
        '2007 uses the type 24 for smart art shapes and type 6 for grouped shapes
        If oShp.Type = 6 Or oShp.Type = 24 Then
            Dim grpie As Shape
            For Each grpie In oShp.GroupItems
                bReplaced = bReplaced Or ReplaceInShape(grpie, sFind, sReplace)
            Next
        End If
    End If
    
    ReplaceInShape = bReplaced
End Function


Public Function DoMasterER(FindString As String, ReplaceString As String, DataType As String) As Boolean
   Dim oShp As Shape
   Dim oTxtRng As TextRange
   Dim oTmpRng As TextRange
   Dim iRow As Integer
   Dim iCol As Integer
          
    Dim bReplaced As Boolean
    
    bReplaced = False
          
    Dim oDesign As Design
    Dim oLayout As CustomLayout
    
    '10/28/11 DS: this code will replace in all master slides/custom layouts.
    For Each oDesign In ActivePresentation.Designs
        bReplaced = bReplaced Or ReplaceShapes(oDesign.SlideMaster.Shapes, FindString, ReplaceString)
        
        For Each oLayout In oDesign.SlideMaster.CustomLayouts
            bReplaced = bReplaced Or ReplaceShapes(oLayout.Shapes, FindString, ReplaceString)
        Next
    Next
              
    DoMasterER = bReplaced
    
End Function

'Takes a shape list from any source and performs a find/replace within all shapes.
Public Function ReplaceShapes(shapeList As Shapes, FindString As String, ReplaceString As String) As Boolean
    Dim oShp As Shape
    Dim bReplaced As Boolean
    
    bReplaced = False
                         
    For Each oShp In shapeList
        bReplaced = bReplaced Or ReplaceInShape(oShp, FindString, ReplaceString)
    Next oShp
    
    ReplaceShapes = bReplaced

End Function


' Returns True if at least one instance of FindString was found and replaced
Public Function EditReplace(FindString As String, ReplaceString As String, DataType As String) As Boolean

    Dim oSld As Slide
    EditReplace = False
    
    On Error Resume Next

    If Len(ReplaceString) > 0 Then
        With ActivePresentation
             For Each oSld In .Slides
                 EditReplace = EditReplace Or DoER(oSld, FindString, ReplaceString, DataType)
             Next oSld
             EditReplace = EditReplace Or DoMasterER(FindString, ReplaceString, DataType)
        End With
    End If

End Function


Public Sub DoGalleryEditReplaces()
    Const CODE_START = "<<GALLERY: "
    Dim sFullCode As String
    Dim sGUID As String
    Dim sContentFile As String
    Dim contentID As String
    Dim nRevision As Integer
    Dim extIdx As Integer

    Dim oSld As Slide
    Dim oShp As Shape
    Dim oTxtRng As TextRange
    Dim iRow As Integer
    Dim iCol As Integer
       
    For Each oSld In buildDocument.Slides
        For Each oShp In oSld.Shapes
            If oShp.HasTextFrame Then
                If oShp.TextFrame.HasText Then
                    Set oTxtRng = oShp.TextFrame.TextRange
                    If InStr(oTxtRng.Text, CODE_START) > 0 Then
                        sFullCode = GetFullGalleryCode(oTxtRng.Text, sGUID)
                        'get local file name (including content ID) - force download of gallery items
                        'get local file name (including content ID)
                        sContentFile = dh.GetContentFileByGUID(sGUID)
                        DebugMsgBox "sContentFile [" & sContentFile & "]", "DoGalleryEditReplaces:"
                        
                        ' We need to split out the content file and revision
                        extIdx = InStr(1, sContentFile, "|")
                        DebugMsgBox "extIdx [" & extIdx & "]", "DoGalleryEditReplaces:"
                        If extIdx > 0 Then
                            contentID = Left(sContentFile, extIdx - 1)
                            nRevision = CInt(Mid(sContentFile, extIdx + 1))
                        Else
                            contentID = sContentFile
                            nRevision = -1
                        End If
                        DebugMsgBox "contentID [" & contentID & "] and nRevision [" & nRevision & "]", "DoGalleryEditReplaces:"
                        sContentFile = dlContent(contentID, nRevision, True)
                        
                        Select Case LCase(GetFileInfo(contentID, "extension"))
                            Case "gif", "bmp", "jpg", "jpeg", "wmf", "tif", "png" 'graphic
                                ReplaceInShaped oSld.Shapes, sFullCode, sContentFile
                            
                            Case "ppt", "pptx"
                                'ReplaceTextInRange oTxtRng, sFullCode, GetContentFromFile(sContentFile)
                                'oShp.TextFrame.DeleteText
                                CopyContentFromFileToShape sContentFile, oShp, 0, sFullCode
                                                                                    
                            Case Else
                        
                        End Select
                    End If
                End If
            ElseIf oShp.HasTable Then
                For iRow = 1 To oShp.Table.Rows.count
                    For iCol = 1 To oShp.Table.Columns.count
                    
                        Set oTxtRng = oShp.Table.Cell(iRow, iCol).Shape.TextFrame.TextRange
                        If InStr(oTxtRng.Text, CODE_START) > 0 Then
                            sFullCode = GetFullGalleryCode(oTxtRng.Text, sGUID)
                            'get local file name (including content ID)
                            sContentFile = dh.GetContentFileByGUID(sGUID)
                            DebugMsgBox "sContentFile [" & sContentFile & "]", "DoGalleryEditReplaces:"
                            
                            ' We need to split out the content file and revision
                            extIdx = InStr(1, sContentFile, "|")
                            DebugMsgBox "extIdx [" & extIdx & "]", "DoGalleryEditReplaces:"
                            If extIdx > 0 Then
                                contentID = Left(sContentFile, extIdx - 1)
                                nRevision = CInt(Mid(sContentFile, extIdx + 1))
                            Else
                                contentID = sContentFile
                                nRevision = -1
                            End If
                            DebugMsgBox "contentID [" & contentID & "] and nRevision [" & nRevision & "]", "DoGalleryEditReplaces:"
                            sContentFile = dlContent(contentID, nRevision, True)
                            
                            Select Case LCase(GetFileInfo(contentID, "extension"))
                                Case "gif", "bmp", "jpg", "jpeg", "wmf", "tif", "png" 'graphic
                                    'can't do graphic edit replaces within a table, so skip
                                
                                Case "ppt", "pptx"
                                'ReplaceTextInRange oTxtRng, sFullCode, GetContentFromFile(sContentFile)
                                'oShp.TextFrame.DeleteText
                                CopyContentFromFileToShape sContentFile, oShp, 0, sFullCode
                                                                                        
                                Case Else
                            
                            End Select
                        End If
                    Next
                Next
            End If
        Next oShp
    Next oSld

End Sub

Public Function GetContentFromFile(sFile As String) As String
    Dim SourcePres As Presentation
    Dim oShp As Shape
    Dim oTxtRng As TextRange
    
    Set SourcePres = Application.Presentations.Open(sFile)
    
    For Each oShp In SourcePres.Slides(1).Shapes
        If oShp.TextFrame.HasText Then
            Set oTxtRng = oShp.TextFrame.TextRange
            
            GetContentFromFile = oTxtRng.Text
                        
            Exit For
        End If
    Next

    SourcePres.Close
End Function

Public Function GetFullGalleryCode(ByVal sText As String, ByRef GUID As String) As String
    Dim sERCode As String
    Dim sRestOfTag As String
    Dim lFoundPos As Long
    
    lFoundPos = InStr(1, sText, "<<GALLERY: ")

    If lFoundPos > 0 Then

        sText = Right(sText, Len(sText) - lFoundPos - 10) 'trim off up to found portion

        lFoundPos = InStr(1, sText, " -")

        GUID = Left(sText, lFoundPos - 1)

        sText = Right(sText, Len(sText) - lFoundPos - 1)

        lFoundPos = InStr(1, sText, ">>")

        sRestOfTag = Left(sText, lFoundPos - 1)

        sText = Right(sText, Len(sText) - lFoundPos - 1)

        sERCode = "<<GALLERY: " & GUID & " -" & sRestOfTag & ">>"
    End If

    GetFullGalleryCode = sERCode

End Function


'
'DS I don't think this is still used in 9.0 - was called from browser to find/replace
'
'Public Function FindReplace()
'    'findString As String, ReplaceString As String, bMatchCase As Boolean, bWholeWords As Boolean
'
'   Dim oSld As Slide
'   Dim oShp As Shape
'   Dim oTxtRng As TextRange
'   Dim oTmpRng As TextRange
'   Dim iRow As Integer
'   Dim icol As Integer
'
'    Dim FindString As String
'    Dim ReplaceString As String
'    Dim bMatchCase As Boolean
'    Dim bWholeWords As Boolean
'
'    FindString = CallingPage.GetTextToFind
'    ReplaceString = CallingPage.GetTextToReplace
'    bMatchCase = CallingPage.GetMatchCase
'    bWholeWords = CallingPage.GetWholeWord
'
'   On Error Resume Next
'
'   With ActivePresentation
'
'   For Each oSld In .Slides
'      For Each oShp In oSld.Shapes
'         If oShp.HasTextFrame Then
'            If oShp.TextFrame.HasText Then
'               ' One needs to locate the text as well as iterate
'               ' for multiple instances of the text
'                Set oTxtRng = oShp.TextFrame.TextRange
'                Set oTmpRng = oTxtRng.Replace(FindWhat:=FindString, _
'                Replacewhat:=ReplaceString, MatchCase:=bMatchCase, wholeWords:=bWholeWords)
'                Do While Not oTmpRng Is Nothing
'                   If oTmpRng.Start + oTmpRng.length >= oTxtRng.length Then
'                     Exit Do
'                   End If
'
'                   Set oTmpRng = oTxtRng.Replace(FindWhat:=FindString, _
'                                              Replacewhat:=ReplaceString, _
'                                              After:=oTmpRng.Start + oTmpRng.length, _
'                                              wholeWords:=bWholeWords, _
'                                              MatchCase:=bMatchCase)
'                Loop
'
'            End If
'          ElseIf oShp.HasTable Then
'             For iRow = 1 To oShp.Table.Rows.count
'                 For icol = 1 To oShp.Table.Columns.count
'
'                    Set oTxtRng = oShp.Table.Cell(iRow, icol).Shape.TextFrame.TextRange
'                    Set oTmpRng = oTxtRng.Replace(FindWhat:=FindString, _
'                    Replacewhat:=ReplaceString, MatchCase:=bMatchCase, wholeWords:=bWholeWords)
'                    Do While Not oTmpRng Is Nothing
'                       If oTmpRng.Start + oTmpRng.length >= oTxtRng.length Then
'                         Exit Do
'                       End If
'
'                    Set oTmpRng = oTxtRng.Replace(FindWhat:=FindString, _
'                                              Replacewhat:=ReplaceString, _
'                                              After:=oTmpRng.Start + oTmpRng.length, _
'                                              wholeWords:=bWholeWords, _
'                                              MatchCase:=bMatchCase)
'                    Loop
'                 Next
'             Next
'         End If
'      Next oShp
'   Next oSld
'
'   End With
'
'End Function

Public Sub OpenFile(thisFile As String)
    Set buildDocument = Application.Presentations.Open(thisFile)
End Sub

Public Sub BringShellToFront(ThisHandle As Long)
    SetForegroundWindow ThisHandle
End Sub

Public Sub KillAssistant()
    On Error Resume Next
    DoEvents
    Assistant.visible = False
End Sub

'Public Sub StoreAssistantStatus()
'    On Error Resume Next
'    DoEvents
'    Registry.PutRegVal_String REG_KEY & "\Settings\Template", "AssistantVisible", CStr(Assistant.Visible)
'End Sub

'Public Sub ReturnAssistantDefaultStatus()
'    On Error Resume Next
'    DoEvents
'    Assistant.Visible = CBool(Registry.GetRegVal_String(REG_KEY & "\Settings\Template", "AssistantVisible"))
'End Sub

'-------------------------------------------------------------------------------------------------
'  PURPOSE: To return information about a file string
'  INPUT:   A file name/path as a string; an optional string specificing the information requested
'           Valid requests are: The path of the string: "Path" (default)
'           The name of the file without the path: "Name"
'           The extention of the file: "Extention"
'           The drive letter of the file: "Drive"
'  RETURN:  A string (an empty string if request was not found)
'-------------------------------------------------------------------------------------------------
Public Function GetFileInfo(ByVal PathAndName As String, Optional InfoType As String = "Path", _
                         Optional OtherOptions As String = "") As String

    Const PathSep As String = "\"
    Dim CurPos As Long, LastPos As Long
    Dim TempString As String

    On Error GoTo ErrorHandler

    '----------------------------------------------------------------------------------------------
    '
    '----------------------------------------------------------------------------------------------
    Select Case format(InfoType, "<")
        Case "path", "name"
            LastPos = 1
            CurPos = InStr(LastPos, PathAndName, PathSep)
            Do While True
                CurPos = InStr(LastPos, PathAndName, PathSep)
                If CurPos > 0 Then
                    LastPos = CurPos + 1
                Else
                    Exit Do
                End If
            Loop
            If format(InfoType, "<") = "path" Then
                If LastPos = 1 Then
                    GetFileInfo = ""
                Else
                    GetFileInfo = Mid(PathAndName, 1, (LastPos - 2))
                End If
            Else
                Select Case format(OtherOptions, "<")
                    Case "no extension"
                        TempString = Mid(PathAndName, LastPos, Len(PathAndName) - (LastPos - 1))
                        'CurPos = InStr(1, TempString, ".")
                        CurPos = RevInstr(PathAndName, ".")
                        If CurPos = 0 Then
                            GetFileInfo = TempString
                        Else
                            GetFileInfo = Mid(TempString, 1, CurPos - 1)
                        End If
                    Case Else
                        GetFileInfo = Mid(PathAndName, LastPos, Len(PathAndName) - (LastPos - 1))
                End Select
            End If
        Case "extension"
            'CurPos = InStr(1, PathAndName, ".")
            CurPos = RevInstr(PathAndName, ".")
            If CurPos = 0 Then
                GetFileInfo = ""
            Else
                GetFileInfo = Mid(PathAndName, CurPos + 1, Len(PathAndName) - (CurPos))
            End If
        Case "drive"
            CurPos = InStr(1, PathAndName, ":")
            If CurPos = 0 Then
                GetFileInfo = ""
            Else
                GetFileInfo = Mid(PathAndName, CurPos - 1, 1)
            End If
        Case Else
            GetFileInfo = ""
    End Select
    Exit Function
ErrorHandler:
'    ErrorLog.LogError AppName, ComponentName, "clsTools", "GetFileInfo", Err.Number & " " & Err.Description

End Function

'JSB: Evaluate difference between this and InStrRev
Public Function RevInstr(strSource As String, strSubString As String)
    Dim i As Integer
    Dim intLen As Integer
    On Error GoTo ErrorHandler

    intLen = Len(strSource)

    For i = intLen To 1 Step -Len(strSubString)
        If Mid$(strSource, i, Len(strSubString)) = strSubString Then
            RevInstr = i
            Exit Function
        End If
    Next

    Exit Function

ErrorHandler:
'    ErrorLog.LogError AppName, ComponentName, "clsTools", "RevInstr", Err.Number & " " & Err.Description
    RevInstr = strSource

End Function

'-------------------------------------------------------------------------------------------------
'  PURPOSE: Determines if a single path or file exists within a given path
'    INPUT: Path: The path to check
'           Attr: Attributes which must be present in order to verify
'   RETURN: Long: 1=Found/0=Missing
'-------------------------------------------------------------------------------------------------
Public Function PathExists(path As String, Optional Attr As Long = vbDirectory) As Boolean
    On Error GoTo ErrorHandler

    If Len(path) Then
        If Len(Dir(path, Attr)) Then
            PathExists = True
        Else
            PathExists = False
        End If
    Else
        PathExists = False
    End If

    Exit Function
ErrorHandler:
'    ErrorLog.LogError AppName, ComponentName, "clsTools", "PathExists", Err.Number & " " & Err.Description
    PathExists = False

End Function

'-------------------------------------------------------------------------------------------------
' PURPOSE: Dumps the contents of a specified directory into a passed array
'   INPUT: Path     : The path to read
'          DirList(): An array to dump the directory contents in
'          [Pattern]: Directory Match pattern
'  RETURN: Long     : 1=Success/0=Fail
'-------------------------------------------------------------------------------------------------
Public Function ReadDir(ByVal path As String, _
                        ByRef DirList() As String, _
                        Optional Pattern As String = "*.*") As Long

    Dim lArraySub As Long
    Dim sCurrentEntry As String

    On Error GoTo ErrorHandler

    '----------------------------------------------------------------------------------------------
    ' Prepare the passed arguments for processing
    '----------------------------------------------------------------------------------------------
    Erase DirList
    lArraySub = 0
    sCurrentEntry = ""

    '----------------------------------------------------------------------------------------------
    ' Determine if a trailing backslash is present. If not, adds one
    '----------------------------------------------------------------------------------------------
    If Right(path, 1) <> "\" Then
        path = path & "\"
    End If

    '----------------------------------------------------------------------------------------------
    ' Append the pattern
    '----------------------------------------------------------------------------------------------
    path = path & Pattern

    '----------------------------------------------------------------------------------------------
    ' Determine if the path exists
    '----------------------------------------------------------------------------------------------
    If CBool(Len(path)) And CBool(Len(Dir(path))) Then
        '-------------------------------------------------------------------------------------------
        ' Retrieve the first file from the directory
        '-------------------------------------------------------------------------------------------
        sCurrentEntry = Dir(path)

        '-------------------------------------------------------------------------------------------
        ' Continue processing until there are no more directory entries
        '-------------------------------------------------------------------------------------------
        Do While (sCurrentEntry <> "")
            '----------------------------------------------------------------------------------------
            ' Increment and redim the array
            '----------------------------------------------------------------------------------------
            lArraySub = lArraySub + 1
            ReDim Preserve DirList(lArraySub)

            '----------------------------------------------------------------------------------------
            ' Save the directory entry to the array
            '----------------------------------------------------------------------------------------
            DirList(lArraySub) = sCurrentEntry
            sCurrentEntry = Dir
        Loop
    End If

    '----------------------------------------------------------------------------------------------
    ' Return the array subscript
    '----------------------------------------------------------------------------------------------
    ReadDir = lArraySub

    Exit Function
ErrorHandler:
'    ErrorLog.LogError AppName, ComponentName, "clsTools", "ReadDir", Err.Number & " " & Err.Description
    ReadDir = 0

End Function


Function ClearDirectory(ByVal ThisDir As String)

   Dim strTemp As String
   Dim fso As New FileSystemObject

   On Error Resume Next

   strTemp = Dir(ThisDir)

   Do While strTemp <> ""
      fso.DeleteFile ThisDir & strTemp, True

      Debug.Print Err.Number

       ' Get the next file that meets the spec and go round again
       strTemp = Dir
   Loop

   Err.Clear

End Function

Public Function FileExists(ByVal thisFile As String)

   Dim fso As New FileSystemObject

   If fso.FileExists(thisFile) Then
      FileExists = True
   Else
      FileExists = False
   End If

   Set fso = Nothing

End Function

Public Function GetActiveSlide(ByVal oWnd As Object) As Slide
    Dim SlideNum As Integer
    Dim oTempPres As Presentation
    On Error GoTo Err_GetActiveSlide
    Set oTempPres = oWnd.Presentation
    SlideNum = 0
    If oTempPres.Slides.count > 0 Then
        Select Case TypeName(oWnd)
        Case "DocumentWindow"
            Select Case oWnd.View.Type
            Case ppViewSlide, ppViewNotesPage
                SlideNum = oWnd.View.Slide.slideIndex
            Case ppViewNormal
                oWnd.Panes(2).Activate
                SlideNum = oWnd.View.Slide.slideIndex
            Case ppViewSlideSorter
                If oWnd.Selection.Type = ppSelectionSlides Then
                    If oWnd.Selection.SlideRange.count = 1 Then
                        SlideNum = oWnd.Selection.SlideRange.slideIndex
                    End If
                End If
            Case ppViewOutline
                If oWnd.Selection.SlideRange.count = 1 Then
                    SlideNum = oWnd.Selection.SlideRange.slideIndex
                End If
            End Select
        Case "SlideShowWindow"
            SlideNum = oWnd.View.Slide.slideIndex
        End Select
    End If
    If SlideNum > 0 Then
        Set GetActiveSlide = oTempPres.Slides(SlideNum)
    End If
Err_GetActiveSlide:
End Function

'Function GetWinHandle() As Long
'    Dim tempHwnd As Long
'    Dim buf As String * 256
'    Dim title As String
'    Dim Length As Long
'
'   ' Grab the first window handle that Windows finds:
'   tempHwnd = FindWindow(vbNullString, vbNullString)
'
'   ' Loop until you find a match or there are no more window handles:
'   Do Until tempHwnd = 0
'    If GetParent(tempHwnd) = 0 Then
'        Length = GetWindowText(tempHwnd, buf, Len(buf))
'        title = Left$(buf, Length)
'        If InStr(title, "Sant Editor") > 0 Then
'             Exit Do
'        End If
'    End If
'    tempHwnd = GetWindow(tempHwnd, GW_HWNDNEXT)
'   Loop
'   GetWinHandle = tempHwnd
'End Function

Public Function UnScrambleX(ByVal base64String) As String
  'rfc1521
  '1999 Antonin Foller, Motobit Software, http://Motobit.cz
…
vbaProject_00.bin🔏 SignedVBA project digital signature
Covers VBA source only — not the compiled p-code. A digital signature does not by itself mean the macro is safe.		 vba-project OOXML VBA project: ppt/vbaProject.bin 3279872 bytes
SHA-256: 4163c2bb8731c497d19bcdd957a6cc865d09a808d4c1513dc81c123b00e47fea
Detection
ClamAV: Doc.Dropper.Generic-6834355-0
Obfuscation or payload: unlikely

Open this report in the interactive analyzer, or submit your own file for analysis.