Attribute VB_Name = "Mmantenimiento"
'OBSERVACION: LOS CONTROLES COMMANDBUTTON DEBEN ESTAR EN TABSTOP TRUE, EN LOS FORMULARIOS

Option Explicit
  
 'Variables grabadas en Mayo 2004
 Public Gstrarchivoaudita As String
  
 '****************************************************************************************************
  
 Public GintProveedorAcces As Integer
 Public GstrNombreZip As String
 Public GintZipActivo As Integer
 Public GstrRutaHistoricaTrans As String
 Public GintDecimalDescuento As Integer
 
 Public GstrRutaHistoricaRecep As String
 Public GintCentralEstacion As Integer
 
 Public GstrCodCompraPlaya As String
 Public GstrCodCompraTienda As String
 
 Public GstrReversaCompraPlaya As String
 Public GstrReversaCompraTienda As String
  
'****************************************************************************************************
'Variables de Configuracion IN_SETUP
'****************************************************************************************************

 Public GdblMaxredondeo As Double
 Public GintSkuredondeo As String
 
 Private MobjSetup As UTIL_SETUP.C_SETUP
 Private MOBJ_ALMACEN As DB_INV_MANTENIMIENTOS.C_ALMACEN
 Private MOBJ_moneda As DB_MA_MANTENIMIENTOS.C_MONEDA
 Private MrsTemporal As ADODB.Recordset
 
 Public GintCantidadTurnos As Integer       ' Cantidad de Turnos de la estación
 Public GintCantidadCaras As Integer        ' Cantidad de Caras de la estación
        
               
 Public GstrSimboloMonedaBaseModGen As String
 Public GstrMonedaExtranjeraModgen As String
 Public GstrSimboloMonedaExtModGen As String
                  
 Public GstrRutaPDT As String
 Public GintRutaPDTActiva As String
                  
 Public GstrTipoCambioVentas As String
 Public GstrTipodeCambio As String
 Public GintDecPrecio As Integer 'Almacena los decimales del precio
 Public GintDecCosto As Integer  'Almacena los decimales de los costos
 Public GintDecStock As Integer  'Almacena los decimales del Stock
 Public GintDecResultado As Integer  'Almacena los decimales de los Resultados
 Public GstrCodMonedaBase As String  'Almacena el codigo de la moneda base
 Public GIntPermiteStkNegativo As Integer 'Si es que se permite Stock Negativo
 Public GintTurnoActual As Integer
 Public GStrTipoControlCombustible As String
 Public GStrArticuloRedondeo As String
 Public GdbldiferenciaPermitida As Double
 Public GStrTipoNotaCreditoAjuste  As String
  
 
 Public GdblIGV As Double 'Almacena el porcentaje de IGV /Pero debe ser el codigo de la Tabla tAXS
 Public GStrCodigoIGV As String  'Guarda el código del IGV
 Public GDatFechaProceso As Date 'Almacena la Fecha de Proceso
 
 Public GstrPeriodo As String 'Almacena el periodo del Documento
 Public GstrCodTransferenciaIng As String
 Public GstrCodTransferenciaSal As String
 Public GstrReportesInv As String 'Almacena la ruta a los Reportes de Inventario
 Public GstrSiteProce As String
 Public GstrCodProveedorDefault As String
  
 Public GbytMovimiento As Byte ' 1 si es ingreso, 0 si es salida para las busquedas de movimientos
'****************************************************************************************************
 
 Public GCUSERID As String   'codigo de usuario
 Public gformmdi As MDIForm  ' referencia al formulario mdi
 Private mobj_cseguridad As DB_SE_MANTENIMIENTOS.c_seguridad


'Variables de Ventas

 Public GIntVentaAutoCombust As Integer
 Public GDatFechaProcesoVentas As Date
 Public GstrCategoriaFuels As String
 Public gblnsaltarcorrelativo As Boolean
 Public GstrRutaTran As String 'Almacena la ruta de la carpeta en donde se encuentran los Trans
 Public GstrRutaTranBlanco As String 'Almacena la ruta de la carpeta en donde se encuentran los Trans en blanco
 Public GstrReportesVta As String           ' Almacena la Ruta de los Reportes de Ventas
 Public GINTCONECTAR As Integer
 Public GSTRCADENACONECTA As String
 Public GintTipoControlador As Integer
 
 Public GstrRutaTranError As String
 Public GstrRutaJtran As String
 Public GintUser9_opsetup As Integer
 Public GcambPass As Integer
 
 
 '****************************************************************************************************
 ' Para Controlar el Estado del Cliente
 
 Public Const GC_CLIENTEACTIVO = "A"
 Public Const GC_CLIENTERETENCIONADMI = "H"
 Public Const GC_CLIENTERETENCIONCRED = "R"
 Public Const GC_CLIENTEINACTIVO = "I"
 Public Const GC_CLIENTEOTROS = "O"
 
 ' Para Controlar los Tipos de Pagos
 

 Public Const GC_PAGOEFECTIVO = "01"
 Public Const GC_TARJETACRED = "02"
 Public Const GC_CHEQUEGERENCIA = "03"
 Public Const GC_CHEQUECOMERCIAL = "04"
 Public Const GC_CHEQUEDIFERIDOCRED = "05"
 Public Const GC_VALESCRED = "06"
 Public Const GC_OTROS = "00"
 Public Const GC_CONTADOADELANTO = "14"
 
 ' Constantes de color para los enfoques
 Public Const GC_ColorEnfoque As Long = &HFFFFC0
 Public Const GC_ColorDefecto As Long = &HFFFFFF
 
Public ytrewq2 As Variant

'Para manipular los descuentos por item (Mi Mercado) -- J.L.I.U.
Public descuentoItem As Boolean      'Permite saber si se hace un descuento por Item
Public descuentoAdicional As Boolean 'Permite saber si se hace un descuento por monto del documento
Public TipoDescuento As Integer      'Descuento en: 1 = Porcentaje; 2 = Monto


'Recoge los valores en porcentaje de descuentos que se guardara para mostrar en la grilla de detalles de venta
Public montDescItem1PORC As Double  'porcentaje descuento 1= porcentaje y monto * item
Public montDescItem2PORC As Double

Public montDescAdic1PORC As Double 'porcentaje descuento 1= porcentaje y monto * documento
Public montDescAdic2PORC As Double

Sub Main()
        
        Set MOBJ_ALMACEN = New DB_INV_MANTENIMIENTOS.C_ALMACEN
        Set MOBJ_moneda = New DB_MA_MANTENIMIENTOS.C_MONEDA
        Set MobjSetup = New UTIL_SETUP.C_SETUP
        
        Set mobj_cseguridad = New DB_SE_MANTENIMIENTOS.c_seguridad
        
        Set MrsTemporal = MobjSetup.ObtenerSetupGeneral
        
        If MrsTemporal.EOF Or MrsTemporal.RecordCount = 0 Then
            MsgBox "No se encontraron los datos de configuracion", vbCritical, "Error"
            End
        End If
                
        '************************************************************
        'Cargar Variables del Setup General
        '************************************************************
                
        GintProveedorAcces = MrsTemporal!VERSIONACCESS
        GstrTipoCambioVentas = MrsTemporal!CURYTYPEIDSALES
        GintDecPrecio = MrsTemporal!FLOATPRICE
        GintDecCosto = MrsTemporal!FLOATCOST
        GintDecStock = MrsTemporal!FLOATQTY
        GintDecResultado = MrsTemporal!FLOATOUTPUT
        
        GintDecimalDescuento = MrsTemporal!FLOATDESC
        
        GdblIGV = MrsTemporal!TAXVALUEIGV
        GStrCodigoIGV = MrsTemporal!TAXID
        GstrCodMonedaBase = MOBJ_moneda.MONEDAoriginal()
        GstrSimboloMonedaBaseModGen = MOBJ_moneda.ListarPorMonedaID(GstrCodMonedaBase)!DescrMoney
        GstrMonedaExtranjeraModgen = MOBJ_moneda.ObtenerMonedaExtranjera(GstrCodMonedaBase)
        GstrSimboloMonedaExtModGen = MOBJ_moneda.ListarPorMonedaID(GstrMonedaExtranjeraModgen)!DescrMoney
                        
        GstrSiteProce = MOBJ_ALMACEN.Almacenoriginal()
        GStrCodigoIGV = MrsTemporal!TAXID
        GDatFechaProceso = MrsTemporal!DATEPROCE
        GstrTipodeCambio = MrsTemporal!SOURCECURYTYPEID
        GintTurnoActual = MrsTemporal!SALESPERSONTURN
        GintCantidadTurnos = MrsTemporal!QTYSALESPERSONTURN
        GintCantidadCaras = MrsTemporal!QTYSIDE
        GStrTipoControlCombustible = MrsTemporal!TYPECONTROLLERFUEL
        GdbldiferenciaPermitida = MrsTemporal!MAXDIFDIARY
          
        GstrNombreZip = MrsTemporal!NAMEZIP
        GintZipActivo = MrsTemporal!NAMEZIPACTIVE
        GstrRutaHistoricaTrans = MrsTemporal!PATHHISTOTRANS
        
        GstrRutaHistoricaRecep = MrsTemporal!PATHHISTORECEP
        GintCentralEstacion = MrsTemporal!CENTRALSTATION
        Gstrarchivoaudita = MrsTemporal!user3
        GcambPass = MrsTemporal!VENCPASS
                 
        '************************************************************
        'Cargar Variables del Setup de Inventarios
        '************************************************************
                
        Set MrsTemporal = MobjSetup.ObtenerSetupInventarios
        
        'GstrPeriodo = MrsTemporal!PERPOST
        GstrCodTransferenciaIng = MrsTemporal!INTYPETRANSFERIN
        GstrCodTransferenciaSal = MrsTemporal!INTYPETRANSFEROUT
        GstrReportesInv = Trim(MrsTemporal!REPORTPATH)
        GstrCodProveedorDefault = MrsTemporal!IDVENDORSS
        GIntPermiteStkNegativo = MrsTemporal!STKSTOCK
        GstrRutaPDT = MrsTemporal!PDTPATH
        GintRutaPDTActiva = MrsTemporal!ACTIVEPDTPATH
        
        GstrCodCompraPlaya = MrsTemporal!INTYPETRBUYFUELS
        GstrCodCompraTienda = MrsTemporal!INTYPETRBUYSTORE
        GstrReversaCompraPlaya = MrsTemporal!INTYPEREVBUYFUELS
        GstrReversaCompraTienda = MrsTemporal!INTYPEREVBUYSTORE
        
        GdblMaxredondeo = MrsTemporal!MAXROUNDINV
        GintSkuredondeo = MrsTemporal!SKUROUND
        
        '************************************************************
        'Cargar Variables del Setup de Ventas
        '************************************************************
                                                    
        Set MrsTemporal = MobjSetup.ObtenerSetupVentas
         
        If MrsTemporal!AUTOMATICSALES = True Then
           GIntVentaAutoCombust = 1
           
           GStrTipoControlCombustible = "1"
        Else
           GIntVentaAutoCombust = 0
           GStrTipoControlCombustible = "0"
        End If
        
        'GDatFechaProceso = MrsTemporal!DATEPROCESALES
        GDatFechaProcesoVentas = MrsTemporal!DATEPROCESALES
        gblnsaltarcorrelativo = MrsTemporal!STKCORRELATIVE
        GstrCategoriaFuels = MrsTemporal!CATEGORYFUEL
        GstrRutaTran = MrsTemporal!TRANSACFUELPATH
        GstrRutaTranBlanco = MrsTemporal!TABLESTRANSACFUEL
        GstrReportesVta = MrsTemporal!REPORTPATH
        GINTCONECTAR = MrsTemporal!STKODBCSTRING
        GSTRCADENACONECTA = MrsTemporal!STRINGCONECC
        GStrArticuloRedondeo = MrsTemporal!SKUROUNDSALES
        GStrTipoNotaCreditoAjuste = MrsTemporal!DOCTYPEIDNCAJUSTE
        GintTipoControlador = MrsTemporal!TYPECONTROLLER
        GstrRutaTranError = MrsTemporal!TRANSACFUELPATHERROR
        GstrRutaJtran = MrsTemporal!TRANSACFUELPATHJTRAN
        
        If IsNull(MrsTemporal!user9) Then
         GintUser9_opsetup = 0
        Else
         GintUser9_opsetup = MrsTemporal!user9
        End If
                                                                                                                                                                                                                                                  
                                                                                                                                                                                                                                                  
        Set MOBJ_ALMACEN = Nothing
        Set MOBJ_moneda = Nothing
        Set MobjSetup = Nothing
        Set MrsTemporal = Nothing

        fSeguridad.Show
End Sub
Public Sub gHabilitarReg(frmformulario As Form, ByVal valor As Boolean)
' funcionabilidad    : activa o desactiva los objetos de un formulario
' parametros entrada: formulario donde se activan/desantivan los controles
'On Error Resume Next
Dim curcontrol As Control
With frmformulario
For Each curcontrol In .Controls
    If TypeOf curcontrol Is TextBox Then
            curcontrol.Enabled = valor
    End If
     If TypeOf curcontrol Is DataCombo Then
             curcontrol.Enabled = valor
    End If
     If TypeOf curcontrol Is ComboBox Then
          curcontrol.Enabled = valor
    End If
     If TypeOf curcontrol Is CommandButton Then
          curcontrol.Enabled = Not curcontrol.Enabled
    End If
    
    If TypeOf curcontrol Is CheckBox Then
          curcontrol.Enabled = valor
    End If
    If TypeOf curcontrol Is OptionButton Then
          curcontrol.Enabled = valor
    End If
    If TypeOf curcontrol Is Frame Then
          curcontrol.Enabled = Not curcontrol.Enabled
    End If
    If TypeOf curcontrol Is CtrlNumber Then
          curcontrol.Enabled = Not curcontrol.Enabled
    End If
    If TypeOf curcontrol Is DTPicker Then
          curcontrol.Enabled = Not curcontrol.Enabled
    End If
Next
End With
End Sub

Public Sub gactualiza_barra(frm As Form)
'editar, primerregistro, ultimoregistro)
' funcionabilidad   : actualiza el status bar activando o desactivando
'                     los botones segun el valor pasado
    gformmdi.Toolbar1.Buttons(18).Caption = "Cerrar"    ' boton salir
'pb_editar , pb_primerregistro, pb_ultimoregistro

Select Case frm.pb_tiposcreen
    Case "M"
        If frm.pb_editar = True Then
            gformmdi.Toolbar1.Buttons(1).Enabled = False    ' boton agregar
            gformmdi.Toolbar1.Buttons(2).Enabled = False    ' boton modificar
            gformmdi.Toolbar1.Buttons(3).Enabled = True     ' boton Grabar
            gformmdi.Toolbar1.Buttons(4).Enabled = True     ' boton Descartar
            gformmdi.Toolbar1.Buttons(6).Enabled = False    'Boton Borrar
            gformmdi.Toolbar1.Buttons(8).Enabled = False    'Boton Refrescar
            gformmdi.Toolbar1.Buttons(10).Enabled = False   ' Boton Primero
            gformmdi.Toolbar1.Buttons(11).Enabled = False   ' Boton Anterior
            gformmdi.Toolbar1.Buttons(12).Enabled = False   ' Boton Siguiente
            gformmdi.Toolbar1.Buttons(13).Enabled = False   ' Boton Ultimo
            gformmdi.Toolbar1.Buttons(15).Enabled = False   ' Boton Ultimo
        Else
            gformmdi.Toolbar1.Buttons(3).Enabled = False ' boton Grabar
            gformmdi.Toolbar1.Buttons(4).Enabled = False  ' boton Descartar
            gformmdi.Toolbar1.Buttons(8).Enabled = True 'Boton Refrescar
        End If
        If frm.pb_primerregistro = True And (Not frm.pb_editar) Then
            gformmdi.Toolbar1.Buttons(10).Enabled = False ' Boton Primero
            gformmdi.Toolbar1.Buttons(11).Enabled = False ' Boton Anterior
            gformmdi.Toolbar1.Buttons(12).Enabled = True  ' Boton Siguiente
            gformmdi.Toolbar1.Buttons(13).Enabled = True   ' Boton Ultimo
        End If
        If frm.pb_ultimoregistro = True And (Not frm.pb_editar) Then
            gformmdi.Toolbar1.Buttons(10).Enabled = True ' Boton Primero
            gformmdi.Toolbar1.Buttons(11).Enabled = True ' Boton Anterior
            gformmdi.Toolbar1.Buttons(12).Enabled = False ' Boton Siguiente
            gformmdi.Toolbar1.Buttons(13).Enabled = False ' Boton Ultimo
        End If
        If (Not frm.pb_primerregistro) And (Not frm.pb_ultimoregistro) And (Not frm.pb_editar) Then
            gformmdi.Toolbar1.Buttons(10).Enabled = True ' Boton Primero
            gformmdi.Toolbar1.Buttons(11).Enabled = True ' Boton Anterior
            gformmdi.Toolbar1.Buttons(12).Enabled = True ' Boton Siguiente
            gformmdi.Toolbar1.Buttons(13).Enabled = True ' Boton Ultimo
        End If
    Case "P"
        gformmdi.Toolbar1.Buttons(1).Enabled = False    ' boton agregar
        gformmdi.Toolbar1.Buttons(2).Enabled = False    ' boton modificar
        gformmdi.Toolbar1.Buttons(3).Enabled = False     ' boton Grabar
        gformmdi.Toolbar1.Buttons(4).Enabled = False     ' boton Descartar
        gformmdi.Toolbar1.Buttons(6).Enabled = False    'Boton Borrar
        gformmdi.Toolbar1.Buttons(8).Enabled = True    'Boton Refrescar
        gformmdi.Toolbar1.Buttons(10).Enabled = False   ' Boton Primero
        gformmdi.Toolbar1.Buttons(11).Enabled = False   ' Boton Anterior
        gformmdi.Toolbar1.Buttons(12).Enabled = False   ' Boton Siguiente
        gformmdi.Toolbar1.Buttons(13).Enabled = False   ' Boton Ultimo
        gformmdi.Toolbar1.Buttons(15).Enabled = False   ' Boton imprimir
    Case "R"
        gformmdi.Toolbar1.Buttons(1).Enabled = False    ' boton agregar
        gformmdi.Toolbar1.Buttons(2).Enabled = False    ' boton modificar
        gformmdi.Toolbar1.Buttons(3).Enabled = False     ' boton Grabar
        gformmdi.Toolbar1.Buttons(4).Enabled = False     ' boton Descartar
        gformmdi.Toolbar1.Buttons(6).Enabled = False    'Boton Borrar
        gformmdi.Toolbar1.Buttons(8).Enabled = True    'Boton Refrescar
        gformmdi.Toolbar1.Buttons(10).Enabled = False   ' Boton Primero
        gformmdi.Toolbar1.Buttons(11).Enabled = False   ' Boton Anterior
        gformmdi.Toolbar1.Buttons(12).Enabled = False   ' Boton Siguiente
        gformmdi.Toolbar1.Buttons(13).Enabled = False   ' Boton Ultimo
        gformmdi.Toolbar1.Buttons(15).Enabled = True  ' Boton imprimir
    Case "T"
        If frm.pb_editar = True Then
            gformmdi.Toolbar1.Buttons(1).Enabled = False    ' boton agregar
            gformmdi.Toolbar1.Buttons(2).Enabled = False    ' boton modificar
            gformmdi.Toolbar1.Buttons(3).Enabled = True     ' boton Grabar
            gformmdi.Toolbar1.Buttons(4).Enabled = True     ' boton Descartar
            gformmdi.Toolbar1.Buttons(6).Enabled = False    'Boton Borrar
            gformmdi.Toolbar1.Buttons(8).Enabled = False    'Boton Refrescar
            gformmdi.Toolbar1.Buttons(10).Enabled = False   ' Boton Primero
            gformmdi.Toolbar1.Buttons(11).Enabled = False   ' Boton Anterior
            gformmdi.Toolbar1.Buttons(12).Enabled = False   ' Boton Siguiente
            gformmdi.Toolbar1.Buttons(13).Enabled = False   ' Boton Ultimo
            gformmdi.Toolbar1.Buttons(15).Enabled = True  ' Boton imprimir
        Else
            gformmdi.Toolbar1.Buttons(3).Enabled = False ' boton Grabar
            gformmdi.Toolbar1.Buttons(4).Enabled = False  ' boton Descartar
            gformmdi.Toolbar1.Buttons(8).Enabled = True 'Boton Refrescar
        End If
    Case Else
        gformmdi.Toolbar1.Buttons(1).Enabled = False    ' boton agregar
        gformmdi.Toolbar1.Buttons(2).Enabled = False    ' boton modificar
        gformmdi.Toolbar1.Buttons(3).Enabled = False     ' boton Grabar
        gformmdi.Toolbar1.Buttons(4).Enabled = False     ' boton Descartar
        gformmdi.Toolbar1.Buttons(6).Enabled = False    'Boton Borrar
        gformmdi.Toolbar1.Buttons(8).Enabled = False    'Boton Refrescar
        gformmdi.Toolbar1.Buttons(10).Enabled = False   ' Boton Primero
        gformmdi.Toolbar1.Buttons(11).Enabled = False   ' Boton Anterior
        gformmdi.Toolbar1.Buttons(12).Enabled = False   ' Boton Siguiente
        gformmdi.Toolbar1.Buttons(13).Enabled = False   ' Boton Ultimo
        gformmdi.Toolbar1.Buttons(15).Enabled = False  ' Boton imprimir
        
    End Select
    
    gformmdi.Toolbar1.Buttons(18).Caption = "Cerrar"
End Sub
Sub Gprimer_registro(frm As Form, irst As ADODB.Recordset)
'FUNCIONABILIDAD        : MOVERSE AL PRIMER REGISTRO DE UN ADODB.Recordset
'argumento de entrada   : formulario y ADODB.Recordset
If Not irst.EOF Then
    frm.pb_primerregistro = True
    frm.pb_ultimoregistro = False
    irst.MoveFirst
    Call gactualiza_barra(frm) 'frm.pb_editar, frm.pb_primerregistro, frm.pb_ultimoregistro)
End If
End Sub
Sub Gregistro_siguiente(frm As Form, irst As ADODB.Recordset)
'FUNCIONABILIDAD        : MOVERSE AL SIGUIENTE REGISTRO DE UN ADODB.ADODB.Recordset
'argumento de entrada   : formulario y ADODB.ADODB.Recordset
If Not irst.EOF Then
    frm.pb_primerregistro = False
    irst.MoveNext
    If irst.EOF Then
        MsgBox ("Ùltimo registro"), vbInformation + vbDefaultButton1, "Mensaje"
        frm.pb_ultimoregistro = True
        irst.MoveLast
    End If
    Call gactualiza_barra(frm) 'frm.pb_editar, frm.pb_primerregistro, frm.pb_ultimoregistro)
End If
End Sub

Sub Gregistro_anterior(frm As Form, irst As ADODB.Recordset)
'FUNCIONABILIDAD        : MOVERSE AL SIGUIENTE REGISTRO DE UN ADODB.Recordset
'argumento de entrada   : formulario y ADODB.Recordset
If Not irst.EOF Then
    frm.pb_ultimoregistro = False
    irst.MovePrevious
    If irst.BOF Then
        MsgBox ("Primer Registro"), vbInformation + vbDefaultButton1, "Mensaje"
        frm.pb_primerregistro = True
        irst.MoveFirst
    End If
    Call gactualiza_barra(frm) 'frm.pb_editar, frm.pb_primerregistro, frm.pb_ultimoregistro)
End If
End Sub
Sub Gultimo_registro(frm As Form, irst As ADODB.Recordset)
'FUNCIONABILIDAD        : MOVERSE AL SIGUIENTE REGISTRO DE UN ADODB.Recordset
'argumento de entrada   : formulario y ADODB.Recordset
If Not irst.EOF Then
    frm.pb_ultimoregistro = True
    frm.pb_primerregistro = False
    irst.MoveLast
    Call gactualiza_barra(frm) 'frm.pb_editar, frm.pb_primerregistro, frm.pb_ultimoregistro)
End If
End Sub
Sub ggrabar_registro(frm As Form)
'funcionabilidad      : actualizar los flags
'parametros de entrada : formulario que se esta grabando
frm.pb_agregar = False
frm.pb_editar = False
Call gactualiza_barra(frm) 'frm.pb_editar, frm.pb_primerregistro, frm.pb_ultimoregistro)
Call gHabilitarReg(frm, frm.pb_editar)
Call gactualizaopcion(frm.pbderecho_agregar, frm.pbderecho_editar, frm.pbderecho_borrar, frm.pbderecho_imprimir)
MsgBox ("Registro Grabado"), vbInformation + vbDefaultButton1, "Mensaje"
End Sub
Public Sub gnuevoReg(frmformulario As Form)
'funcionabilidad    : pone en blanco todos los controles de un formulario
' parametros entrada: formulario donde se agregaran un registro
Dim curcontrol As Control
With frmformulario
For Each curcontrol In .Controls
    If TypeOf curcontrol Is TextBox Then
            curcontrol.Text = ""
    End If
     If TypeOf curcontrol Is DataCombo Then
             curcontrol.Text = ""
    End If
     If TypeOf curcontrol Is ComboBox Then
          curcontrol.Text = ""
    End If
    If TypeOf curcontrol Is CtrlNumber Then
          curcontrol.Text = "0"
    End If
    If TypeOf curcontrol Is CheckBox Then
          curcontrol.Value = 0
    End If
Next
End With
End Sub
Sub gagregar_registro(frm As Form, obj As Control)
'funcionabilidad    : agregar registros a un ADODB.Recordset
'parametros de entrada  : obj dbe ser el pk para dar el enfoque
'                         frm formulario donde se encuentra el ADODB.Recordset
Dim curcontrol As Control
frm.pb_agregar = True
frm.pb_editar = True
Call gHabilitarReg(frm, frm.pb_editar)
Call gactualiza_barra(frm) 'frm.pb_editar, frm.pb_primerregistro, frm.pb_ultimoregistro)
With frm
For Each curcontrol In .Controls
    If TypeOf curcontrol Is TextBox Then
            curcontrol.Text = ""
    End If
     If TypeOf curcontrol Is DataCombo Then
             curcontrol.Text = ""
    End If
    If TypeOf curcontrol Is ComboBox Then
        If curcontrol.Style <> 2 Then
          curcontrol.Text = ""
        End If
    End If
    If TypeOf curcontrol Is CtrlNumber Then
          curcontrol.ValorPorDefecto
    End If
    If TypeOf curcontrol Is CheckBox Then
          curcontrol.Value = 0
    End If
Next
obj.SetFocus
End With
End Sub
Sub gmodificar_registro(frm As Form, obj As Control)
'funcionabilidad : activa los campos de un formulario y actualiza el status bar
'parametros de entrada: obj debe ser el pk para bloquer
'                       frm el formulario donde se encuentra el ADODB.Recordset

frm.pb_editar = True
Call gHabilitarReg(frm, frm.pb_editar)
Call gactualiza_barra(frm) 'frm.pb_editar, frm.pb_primerregistro, frm.pb_ultimoregistro)
obj.Enabled = False
End Sub
Sub gdescartar_registro(frm As Form)
'funcionabilidad : desactiva los campos de un formulario y actualiza el status bar
'parametros de entrada: frm el formulario donde se encuentra el ADODB.Recordset
 
 frm.pb_agregar = False
 frm.pb_editar = False
 Call gHabilitarReg(frm, frm.pb_editar)
 Call gactualiza_barra(frm) 'frm.pb_editar, frm.pb_primerregistro, frm.pb_ultimoregistro)
 Call gactualizaopcion(frm.pbderecho_agregar, frm.pbderecho_editar, frm.pbderecho_borrar, frm.pbderecho_imprimir)
 MsgBox ("Cambios Descartados"), vbInformation + vbDefaultButton1, "Mensaje"
 
End Sub
Sub gborrar_Registro(frm As Form, Optional rst As ADODB.Recordset, Optional obj As Control)
'funcionabilidad    :llamar al proc. de borrado,
' parametros de entrada frm formulario donde se desea eliminar
'                           rst ADODB.Recordset donde se va a eliminar
'                           obj control que contiene el pk
'llamada al procedimiento de borrado
'if not error then
    MsgBox ("Registro Borrado"), vbInformation + vbDefaultButton1, "Mensaje"
    Call gactualiza_barra(frm) 'frm.pb_editar, frm.pb_primerregistro, frm.pb_ultimoregistro)
'End If
End Sub
Function gseguridad(frm As Form)
'funcionabilidad        : determinar los derechos que el usuario tiene con ese formualario
' parametros de entrada : frm formulario donde se desea saber los derechos
' la sintaxis del titulo del formulario debe ser "descripcion ( MM NNN.NNN)
' MM modulo
' NNNN.NNN identificador de screen
Dim stitulo As String       'titulo del formulario
Dim sid As String        ' id del formulario
Dim rs_derechos As ADODB.Recordset  'derechos que tiene el usuario sobre el formualario
Dim scade As String 'cadena de conexion
stitulo = frm.Caption
sid = Mid(Trim(frm.Caption), Len(stitulo) - 9, 9)
sid = Mid(sid, 1, 2) + Mid(sid, 4, 3) + Mid(sid, 8, 2)
'Set rs_derechos = New adodb.Recordset

Set rs_derechos = mobj_cseguridad.listar_derechosUsuario(GCUSERID, sid)

' identifica los derechos del usuario
If rs_derechos.EOF Then
    frm.pbderecho_agregar = False
    frm.pbderecho_consultar = False
    frm.pbderecho_editar = False
    frm.pbderecho_borrar = False
    frm.pbderecho_imprimir = False
    gseguridad = False
    frm.pb_tiposcreen = ""
Else
    rs_derechos.MoveFirst
    frm.pb_tiposcreen = rs_derechos!screentype
    Do Until rs_derechos.EOF
        Select Case rs_derechos!screentype
            Case "T"        'transacciones
                frm.pbderecho_anular = IIf(Not frm.pbderecho_anular, rs_derechos!nullRIGHTS, True)
                frm.pbderecho_emitir = IIf(Not frm.pbderecho_emitir, rs_derechos!closeRIGHTS, True)
                frm.pbderecho_consultar = IIf(Not frm.pbderecho_consultar, rs_derechos!ViewRIGHTS, True)
                frm.pbderecho_agregar = IIf(Not frm.pbderecho_agregar, rs_derechos!iNSERTRIGHTS, True)
                frm.pbderecho_editar = IIf(Not frm.pbderecho_editar, rs_derechos!uPDATERIGHTS, True)
                frm.pbderecho_borrar = IIf(Not frm.pbderecho_borrar, rs_derechos!dELETERIGHTS, True)
                frm.pbderecho_imprimir = IIf(Not frm.pbderecho_imprimir, rs_derechos!pRINTRIGHTS, True)
            Case "M"        'maestros
                frm.pbderecho_consultar = IIf(Not frm.pbderecho_consultar, rs_derechos!ViewRIGHTS, True)
                frm.pbderecho_agregar = IIf(Not frm.pbderecho_agregar, rs_derechos!iNSERTRIGHTS, True)
                frm.pbderecho_editar = IIf(Not frm.pbderecho_editar, rs_derechos!uPDATERIGHTS, True)
                frm.pbderecho_borrar = IIf(Not frm.pbderecho_borrar, rs_derechos!dELETERIGHTS, True)
                frm.pbderecho_imprimir = IIf(Not frm.pbderecho_imprimir, rs_derechos!pRINTRIGHTS, True)
            Case "P"        'procesos
                frm.pbderecho_consultar = IIf(Not frm.pbderecho_consultar, rs_derechos!ViewRIGHTS, True)
                frm.pbderecho_agregar = False
                frm.pbderecho_editar = False
                frm.pbderecho_borrar = False
                frm.pbderecho_imprimir = IIf(Not frm.pbderecho_imprimir, rs_derechos!pRINTRIGHTS, True)
            Case "R"        'REPORTE
                frm.pbderecho_consultar = IIf(Not frm.pbderecho_consultar, rs_derechos!ViewRIGHTS, True)
                frm.pbderecho_agregar = False
                frm.pbderecho_editar = False
                frm.pbderecho_borrar = False
                frm.pbderecho_imprimir = IIf(Not frm.pbderecho_imprimir, rs_derechos!pRINTRIGHTS, True)
        End Select
        rs_derechos.MoveNext
    Loop
    gseguridad = frm.pbderecho_consultar
End If
End Function
Sub gsalir()
Unload gformmdi
End
End Sub
Sub gactualizaopcion(agregar, editar, borrar, imprimir)
gformmdi.Toolbar1.Buttons(1).Enabled = agregar ' Boton agregar
gformmdi.Toolbar1.Buttons(2).Enabled = editar ' Boton editar
gformmdi.Toolbar1.Buttons(6).Enabled = borrar ' Boton borrar
gformmdi.Toolbar1.Buttons(15).Enabled = imprimir ' Boton imprimir
End Sub

Public Sub gdesactiva_barra()
' funcionabilidad   : desactiva todos los gbotones de la barra
gformmdi.Toolbar1.Buttons(18).Caption = "Salir"    ' boton salir
gformmdi.Toolbar1.Buttons(1).Enabled = False    ' boton agregar
gformmdi.Toolbar1.Buttons(2).Enabled = False    ' boton modificar
gformmdi.Toolbar1.Buttons(3).Enabled = False    ' boton Grabar
gformmdi.Toolbar1.Buttons(4).Enabled = False     ' boton Descartar
gformmdi.Toolbar1.Buttons(6).Enabled = False    'Boton Borrar
gformmdi.Toolbar1.Buttons(8).Enabled = False    'Boton Refrescar
gformmdi.Toolbar1.Buttons(10).Enabled = False   ' Boton Primero
gformmdi.Toolbar1.Buttons(11).Enabled = False   ' Boton Anterior
gformmdi.Toolbar1.Buttons(12).Enabled = False   ' Boton Siguiente
gformmdi.Toolbar1.Buttons(13).Enabled = False   ' Boton Ultimo
gformmdi.Toolbar1.Buttons(15).Enabled = False   ' Boton imprimir
End Sub
Sub gestadoactualrs(frm As Form, rs As ADODB.Recordset)
If rs.EOF Then  'no hay registros
   Exit Sub
End If

If rs.AbsolutePosition = 1 Then
    frm.pb_ultimoregistro = False
    frm.pb_primerregistro = True
Else
    frm.pb_primerregistro = False
End If
If rs.AbsolutePosition = rs.RecordCount Then
    frm.pb_primerregistro = False
    frm.pb_ultimoregistro = True
Else
    frm.pb_ultimoregistro = False
End If
End Sub

Public Function GBloqueaCaracter(KeyAscii As Integer) As Integer
'autor : emnrique franco
'funcion evita que se digiten caracteres invalidos
If KeyAscii = 39 Or KeyAscii = 124 Then
    GBloqueaCaracter = 0
Else
    If KeyAscii >= 97 And KeyAscii <= 122 Then
       GBloqueaCaracter = KeyAscii - 32
    Else
       GBloqueaCaracter = KeyAscii
    End If
End If
End Function
Public Function GValidarNulos(ByVal IVarDato As Variant) As Variant
'autor : enrique franco
' funcion validas los datos obtenidos, si es null devuelve una cadena vacia
' de lo contrario devuelve el mismo datos
'parametro ingreso  : valor a evaluar
   If IsNull(IVarDato) Then
      GValidarNulos = Empty
   Else
      GValidarNulos = IVarDato
   End If
End Function
Public Function GVDATO(ByVal IVarDato As Variant) As String
'autor      : gustavo duffoo
'funcion    : validas los datos obtenidos, elimina mayusculas y espacios
'               en blanco, elimina los nulos
'parametro ingreso  : valor a cambiar
'parametro salida  : cadena sin espacios ni nulos y en mayusculas
'fecha          : 12/09/20002
   IVarDato = Trim(UCase(GValidarNulos(IVarDato)))
   GVDATO = IVarDato
End Function

'Autor : enrique franco
'Funcionalidad : Devuelve Cadena para formatear Números
'Parametro de Entrada :Numero de Decimales a Formatear

Public Function GMascara(IintNumerodeDecimales As Integer) As String
  Select Case IintNumerodeDecimales
     Case 0
          GMascara = "#######0"
     Case 1
          GMascara = "#######0.0"
     Case 2
          GMascara = "#######0.00"
     Case 3
          GMascara = "#######0.000"
     Case 4
          GMascara = "#######0.0000"
     Case 5
          GMascara = "#######0.00000"
     Case 6
          GMascara = "#######0.000000"
     Case 7
          GMascara = "#######0.0000000"
     Case 8
          GMascara = "#######0.00000000"
End Select
End Function
'Autor : enrique franco
'Funcionalidad : Devuelve el Número Formateado
'Parametro de Entrada :Numero a Formatear ,Decimales

Public Function GFormatodeNumero(IdblValor As Double, IintDecimales As Integer) As Variant
     GFormatodeNumero = Format(IdblValor, GMascara(IintDecimales))
End Function
'Autor : GUSTAVO DUFFOO
'Funcionalidad : VALIDA LOS CAMPOS DE UN FORMULARIO SEGUN EL TAG
'                CONVIERTE TODOS LOS VALORES DE TEXTO A MAYUSCULA, SIN BLANCOS
'                VERIFICA LOS TEXTBOX, COMBOBOX, DATACOMBO,
'                SI EL TAG EMPIEZA CON R ES UN CAMPO REQUERIDO QUE NO DEBE ESTAR EN BLANCO
'                SI ESTA EN BLANCO Y ES REQUERIDO MUESTRA EL MENSAJE QUE ESTA A CONTINUANCION DEL TAG
'
'Parametro de Entrada :FORMULARIO
'Parametro de SALIDAS :BOOLEANO, TRUE SI ENCONTRO ERRORES, FALSE SI TODO ESTA OK
Public Function GVAL(frm As Form) As Boolean
Dim LS_TAG As String
GVAL = True
End Function

'Autor : Enriqueta Franco
'Funcionalidad : Retorna un mensaje de Error De acuerdo a el Número Recibido

Public Function MensajedeError(IVarnumeroError As Variant, Optional ISTRMensajeadicional As String) As String

    Select Case IVarnumeroError
       Case 20000
            MensajedeError = Mid(ISTRMensajeadicional, 48, Len(ISTRMensajeadicional))
       Case 20001
            MensajedeError = Mid(ISTRMensajeadicional, 48, Len(ISTRMensajeadicional))
       Case 20002
            MensajedeError = Mid(ISTRMensajeadicional, 48, Len(ISTRMensajeadicional))
       Case Else
            MensajedeError = ISTRMensajeadicional
    End Select
End Function
'Autor : EDGAR CANCHO
'Funcionalidad : LLENA LOS DATOS EN UN DATACOMPO
'PARAMETROS DE INGRESO :    DATACOMBO , OBJETO A LLENAR datalist o datacombo
'                           Rssource DEL CUAL SE OBTIENEN LOS DATOS
'                           istrCampo1 campo a devolver
'                           istrCampo2 campo a mostrar
Public Sub CargaDataCombo(objDataCombo As Object, rsSource As Recordset, istrCampo1 As String, istrCampo2 As String)
    Set objDataCombo.RowSource = rsSource
    objDataCombo.ListField = istrCampo2
    objDataCombo.BoundColumn = istrCampo1
    If Not rsSource.EOF Then
        objDataCombo.BoundText = rsSource.Fields(istrCampo2)
    End If
End Sub
Public Sub MENSAJES_USUARIO(validar As Integer)
If validar = 1 Then
    MsgBox ("No existe Usuario"), vbDefaultButton1 + vbExclamation, "Advertencia"
    Exit Sub
End If
If validar = 2 Then
    MsgBox ("Clave Incorrecta"), vbDefaultButton1 + vbExclamation, "Advertencia"
    Exit Sub
End If
If validar = 3 Then
    MsgBox ("Clave ha expirado"), vbDefaultButton1 + vbExclamation, "Advertencia"
    Exit Sub
End If
If validar = 4 Then
    MsgBox ("Usuario Desactivado"), vbDefaultButton1 + vbExclamation, "Advertencia"
    Exit Sub
End If
If validar = 5 Then
    MsgBox ("Usuario Suspendido"), vbDefaultButton1 + vbExclamation, "Advertencia"
    Exit Sub
End If
End Sub

Public Function GBloqueanonumeros(KeyAscii As Integer) As Integer
If (KeyAscii >= 48 And KeyAscii <= 57) Or KeyAscii = 8 Then
    GBloqueanonumeros = KeyAscii
Else
    GBloqueanonumeros = 0
End If
End Function

Public Function GValidaRUC(strRUC As String) As Boolean
    Dim intUltimoDigito As Integer
    Dim intDigitoVerifi As Integer
    Dim intVal1 As Integer
    Dim intVal2 As Integer
    Dim intResul As Integer
    
    Dim intD1 As Integer
    Dim intD2 As Integer
    Dim intD3 As Integer
    Dim intD4 As Integer
    Dim intD5 As Integer
    Dim intD6 As Integer
    Dim intD7 As Integer
    Dim intD8 As Integer
    Dim intD9 As Integer
    Dim intD10 As Integer
    
    GValidaRUC = False
    
    strRUC = Trim(strRUC)
    
    intUltimoDigito = CInt(Mid(strRUC, Len(strRUC), 1))
    intD10 = CInt(Mid(strRUC, Len(strRUC) - 1, 1))
    intD9 = CInt(Mid(strRUC, Len(strRUC) - 2, 1))
    intD8 = CInt(Mid(strRUC, Len(strRUC) - 3, 1))
    intD7 = CInt(Mid(strRUC, Len(strRUC) - 4, 1))
    intD6 = CInt(Mid(strRUC, Len(strRUC) - 5, 1))
    intD5 = CInt(Mid(strRUC, Len(strRUC) - 6, 1))
    intD4 = CInt(Mid(strRUC, Len(strRUC) - 7, 1))
    intD3 = CInt(Mid(strRUC, Len(strRUC) - 8, 1))
    intD2 = CInt(Mid(strRUC, Len(strRUC) - 9, 1))
    intD1 = CInt(Mid(strRUC, Len(strRUC) - 10, 1))
    
    intVal1 = 5 * intD1 + 4 * intD2 + 3 * intD3 + 2 * intD4 + 7 * intD5 + 6 * intD6 + 5 * intD7 + 4 * intD8 + 3 * intD9 + 2 * intD10
    intVal2 = intVal1 \ 11
    intResul = 11 - (intVal1 - (intVal2 * 11))

    If intResul = 10 Then
        intDigitoVerifi = 0
    Else
        If intResul = 11 Then
            intDigitoVerifi = 1
        Else
            intDigitoVerifi = intResul
        End If
    End If


    If intDigitoVerifi = intUltimoDigito Then
        GValidaRUC = True
    End If
    
End Function

Public Function GGeneraClaveDeposito(strReferencia As String) As String

Dim strEvaluacion As String
Dim i As Integer
Dim intVAL As Integer
Dim intSUM As Integer
Dim intRESIDUO As Integer
Dim intRESTA As Integer
Dim strClave As String
    
If Len(Trim(strReferencia)) = 10 Then

    strEvaluacion = Mid(strReferencia, 2, 2) + Right(strReferencia, 5)
    intSUM = 0
    
    For i = 1 To Len(strEvaluacion)
        intVAL = Val(Mid(strEvaluacion, i, 1))
        intSUM = intSUM + (intVAL * (8 - i))
    Next
    
    intRESIDUO = intSUM Mod 11
    intRESTA = 11 - intRESIDUO
    
    If intRESIDUO = 0 Or intRESIDUO = 1 Then
        intRESTA = 0
    End If
    
    strClave = strEvaluacion + Trim(Str(intRESTA))
    
    GGeneraClaveDeposito = strClave
    
Else
    strReferencia = Trim(GstrSiteProce) + Mid(strReferencia, 1, 5)
    
    strEvaluacion = Mid(strReferencia, 1, 2) + Right(strReferencia, 5)
    intSUM = 0
    
    For i = 1 To Len(strEvaluacion)
        intVAL = Val(Mid(strEvaluacion, i, 1))
        intSUM = intSUM + (intVAL * (8 - i))
    Next
    
    intRESIDUO = intSUM Mod 11
    intRESTA = 11 - intRESIDUO
    
    If intRESIDUO = 0 Or intRESIDUO = 1 Then
        intRESTA = 0
    End If
    
    strClave = strEvaluacion + Trim(Str(intRESTA))
    
    GGeneraClaveDeposito = strClave
End If
    
End Function

' Función Agregada para Verifcar Vencimiento de Usuario
Function Verifica_dias_Venc(StrUsuario As String, StrPassword As String)
        
    Dim LintdiasUltCamb As Integer
    Dim Lintdiasdispo As Integer
    Dim LintdiaVenc As Integer
    Dim LUtilMod As UTIL_SETUP.C_SETUP
    Dim Lrstemp As ADODB.Recordset
    
    Dim FCambioClave
    
    Set LUtilMod = New UTIL_SETUP.C_SETUP
    
    If UCase(Trim(StrUsuario)) = "SYSADMIN" Then
       Exit Function
    End If
                
    If Trim(StrPassword) = "" Then
       ' Hay que Obtener el password y hay que desencriptarlo
          
        Set Lrstemp = LUtilMod.Auxiliar3("select password from se_userrec where userid='" & Trim(StrUsuario) & "'")
        If Not Lrstemp.EOF Then
           StrPassword = Trim(Encrip(Trim(Lrstemp!Password)))
        End If
        
    End If
                
    Set LUtilMod = New UTIL_SETUP.C_SETUP
          
    Set Lrstemp = LUtilMod.Auxiliar3("select User2 from se_userrec where userid='" & Trim(StrUsuario) & "'")
          
    If Not IsNull(Lrstemp!USER2) Then
       If Trim(Lrstemp!USER2) = "T" Then
          ' Significa que es un password temporal y se tiene que deshabilitar
          Dim LutMante As DB_UT_MANTENIMIENTOS.C_PROCESOS
          Set LutMante = New DB_UT_MANTENIMIENTOS.C_PROCESOS
          LutMante.Auxiliar1 " Update se_userrec set STATUS=0,user2='D' where userid='" & StrUsuario & "'"
          Set LutMante = Nothing
          Exit Function
       End If
       If Trim(Lrstemp!USER2) = "D" Then
          ' El password temporal ya está deshabilitado
          MsgBox "Su cuenta está deshabilitada ", vbDefaultButton1 + vbExclamation, "Mensaje"
          End
       End If
    End If
          
    Set Lrstemp = LUtilMod.Auxiliar3("Select ISNULL(datediff(DD,max(date),GETDATE()),0) AS ULTCAMB from SE_USERPASS where userid='" & StrUsuario & "'")
        
    If Not Lrstemp.EOF Then
       LintdiasUltCamb = Lrstemp!Ultcamb
    End If
     
    Set Lrstemp = LUtilMod.Auxiliar3("select isnull(user8,0) as dias from setup")
    
    LintdiaVenc = Lrstemp!dias
                           
    If LintdiaVenc <> 0 Then ' Se ha configurado la fecha de aviso
               
       Lintdiasdispo = GcambPass - LintdiasUltCamb
       
       If Lintdiasdispo <= LintdiaVenc Then
         If Lintdiasdispo < 0 Then
            ' Bloquear Cuenta
            GBloquearUsuario StrUsuario
            MsgBox "Su password ha expirado", vbDefaultButton1 + vbExclamation, "Mensaje"
            End
         Else
           If Lintdiasdispo = 0 Then
              If MsgBox("Su password expirará el día de hoy " + vbCrLf + "Si no lo cambia su cuenta se bloqueará el día de mañana " + vbCrLf + "Desea Cambiarlo ahora ?", vbYesNo + vbQuestion, "Advertencia") = vbYes Then
               ' Levantar pantalla de canmbio de password
               FCambioClave.GstrUsuario = StrUsuario
               FCambioClave.GstrPassword = StrPassword
               FCambioClave.Show vbModal
              End If
           Else
              If MsgBox("Su password expirará en " + CStr(Lintdiasdispo) + " días " + vbCrLf + " Desea Cambiarlo ahora ?", vbYesNo + vbQuestion, "Advertencia") = vbYes Then
               ' Levantar pantalla de canmbio de password
               FCambioClave.GstrUsuario = StrUsuario
               FCambioClave.GstrPassword = StrPassword
               FCambioClave.Show vbModal
              End If
           End If
         End If
       End If
    Else
       ' No se ha configurado los dias de aviso
       Lintdiasdispo = GcambPass - LintdiasUltCamb
       If Lintdiasdispo < 0 Then
          ' Bloquear la cuenta
          GBloquearUsuario StrUsuario
          MsgBox "Su password ha expirado", vbDefaultButton1 + vbExclamation, "Mensaje"
          End
       End If
    End If
                            
    Set LUtilMod = Nothing
        
End Function

Public Function Encrip(X As String) As String
 
 Dim i As Integer, aux, Result, ult As String
 ult = Right(X, 1)
 aux = ""
 Result = ""
 i = 1

If ult <> "-" Then    '  si es que no esta encriptado
    
    'Primero vamos a cambiar de lugar a la cadena.
    'Ej: "DAEBFC" -> "ABCDEFG"
    'Primero los pares, luego los impares
 
    Do While Len(X) > i
        aux = aux + Right(Left(X, i + 1), 1)
        i = i + 2
    Loop
    i = 1
    Do While Len(X) >= i
        aux = aux + Right(Left(X, i), 1)
        i = i + 2
    Loop
    
  ' Segundo, Vamos a manipular los ASCII
     
     i = 1
       Do While Len(aux) >= i
        Result = Result + Chr(Asc(Right(Left(aux, i), 1)) - 10)
        i = i + 1
       Loop
      Encrip = Result + "-"
       
Else ' Si es qque ya esta encriptado
  X = Left(X, Len(X) - 1)

 ' Primero vamos a devolver el orden inicial
 '  Ej: ABCDEFG -> DAEBFC
   
  Do While Len(X) \ 2 + 1 >= i
       If Len(X) \ 2 + 1 > i Or Len(X) Mod 2 <> 0 Then
        aux = aux + Right(Left(X, (Len(X) \ 2) + i), 1)
       End If
       
       If Len(X) \ 2 >= i Then
        aux = aux + Right(Left(X, i), 1)
       End If
        
        i = i + 1
  Loop
  i = 1
  Do While Len(aux) >= i
        Result = Result + Chr(Asc(Right(Left(aux, i), 1)) + 10)
        i = i + 1
  Loop
      Encrip = Result
End If

End Function

Public Function GValidaPassword(StrUsuarioId As String, StrPassword As String) As String
   
Dim LintLongitud As Integer
Dim i As Integer
                       
If Len(Trim(StrPassword)) < 8 Then
   GValidaPassword = "LMENOR"
   MsgBox "La longitud del password debe ser mayor a 8 caracteres ", vbDefaultButton1 + vbExclamation, "Mensaje"
   Exit Function
End If
      
If Len(Trim(StrPassword)) > 11 Then
   GValidaPassword = "LMAYOR"
   MsgBox "La longitud del password debe ser menor o igual a 11 caracteres ", vbDefaultButton1 + vbExclamation, "Mensaje"
   Exit Function
End If
      
If UCase(Trim(StrUsuarioId)) = UCase(Trim(StrPassword)) Then
   GValidaPassword = "IDEN"
   MsgBox "El password no puede ser igual al usuario ", vbDefaultButton1 + vbExclamation, "Mensaje"
   Exit Function
End If
      
LintLongitud = Len(Trim(StrPassword))
      
' Verificar si tiene letras
      
 For i = 1 To LintLongitud
    If Mid(StrPassword, i, 1) Like "[A-Z]" Or Mid(StrPassword, i, 1) Like "[a-z]" Then
        GoTo Controlnumeros
    End If
 Next
 GValidaPassword = "S"
 MsgBox "El password debe contener al menos una letra  ", vbDefaultButton1 + vbExclamation, "Mensaje"
 Exit Function
 
Controlnumeros:
     
 For i = 1 To LintLongitud
    If Mid(StrPassword, i, 1) Like "[0-9]" Then
        GoTo ControlSimbolos
    End If
 Next
 
 GValidaPassword = "N"
 MsgBox "El password debe contener al menos un número  ", vbDefaultButton1 + vbExclamation, "Mensaje"
 Exit Function
ControlSimbolos:
   
 For i = 1 To LintLongitud
    If Mid(StrPassword, i, 1) Like "[!A-Z]" And Mid(StrPassword, i, 1) Like "[!a-z]" And Mid(StrPassword, i, 1) Like "[!0-9]" Then
       GoTo ControlHistorial
    End If
 Next
 GValidaPassword = "E"
 MsgBox "El password debe contener al menos un caracter especial  ", vbDefaultButton1 + vbExclamation, "Mensaje"
 Exit Function
    
ControlHistorial:
  
  Dim LutilTemp As UTIL_SETUP.C_SETUP
  Dim Lrstemp As ADODB.Recordset
  Set LutilTemp = New UTIL_SETUP.C_SETUP
     
  Set Lrstemp = LutilTemp.Auxiliar3("Select password from SE_USERPASS where userid='" & StrUsuarioId & "'")
  
  If Not Lrstemp.EOF Then
     ' Existen password historicos
     Lrstemp.MoveFirst
     Do While Not Lrstemp.EOF
        If Trim(UCase(StrPassword)) = Trim(Encrip(Trim(Lrstemp!Password))) Then
           GValidaPassword = "HISTO"
           MsgBox "El password ingresado ya fue utilizado anteriormente", vbDefaultButton1 + vbExclamation, "Mensaje"
           Exit Function
        End If
        Lrstemp.MoveNext
     Loop
     GoTo final
  Else
     ' No hay password historico
     GoTo final
  End If
  
final:
   
 GValidaPassword = "T"
End Function

Sub GBloquearUsuario(StrUsuario As String)

   Dim LutMantenimiento As DB_UT_MANTENIMIENTOS.C_PROCESOS
   Set LutMantenimiento = New DB_UT_MANTENIMIENTOS.C_PROCESOS
          
   LutMantenimiento.Auxiliar1 "SE_BloquearCuenta  '" & StrUsuario & "'"

   Set LutMantenimiento = Nothing
   
End Sub
