Malicious Office (OOXML) — malware analysis report

Static analysis result for SHA-256 95c3e02ecfd19106…

MALICIOUS

Office (OOXML)

1.17 MB Created: 2014-02-14 15:22:00 UTC Authoring application: Microsoft Office Word 16.0000 First seen: 2021-09-16
MD5: 62491339bed34a421516470ad0602282 SHA-1: 9bcebf83ac6ed980cb06a594cc35580326c5b1bf SHA-256: 95c3e02ecfd1910607d6316779006c5de21fd96e3eb90ac0ff3a39410fba5b55
290 Risk Score

Malware Insights

MITRE ATT&CK
T1059.005 Visual Basic T1059.001 PowerShell T1105 Ingress Tool Transfer T1204.002 Malicious File

The sample contains VBA macros that leverage WScript.Shell to execute commands. A critical heuristic indicates that the VBA stages a PowerShell command to download and run a file, suggesting it acts as a dropper for a second-stage payload. The presence of `DownloadFile` and `WScript.Shell` are key indicators of this behavior.

Heuristics 8

  • VBA project inside OOXML medium 6 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
        lTaskId = Shell(sCommandLine, vbNormalNoFocus)
  • WScript.Shell usage critical OLE_VBA_WSCRIPT
    WScript.Shell usage
    Matched line in script
        Set oWsh = VBA.CreateObject("WScript.Shell")
  • VBA stages a PowerShell/LOLBin download-and-run command critical OLE_VBA_BITSTRANSFER_DROPPER
    The macro assembles a download command using a PowerShell or LOLBin download primitive (Start-BitsTransfer, Invoke-WebRequest, Net.WebClient, bitsadmin, certutil, ...) that fetches a remote payload, then executes it -- writing it to a script file and running it, or launching it directly from an auto-exec handler. The keywords are commonly split with PowerShell backtick / cmd caret escapes to evade scanners; this detection de-escapes the source first. A high-confidence downloader/dropper, stronger than the individual Shell / download keywords on their own.
    Matched line in script
    '                  to be added on document Load or Startup or AutoExec, etc
  • CreateObject call high OLE_VBA_CREATEOBJ
    CreateObject call
    Matched line in script
            Set oKeys = CreateObject("System.Collections.ArrayList")
  • VBA p-code auto-exec with execution tokens high OLE_VBA_PCODE_AUTOEXEC_EXEC
    Triggers on the COMBINATION of two tokens co-occurring in the same compiled VBA/cache stream: an auto-execution entry point (Auto_Open / AutoOpen / Document_Open / Workbook_Open / Auto_Close / AutoClose) AND a shell/download/object-execution token (Shell, CreateObject, GetObject, PowerShell, cmd.exe, URLDownloadToFile, WinHttp, XMLHTTP, ADODB.Stream, ShellExecute, ExecuteExcel4Macro). Neither token alone fires it — it is the pairing that flags p-code-only or source-extraction-failure macro documents where the visible VBA source is unavailable. The matched tokens are named in the detail line below.
  • Environ() call (env variable access) low OLE_VBA_ENVIRON
    Environ() call (env variable access)
    Matched line in script
                                sTempFilePath = Environ$("TEMP") & "\" & sTempFileName
  • 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.i4i.com In document text (OOXML body / shared strings)
    • http://www.i4i.com/ns/x4w/attribute-valuesIn document text (OOXML body / shared strings)
    • http://www.i4i.com/ns/x4w/spl/r4inputIn document text (OOXML body / shared strings)
    • https://github.com/VBA-tools/VBA-JSONIn document text (OOXML body / shared strings)
    • http://www.vbaccelerator.com/home/VB/Code/Techniques/RunTime_Debug_Tracing/VB6_Tracer_Utility_zip_cStringBuilder_cls.aspIn document text (OOXML body / shared strings)
    • https://github.com/VBA-tools/VBA-JSON/pull/82In document text (OOXML body / shared strings)
    • https://github.com/VBA-tools/VBA-UtcConverterIn document text (OOXML body / shared strings)
    • http://i4i.com/s4ent/core/In document text (OOXML body / shared strings)
    • http://localhostIn document text (OOXML body / shared strings)
    • http://www.i4i.com/ns/x4o/data_hubIn document text (OOXML body / shared strings)
    • http://www.i4i.com/ns/x4w/keywordsIn document text (OOXML body / shared strings)
    • http://www.i4i.com/ns/x4w/eulm/infozoneIn document text (OOXML body / shared strings)
    • http://www.i4i.com/ns/x4w/propfindIn document text (OOXML body / shared strings)
    • http://www.i4i.com/ns/x4w/cxp/proppatchIn document text (OOXML body / shared strings)
    • http://www.i4i.com/ns/x4w/propextractIn document text (OOXML body / shared strings)
    • http://www.i4i.com/ns/x4w/ccxmlIn document text (OOXML body / shared strings)
    • http://www.i4i.com/ns/x4w/configIn document text (OOXML body / shared strings)
    • http://www.i4i.com/ns/x4w/schemaIn document text (OOXML body / shared strings)
    • http://www.i4i.com/ns/x4w/schemaxmlIn document text (OOXML body / shared strings)
    • http://www.i4i.com/ns/x4o/densemarkupIn document text (OOXML body / shared strings)
    • http://www.i4i.com/ns/x4o/keywordsIn document text (OOXML body / shared strings)
    • http://i4i.com/s4ent/A4LIn document text (OOXML body / shared strings)
    • http://www.i4i.com/In document text (OOXML body / shared strings)
    • http://www.susandoreydesigns.com/software/WordVBATechniques.pdfIn document text (OOXML body / shared strings)
    • http://i4i.com/s4ent/DocumentManagement/In document text (OOXML body / shared strings)
    • https://raw.githubusercontent.com/HealthCanada/HPFB/master/product-monograph/style-sheet/spl_canada.xslIn document text (OOXML body / shared strings)
    • http://www.i4i.com/ns/x4w/spl/r4input�In document text (OOXML body / shared strings)
    • http://www.i4i.com/ns/x4w/propfind(In document text (OOXML body / shared strings)
    • http://www.i4i.com/ns/x4w/ccxmlxtractIn document text (OOXML body / shared strings)
    • http://www.i4i.com/ns/x4w/attribute-values(In document text (OOXML body / shared strings)
    • http://www.i4i.com/ns/x4w/configes(In document text (OOXML body / shared strings)
    • http://www.i4i.com/ns/x4w/schemaes(In document text (OOXML body / shared strings)
    • http://www.i4i.com/ns/x4w/configxml$In document text (OOXML body / shared strings)
    • http://www.i4i.com/ns/x4o/densemarkup�In document text (OOXML body / shared strings)
    • http://www.i4i.com/ns/x4o/keywordskupIn document text (OOXML body / shared strings)
    • http://www.i4i.com/ns/x4o/data_hubkupIn document text (OOXML body / shared strings)
    • http://www.i4i.com/ns/x4w/keywords�In document text (OOXML body / shared strings)
    • http://www.i4i.com/ns/x4w/propfind�In document text (OOXML body / shared strings)
    • http://www.i4i.com/ns/x4w/attribute-values�In document text (OOXML body / shared strings)
    • http://www.i4i.com/ns/x4w/config�In document text (OOXML body / shared strings)
    • http://www.i4i.com/ns/x4w/schema�In document text (OOXML body / shared strings)
    • http://www.i4i.com/ns/x4o/keywords�In document text (OOXML body / shared strings)
    • http://www.i4i.com/ns/x4o/data_hub�In document text (OOXML body / shared strings)
    • http://i4i.com/s4ent/core/�In document text (OOXML body / shared strings)
    • http://i4i.com/s4ent/A4L�In document text (OOXML body / shared strings)
    • http://www.vaers.hhs.gov�In document text (OOXML body / shared strings)
    • http://@www.ac��sIn document text (OOXML body / shared strings)
    • http://schemas.microsoft.com/office/word/2010/wordprocessingCanvasIn document text (OOXML body / shared strings)
    • http://schemas.microsoft.com/office/drawing/2014/chartexIn document text (OOXML body / shared strings)
    • http://schemas.microsoft.com/office/drawing/2015/9/8/chartexIn document text (OOXML body / shared strings)
    +42 more URL(s)

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) 1297649 bytes
SHA-256: a5e9e5a2cf43da634ef30a6429f475dea0bd1dcee667d37ae43fa931f484c858
Preview script
First 1,000 lines of the extracted script
Attribute VB_Name = "ThisDocument"
Attribute VB_Base = "0{00020906-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Company:          Infrastructures For Information - i4i(www.i4i.com)
'Comment:          Holds document level events
'Date Created:     2010.10.15
'Developer:        Rob Southon
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Private Sub Document_ContentControlAfterAdd(ByVal NewContentControl As ContentControl, ByVal InUndoRedo As Boolean)
    On Error Resume Next
    'Fixed to #20888, #20890
    If InUndoRedo Then
        g_bSkipEvents = True
        Exit Sub
    End If

    Dim oDoc As Document
    Set oDoc = NewContentControl.Parent

    'Remove myself if I'm not allowed - don't allow creation of a CO, CC, HD, ST inside of a CO - 12457
    If NewContentControl.Tag <> "" Then 'Don't act on CCs without a tag
        Dim sMyPrefix As String
        Dim sParentPrefix As String
        sMyPrefix = Left(NewContentControl.Tag, 3)
        sParentPrefix = Left(NewContentControl.ParentContentControl.Tag, 3)
        If (sMyPrefix = gc_sCCPrefixPCData Or sMyPrefix = gc_sCCPrefixStructure Or sMyPrefix = gc_sCCPrefixHighlight Or sMyPrefix = gc_sCCPrefixHeading Or sMyPrefix = gc_sCCPrefixStandardText Or sMyPrefix = gc_sCCPrefixHighlight) And (sParentPrefix = gc_sCCPrefixKeyword Or sParentPrefix = gc_sCCPrefixPCData Or sParentPrefix = gc_sCCPrefixHeading Or sParentPrefix = gc_sCCPrefixStandardText) Then
            'i4i internal: defect12556
            'if parent content control is "st:adverse_highlight", it shouldn't be deleted - special description in highlight for section 6
            If NewContentControl.ParentContentControl.Tag <> gc_sCCPrefixStandardText + "adverse_highlight" Then
                NewContentControl.Delete False
            End If
            Exit Sub
        End If
    End If
    'For moving sections so we don't duplicate IDs
    If g_bSkipIds = True Then Exit Sub

    'Add in our GUID attributes
    If g_CAttribute.GetAttributeValue(NewContentControl, gc_sAttGuid, gc_sXmlnsX4wAttVals) = "" Then
        g_CAttribute.SetAttributeValue NewContentControl, gc_sAttGuid, CreateGUID, gc_sXmlNsAlicei4i, "", gc_sXmlnsX4wAttVals
    End If
    '16583 - set our permanent ID attribute values
    If g_CAttribute.GetAttributeValue(NewContentControl, gc_sAttPermId, gc_sXmlnsX4wAttVals) = "" Then
        g_CAttribute.SetAttributeValue NewContentControl, gc_sAttPermId, CreateGUID, gc_sXmlNsAlicei4i, "", gc_sXmlnsX4wAttVals
    End If
    
End Sub

Private Sub Document_ContentControlOnEnter(ByVal ContentControl As ContentControl)
    On Error GoTo PROC_ERR
        
    If g_bSkipEvents = True Then Exit Sub
    'for densemarkup - autoselect
    If ContentControl.Tag = "ct:DenseMarkup" Then
        selectDenseMarkupNode ContentControl
    End If
    If ContentControl.Tag = "cv:Materials" Then
        CleanUpMaterialListEntries
    End If
    Dim oDoc As Document
    Set oDoc = ContentControl.Parent
   
    'i4i internal: defect12631
    'Keep a flag to remember if the doc was saved because setting locks dirties the document and we don't want it to
    Dim bDocSaved As Boolean
    bDocSaved = oDoc.Saved
                
    'i4i internal: defect12087
    'this would cause "can't execute code in break mode" error after close IE browser
    If IsError(g_ox4oRibbon) = False Then
        If Not g_ox4oRibbon Is Nothing Then
            g_ox4oRibbon.Invalidate
        End If
    Else
        'We don't have control of the menus! Inform the user and close the document
        If MsgBox(g_CLocalization.GetMessage("c_X4O_NOT_CONNECTED_CONFIRM_SAVE", gc_sAppName), vbYesNo + vbCritical, gc_sAppName) = vbYes Then
            oDoc.Close True
        Else
            If MsgBox(g_CLocalization.GetMessage("c_CONFIRM_CLOSE_DOC"), vbYesNo + vbCritical, gc_sAppName) = vbYes Then
                oDoc.Close False
            Else
                oDoc.Close True
            End If
        End If
    End If
               
    'Looks like we can't rely on Word to always unlock on Exit, so we always need to unlock the parent structure tree
    oDoc.ContentControls(1).LockContentControl = False
    oDoc.ContentControls(1).LockContents = False
    g_CContentControls.UnlockParentCCs ContentControl
    If oDoc.FullName <> oDoc.AttachedTemplate.FullName Then 'Don't ever lock CCs in design mode
        LockCC ContentControl
    Else
            
        ContentControl.LockContentControl = False
        ContentControl.LockContents = False
    End If
    oDoc.Saved = bDocSaved
            
    Exit Sub

PROC_ERR:
    g_CUtilities.LogError Err, False, "Document_ContentControlOnEnter of VBA Document ThisDocument"
    Resume Next

End Sub

Private Sub Document_ContentControlOnExit(ByVal ContentControl As ContentControl, Cancel As Boolean)
    On Error GoTo PROC_ERR
        
    Dim oDoc As Document
    Set oDoc = ContentControl.Parent
        
    'i4i internal: defect12631
    'Keep a flag to remember if the doc was saved because setting locks dirties the document and we don't want it to
    Dim bDocSaved As Boolean
    bDocSaved = oDoc.Saved
    oDoc.Saved = bDocSaved
        
    If g_bSkipEvents = True Then Exit Sub
                
    Dim sPrefix As String
    sPrefix = Left(ContentControl.Tag, 3)
            
    'If we are leaving a keyword, update all other instances of the keyword
    Dim oKeywordCC As ContentControl
    Set oKeywordCC = GetCurrentKeywordCC(ContentControl.Range)
    If oKeywordCC Is Nothing Then GoTo SKIP
    If g_bUpdatingKeywords = False And g_bEditingKeyword = True Then
        
        g_bEditingKeyword = False
                    
        'Don't ask to update if we just moved from a keyword CC to its child CC (usually a controlled vocab CC)
        Dim oArrivedKeyword As ContentControl
        Set oArrivedKeyword = GetCurrentKeywordCC
                
        'Don't update if we are just moving within the same parent keyword
        If Not oArrivedKeyword Is Nothing Then
            If oArrivedKeyword.ID = oKeywordCC.ID Then GoTo SKIP
        End If
        
        If oDoc.SelectContentControlsByTag(oKeywordCC.Tag).Count > 1 Then 'Don't bother updating if we are the only one
            If MsgBox(g_CLocalization.GetMessage("c_CONFIRM_KEYWORD_UPDATE_ALL"), vbYesNo, gc_sAppName) = vbYes Then
                g_bUpdatingKeywords = True
                Application.ScreenUpdating = False
                
                UpdateKeywordByNameValue oKeywordCC
                
                Application.ScreenUpdating = True
                g_bUpdatingKeywords = False
            End If
        Else
            If g_CUtilities.GetCustomWordProperty(gc_sCustomPropShading) Then
                oKeywordCC.Range.Shading.BackgroundPatternColor = gc_wdHighlightColor
            End If
        End If
    Else
        If oDoc.SelectContentControlsByTag(ContentControl.Tag).Count = 1 Then
            If g_CUtilities.GetCustomWordProperty(gc_sCustomPropShading) Then
                'Fixed to #18584, crash in word2007
                Dim bSkipEvents As Boolean
                bSkipEvents = g_bSkipEvents
                g_bSkipEvents = True
                oKeywordCC.LockContents = False
                oKeywordCC.Range.Shading.BackgroundPatternColor = gc_wdHighlightColor
                oKeywordCC.LockContents = True
                g_bSkipEvents = bSkipEvents
            End If
        End If
    End If
SKIP:
    oDoc.Saved = bDocSaved
    
    Exit Sub
    
PROC_ERR:
    g_CUtilities.LogError Err, False, "Document_ContentControlOnExit of VBA Document ThisDocument"
    Resume Next
    
End Sub


Attribute VB_Name = "frmInput"
Attribute VB_Base = "0{809E4C1E-343A-4127-AA95-CA46272F6021}{E26888E9-508D-457D-A494-0360199FA117}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False




'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Company:          Infrastructures For Information - i4i(www.i4i.com)
'Comment:          User input imformation
'Date Created:
'Developer:
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Option Explicit
Private m_sTitle As String
Private m_sInstructions As String
Private m_sAnswer As String
Private m_iMsgBoxAnswer As VbMsgBoxResult

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Function/Sub Name:   Title
' Purpose:   Get Title property
' Inputs:
' Returns:   String
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Property Get Title() As String
    On Error Resume Next
    Title = m_sTitle
End Property

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Function/Sub Name:   Title
' Purpose:   Set Title property
' Inputs:    sTitle -- String
' Returns:
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Property Let Title(ByVal sTitle As String)
    On Error Resume Next
    m_sTitle = sTitle
    Me.Caption = sTitle

End Property

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Function/Sub Name:   Instructions
' Purpose:   Get Instructions property
' Inputs:
' Returns:   String
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Property Get Instructions() As String
    On Error Resume Next
    Instructions = m_sInstructions

End Property

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Function/Sub Name:   Instructions
' Purpose:   Set Instructions property
' Inputs:    sInstructions -- String
' Returns:
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Property Let Instructions(ByVal sInstructions As String)
    On Error Resume Next
    m_sInstructions = sInstructions
    lblInstruct.Caption = m_sInstructions

End Property

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Function/Sub Name:   Answer
' Purpose:   Get Answer property
' Inputs:
' Returns:   String
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Property Get Answer() As String
    On Error Resume Next
    m_sAnswer = txtInput.Value
    Answer = m_sAnswer

End Property

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Function/Sub Name:   Answer
' Purpose:   Set Answer property
' Inputs:    sAnswer -- String
' Returns:
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Property Let Answer(ByVal sAnswer As String)
    On Error Resume Next
    txtInput.Value = sAnswer
    m_sAnswer = sAnswer

End Property

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Function/Sub Name:   MsgBoxAnswer
' Purpose:   Get MsgBoxAnswer property
' Inputs:
' Returns:   VbMsgBoxResult
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Property Get MsgBoxAnswer() As VbMsgBoxResult
    On Error Resume Next
    MsgBoxAnswer = m_iMsgBoxAnswer

End Property

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Function/Sub Name:   cmdCancel_Click
' Purpose:   Unload form
' Inputs:
' Returns:
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub cmdCancel_Click()
    On Error Resume Next
    g_sInputAnswer = ""
    m_iMsgBoxAnswer = vbCancel
    g_iMsgBoxAnswer = vbCancel
    Unload Me
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Function/Sub Name:   cmdOk_Click
' Purpose:   Get input text and unload form
' Inputs:
' Returns:
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub cmdOk_Click()
    On Error Resume Next
    g_sInputAnswer = txtInput.Value
    m_iMsgBoxAnswer = vbOK
    g_iMsgBoxAnswer = vbOK
    Unload Me
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Function/Sub Name:   UserForm_Activate
' Purpose:   Initialize global variable
' Inputs:
' Returns:
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub UserForm_Activate()
    On Error Resume Next
    g_sInputAnswer = ""
End Sub


Attribute VB_Name = "frmProgressBar"
Attribute VB_Base = "0{A55A69EE-167B-4D9C-AE97-80738AC76F09}{C591F779-9AC9-4760-9F44-8B3CDD8772E3}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False




Option Explicit
Private m_bCancelProgressFromForm As Boolean
Private m_lMaxProgressOverall As Long
Private m_lCurrentProgressOverall As Long
Private m_oDoc As Word.Document
Private m_sCmd As String
Private m_control As IRibbonControl
Private m_sBaseDoc As String
Private m_sSelectedDoc As String
Private m_sResultDoc As String
Private m_sMetaMode As MetaMode

Public m_bSaveProgress As Boolean
Public m_iDivideNum As Integer

Public Property Set WordDocument(oDoc As Word.Document)
    On Error Resume Next
    Set m_oDoc = oDoc
End Property

Public Property Get WordDocument() As Word.Document
    On Error Resume Next
    Set WordDocument = m_oDoc
End Property

Public Property Set RibbonControl(control As IRibbonControl)
    On Error Resume Next
    Set m_control = control
End Property

Public Property Get RibbonControl() As IRibbonControl
    On Error Resume Next
    Set RibbonControl = m_control
End Property

Public Property Let CommandLineShell(sCmd As String)
    On Error Resume Next
    m_sCmd = sCmd
End Property

Public Property Get CommandLineShell() As String
    On Error Resume Next
    CommandLineShell = m_sCmd
End Property

Public Property Let MaxProgressOverall(lMaxProgressOverall As Long)
    On Error Resume Next
    m_lMaxProgressOverall = lMaxProgressOverall
End Property

Public Property Get MaxProgressOverall() As Long
    On Error Resume Next
    MaxProgressOverall = m_lMaxProgressOverall
End Property

Public Property Let BaseDoc(sBaseDoc As String)
    On Error Resume Next
    m_sBaseDoc = sBaseDoc
End Property
Public Property Get BaseDoc() As String
    On Error Resume Next
    BaseDoc = m_sBaseDoc
End Property
Public Property Let SelectedDoc(sSelectedDoc As String)
    On Error Resume Next
    m_sSelectedDoc = sSelectedDoc
End Property
Public Property Get SelectedDoc() As String
    On Error Resume Next
    SelectedDoc = m_sSelectedDoc
End Property
Public Property Let ResultDoc(sResultDoc As String)
    On Error Resume Next
    m_sResultDoc = sResultDoc
End Property
Public Property Get ResultDoc() As String
    On Error Resume Next
    ResultDoc = m_sResultDoc
End Property

Public Property Let MetaMode(sMode As MetaMode)
    On Error Resume Next
    m_sMetaMode = sMode
End Property
Public Property Get MetaMode() As MetaMode
    On Error Resume Next
    MetaMode = m_sMetaMode
End Property

Public Property Let CurrentProgressOverall(lCurrentProgressOverall As Long)
    On Error Resume Next
    
    m_lCurrentProgressOverall = lCurrentProgressOverall
    Dim PctDone As Single
    PctDone = lCurrentProgressOverall / m_lMaxProgressOverall
    If PctDone * 100 Mod m_iDivideNum = 0 Then
        frameProgress.Caption = Format(PctDone, "0%")
        lblProgress.Width = PctDone * frameProgress.Width
    End If

    DoEvents

End Property

Public Property Get CurrentProgressOverall() As Long
    On Error Resume Next
    CurrentProgressOverall = m_lCurrentProgressOverall
End Property

Public Property Get CancelProgress() As Boolean
    On Error Resume Next
    CancelProgress = m_bCancelProgressFromForm
End Property

Public Property Let Message(sMessage As String)
    On Error Resume Next
    lblMsg.Caption = sMessage
End Property

Private Sub UserForm_Activate()
    On Error GoTo PROC_ERR
    
    Select Case Caption
        Case "DoUpdateDocumentVersion"
            DoUpdateDocumentVersion m_oDoc
        Case "Import Product Codes"
            DoExtractDataFromFolder m_sCmd
        Case "DoPreview"
            DoPreview m_control
        Case g_CLocalization.GetMessage("c_METADATA_COMPARE_CAPTION")
            LaunchMetaCompareResult m_sBaseDoc, m_sSelectedDoc, m_sResultDoc, m_sMetaMode
    End Select

    Application.ScreenRefresh
    Exit Sub
    
PROC_ERR:
    g_CUtilities.LogError Err, False, "UserForm_Activate of Form frmProgressBar"
    Resume Next
End Sub

Private Sub UserForm_Initialize()
    On Error GoTo PROC_ERR
    m_bCancelProgressFromForm = False
    lblProgress.Width = 0
    Exit Sub
    
PROC_ERR:
    g_CUtilities.LogError Err, False, "UserForm_Initialize of Form frmProgressBar"
    Resume Next
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    On Error GoTo PROC_ERR
      
    If CloseMode = 0 Then 'the user is trying to close the form
        If Caption = "DoPreview" Then
            'keep going
            m_bCancelProgressFromForm = False
            Cancel = 1
            Exit Sub
        End If
        If MsgBox(g_CLocalization.GetMessage("c_CONFIRM_CANCEL_PROCESS"), vbYesNo, "Progress") = vbYes Then
            'stop everything
            m_bCancelProgressFromForm = True
            Cancel = 0
            Application.ScreenUpdating = True
            Application.ScreenRefresh
            'UnFreezeScreen
            Set g_ofrmProgressBar = Nothing
            Unload Me
        Else
            'keep going
            m_bCancelProgressFromForm = False
            Cancel = 1
        End If
    End If
    Exit Sub
    
PROC_ERR:
    g_CUtilities.LogError Err, False, "UserForm_QueryClose of Form frmProgressBar"
    Resume Next
End Sub

Attribute VB_Name = "frmSectionManager"
Attribute VB_Base = "0{A832FD98-855F-4235-8411-F2D60DA48FA6}{C144E311-8E58-432C-B2AE-70E898AD8D61}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False





'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Company:          Infrastructures For Information - i4i(www.i4i.com)
'Comment:          Allows the user to manage the semantic CC document
'                  sections
'Date Created:
'Developer:
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
Private m_oActiveDoc As Word.Document 'So any actions performed occur on the document that was used to launch the dialog
Private m_lLastChosenId As Double

Public Enum MoveDirection
    MoveUp = 0
    MoveDown = 1
    MoveLeft = 2
    MoveRight = 3
End Enum

Private m_bTrackingChanges As Boolean 'Used to remember if we were tracking changes and turn it off during document edits
Private m_bUpdateShownCCs As Boolean 'Used to pause update of dialog when checking the visible CCs
Private bInitDocument As Boolean
Private bCmdDeleteVisible As Boolean '#23435, Used to remember whether the selected section exists in the document

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Function/Sub Name:   AssignActiveDocument
' Purpose:   Set AssignActiveDocument property
' Inputs:    oActiveDoc -- Word document
' Returns:
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Property Set AssignActiveDocument(oActiveDoc As Word.Document)
    On Error Resume Next
    Set m_oActiveDoc = oActiveDoc
End Property

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Function/Sub Name:   chkShowAtt_Click
' Purpose:   This is not used in A4L5.2, it will be used in A4L5.3 in the
'            Future
' Inputs:
' Returns:
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub chkShowAtt_Click()
    On Error Resume Next
    InitCCs
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Function/Sub Name:   chkShowBlocks_Click
' Purpose:   This is not used in A4L5.2, it will be used in A4L5.3 in the
'            Future
' Inputs:
' Returns:
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub chkShowBlocks_Click()
    On Error Resume Next
    InitCCs
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Function/Sub Name:   chkShowBodys_Click
' Purpose:   This is not used in A4L5.2, it will be used in A4L5.3 in the
'            Future
' Inputs:
' Returns:
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub chkShowBodys_Click()
    On Error Resume Next
    InitCCs
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Function/Sub Name:   chkShowConcept_Click
' Purpose:   This is not used in A4L5.2, it will be used in A4L5.3 in the
'            Future
' Inputs:
' Returns:
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub chkShowConcept_Click()
    On Error Resume Next
    InitCCs
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Function/Sub Name:   chkShowCustom_Click
' Purpose:   This is not used in A4L5.2, it will be used in A4L5.3 in the
'            Future
' Inputs:
' Returns:
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub chkShowCustom_Click()
    On Error Resume Next
    InitCCs
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Function/Sub Name:   chkShowHeadings_Click
' Purpose:   This is not used in A4L5.2, it will be used in A4L5.3 in the
'            Future
' Inputs:
' Returns:
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub chkShowHeadings_Click()
    On Error Resume Next
    InitCCs
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Function/Sub Name:   chkShowInlineFrags_Click
' Purpose:   This is not used in A4L5.2, it will be used in A4L5.3 in the
'            Future
' Inputs:
' Returns:
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub chkShowInlineFrags_Click()
    On Error Resume Next
    InitCCs
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Function/Sub Name:   chkShowKeywords_Click
' Purpose:   This is not used in A4L5.2, it will be used in A4L5.3 in the
'            Future
' Inputs:
' Returns:
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub chkShowKeywords_Click()
    On Error Resume Next
    InitCCs
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Function/Sub Name:   chkShowSections_Click
' Purpose:   This is not used in A4L5.2, it will be used in A4L5.3 in the
'            Future
' Inputs:
' Returns:
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub chkShowSections_Click()
    On Error Resume Next
    InitCCs
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Function/Sub Name:   chkShowStandardText_Click
' Purpose:   This is not used in A4L5.2, it will be used in A4L5.3 in the
'            Future
' Inputs:
' Returns:
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub chkShowStandardText_Click()
    On Error Resume Next
    InitCCs
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Function/Sub Name:   chkShowVocab_Click
' Purpose:   This is not used in A4L5.2, it will be used in A4L5.3 in the
'            Future
' Inputs:
' Returns:
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub chkShowVocab_Click()
    On Error Resume Next
    InitCCs
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Function/Sub Name:   cmbMode_Change
' Purpose:   Initialize content controls
' Inputs:
' Returns:
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub cmbMode_Change()
    On Error Resume Next
    InitCCs
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Function/Sub Name:   cmdCancel_Click
' Purpose:   Press cancel button to close form
' Inputs:
' Returns:
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub cmdCancel_Click()
    On Error Resume Next
    Me.Hide
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Function/Sub Name:   cmdDelete_Click
' Purpose:   Delete section
' Inputs:
' Returns:
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub cmdDelete_Click()
    On Error GoTo PROC_ERR
    m_oActiveDoc.Activate
    SafeStartUndoStack "Delete Section"

    Dim oCC As ContentControl
    Set oCC = GetCurrentSelectedCC
    
    If oCC.Tag = gc_sCCi4iRoot Then
        MsgBox g_CLocalization.GetMessage("c_ROOT_SECTION_DELETE_ALERT"), vbExclamation + vbOKOnly, gc_sAppName
        Exit Sub
    End If
    
    If Not oCC Is Nothing Then
        Dim sNodeID As String
        sNodeID = "#id:" & oCC.ID
        
        DeleteCCSemantic oCC
        
        If cmbMode.Value = "Show Allowed" Then
            ' change node state to missing
            wbSectionView.Document.parentWindow.execScript "changeNodeType('" & sNodeID & "', 'images/section_missing.png', 'x4o-section-missing');"
        Else
            ' delete node from tree
            wbSectionView.Document.parentWindow.execScript "deleteNode('" & sNodeID & "');"
        End If
    
    End If

    'Set dirty to prompt for save
    m_oActiveDoc.Saved = False
    ActiveWindow.ScrollIntoView Selection.Range, True
    SafeEndUndoStack

    Exit Sub

PROC_ERR:
    g_CUtilities.LogError Err, False, "cmdDelete_Click of Form frmSectionManager"
    Resume Next

End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Function/Sub Name:   cmdInsert_Click
' Purpose:   Insert section
' Inputs:
' Returns:
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub cmdInsert_Click()
    On Error GoTo PROC_ERR

    m_oActiveDoc.Activate
    Dim sHash As String
    sHash = GetHashFromURL(wbSectionView.LocationURL)
    If sHash = vbNullString Then
        MsgBox g_CLocalization.GetMessage("c_SELECT_SECTION"), vbOKOnly + vbExclamation, gc_sAppName
        Exit Sub
    End If
    
    Dim oIS As New frmSections
    Dim lPos As Long
    Dim lStart, lEnd As Long
    Dim lSelectionStart, lSelectionEnd As Long
    Dim oCC As ContentControl
    Set oCC = g_CElements.GetCurrentElement
    lStart = oCC.Range.start
    lEnd = oCC.Range.End
    Dim bFinishInsertSectionFromDlg As Boolean
    
    If cmbMode.Value = "Show Existing" Then
        'Move just inside our selected CC because the user wants the options of the child CC
        'Then just show the insert section dialog
        '#23950
        If oCC.Tag = gc_sCCi4iRoot Then
            lPos = Selection.Range.ParentContentControl.Range.start
        Else
            lPos = Selection.Range.ParentContentControl.Range.start + 1
        End If
        Selection.SetRange lPos, lPos
        oIS.Show
        bFinishInsertSectionFromDlg = oIS.FinishInsertSection
    ElseIf cmbMode.Value = "Show Missing" Then
        'we want to insert the selected section
        InsertFirstOccurenceOfCC sHash
        'Defect AP1-I107
        bFinishInsertSectionFromDlg = FinishInsertFirstOccurenceOfCC
    ElseIf cmbMode.Value = "Show Allowed" Then
    
        'We could have missing or existing items
        'But just insert in the first allowed position for now
        InsertFirstOccurenceOfCC sHash
        'Defect AP1-I107
        bFinishInsertSectionFromDlg = FinishInsertFirstOccurenceOfCC
    End If
    
    lSelectionStart = Selection.start
    lSelectionEnd = Selection.End
    
    'Set dirty to prompt for save
    m_oActiveDoc.Saved = False
    
    'Change the position of selection instead of Locking semantic CC in ShowDocumentSectionsDlg
    ActiveDocument.Range(lStart, lEnd).Select
    ActiveDocument.Range(lSelectionStart, lSelectionStart).Select
    
    If Application.Version = "12.0" Then
        ActiveDocument.UndoClear
    End If
    'i4i internal: defect12262
    'just hide the dlg
    'AP1-I66,ESDZ57-I18
    If bFinishInsertSectionFromDlg = True Then
        Me.Hide
    End If
    Exit Sub

PROC_ERR:
    g_CUtilities.LogError Err, False, "cmdInsert_Click of Form frmSectionManager"
    Resume Next
    
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Function/Sub Name:   GetCurrentSelectedCC
' Purpose:   Get Current Selected Content Control
' Inputs:
' Returns:   Content Control
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Function GetCurrentSelectedCC() As ContentControl
    On Error GoTo PROC_ERR
    
    Dim sHash As String
    sHash = GetHashFromURL(wbSectionView.LocationURL)
    
    Dim oCC As ContentControl
    If sHash = vbNullString Then
    ElseIf cmbMode.Value = "Show Allowed" Then
        If m_oActiveDoc.SelectContentControlsByTag(sHash).Count > 0 Then
            Set oCC = m_oActiveDoc.SelectContentControlsByTag(sHash)(1)
        End If
    Else
        Dim sId As String
        sId = Right(sHash, Len(sHash) - Len("id:"))
        Set oCC = g_CContentControls.GetCCByID(sId, m_oActiveDoc) '13060 and 13257
    End If
    
    If Not oCC Is Nothing Then
        Set GetCurrentSelectedCC = oCC
    Else
NONESELECTED:
        On Error Resume Next
        MsgBox g_CLocalization.GetMessage("c_SELECT_SECTION"), vbExclamation, gc_sAppName
        Set GetCurrentSelectedCC = Nothing
    End If
    Exit Function
    
PROC_ERR:
    g_CUtilities.LogError Err, False, "GetCurrentSelectedCC of Form frmSectionManager"
    Resume Next

End Function

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Function/Sub Name:   cmdLeft_Click
' Purpose:   Move section to left
' Inputs:
' Returns:
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub cmdLeft_Click()
    On Error GoTo PROC_ERR
    m_oActiveDoc.Activate
    Dim oMovedCC As ContentControl
    Set oMovedCC = MoveSib(MoveLeft)
    Exit Sub
    
PROC_ERR:
    g_CUtilities.LogError Err, False, "cmdLeft_Click of Form frmSectionManager"
    Resume Next
    
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Function/Sub Name:   cmdRight_Click
' Purpose:   Move section to right
' Inputs:
' Returns:
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub cmdRight_Click()
    On Error GoTo PROC_ERR
    m_oActiveDoc.Activate
    Dim oMovedCC As ContentControl
    Set oMovedCC = MoveSib(MoveRight)
    Exit Sub
    
PROC_ERR:
    g_CUtilities.LogError Err, False, "cmdRight_Click of Form frmSectionManager"
    Resume Next
    
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Function/Sub Name:   cmdShowAll_Click
' Purpose:  This will be used in A4L5.3
' Inputs:
' Returns:
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub cmdShowAll_Click()
    On Error GoTo PROC_ERR

    m_bUpdateShownCCs = False
    Dim oCtl As control
    For Each oCtl In fraShowItems.Controls
        If Left(oCtl.Name, 3) = "chk" Then
            oCtl.Value = True
        End If
    Next
    m_bUpdateShownCCs = True
    InitCCs
    Exit Sub
    
PROC_ERR:
    g_CUtilities.LogError Err, False, "cmdShowAll_Click of Form frmSectionManager"
    Resume Next

End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Function/Sub Name:   cmdShowNone_Click
' Purpose:  This will be used in A4L5.3
' Inputs:
' Returns:
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub cmdShowNone_Click()
    On Error GoTo PROC_ERR
    
    m_bUpdateShownCCs = False
    Dim oCtl As control
    For Each oCtl In fraShowItems.Controls
        If Left(oCtl.Name, 3) = "chk" Then
            oCtl.Value = False
        End If
    Next
    m_bUpdateShownCCs = True
    InitCCs
    Exit Sub
    
PROC_ERR:
    g_CUtilities.LogError Err, False, "cmdShowNone_Click of Form frmSectionManager"
    Resume Next

End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Function/Sub Name:   cmdUp_Click
' Purpose:  Move section up
' Inputs:
…
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: word/vbaProject.bin 2745856 bytes
SHA-256: fb805c8530960f8af634745a07a65e1457736119683889d9a630945b1310450a