VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CFactoria"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private sqlTraceStat As Boolean

Public Function LoadScriptFile(sFileName As String, Optional pDest As Object = Nothing, Optional bNotifyErrors As Boolean = True) As Boolean
  LoadScriptFile = mScriptExecute.LoadScriptFile(sFileName, pDest, bNotifyErrors)
End Function

Public Function ExisteProcedimiento(Script As Object, ByVal procName As String) As Boolean
  ExisteProcedimiento = mScriptExecute.ExisteProcedimiento(Script, procName)
End Function

' ------------------------------------------------
' Funciones para el soporte de las interfaces de
' usuario V7
Public Function TemaUI() As Tema
  Set TemaUI = mMain.TemaUI
End Function

Public Function getSysIcon(iconId As Integer) As IPictureDisp
  Set getSysIcon = mGlobales.getSysIcon((iconId))
End Function

Public Function loadFileIcon(fileName As String) As IPictureDisp
  Set loadFileIcon = mGlobales.loadFileIcon(fileName)
End Function
' -------------------------------------------------

Public Sub setSQLTrace(Value)
  On Error Resume Next
  sqlTraceStat = lmdbHandle.doSQLtrace
  lmdbHandle.doSQLtrace = CBool(Value)
  If err.Number Then
    MsgBox "ERROR (" & err.Number & "): " & err.Description, vbCritical, "Factoria.setSQLTrace"
  End If
  On Error GoTo 0
End Sub

Public Sub restoreSQLTrace()
  lmdbHandle.doSQLtrace = sqlTraceStat
End Sub

'---------------------------------------------------------------------------------------
' Procedure : carpetaFotos
' DateTime  : 01/09/2013 11:12
' Author    : Leonardo Azpurua
' Purpose   : Devuelve la ruta de la carpeta de foto
'---------------------------------------------------------------------------------------
'
Public Function carpetaFotos() As String
Dim sRetVal As String
  sRetVal = GetSetting("ClearLight", "General\CarpetaFotos", "")
  If sRetVal = "" Then sRetVal = BuildDataPath("", "ClearLight") & "Fotos\"
  carpetaFotos = mFileNames.normalizePath(sRetVal)
End Function

' CFactoria: Proveedor de objetos, referencias y servicios para
' componentes en VBScript

Public Function GetSetting(Section, Key, default)
  GetSetting = lmGetSetting.GetSetting("ClearLight", Section, Key, default)
End Function

Public Function CheckForWildcards(codigo, Tabla, nombreCodigo) As String
  CheckForWildcards = lmWildCards.CheckForWildcards(CStr(codigo), CStr(Tabla), CStr(nombreCodigo))
End Function

Public Function PuedeUsarAlmacen(codigoUsuario As String, codigoAlmacen As String, Optional ByVal warn As Boolean = False) As Boolean
  PuedeUsarAlmacen = lmUsuarios.PuedeUsarAlmacen(codigoUsuario, codigoAlmacen, warn)
End Function

Public Function usrDLL() As CUsrDLL
  Set usrDLL = New CUsrDLL
End Function

Public Function DoIncluirIVA() As Boolean
  DoIncluirIVA = mIVAEDit.DoIncluirIVA()
End Function

Public Function ConnString() As String
  ConnString = sConnString
End Function

Public Function UltimaAutorizacionPor() As String
  UltimaAutorizacionPor = UsuarioUltimaAutorizacion
End Function

Public Function ensamblarSegmentoSQL(ByVal segmentTemplate, ParamArray args() As Variant) As String
Dim v() As Variant, n As Integer, b As Integer
  b = UBound(args)
  If b >= 0 Then ReDim v(b)
  For n = 0 To b
    v(n) = args(n)
  Next
  ensamblarSegmentoSQL = lmdbHandle.ensamblarSegmentoSQLA(segmentTemplate, v)
End Function

Public Function ReadScalarA(ByVal selectSentence As String, args) As Variant
  ReadScalarA = lmdbHandle.ReadScalarA(selectSentence, args)
End Function

Public Function ReadScalar(ByVal selectSentence As String, ParamArray args() As Variant) As Variant
Dim v() As Variant, n As Integer, b As Integer
  b = UBound(args)
  If b >= 0 Then ReDim v(b)
  For n = 0 To b
    v(n) = args(n)
  Next
  ReadScalar = lmdbHandle.ReadScalarA(selectSentence, v)
End Function

Public Function ExecuteSQL(ByVal sqlSentence As String, ParamArray args() As Variant) As Long
Dim v() As Variant, n As Integer, b As Integer
  b = UBound(args)
  If b >= 0 Then ReDim v(b)
  For n = 0 To b
    v(n) = args(n)
  Next
  ExecuteSQL = lmdbHandle.ExecuteSQLA(sqlSentence, v)
End Function

Public Function ExecuteSQLA(ByVal sqlSentence As String, args As Variant) As Long
  ExecuteSQLA = lmdbHandle.ExecuteSQLA(sqlSentence, args)
End Function

Public Function OpenRecordsetA(selectSentence As String, args As Variant)
  Set OpenRecordsetA = lmdbHandle.OpenRecordsetA(selectSentence, args)
End Function

Public Function OpenRecordset(selectSentence As String, ParamArray args() As Variant)
Dim v() As Variant, n As Integer, b As Integer
  b = UBound(args)
  If b >= 0 Then ReDim v(b)
  For n = 0 To b
    v(n) = args(n)
  Next
  Set OpenRecordset = lmdbHandle.OpenRecordsetA(selectSentence, v)
End Function

Public Property Get FechaGlobal() As Date
  FechaGlobal = mIVAEDit.FechaGlobal
End Property

Public Property Let FechaGlobal(ByVal dt As Date)
  mIVAEDit.FechaGlobal = dt
End Property

Public Function EstaAutorizado(ByVal m As Integer) As Boolean
Dim p As PermisosUsuario
  p = m
  EstaAutorizado = lmUsuarios.EstaAutorizado(UsuarioActivo.codigo, p)
End Function

Public Function Suscriptores() As Collection
  Set Suscriptores = mGlobales.Suscriptores
End Function

Public Sub mAdvertencia(s As String)
  mGlobalLock.mAdvertencia s
End Sub

Public Function DeterminarFormato(sValueID As String, sOptionsKey As String, sDefVal As String, Optional pOwnerObject As Object = Nothing) As String
  DeterminarFormato = mDefinirFormato.DeterminarFormato(sValueID, sOptionsKey, sDefVal, pOwnerObject)
End Function

Public Sub ReportarError(isFatal As Boolean, numError As Long, sDescripcion As String, stLocus As String)
  mGlobalLock.ReportarError isFatal, numError, sDescripcion, stLocus
End Sub

Public Function SetGlobalLock(Optional s As String = "") As Boolean
  SetGlobalLock = mGlobalLock.SetGlobalLock(s)
End Function

Public Sub FreeGlobalLock()
  mGlobalLock.FreeGlobalLock
End Sub

Public Sub SubmitDoc(pDoc As Object, Optional TipoE As String = "")
  mGlobalLock.SubmitDoc pDoc, TipoE
End Sub

Public Function StartTransaction() As Boolean
  StartTransaction = lmdbHandle.StartTransaction
End Function

Public Function CommitTransaction() As Boolean
  CommitTransaction = lmdbHandle.CommitTransaction
End Function

Public Function AbortTransaction() As Boolean
  AbortTransaction = lmdbHandle.AbortTransaction
End Function

Public Function FechaDB(fecha) As String
    FechaDB = lmdbHandle.FechaDB(CDate(fecha))
End Function

Public Function TimeDateDB(fecha) As String
    TimeDateDB = lmdbHandle.TimeDateDB(CDate(fecha))
End Function

Public Function StringDB(starg) As String
    StringDB = lmdbHandle.StringDB(CStr(starg))
End Function

Public Function NumeroDB(dblArg) As String
    NumeroDB = lmdbHandle.NumeroDB(CDbl(dblArg))
End Function

Public Function AppExeName() As String
  AppExeName = App.EXEName
End Function

Public Function AppPath() As String
  AppPath = App.Path & "\"
End Function

Public Function DataPath() As String
  DataPath = BuildDataPath("", AppName)
End Function

Public Function ProximaFacturaPOS() As Long
  ProximaFacturaPOS = mMachineID.ProximoTicketMaquina
End Function

Public Function NumeroMaquina() As Long
  NumeroMaquina = mMachineID.MachineID
End Function

Public Function Format(ByVal arg As Variant, ByVal Formato As Variant) As Variant
Dim vRetVal As Variant
    vRetVal = VBA.Format(arg, Formato)
    Format = vRetVal
End Function

Public Function VerificarUsuario(stArgCaption As String) As Integer
  VerificarUsuario = lmUsuarios.VerificarUsuario(stArgCaption)
End Function

Public Function NewForm(sFormName) As CFormEnvelope
Dim f As Form, Env As CFormEnvelope
  On Error GoTo ErrHandler
  Set f = Forms.Add(sFormName)
  Set Env = New CFormEnvelope
  Env.SetForm f
ResumePoint:
  Set NewForm = Env

ErrHandler:
  Set Env = Nothing
  Resume ResumePoint
End Function

Public Function NewForm2(sFormName As String) As Object
Dim f As Form
  Set f = Forms.Add(sFormName)
  Set NewForm2 = f
End Function

Public Function Forms()
  Set Forms = VB.Forms()
End Function

Public Function FormByName(sFormName) As Form
Dim f, sf As String
  
  sf = UCase(sFormName)
  ' Guarrada para adaptar clrCaja4 al protocolo normal
'  If UCase(App.EXEName) = "CAJAPOS4" Or UCase(App.EXEName) = "CLRCAJA4" _
'  And UCase(sf) = "FRMPOS" Then _
'    sf = "FRMPASARCONSUMO"

  For Each f In Forms
    If UCase(f.Name) = sf Then
      Set FormByName = f
      Exit Function
    End If
  Next
  Set FormByName = Nothing
End Function

Public Function ExtendEval(Owner As Object, fileName As String, sVarId, vRetBuffer, sRetString) As Boolean
Dim bRetVal As Boolean, vRetVal As Variant
  bRetVal = mScriptExecute.ExtendEval(Owner, fileName, sVarId, vRetVal)
  If bRetVal Then
    vRetBuffer = vRetVal
    sRetString = vRetVal
  End If
  ExtendEval = bRetVal
End Function

Public Sub EditarDetallesSesion()
Dim f As frmEliminarDetSesion
  If SesionActiva.detalles.Count = 0 Then Exit Sub
  Set f = New frmEliminarDetSesion
  f.LoadSesion
  f.Show vbModal
  Unload f
End Sub

Public Function CrearObjeto(istrCodigoClase) As Object
Dim pRetObject As Object

    Select Case UCase(istrCodigoClase)
    Case "AJUSTE"
      Set pRetObject = New clsAjuste
    Case "ALMACEN"
      Set pRetObject = New clsAlmacen
    Case "ALMACENES"
      Set pRetObject = Almacenes
    Case "ALMACENCLIENTES"
      Set pRetObject = AlmacenClientes
    Case "ALMACENCUENTAS"
      Set pRetObject = AlmacenCuentas
    Case "ALMACENDETALLESITEMVENTA"
      Set pRetObject = AlmacenDetallesItemVenta
    Case "ALMACENITEMSINVENTARIO"
      Set pRetObject = AlmacenItemsInventario
    Case "ALMACENITEMSVENTA"
      Set pRetObject = AlmacenItemsVenta
    Case "ALMACENVENDEDORES"
      Set pRetObject = AlmacenVendedores
    Case "APP"
      Set pRetObject = App
    Case "ATRIBUTOS"
      Set pRetObject = New clsAtributoEntidad
    Case "CLIENTE", "CLIENTEPOS"
      Set pRetObject = New clsClientes
    Case "COLLECTION"
      Set pRetObject = New Collection
    Case "COMPROBANTE"
      Set pRetObject = New clsComprobante
    Case "BCOMPROBANTE"
      Set pRetObject = New clsBufferComprobante
    Case "COMPROBANTEALMACEN"
      Set pRetObject = New clsComprobanteAlmacen
    Case "CONDICIONES"
      Set pRetObject = Condiciones
    Case "CUENTA"
      Set pRetObject = New clsCuenta
    Case "CUENTAPOS"
      Set pRetObject = New clsCuentasPOS
    Case "DATABASE"
      Set pRetObject = dbHandle
    Case "DETALLECE"
      Set pRetObject = New clsDetalleCuentaEntidad
    Case "DOCUMENTOISPC"
      Set pRetObject = New clsDocumentosISPC
    Case "EMPRESA"
      Set pRetObject = Empresa
    Case "FACTURAPOS"
      Set pRetObject = New clsFacturasPOS
    Case "GENERALSCRIPT", "PSCRIPT"
      Set pRetObject = pScript
'    Case "FORMAPOS"
'      Set pRetObject = formaPOS
    Case "ITEMINVENTARIO"
      Set pRetObject = New clsItemInventario
    Case "ITEMVENTA"
      Set pRetObject = New clsItemVenta
    Case "LINEPRINTER"
      Set pRetObject = New CLinePrinter
    Case "MOVIMIENTOCAJA"
      Set pRetObject = New CIngresoCaja
    Case "NOTADCPP", "NOTADCCP"
      Set pRetObject = New clsNotasDCCP
    Case "PERFILES"
      Set pRetObject = CreateObject("perfilesPrecioCliente.activator")
      pRetObject.Init Me
    Case "POSEXT", "SCRIPT", "PSCRIPTPOS"
      Set pRetObject = pScriptPOS
    Case "PRINTER"
      Set pRetObject = Printer
    Case "PRINTERS"
      Set pRetObject = Printers
    Case "RENGLON", "RENGLONCUENTA", "RENGLONSESION"
      Set pRetObject = New clsRenglonSesion
    Case "SESION"
      Set pRetObject = SesionActiva
    Case "SESIONES"
      Set pRetObject = Sesiones
    Case "SERIES"
      Set pRetObject = Series
    Case "TIPOSIMPUESTO"
      Set pRetObject = TiposImpuesto
    Case "USUARIO"
      Set pRetObject = New clsUsuario
      pRetObject.SetUsuario UsuarioActivo.codigo
    Case "VENDEDOR"
      Set pRetObject = New clsVendedores
    Case "VSLIB"
      Set pRetObject = VSLRTLIB
    Case "SERVCAJA", "SERVICIOSCAJA"
      Set pRetObject = ServiciosCaja
    Case Else
      Set pRetObject = Nothing
    End Select
    
    Set CrearObjeto = pRetObject

End Function