Attribute VB_Name = "Funciones"
' declaraciones
Const MAX_COMPUTERNAME_LENGTH = 255
'Const MAX_COMPUTERNAME_LENGTH = 255

Private Const gesCartola As Integer = 1
Private Const gesCalendarioCurso As Integer = 2
Private Const gesModalXmes As Integer = 3
Private Const gesGradoXmes As Integer = 4
Private Const gesLetraXmes As Integer = 5
Private Const gesNombreModalXmes As Integer = 6
Private Const gesNombreMes As Integer = 7
Private Const gesAsisOK As Integer = 8
Private Const gesAsisBad As Integer = 9
Private Const gesLetraNivelSinTerminar As Integer = 10

Public rut_prof As String
Public Nom_usu_ses As String
'Public Nom_com_usu_ses As String

'VAR POLETTE
Public cosa As Integer

Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long

' Para usar Archivos INI
Public Declare Function GetPrivateProfileSectionNames Lib "kernel32" Alias "GetPrivateProfileSectionNamesA" _
    (ByVal lpszReturnBuffer As String, ByVal nSize As Long, _
    ByVal lpFileName As String) As Long
Public Declare Function GetPrivateProfileSection Lib "kernel32" Alias "GetPrivateProfileSectionA" _
    (ByVal lpAppName As String, ByVal lpReturnedString As String, _
    ByVal nSize As Long, ByVal lpFileName As String) As Long
Public Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" _
    (ByVal lpApplicationName As String, ByVal lpKeyName As Any, _
     ByVal lpDefault As String, ByVal lpReturnedString As String, _
     ByVal nSize As Long, ByVal lpFileName As String) As Long
Public Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" _
    (ByVal lpApplicationName As String, ByVal lpKeyName As Any, _
     ByVal lpString As Any, ByVal lpFileName As String) As Long
     
'********** FIN INI
Public Type TConfig
   Disco As String
   Directorio As String
   FicheroAnexo As String
   De As String
   Para As String
   Smtp As String
   AnexoVisible As Boolean
   HayAnexo As Boolean
End Type
Public arr_deuda(5) As String
Public arr_descuentos(8) As String
Public base_inicio As String
Public Cfg As TConfig
Public Paso As Integer
Public Cadena As String
Public NFich As String
Public ConexionEstablecida As Boolean
Public Cabecera(100) As String
Public Boundary As String
Public InicioAnexo As Integer
Public InicioBoundaryAnexo As Integer
Public EnviandoMensaje As Boolean
Public ContTotal As Long
Public Tipo_Item_Formacion As String
Public pre_ens As String
Public renuncia_run As String
Public renuncia_proceso As String
Public alert As Integer


'declaracion de constantes
Private Const ODBC_ADD_DSN = 1 ' Add data source
Private Const ODBC_CONFIG_DSN = 2 ' Configure (edit) data source
Private Const ODBC_REMOVE_DSN = 3 ' Remove data source
Private Const vbAPINull As Long = 0& ' NULL Pointer
'delcaracion de funciones
#If Win32 Then
    Private Declare Function SQLConfigDataSource Lib "ODBCCP32.DLL" _
            (ByVal hwndParent As Long, ByVal fRequest As Long, _
             ByVal lpszDriver As String, ByVal lpszAttributes As String) As Long
#Else
    Private Declare Function SQLConfigDataSource Lib "ODBCINST.DLL" _
            (ByVal hwndParent As Integer, ByVal fRequest As Integer, ByVal _
            lpszDriver As String, ByVal lpszAttributes As String) As Integer
#End If

Public Declare Function _
SystemParametersInfo Lib "user32" Alias _
"SystemParametersInfoA" (ByVal uAction As Long, _
ByVal uParam As Long, ByRef lpvParam As Any, _
ByVal fuWinIni As Long) As Long
Private Type RECT
Izq As Long
Sup As Long
Der As Long
Inf As Long
End Type
Public Const SPI_GETWORKAREA = 48
Private Declare Sub CoTaskMemFree Lib "ole32" (ByVal hPointer As Long)
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal hIDL As Long, ByVal cPath As String) As Boolean
Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByValhwndOwner As Long, ByVal nFolder As Long, pidl As Long) As Long

'delay
Public Declare Sub Sleep Lib "kernel32" Alias "sleep" (ByVal dwMilliseconds As Long)


Public Sub IniDelete(ByVal sIniFile As String, ByVal sSection As String, _
                    Optional ByVal sKey As String = "")
    If Len(sKey) = 0 Then
        Call WritePrivateProfileString(sSection, 0&, 0&, sIniFile)
    Else
        Call WritePrivateProfileString(sSection, sKey, 0&, sIniFile)
    End If
End Sub

Public Sub InformeRepitentesProbables(ByRef agno As Integer, ByRef CNX As ADODB.Connection)
    Dim Sql As String
    
    Sql = "delete from informe_repro"
    conn.Execute Sql
    
    Sql = "REPLACE INTO informe_repro(ci_alu,colegio,cod_ens,num_gra,letra_curso,agno,prom,rojos,morados,dias_clases,dias_asis,porc_asis,repro_asis,danger_asis) "
    Sql = Sql & "Select p.ci_alu, '" & RetornaCampo("CFG", "valor", "param='CODBC'", conn) & "' as 'colegio', p.cod_ens, p.num_gra, p.letra_curso, p.agno, round(avg(p.nf)) as prom, sum(if(p.nf<4,1,0)) as 'rojos', sum(if((p.nf<=4.5 and p.nf>=4.0),1,0)) as 'morados', a.dias_clases, a.dias_asis, a.porc_asis, if((a.porc_asis<0.85),1,0) as 'repro_asis', if( (a.porc_asis<=0.87 and a.porc_asis>=0.85) , 1, 0) as 'danger_asis' "
    Sql = Sql & "From promedios as p,alu_x_cur as axc, (select ci_alu, agno, sum(asi_r) as 'dias_clases', sum(asi_t) as 'dias_asis', round((sum(asi_t)/sum(asi_r)),4) as 'porc_asis' From asistencia where agno=" & agno & " Group By ci_alu) as a,asi_x_cur_prof prof "
    Sql = Sql & "Where p.ci_alu=a.ci_alu and p.agno=a.agno and p.agno=" & agno & " and p.cod_asi<>13 and p.nf>0 "
    Sql = Sql & " and p.ci_alu = axc.ci_alu and p.agno = axc.agno and p.cod_ens = axc.cod_ens and p.num_gra = axc.num_gra and " _
        & " p.letra_curso = axc.let_cur and axc.activo_alu = 'SI'" _
        & " and prof.cod_ens = p.cod_ens and prof.cod_sec = p.cod_sec and prof.cod_asi = p.cod_asi and prof.num_gra = p.num_gra and prof.let_cur = p.letra_curso and prof.agno = p.agno "
    Sql = Sql & "Group By p.ci_alu "
    Sql = Sql & "Order By p.cod_ens, p.num_gra, p.letra_curso, p.ci_alu;"
    
    CNX.Execute Sql
End Sub

Public Function IniGet(ByVal lpFileName As String, ByVal lpAppName As String, _
                       ByVal lpKeyName As String, _
                       Optional ByVal lpDefault As String = "") As String
    Dim LTmp As Long
    Dim sRetVal As String
    sRetVal = String$(255, 0)
    LTmp = GetPrivateProfileString(lpAppName, lpKeyName, lpDefault, sRetVal, Len(sRetVal), lpFileName)
    If LTmp = 0 Then
        IniGet = lpDefault
    Else
        IniGet = Left(sRetVal, LTmp)
    End If
End Function


Public Sub IniWrite(ByVal lpFileName As String, ByVal lpAppName As String, _
                    ByVal lpKeyName As String, ByVal lpString As String)
    Call WritePrivateProfileString(lpAppName, lpKeyName, lpString, lpFileName)
End Sub


Public Function IniGetSection(ByVal lpFileName As String, _
                              ByVal lpAppName As String) As Variant
    Dim tContenidos As Collection
    Dim nSize As Long
    Dim i As Long
    Dim j As Long
    Dim sTmp As String
    Dim sClave As String
    Dim sValor As String
    sBuffer = String$(32767, Chr$(0))
   
    nSize = GetPrivateProfileSection(lpAppName, sBuffer, Len(sBuffer), lpFileName)
    If nSize Then
        Set tContenidos = New Collection
        sBuffer = Left$(sBuffer, nSize)
        i = InStr(sBuffer, vbNullChar & vbNullChar)
        If i Then
            sBuffer = Left$(sBuffer, i - 1)
        End If
        Do
            i = InStr(sBuffer, Chr$(0))
            If i Then
                sTmp = LTrim$(Left$(sBuffer, i - 1))
                If Len(sTmp) Then
                    j = InStr(sTmp, "=")
                    If j Then
                        sClave = Left$(sTmp, j - 1)
                        sValor = LTrim$(Mid$(sTmp, j + 1))
                        tContenidos.Add sClave
                        tContenidos.Add sValor
                    End If
                End If
                sBuffer = Mid$(sBuffer, i + 1)
            End If
        Loop While i
        If Len(sBuffer) Then
            j = InStr(sBuffer, "=")
            If j Then
                sClave = Left$(sBuffer, j - 1)
                sValor = LTrim$(Mid$(sBuffer, j + 1))
                tContenidos.Add sClave
                tContenidos.Add sValor
            End If
        End If
    End If
    Set IniGetSection = tContenidos
End Function


Public Function IniGetSections(ByVal lpFileName As String) As Variant
    ' Devuelve todas las secciones de un fichero INI
    Dim tContenidos As Collection
    Dim nSize As Long
    Dim i As Long
    Dim sTmp As String
    sBuffer = String$(32767, Chr$(0))
    nSize = GetPrivateProfileSectionNames(sBuffer, Len(sBuffer), lpFileName)
       
    If nSize Then
        Set tContenidos = New Collection
        sBuffer = Left$(sBuffer, nSize)
        i = InStr(sBuffer, vbNullChar & vbNullChar)
        If i Then
            sBuffer = Left$(sBuffer, i - 1)
        End If
        Do
            i = InStr(sBuffer, Chr$(0))
            If i Then
                sTmp = LTrim$(Left$(sBuffer, i - 1))
                If Len(sTmp) Then
                    tContenidos.Add sTmp
                End If
                sBuffer = Mid$(sBuffer, i + 1)
            End If
        Loop While i
        If Len(sBuffer) Then
            tContenidos.Add sBuffer
        End If
    End If
    Set IniGetSections = tContenidos
End Function

'Public Sub CentrarForma(frm As Form)
'Dim R As RECT
'Dim lRes As Long
'Dim lAncho As Long
'Dim lLargo As Long
'With frm
'If .WindowState = vbMinimized Or .WindowState = vbMaximized Then Exit Sub
'End With
'lRes = SystemParametersInfo(SPI_GETWORKAREA, 0, R, 0)
'If lRes Then
'With R
'.Izq = Screen.TwipsPerPixelX * .Izq
'.Sup = Screen.TwipsPerPixelY * .Sup
'.Der = Screen.TwipsPerPixelX * .Der
'.Inf = Screen.TwipsPerPixelY * .Inf
'lAncho = .Der - .Izq
'lLargo = .Inf - .Sup
'
'frm.Move (.Izq + (lAncho - frm.Width) \ 2) - 35, (.Sup + (lLargo - frm.Height) \ 2) - 510
'End With
'End If
'End Sub
Public Function PromMinMaxGen(tabla As String, campo As String, Criterio As String, Conexion As ADODB.Connection) As String

'**************** ASI SE USA ********************
'min_max_gen = PromMinMaxGen("PROMEDIOS", "P" & Left(Me.Cmd_Per.Text, 1), "cod_ens ='" & CodModalidad & "' AND num_gra ='" & Me.Cmb_Grado & "' AND letra_curso ='" & Me.Cmb_Let_Cur & "' AND cod_sec ='" & CodSec & "' AND cod_asi ='" & CodAsi & "'")
'Me.LbPromL.Caption = Left(min_max_gen, 3)
'Me.LbPromH.Caption = Mid(min_max_gen, 4, 3)
'Me.LbPromG.Caption = Right(min_max_gen, 3)
'************************************************

Dim MmG As String
Set RsAux = New ADODB.Recordset
RsAux.CursorLocation = adUseClient

If Criterio <> "" And campo <> "PS" Then
    RsAux.Open "SELECT MIN(" & campo & ") FROM " & tabla & " where " & campo & "<> 0 and " & Criterio, Conexion, adOpenKeyset
    MmG = Format(RsAux(0), "0.0")
    RsAux.Close
    RsAux.Open "SELECT MAX(" & campo & ") FROM " & tabla & " where " & campo & "<> 0 and " & Criterio, Conexion, adOpenKeyset
    MmG = MmG & Format(RsAux(0), "0.0")
    RsAux.Close
    RsAux.Open "SELECT AVG(" & campo & ") FROM " & tabla & " where " & campo & "<> 0 and " & Criterio, Conexion, adOpenKeyset
    MmG = MmG & Format(Int(Round(RsAux(0) * 10, 1)) / 10, "0.0")
    RsAux.Close
End If
If Criterio = "" Then
    RsAux.Open "SELECT MIN(" & campo & ") FROM " & tabla & Criterio, Conexion, adOpenKeyset
    MmG = Format(RsAux(0), "0.0")
    RsAux.Close
    RsAux.Open "SELECT MAX(" & campo & ") FROM " & tabla & Criterio, Conexion, adOpenKeyset
    MmG = MmG & Format(RsAux(0), "0.0")
    RsAux.Close
    RsAux.Open "SELECT AVG(" & campo & ") FROM " & tabla & Criterio, Conexion, adOpenKeyset
    MmG = MmG & Format(RsAux(0), "0.0")
    RsAux.Close
End If

If Len(MmG) > 0 Then
    PromMinMaxGen = MmG
Else
    PromMinMaxGen = "0,0"
End If
Set rsrsaux = Nothing
End Function

Sub Dither(vForm As Form)
'Demostración de como puede tener una ventana
' en escala de Azules.
'
' El formulario deberá tener el AutoRedraw a True
Dim intLoop As Integer
vForm.DrawStyle = vbInsideSolid
vForm.DrawMode = vbCopyPen
vForm.ScaleMode = vbPixels
vForm.DrawWidth = 2
vForm.ScaleHeight = 256
For intLoop = 0 To 255
vForm.Line (0, intLoop)-(Screen.Width, intLoop - 1), RGB(0, 0, 255 - intLoop), B
Next intLoop
End Sub

Public Function calculaEdad(FechaNacimiento As Date, fechaactual As Date) As Integer
    ' Se calcula la edad con respecto a la fecha del dia en curso
    calculaEdad = Year(fechaactual) - Year(FechaNacimiento)
    If (Month(fechaactual) < Month(FechaNacimiento)) Or (Month(fechaactual) = Month(FechaNacimiento) And Day(fechaactual) < Day(FechaNacimiento)) Then
            calculaEdad = calculaEdad - 1
    End If
End Function

Public Sub llenalistaespecial(Control As ListBox, tabla, campo, criteriobus As String, Conexion As ADODB.Connection)
'esta funcion llena la lista de asignaturas segun nivel y compara si esa asignatura
' ya esta asignada a un curso y su profesor X
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
rs.CursorLocation = adUseClient
a = " SELECT " & campo & " FROM " & tabla & " " & criteriobus
rs.Open a, Conexion
If rs.RecordCount > 0 Then
    For t = 0 To rs.RecordCount - 1
        If Not valorenlista(Form_man_asi_x_prof.lst_asi_asignadas, rs(campo)) Then
            Control.AddItem rs(campo)
        End If
        rs.MoveNext
    Next t
End If
rs.Close
End Sub

Public Sub llenalista(Control As ListBox, tabla, campo, criteriobus As String, Conexion As ADODB.Connection)
'esta funcion llena una lista con un campo X basado en un criterio especifico
rs.CursorLocation = adUseClient
a = " SELECT " & campo & " FROM " & tabla & " " & criteriobus
rs.Open a, Conexion
If rs.RecordCount > 0 Then
    For t = 0 To rs.RecordCount - 1
            Control.AddItem rs(campo)
        rs.MoveNext
    Next t
End If
rs.Close
End Sub

Public Function Valorenmatriz(Arreglo As Variant, Dimension As Integer, valor As String) As Boolean
Dim largo As Variant
Valorenmatriz = False
largo = UBound(Arreglo, Dimension)
For t = 0 To largo
    If UCase(Arreglo(t, Dimension)) = UCase(valor) Then
        Valorenmatriz = True
        Exit For
    End If
Next t
End Function

Public Function valorenlista(Control As ListBox, valor As String) As Boolean
valorenlista = False
For t = 0 To Control.ListCount
    If UCase(Control.List(t)) = UCase(valor) Then
        valorenlista = True
        Exit For
    End If
Next t
End Function

Public Function Quitavalorenlista(Control As ListBox, valor As String, Todos As Boolean) As Boolean
Dim t As Integer
Quitavalorenlista = False
For t = 0 To Control.ListCount
    If UCase(Control.List(t)) = UCase(valor) Then
        Control.RemoveItem t
        Quitavalorenlista = True
        If Not Todos Then
            Exit For
        End If
    End If
Next t
End Function

Public Function Buscavalorenlista(Control As ListBox, valor As String) As Integer
Dim t As Integer
Buscavalorenlista = -1
For t = 0 To Control.ListCount
    If UCase(Control.List(t)) = UCase(valor) Then
        Buscavalorenlista = t
        Exit For
    End If
Next t
End Function

Public Sub menuhabilitado(status As Boolean)
    'Form_main.PAR_GLO.Enabled = status
    Form_main.man_tab.Enabled = status
    Form_main.Proc.Enabled = status
    Form_main.informes.Enabled = status
    Form_main.Hrm.Enabled = status
    'Form_main.fin.Enabled = status
    'Form_main.Hlp.Enabled = status
    'Form_main.Toolbar1.Enabled = status
    Form_main.Toolbar2.Enabled = status
    Form_main.Toolbar3.Enabled = status
    Form_main.Toolbar4.Enabled = status
End Sub

Public Function posicionenlista(Control As ComboBox, valor As String) As Integer
posicionenlista = -1
For t = 0 To Control.ListCount
    If UCase(Control.List(t)) = UCase(valor) Then
        posicionenlista = t
        Exit For
    End If
Next t
End Function

'Public Function InvierteFecha(fecha As Date, DerechoReves As String) As String
'If UCase(DerechoReves) = "D" Then InvierteFecha = Format(fecha, "dd/mm/yyyy")
'If UCase(DerechoReves) = "R" Then InvierteFecha = Format(fecha, "yyyy/mm/dd")
'End Function

Public Function digito(rut As String, Optional MSG As Boolean = True) As String
Dim aux, Res As Long
Dim Con As Integer
aux = 2
Res = 0
For Con = Len(Trim(rut)) To 1 Step -1
  Res = (aux * CLng(Mid(rut, Con, 1))) + Res
  aux = aux + 1
  If aux > 7 Then
    aux = 2
  End If
Next Con
Res = Res Mod 11
digito = CStr(11 - Res)
If digito = "10" Then
  digito = "K"
  ElseIf digito = "11" Then
  digito = "0"
 End If
If rut = "" And MSG Then
    MsgBox "El RUT ingresado no es válido.", vbOKOnly, "Atención"
End If
End Function

Public Function tablavacia(tabla As String, Conexion As ADODB.Connection) As Boolean
Dim abrio As Boolean
'On Error GoTo controlerror

Set rs = New ADODB.Recordset
abrio = False
rs.CursorLocation = adUseClient
rs.Open "SELECT * FROM " & tabla, Conexion
abrio = True
If rs.RecordCount > 0 Then
'Ojo con el error que dice el proveedor de datos u otro servicio
'devolvió un estado E_FAIL, ocurre cuando un campo almacena un dato de tipo
'diferente al campo
    tablavacia = False
Else
    tablavacia = True
End If
rs.Close
Exit Function
Controlerror:
If Err.Number = -2147467259 Then
    tablavacia = True
    If abrio Then
        rs.Close
    End If
End If
End Function
Sub validatexto(cajatexto As textbox, Mensaje As String)
        MsgBox ("" + Mensaje)
        cajatexto.Enabled = True
        cajatexto.SetFocus
        SendKeys "{home}+{end}"
End Sub

Public Function DevuelveCampo(tabla As String, entracampo As String, salecampo As String, criteriobus As String, Conexion As ADODB.Connection) As String
On Error GoTo controlerr
' Esta funcion devuelve un campo por otro acompañado de un criterio de busqueda
Set RsFuncion = New ADODB.Recordset
RsFuncion.CursorLocation = adUseClient
'rs.Open "select " & salecampo & "," & "from " & tabla & " where " & criteriobus, Conexion
a = "select " & salecampo & " from " & tabla & " where " & criteriobus
RsFuncion.Open a, Conexion
If RsFuncion.RecordCount > 0 Then
    RsFuncion.MoveFirst
    DevuelveCampo = IIf(Not IsNull(RsFuncion(0)), RsFuncion(0), "")
Else
    DevuelveCampo = ""
End If
RsFuncion.Close
Set RsFuncion = Nothing
Exit Function
' Error cuando devuelve e-fail con generacion de cuponeras
controlerr:
If Err.Number = -2147467259# And Trim(tabla) = "fnza_deta_cupones" Then
    DevuelveCampo = ""
End If
End Function

Public Sub Limpieza()
  ' *** cerrar los objetos de base de datos
    ' *** y liberar la memoria
    '
    On Error Resume Next
    '
    Dim ws As Workspace
    Dim db As Database
    Dim rs As Recordset
    '
    For Each ws In Workspaces
        For Each db In ws.Databases
            For Each rs In db.Recordsets
                rs.Close
                Set rs = Nothing
            Next
            db.Close
            Set db = Nothing
        Next
        ws.Close
        Set ws = Nothing
    Next
    '
    
    conn.Close
    Set conn = Nothing
End Sub
Public Sub llenacomboconarreglo(Control As ComboBox, tabla, CAMPO1, CAMPO2, Arreglo, Conexion As ADODB.Connection)
Set RsFuncion = New ADODB.Recordset
RsFuncion.CursorLocation = adUseClient
a = " SELECT " & CAMPO1 & "," & CAMPO2 & " FROM " & tabla
RsFuncion.Open a, Conexion
If RsFuncion.RecordCount > 0 Then
    ReDim Arreglo(RsFuncion.RecordCount)
    For t = 0 To RsFuncion.RecordCount - 1
        Control.AddItem RsFuncion(0)
        Arreglo(t) = RsFuncion(1)
        RsFuncion.MoveNext
    Next t
End If
RsFuncion.Close
End Sub

Public Function separarut(rut As String)
If Trim(rut) = "-" Or Trim(rut) = "" Then
    separarut = ""
Else
    separarut = Mid(rut, 1, Len(Trim(rut)) - 2)
    ' saco el rut sin el digito verificador y el guión
End If
End Function
Public Sub LlenaGrilla(nombregrilla As MSFlexGrid, encabezados As String, tabla As String, campos As String, criteriobus As String, Conexion As ADODB.Connection)
Dim c As Integer
Dim encab As String
Dim colu As Integer
Dim sale As Boolean

nombregrilla.Clear
colu = 0
Fila = 2
poscoma = 1
nombregrilla.Row = 0

n = 1
While n <> 0 '
i = i + 1    ' el total de columnas de la grilla.
n = InStr(n + 1, encabezados, ",") ' /
Wend                                    '/

ncampos = 1
While ncampos <> 0   'aqui cuento el
    icampos = icampos + 1    ' el total de campos a traer
    ncampos = InStr(ncampos + 1, campos, ";") ' /
Wend                                          '/
                                             '/
nombregrilla.Cols = i            ' <----\____/
Encabfinal = ""
While Len(encabezados) > 0   ' Aquí se crean los encabezados
    poscoma = InStr(1, encabezados, ",")
    If poscoma > 1 Then
        encab = Mid(encabezados, 1, poscoma - 1)
        encabezados = Mid(encabezados, poscoma + 1, Len(encabezados))
        Encabfinal = Encabfinal + encab + "|"
    ElseIf poscoma = 0 And Len(encabezados) > 0 Then
        encab = Mid(encabezados, 1, Len(encabezados))
        encabezados = ""
        Encabfinal = Encabfinal + encab
    End If

Wend
nombregrilla.FormatString = Encabfinal
' Aquí tomo la cadena con los campos y reemplazo el caracter ; por ,
' el motivo de usar ; en vez de , es poder usar funciones que requieren comas
' para separar argumentos. Si se usan comas en toda la cadena, al contar todas las comas de la
 ' cadena se produce una diferencia entre los campos reales y los contados en la cadena.
Camposfinal = ""
While Len(campos) > 0
    poscoma = InStr(1, campos, ";")
    If poscoma > 1 Then
        encab = Mid(campos, 1, poscoma - 1)
        campos = Mid(campos, poscoma + 1, Len(campos))
        Camposfinal = Camposfinal + encab + ","
    ElseIf poscoma = 0 And Len(campos) > 0 Then
        encab = Mid(campos, 1, Len(campos))
        campos = ""
        Camposfinal = Camposfinal + encab
    End If
Wend
campos = Camposfinal
nombregrilla.Rows = 2
If Len(Trim(tabla)) <> 0 Then
    Set RsAux = New ADODB.Recordset
    RsAux.CursorLocation = adUseClient
    If Len(Trim(criteriobus)) > 0 Then
        a = " SELECT " & campos & " FROM " & tabla & " Where " & criteriobus
    Else
        a = " SELECT " & campos & " FROM " & tabla
    End If
    
    RsAux.Open a, Conexion
    If RsAux.RecordCount > 0 Then
        ReDim arraygrilla(RsAux.RecordCount, icampos)
        c = 1
        While Not RsAux.EOF
            nombregrilla.Row = c
            For t = 1 To icampos
                If t <= i Then
                    nombregrilla.Col = t - 1
                    If IsNull(RsAux(t - 1)) Then
                        nombregrilla.Text = ""
                        arraygrilla(c, t) = ""
                    Else
                        nombregrilla.Text = RsAux(t - 1)
                        arraygrilla(c, t) = RsAux(t - 1)
                    End If
                Else
                    If IsNull(RsAux(t - 1)) Then
                        arraygrilla(c, t) = ""
                    Else
                        arraygrilla(c, t) = RsAux(t - 1)
                    End If
                End If
            Next t
            nombregrilla.Rows = nombregrilla.Rows + 1
            c = c + 1
            RsAux.MoveNext
        Wend
        nombregrilla.Rows = nombregrilla.Rows - 1
        RsAux.Close
    Else
        RsAux.Close
    End If
    'If nombregrilla.Rows > 2 Then
    '   nombregrilla.RemoveItem (nombregrilla.Rows)
    'End If
End If
End Sub
Public Function separadigito(rut As String)
If Trim(rut) = "-" Or Trim(rut) = "" Then
   separadigito = ""
Else
   separadigito = Right(rut, 1)
   ' saco el digito verificador y el guión
End If
End Function

Public Function nombreconcomas(tabla, camponombre, Apellido1, Apellido2, criteriobus, Conexion As ADODB.Connection)
' Esta funcion devuelve un nombre compuesto por un campo nombres y otro campo apellidos
' separados por coma, todo esto en base a un rut
rs.CursorLocation = adUseClient
If Apellido2 = "" Then a = " SELECT " & camponombre & ", " & Apellido1 & ", " & Apellido2 & " FROM " & tabla & " where " & criteriobus & " order by " & Apellido1 & ", " & Apellido2 & ", " & camponombre & " asc"
If Apellido2 <> "" Then a = " SELECT " & camponombre & ", " & Apellido1 & " FROM " & tabla & " where " & criteriobus & " order by " & Apellido1 & ", " & camponombre & " asc"
rs.Open a, Conexion
If rs.RecordCount > 0 Then
    nombreconcomas = rs(Apellido1) + " , " + rs(camponombre)
End If
rs.Close



End Function
Public Sub combonombreconcomas(Control As ComboBox, tabla, camponombre, Apellido1, Apellido2, Conexion As ADODB.Connection)
' llena un combobox con el nombre y apellido  separado por coma
rs.CursorLocation = adUseClient
 If Trim(Apellido2) <> "" Then a = " SELECT " & Apellido1 & ", " & Apellido2 & ", " & camponombre & " FROM " & tabla & " order by " & Apellido1 & ", " & Apellido2 & ", " & camponombre & " asc"
 If Trim(Apellido2) = "" Then a = " SELECT " & Apellido1 & ", " & camponombre & " FROM " & tabla & " order by " & Apellido1 & ", " & camponombre & " asc"

rs.Open a, Conexion
Control.Clear
If rs.RecordCount > 0 Then
    While Not rs.EOF
        If Trim(Apellido2) <> "" Then Control.AddItem Trim(rs(Apellido1)) & " " & Trim(rs(Apellido2)) & " , " + Trim(rs(camponombre))
        If Trim(Apellido2) = "" Then Control.AddItem Trim(rs(Apellido1)) & " , " & Trim(rs(camponombre))
        rs.MoveNext
    Wend
End If
rs.Close

End Sub

Public Function traerutespecial(tabla, nombrecamporut, nombrecamponombres, nombrecampoapellidos, textonombrecompleto, Conexion As ADODB.Connection) As String
' esta funcion devuelve el rut en base a un consulta de nombre separado por comas
Dim apellidos, nombres, AF As String
coma = InStr(1, textonombrecompleto, ",", 1)
If coma <> 0 Then
    nombres = Trim(Mid(textonombrecompleto, coma + 2, Len(Trim(textonombrecompleto))))
    apellidos = Trim(Mid(textonombrecompleto, 1, coma - 2))
Else
    nombres = ""
    apellidos = ""
End If
rs.CursorLocation = adUseClient

AF = "SELECT " & nombrecamporut & " FROM " & tabla & " where " & nombrecamponombres & " = '" & nombres & "' and " & nombrecampoapellidos & " = '" & apellidos & "'"
rs.Open AF, Conexion
If rs.RecordCount > 0 Then
    traerutespecial = rs(nombrecamporut)
Else
    traerutespecial = "Vacio"
End If
rs.Close

End Function

Public Function CuentaReg(NameTabla As String, criteriobus As String, Conexion As ADODB.Connection) As Long
On Error GoTo Controlerror
    Dim abrio As Boolean
    Set rsCtaReg = New ADODB.Recordset
    rsCtaReg.CursorLocation = adUseClient
    
    If criteriobus <> "" Then rsCtaReg.Open "SELECT distinct count(*) as num FROM " & NameTabla & " where " & criteriobus, Conexion, adOpenKeyset
    If criteriobus = "" Then rsCtaReg.Open "SELECT distinct count(*) as num FROM " & NameTabla & criteriobus, Conexion, adOpenKeyset
    If rsCtaReg.EOF And rsCtaReg.BOF Then
        CuentaReg = 0
    Else
        CuentaReg = rsCtaReg!num
    End If
    
    rsCtaReg.Close
    Set rsCtaReg = Nothing
    Exit Function
Controlerror:
    MsgBox "Error Nº :" & Err.Number & Chr(13) & Err.Description, vbCritical + vbOKOnly, "ERROR"
End Function

Public Sub LlenaCombo(Control As ComboBox, tabla, campo, criteriobus As String, Conexion As ADODB.Connection)
'esta funcion llena un combo con un campo X sin array
Set RsFuncion = New ADODB.Recordset
RsFuncion.CursorLocation = adUseClient
a = "SELECT " & campo & " FROM " & tabla & " " & criteriobus
RsFuncion.Open a, Conexion
If RsFuncion.RecordCount > 0 Then
    For t = 0 To RsFuncion.RecordCount - 1
        If Not IsNull(RsFuncion(0)) Then
            Control.AddItem RsFuncion(0)
        End If
        RsFuncion.MoveNext
    Next t
End If
RsFuncion.Close
End Sub
Public Sub RegOpe(CodOpe As String, DesOpe As String, Conexion As ADODB.Connection)
'********** Registro de operaciones ***********
Conexion.Execute "INSERT INTO REG_OPE(aut_nombre_usuario, FEC_OPE, HOR_OPE, COD_OPE, DES_OPE, PC_IP, PC_NOM) values('" & RutGlobal & "', '" & InvierteFecha(Date, "R") & "', '" & Time & "', '" & CodOpe & "', '" & DesOpe & "', '" & PC_IP & "', '" & PC_Nom & "')"
'********** FIN Registro de operaciones ***********
End Sub

Public Function ExistReg(NameTabla As String, criteriobus As String, Conexion As ADODB.Connection) As Boolean
On Error GoTo controler
Dim abrio As Boolean
Set rsER = New ADODB.Recordset
rsER.CursorLocation = adUseClient
abrio = False
rsER.CursorLocation = adUseClient
'revisa Si el registro existe
rsER.Open "SELECT * FROM " & NameTabla & " where " & criteriobus, Conexion, adOpenKeyset
abrio = True
If rsER.RecordCount > 0 Then
    ExistReg = True
Else
    ExistReg = False
End If
rsER.Close
Exit Function
controler: 'Controla el error E_Fail
If Err.Number = -2147467259 Then
    ExistReg = True
    If abrio Then
        rsER.Close ' tener cuidado cuando intente cerrar la conexión al recordset si haberla abierto.
    End If
End If
End Function

Public Function llenaconceros(Cadena, nceros, largocorte)
Dim strceros As String
Dim t As Integer
strceros = ""
For t = 1 To nceros
strceros = strceros & "0"
Next t
strceros = strceros & Cadena
llenaconceros = Right(strceros, largocorte)
End Function
Public Function FillconCero(cod As String, largo As Integer)
    cod = String(largo, "0") + cod
    FillconCero = (Right(cod, largo))
End Function

Public Function GeneraCod(NameTabla As String, NameCampo As String, criteriobus As String, largo As Integer, Conexion As ADODB.Connection)
'On Error GoTo controler
Set rs = New ADODB.Recordset
rs.CursorLocation = adUseClient
'Genera código
If criteriobus <> "" Then rs.Open "SELECT max(" & NameCampo & ") FROM " & NameTabla & " where " & criteriobus, Conexion, adOpenKeyset
If criteriobus = "" Then rs.Open "SELECT max(" & NameCampo & ") FROM " & NameTabla, Conexion, adOpenKeyset

If rs.RecordCount > 0 Then
    cod_gen = rs(0)
    rs.Close
    If IsNull(cod_gen) Then GeneraCod = FillconCero("1", largo): Exit Function
    
    For i = 1 To Len(cod_gen)
        If Mid(cod_gen, i, 1) <> "0" Then
            cod_gen2 = Mid(cod_gen, i, (Len(cod_gen) - i) + 1) 'hace mid desde que comienzan los números <> de 0 hasta el final
            Exit For
        End If
    Next i
    GeneraCod = FillconCero(Trim(str(val(cod_gen2) + 1)), largo)
Else
    GeneraCod = String(largo - 1, "0") & "1"
End If

Exit Function
controler:
If Err.Number = -2147467259 Then GeneraCod = FillconCero("1", largo): rs.Close
End Function
Function agregacodigo(tabla, campo, Conexion As ADODB.Connection)
Dim cod1, sw, cod2, cod
rs.CursorLocation = adUseClient
rs.Open "SELECT * FROM " & tabla & " order by " & campo & " ASC", Conexion, adOpenKeyset
If rs.RecordCount > 0 Then
    rs.MoveLast
    rs.MoveFirst
    cod1 = 1
    sw = 0
    If val(rs(campo)) > cod1 Then
        cod = "1"
    Else
        While Not rs.EOF And sw = 0
            cod2 = val(rs(campo))
            If (cod2 - cod1) <> 1 And cod2 <> cod1 Then
                cod = cod1 + 1
                sw = 1
            Else
                cod1 = val(rs(campo))
                cod = cod2 + 1
            End If
            rs.MoveNext
        Wend
    End If
    rs.Close
Else
    rs.Close
cod = "1"
End If
agregacodigo = cod
End Function


Function ValidarIP(ByVal IPaValidar As String) As Boolean
    On Error GoTo Error_ValidarIP
    Dim ByteIP As String, FinValidar As Boolean, cIP As Integer, cIPBis As Integer
    If Not IsNumeric(IPaValidar) Then Exit Function
    ValidarIP = True
    cIP = 1
    FinValidar = False
    Do
        cIPBis = InStr(cIP, IPaValidar, ".")
        If cIPBis = 0 Then
            cIPBis = Len(IPaValidar) + 1
            FinValidar = True
        End If
        
        ' Le restamos la posicion inicial para obtener el número
        ByteIP = Mid(IPaValidar, cIP, cIPBis - cIP)
        If ByteIP < 0 Or ByteIP > 256 Then ValidarIP = False
        cIP = cIPBis + 1
    Loop Until FinValidar
Exit Function
Error_ValidarIP:
    ValidarIP = False
End Function
Public Function TipoCampo(intTipo As Integer) As String
    Select Case intTipo
        Case dbBoolean
            TipoCampo = "dbBoolean"
        Case dbByte
            TipoCampo = "dbByte"
        Case dbInteger
            TipoCampo = "dbInteger"
        Case dbLong
            TipoCampo = "dbLong"
        Case dbCurrency
            TipoCampo = "dbCurrency"
        Case dbSingle
            TipoCampo = "dbSingle"
        Case dbDouble
            TipoCampo = "dbDouble"
        Case dbDate
            TipoCampo = "dbDate"
        Case dbText
            TipoCampo = "dbText"
        Case dbLongBinary
            TipoCampo = "dbLongBinary"
        Case dbMemo
            TipoCampo = "dbMemo"
        Case dbGUID
            TipoCampo = "dbGUID"
    End Select
End Function
Public Sub CreaTabla(NomBd As String, NomTabla As String, Campos_con_Tipos As String)
'On Error GoTo errores
Dim dbsTemp As Database
Dim NumCampos, TipoCampo As Integer
Dim tdfNuevo As TableDef
Set dbsTemp = OpenDatabase(NomBd)
Set tdfNuevo = dbsTemp.CreateTableDef(NomTabla)

' Crea los campos y los agrega al objeto TableDef nuevo
Dim CamposTipo()
c = 0
n = 1
n2 = 1
veces = 0

    If InStr(n, Campos_con_Tipos, "-") = 0 Then
        subcampos = Campos_con_Tipos
        ReDim Preserve CamposTipo(0)
        CamposTipo(0) = subcampos
        veces = 1
    Else
        Do
            subcampos = ""
            subcampos = Mid(Campos_con_Tipos, n, Abs(n - InStr(n, Campos_con_Tipos, "-")))
            n = InStr(n, Campos_con_Tipos, "-") + 1
            n2 = InStr(n2, Campos_con_Tipos, ",") + 1
            veces = veces + 1
            ReDim Preserve CamposTipo(veces - 1)
            CamposTipo(veces - 1) = subcampos
        Loop Until InStr(n2, Campos_con_Tipos, ",") = 0
    End If

For l = 1 To veces
    NumCampos = Mid(CamposTipo(l - 1), 1, InStr(CamposTipo(l - 1), ",") - 1)
    TipoCampo = Mid(CamposTipo(l - 1), InStr(CamposTipo(l - 1), ",") + 1, Len(CamposTipo(l - 1)))

    For campos = 1 To val(NumCampos)
        c = c + 1
    With tdfNuevo
        .Fields.Append .CreateField("C" & c, TipoCampo)
    End With
    Next campos
Next l
dbsTemp.TableDefs.Append tdfNuevo
dbsTemp.Close
Exit Sub
errores:
If Err.Number = 3010 Then
    dbsTemp.TableDefs.Delete NomTabla
    Resume
End If
End Sub

Public Sub CreaBD(NomBd As String)
Dim wrkPredeterminado As Workspace
   Dim dbsNueva As Database
   Dim prpBucle As Property

   ' Obtiene el Workspace predeterminado.
   Set wrkPredeterminado = DBEngine.Workspaces(0)
   If dir(NomBd) <> "" Then Kill NomBd
   ' Crea a una base de datos nueva encriptada con la
   ' secuencia de intercalación especificada.
   Set dbsNueva = wrkPredeterminado.CreateDatabase(NomBd, _
      dbLangGeneral) ', dbEncrypt
   dbsNueva.Close


End Sub

Public Function CrearDsn(NombreDsn As String, Servidor As String, Basededatos As String, Usuario As String, Password As String) As Boolean
'Para crear un DSN :
#If Win32 Then
    Dim intRet As Long
#Else
    Dim intRet As Integer
#End If
Dim strDriver As String
Dim strAttributes As String
'Seleccionamos el driver a usar
strDriver = "MySQL ODBC 3.51 Driver"
'Asignamos los parametros separados por null.
strAttributes = "SERVER=" & Servidor & Chr$(0)
strAttributes = strAttributes & "DESCRIPTION=MySQL ODBC 3.51" & Chr$(0)
strAttributes = strAttributes & "DSN=" & NombreDsn & Chr$(0)
strAttributes = strAttributes & "DATABASE=" & Basededatos & Chr$(0)
strAttributes = strAttributes & "UID=" & Usuario & Chr$(0)
strAttributes = strAttributes & "PWD=" & Password & Chr$(0)
strAttributes = strAttributes & "PORT=3306" & Chr$(0)
'Para mostrar el diálogo usar Form1.Hwnd en vez de vbAPINull.
intRet = SQLConfigDataSource(vbAPINull, ODBC_ADD_DSN, strDriver, strAttributes)
If intRet Then
    CrearDsn = True
    'MsgBox "DSN Creado"
Else
    CrearDsn = False
    'MsgBox "Fallo en la creación"
    'CrearDsn = False
End If

End Function
Public Function BorrarDsn(NombreDsn As String) As Boolean
'Para borrarlo:
#If Win32 Then
    Dim intRet As Long
#Else
    Dim intRet As Integer
#End If
Dim strDriver As String
Dim strAttributes As String
'usamos el driver de SQL Server porque es el mas comun
strDriver = "MySQL ODBC 3.51 Driver"
'Asignamos los parametros separados por null.
strAttributes = "DSN=" & NombreDsn & Chr$(0)
'Para mostrar el diálogo usar Form1.Hwnd en vez de vbAPINull.
intRet = SQLConfigDataSource(vbAPINull, ODBC_REMOVE_DSN, strDriver, strAttributes)
If intRet Then
    BorrarDsn = True
    'MsgBox "DSN Eliminado"
Else
    BorrarDsn = False
    'MsgBox "Fallo en el borrado"
End If

End Function

Public Function ModificarDsn(NombreDsn As String, Servidor As String, Basededatos As String, Usuario As String, Password As String) As Boolean
'Para modificarlo:

#If Win32 Then
    Dim intRet As Long
#Else
    Dim intRet As Integer
#End If
Dim strDriver As String
Dim strAttributes As String

'Seleccionamos el driver a usar
strDriver = "MySQL ODBC 3.51 Driver"
'Asignamos los parametros separados por null.
strAttributes = "SERVER=" & Servidor & Chr$(0)
strAttributes = strAttributes & "DESCRIPTION=MySQL ODBC 3.51 modificado" & Chr$(0)
strAttributes = strAttributes & "DSN=" & NombreDsn & Chr$(0)
strAttributes = strAttributes & "PORT=3306" & Chr$(0)
strAttributes = strAttributes & "DATABASE=" & Basededatos & Chr$(0)
strAttributes = strAttributes & "UID=" & Usuario & Chr$(0)
strAttributes = strAttributes & "PWD=" & Password & Chr$(0)

'Para mostrar el diálogo usar Form1.Hwnd en vez de vbAPINull.
intRet = SQLConfigDataSource(vbAPINull, ODBC_CONFIG_DSN, strDriver, strAttributes)
If intRet Then
    ModificarDsn = True
    'MsgBox "DSN Modificado"
Else
    ModificarDsn = False
    'MsgBox "Fallo en la modificacion"
End If
End Function

Function EnviarDatos(Cadena As String)
   ' actualizo el fichero de log
'   Print #1, "S: " & Cadena;
   ' Cambio el color del LED de Efectos Especiales.
   correo.Sck.SendData (Cadena)
   ' Este temporizador sirve de "TimeOut"
   ' Si pasan X segundos y aun no hay respuesta se genera un mensaje de error
   correo.TimeOut.Enabled = True
   'DoEvents
End Function
Function TraeLinea(archivo, linea As Integer) As String
Dim Numeroarchivo As Integer
Dim linea1, linea2, linea3, linea4, linea5 As String
Numeroarchivo = FreeFile
 If dir$(archivo) <> "" Then
    Open archivo For Input As #Numeroarchivo
    Line Input #Numeroarchivo, linea1
    Line Input #Numeroarchivo, linea2
    Line Input #Numeroarchivo, linea3
    Line Input #Numeroarchivo, linea4
    If linea = 1 Then TraeLinea = linea1
    If linea = 2 Then TraeLinea = linea2
    If linea = 3 Then TraeLinea = linea3
    If linea = 4 Then TraeLinea = linea4
    Close #Numeroarchivo
  Else
    Open archivo For Output As #Numeroarchivo
        Print #Numeroarchivo, ""
    Close #Numeroarchivo
    TraeLinea = "vacio"
 End If
End Function
Function SpecialDir(CISDL As Long) As String
  Dim ItemIDList As Long
  Dim FolderPath As String * 260
  Dim retVal As Long

  ItemIDList = 0
  retVal = SHGetSpecialFolderLocation(hwnd, CISDL, ItemIDList)
  If retVal = 0 Then
    SHGetPathFromIDList ItemIDList, FolderPath
    CoTaskMemFree ItemIDList
    retVal = InStr(FolderPath, Chr$(0))
    If retVal > 0 Then
        SpecialDir = Left(FolderPath, retVal - 1)
    Else
        SpecialDir = ""
    End If
  Else
    SpecialDir = ""
  End If
End Function
Public Function AsigMen(RutApo As String) As String()
'#### MUESTRA HERMANOS CON EL VALOR DE CUOTA ####
Dim CodConvBci As String
Dim Pk As Integer
Dim Bos As Integer
Dim j As Integer
Dim Convenio As Boolean
'*** matriz que guarda el valor de la cuota del alumno y el exedente
Dim MenExe() As Long
'*** MenExe(0) Cuota alumno
'*** MenExe(0) Exedente
Dim MatrizHer() As String
CodConvBci = DevuelveCampo("establecimientos", "", "cod_conv_bci", "cod_conv_bci=cod_conv_bci", conn)
If Trim(CodConvBci) = "" Then
    ReDim MatrizHer(0, 1)
    MatrizHer(0, 0) = "ERR"
    MatrizHer(0, 1) = "No se encontro un código de convenio para este colegio. Consultar al administrador del sistema." & Chr(13) & Chr(13) & "NO ES POSIBLE CONTINUAR"
    AsigMen = MatrizHer
    Exit Function
End If
Convenio = IIf(IsNull(DevuelveCampo("apoderados", "", "cod_conv", "rut_apo ='" & RutApo & "'", conn)) Or Trim(DevuelveCampo("apoderados", "", "cod_conv", "rut_apo ='" & RutApo & "'", conn)) = "" Or UCase(DevuelveCampo("apoderados", "", "cod_conv", "rut_apo ='" & RutApo & "'", conn)) = "N", False, True)

'IIf(IsNull(Rs(4)) Or Trim(Rs(4)) = "" Or UCase(Trim(Rs(4))) = "NINGUNO", False, True)
'For i = 0 To Me.lst_filtro_Rutapo.ListCount - 1
        
    '    Rutapofiltrado = Me.lst_filtro_Rutapo.List(i)
        rs.CursorLocation = adUseClient
        ' ************En esta consulta se trae el apoderado con todos sus pupilos************
        ' *** AQUÍ SE DEBE MANEJAR EL ORDEN DE HERMANOS, DE MAYOR A MENOR POR NIVEL Y CODIGO DE ENSEÑANZA
        a = "SELECT distinct apa.rut_apo, p.ci_alu, p.ape_pat_alu, p.ape_mat_alu, p.nom_alu, m.anno_mat, m.cod_ens, co.cod_des, m.ind_beca, m.ind_mbeca, m.num_gra, p.fec_nacalu, m.fec_mat " & _
            "FROM apo_x_alu apa, postulantes p, matriculas m, codigos_ensenanza co  WHERE apa.ci_alu = p.ci_alu AND apa.ci_alu = m.ci_alu AND apa.rut_apo ='" & RutApo & "' and m.activo_alu ='si' AND m.anno_mat = apa.agno AND m.anno_mat = '" & Anno & "' and m.cod_ens=co.cod_ens order by co.ord_ens desc, m.num_gra desc, p.fec_nacalu Asc"

        rs.Open a, conn
        If rs.RecordCount > 0 Then
            Pk = 0
            Bos = 0
        
            'If Rs.RecordCount = 3 Then MsgBox Rs.RecordCount
            For j = 1 To rs.RecordCount
                If rs(6) = "996" Then Pk = Pk + 1
                rs.MoveNext
            Next j
            rs.MoveFirst
            Bos = rs.RecordCount - Pk
        
            ReDim MatrizHer(rs.RecordCount, 5)
            For j = 1 To rs.RecordCount
                MatrizHer(j - 1, 0) = rs.RecordCount
                MatrizHer(j - 1, 1) = j
                MatrizHer(j - 1, 2) = rs(1)
                MenExe = CalMenM(CodConvBci, rs(6), rs.RecordCount, Bos, Pk, Convenio, IIf(IsNull(rs(8)) Or Trim(rs(8)) = "" Or Trim(rs(8)) = "0", False, True), IIf(IsNull(rs(9)) Or Trim(rs(9)) = "" Or Trim(rs(9)) = "0", False, True), j)
                MatrizHer(j - 1, 3) = MenExe(0) 'CuotaALu
                MatrizHer(j - 1, 4) = MenExe(1)
                MatrizHer(j - 1, 5) = rs(6)
                'Call InsertAlu(Rs.RecordCount, Bos, Pk, j)   'inserta los hijos del apoderado en la grilla
                rs.MoveNext
            Next j
        Else
            ReDim MatrizHer(0, 1)
            MatrizHer(0, 0) = "ERR"
            MatrizHer(0, 1) = "No se encontraron alumnos para el apoderado RUT :" & RutApo
        End If
        rs.Close
        AsigMen = MatrizHer
        'RsApo.MoveNext
        'Me.MSFlexGrid1.Refresh
        'Me.ProgBar1.ShowProgress i
        'DoEvents
'Next i
'#### FIN MUESTRA HERMANOS CON EL VALOR DE CUOTA ####
End Function

Public Function CalMenM(colegio As String, ColoPK As String, NumAluTot As Integer, NumAluBos As Integer, NumAluPK As Integer, Convenio As Boolean, Beca As Boolean, mBeca As Boolean, IdHermano As Integer) As Long()
Dim MenExe(1) As Long
Dim exencion As Long
Dim CalMen As Long
'Dim ValCuota As Long


'## Colegio   - Discriminante de colegio (600, 601, 602...)
'## ColoPK    - Determina si el alumno esta en Kinder a Media o Prekinder para efecto de el tipo de empresa
'## NumAluTot - Total de alumnos hermanos (Tabla)
'## NumAluBos - Total de alumnos Boston (Tabla)
'## NumAluPK  - Total de alumnos en prekinder (Tabla - "Miss Marta o Julio Martínez según sea)"
'Dim mC1yLetras(3) As String
'CodConvBci = "604" 'Fuerzo a que entre al Lincoln para probar su funcionamiento
Dim DescuentoConvenio As Single
DescuentoConvenio = IIf(Convenio, 0.7, 1)
Select Case colegio 'CodConvBci 'Discrimina Colegio

Case "600", "601", "603" 'M A I P U,  F A R F A N A  Y  S A N  M A R T I N
    ValCuota = 21000
    
    Select Case NumAluTot
        Case 1 '1 ###### hermano
            If ColoPK = "996" Then ' Es alumno prekinder - 606
                ValCuota = 25000
                CalMen = 25000 * DescuentoConvenio
                CalMen = IIf(Beca, 25000 * 0, CalMen)
                CalMen = IIf(mBeca, 25000 * 0.5, CalMen)
            Else    ' Es alumno boston - "600", "601" o "603"
                CalMen = 21000 * DescuentoConvenio
                CalMen = IIf(Beca, 21000 * 0, CalMen)
                CalMen = IIf(mBeca, 21000 * 0.5, CalMen)
            End If
        Case 2 '2 ###### hermanos
            If NumAluBos = 2 Then ' 2 alumnos boston
                Select Case IdHermano
                    Case 1 'hermano  mayor
                        CalMen = 21000 * DescuentoConvenio
                        CalMen = IIf(Beca, 21000 * 0, CalMen)
                        CalMen = IIf(mBeca, 21000 * 0.5, CalMen)
                    Case 2 'hermano  menor
                        CalMen = 15000 * DescuentoConvenio
                        CalMen = IIf(Beca, 21000 * 0, CalMen)
                        CalMen = IIf(mBeca, 21000 * 0.5, CalMen)
                End Select
            End If
            If NumAluBos = 1 And NumAluPK = 1 Then ' 1 alumnos boston y 1 Miss Marta
                Select Case ColoPK
                    Case "010", "110", "310" 'Alumno en Boston
                        CalMen = 16000 * DescuentoConvenio
                        CalMen = IIf(Beca, 21000 * 0, CalMen)
                        CalMen = IIf(mBeca, 21000 * 0.5, CalMen)
                    Case "996" 'Alumno en Miss Marta
                       ValCuota = 25000
                        CalMen = 25000 * DescuentoConvenio
                        CalMen = IIf(Beca, 25000 * 0, CalMen)
                        CalMen = IIf(mBeca, 25000 * 0.5, CalMen)
                End Select
            End If
            If NumAluPK = 2 Then ' 2 alumnos en Miss Marta
                ValCuota = 25000
                Select Case IdHermano
                    Case 1 'Miss Marta 1
                        CalMen = 25000 * DescuentoConvenio
                        CalMen = IIf(Beca, 25000 * 0, CalMen)
                        CalMen = IIf(mBeca, 25000 * 0.5, CalMen)
                    Case 2 'Miss Marta 2
                        CalMen = 20000 * DescuentoConvenio
                        CalMen = IIf(Beca, 25000 * 0, CalMen)
                        CalMen = IIf(mBeca, 25000 * 0.5, CalMen)
                End Select
            End If
            
        
        Case 3 '3 ###### hermanos
            If NumAluBos = 3 Then ' 3 alumnos boston
                Select Case IdHermano
                    Case 1 'hermano  mayor
                        CalMen = 21000 * DescuentoConvenio
                        CalMen = IIf(Beca, 21000 * 0, CalMen)
                        CalMen = IIf(mBeca, 21000 * 0.5, CalMen)
                    Case 2, 3 'hermano  medio y menor
                        CalMen = 14000 * DescuentoConvenio
                        CalMen = IIf(Beca, 21000 * 0, CalMen)
                        CalMen = IIf(mBeca, 21000 * 0.5, CalMen)
                End Select
            End If
            If NumAluBos = 2 And NumAluPK = 1 Then ' 2 alumnos boston y 1 Miss Marta
                Select Case ColoPK
                    Case "010", "110", "310" 'Alumno en Boston
                        CalMen = 14000 * DescuentoConvenio
                        CalMen = IIf(Beca, 21000 * 0, CalMen)
                        CalMen = IIf(mBeca, 21000 * 0.5, CalMen)
                    Case "996" 'Alumno en Miss Marta
                        ValCuota = 25000
                        CalMen = 25000 * DescuentoConvenio
                        CalMen = IIf(Beca, 25000 * 0, CalMen)
                        CalMen = IIf(mBeca, 25000 * 0.5, CalMen)
                End Select
            End If
            If NumAluBos = 1 And NumAluPK = 2 Then ' 1 alumnos boston y 2 Miss Marta
                Select Case ColoPK
                    Case "010", "110", "310" 'Alumno en Boston
                        CalMen = 12000 * DescuentoConvenio
                        CalMen = IIf(Beca, 21000 * 0, CalMen)
                        CalMen = IIf(mBeca, 21000 * 0.5, CalMen)
                    Case "996" 'Alumno en Miss Marta
                        ValCuota = 25000
                        CalMen = 25000 * DescuentoConvenio
                        CalMen = IIf(Beca, 25000 * 0, CalMen)
                        CalMen = IIf(mBeca, 25000 * 0.5, CalMen)
                End Select
            End If
            If NumAluPK = 3 Then ' 3 alumnos en Miss Marta
                ValCuota = 25000
                Select Case IdHermano
                    Case 1, 2 ' Miss Marta 1 y Miss Marta 2
                        CalMen = 25000 * DescuentoConvenio
                        CalMen = IIf(Beca, 25000 * 0, CalMen)
                        CalMen = IIf(mBeca, 25000 * 0.5, CalMen)
                    Case 3 'Miss Marta 3
                        CalMen = 17000 * DescuentoConvenio
                        CalMen = IIf(Beca, 25000 * 0, CalMen)
                        CalMen = IIf(mBeca, 25000 * 0.5, CalMen)
                End Select
            End If
        
        Case 4 '4 ###### hermanos
            If NumAluBos = 4 Then ' 4 alumnos boston
                Select Case IdHermano
                    Case 1 'boston  mayor
                        CalMen = 21000 * DescuentoConvenio
                        CalMen = IIf(Beca, 21000 * 0, CalMen)
                        CalMen = IIf(mBeca, 21000 * 0.5, CalMen)
                    Case 2, 3, 4 ' boston 2, boston 3 y boston menor
                        CalMen = 15000 * DescuentoConvenio
                        CalMen = IIf(Beca, 21000 * 0, CalMen)
                        CalMen = IIf(mBeca, 21000 * 0.5, CalMen)
                End Select
            End If
            If NumAluBos = 3 And NumAluPK = 1 Then ' 3 alumnos boston y 1 Miss Marta
                Select Case ColoPK
                    Case "010", "110", "310" 'Alumno en Boston - Mayor, medio y menor
                        CalMen = 15000 * DescuentoConvenio
                        CalMen = IIf(Beca, 21000 * 0, CalMen)
                        CalMen = IIf(mBeca, 21000 * 0.5, CalMen)
                    Case "996" 'Alumno en Miss Marta
                        ValCuota = 25000
                        CalMen = 25000 * DescuentoConvenio
                        CalMen = IIf(Beca, 25000 * 0, CalMen)
                        CalMen = IIf(mBeca, 25000 * 0.5, CalMen)
                End Select
            End If
            If NumAluBos = 2 And NumAluPK = 2 Then ' 2 alumnos boston y 2 Miss Marta
                Select Case ColoPK
                    Case "010", "110", "310" 'Alumno en Boston - MAyor y Menor
                        CalMen = 14000 * DescuentoConvenio
                        CalMen = IIf(Beca, 21000 * 0, CalMen)
                        CalMen = IIf(mBeca, 21000 * 0.5, CalMen)
                    Case "996" 'Alumno en Miss Marta - Miss Marta 1 y Miss Marta 2
                        ValCuota = 25000
                        CalMen = 25000 * DescuentoConvenio
                        CalMen = IIf(Beca, 25000 * 0, CalMen)
                        CalMen = IIf(mBeca, 25000 * 0.5, CalMen)
                End Select
            End If
            If NumAluBos = 1 And NumAluPK = 3 Then ' 1 alumnos boston y 3 Miss Marta
                Select Case IdHermano
                    Case "010", "110", "310" 'Alumno en Boston
                        CalMen = 6000 * DescuentoConvenio
                        CalMen = IIf(Beca, 21000 * 0, CalMen)
                        CalMen = IIf(mBeca, 21000 * 0.5, CalMen)
                    Case "996" 'Alumno en Miss Marta - Miss Marta 1, Miss Marta 2 y Miss Marta 3
                        ValCuota = 25000
                        CalMen = 25000 * DescuentoConvenio
                        CalMen = IIf(Beca, 25000 * 0, CalMen)
                        CalMen = IIf(mBeca, 25000 * 0.5, CalMen)
                End Select
            End If
    'Exencion = ValCuota - CalMen
    End Select

Case "602" 'F L O R I D A
    'EN FLORIDA ONO HAY CONVENIOS ->DescuentoConvenio SIEMPRE ES 1
    ValCuota = 28000
    Select Case NumAluTot
        Case 1 '1 ###### hermano
            If ColoPK = "996" Or ColoPK = "010" Or ColoPK = "110" Or ColoPK = "310" Then ' igual para boston y miss Marta
                CalMen = 28000 * DescuentoConvenio
                CalMen = IIf(Beca, 2800 * 0, CalMen)
                CalMen = IIf(mBeca, 28000 * 0.5, CalMen)
            End If
        Case 2 '2 ###### hermanos
            If NumAluBos = 2 Then ' 2 alumnos boston
                Select Case IdHermano
                    Case 1 'hermano  mayor
                        CalMen = 28000 * DescuentoConvenio
                        CalMen = IIf(Beca, 28000 * 0, CalMen)
                        CalMen = IIf(mBeca, 28000 * 0.5, CalMen)
                    Case 2 'hermano  menor
                        CalMen = 21000 * DescuentoConvenio
                        CalMen = IIf(Beca, 28000 * 0, CalMen)
                        CalMen = IIf(mBeca, 28000 * 0.5, CalMen)
                End Select
            End If
            If NumAluBos = 1 And NumAluPK = 1 Then ' 1 alumnos boston y 1 Miss Marta
                Select Case ColoPK
                    Case "010", "110", "310" 'Alumno en Boston
                        CalMen = 21000 * DescuentoConvenio '16000 cambio 28-03-2004
                        CalMen = IIf(Beca, 28000 * 0, CalMen)
                        CalMen = IIf(mBeca, 28000 * 0.5, CalMen)
                    Case "996" 'Alumno en Miss Marta
                        CalMen = 28000 * DescuentoConvenio '25000 cambio 28-03-2004
                        CalMen = IIf(Beca, 28000 * 0, CalMen) '25000 cambio 28-03-2004
                        CalMen = IIf(mBeca, 28000 * 0.5, CalMen) '25000 cambio 28-03-2004
                End Select
            End If
            If NumAluPK = 2 Then ' 2 alumnos en Miss Marta
                Select Case IdHermano
                    Case 1 'Miss Marta 1
                        CalMen = 28000 * DescuentoConvenio
                        CalMen = IIf(Beca, 28000 * 0, CalMen)
                        CalMen = IIf(mBeca, 28000 * 0.5, CalMen)
                    Case 2 'Miss Marta 2
                        CalMen = 21000 * DescuentoConvenio
                        CalMen = IIf(Beca, 28000 * 0, CalMen)
                        CalMen = IIf(mBeca, 28000 * 0.5, CalMen)
                End Select
            End If
            
        
        Case 3 '3 ###### hermanos
            If NumAluBos = 3 Then ' 3 alumnos boston
                Select Case IdHermano
                    Case 1 'hermano  mayor
                        CalMen = 28000 * DescuentoConvenio
                        CalMen = IIf(Beca, 28000 * 0, CalMen)
                        CalMen = IIf(mBeca, 28000 * 0.5, CalMen)
                    Case 2, 3 'hermano  medio y menor
                        CalMen = 21000 * DescuentoConvenio
                        CalMen = IIf(Beca, 28000 * 0, CalMen)
                        CalMen = IIf(mBeca, 28000 * 0.5, CalMen)
                End Select
            End If
            If NumAluBos = 2 And NumAluPK = 1 Then ' 2 alumnos boston y 1 Miss Marta
                Select Case ColoPK
                    Case "010", "110", "310" 'Alumno en Boston
                        CalMen = 21000 * DescuentoConvenio
                        CalMen = IIf(Beca, 28000 * 0, CalMen)
                        CalMen = IIf(mBeca, 28000 * 0.5, CalMen)
                    Case "996" 'Alumno en Miss Marta
                        CalMen = 28000 * DescuentoConvenio
                        CalMen = IIf(Beca, 28000 * 0, CalMen)
                        CalMen = IIf(mBeca, 28000 * 0.5, CalMen)
                End Select
            End If
            If NumAluBos = 1 And NumAluPK = 2 Then ' 1 alumnos boston y 2 Miss Marta
                Select Case ColoPK
                    Case "010", "110", "310" 'Alumno en Boston
                        CalMen = 14000 * DescuentoConvenio
                        CalMen = IIf(Beca, 28000 * 0, CalMen)
                        CalMen = IIf(mBeca, 28000 * 0.5, CalMen)
                    Case "996" 'Alumno en Miss Marta
                        CalMen = 28000 * DescuentoConvenio
                        CalMen = IIf(Beca, 28000 * 0, CalMen)
                        CalMen = IIf(mBeca, 28000 * 0.5, CalMen)
                End Select
            End If
            If NumAluPK = 3 Then ' 3 alumnos en Miss Marta
                Select Case IdHermano
                    Case 1, 2 ' Miss Marta 1 y Miss Marta 2
                        CalMen = 28000 * DescuentoConvenio
                        CalMen = IIf(Beca, 28000 * 0, CalMen)
                        CalMen = IIf(mBeca, 28000 * 0.5, CalMen)
                    Case 3 'Miss Marta 3
                        CalMen = 14000 * DescuentoConvenio
                        CalMen = IIf(Beca, 28000 * 0, CalMen)
                        CalMen = IIf(mBeca, 28000 * 0.5, CalMen)
                End Select
            End If
        
        Case 4 '4 ###### hermanos
            If NumAluBos = 4 Then ' 4 alumnos boston
                Select Case IdHermano
                    Case 1 'boston  mayor
                        CalMen = 28000 * DescuentoConvenio
                        CalMen = IIf(Beca, 28000 * 0, CalMen)
                        CalMen = IIf(mBeca, 28000 * 0.5, CalMen)
                    Case 2, 3 ' boston 2, boston 3 y boston menor
                        CalMen = 21000 * DescuentoConvenio
                        CalMen = IIf(Beca, 28000 * 0, CalMen)
                        CalMen = IIf(mBeca, 28000 * 0.5, CalMen)
                    Case 4 ' boston 2, boston 3 y boston menor
                        CalMen = 20000 * DescuentoConvenio
                        CalMen = IIf(Beca, 28000 * 0, CalMen)
                        CalMen = IIf(mBeca, 28000 * 0.5, CalMen)
                End Select
            End If
            If NumAluBos = 3 And NumAluPK = 1 Then ' 3 alumnos boston y 1 Miss Marta
                Select Case ColoPK
                                    
                    Case "010", "110", "310" 'Alumno en Boston - Mayor, medio y menor
                        Select Case IdHermano
                            Case 1, 2
                                CalMen = 21000 * DescuentoConvenio
                                CalMen = IIf(Beca, 28000 * 0, CalMen)
                                CalMen = IIf(mBeca, 28000 * 0.5, CalMen)
                            Case 3
                                CalMen = 20000 * DescuentoConvenio
                                CalMen = IIf(Beca, 28000 * 0, CalMen)
                                CalMen = IIf(mBeca, 28000 * 0.5, CalMen)
                        End Select
                    Case "996" 'Alumno en Miss Marta
                        CalMen = 28000 * DescuentoConvenio
                        CalMen = IIf(Beca, 28000 * 0, CalMen)
                        CalMen = IIf(mBeca, 28000 * 0.5, CalMen)
                End Select
            End If
            If NumAluBos = 2 And NumAluPK = 2 Then ' 2 alumnos boston y 2 Miss Marta
                Select Case ColoPK
                    Case "010", "110", "310" 'Alumno en Boston - MAyor y Menor
                        CalMen = 17000 * DescuentoConvenio
                        CalMen = IIf(Beca, 28000 * 0, CalMen)
                        CalMen = IIf(mBeca, 28000 * 0.5, CalMen)
                    Case "996" 'Alumno en Miss Marta - Miss Marta 1 y Miss Marta 2
                        CalMen = 28000 * DescuentoConvenio
                        CalMen = IIf(Beca, 28000 * 0, CalMen)
                        CalMen = IIf(mBeca, 28000 * 0.5, CalMen)
                End Select
            End If
            If NumAluBos = 1 And NumAluPK = 3 Then ' 1 alumnos boston y 3 Miss Marta
                Select Case IdHermano
                    Case "010", "110", "310" 'Alumno en Boston
                        CalMen = 6000 * DescuentoConvenio
                        CalMen = IIf(Beca, 28000 * 0, CalMen)
                        CalMen = IIf(mBeca, 28000 * 0.5, CalMen)
                    Case "996" 'Alumno en Miss Marta - Miss Marta 1, Miss Marta 2 y Miss Marta 3
                        CalMen = 28000 * DescuentoConvenio
                        CalMen = IIf(Beca, 28000 * 0, CalMen)
                        CalMen = IIf(mBeca, 28000 * 0.5, CalMen)
                End Select
            End If
    End Select
Case "604" ' L I N C O L N
    Select Case IdHermano 'NumAluTot
        Case 1 '1 ###### hermano
            Select Case ColoPK
                Case "010"
                    ValCuota = 11500
                    CalMen = 11500
                    CalMen = IIf(Beca, 11500 * 0, CalMen)
                    CalMen = IIf(mBeca, 11500 * 0.5, CalMen)
                Case "110"
                    ValCuota = 12000
                    CalMen = 12000
                    CalMen = IIf(Beca, 12000 * 0, CalMen)
                    CalMen = IIf(mBeca, 12000 * 0.5, CalMen)
                Case "310"
                    ValCuota = 12500
                    CalMen = 12500
                    CalMen = IIf(Beca, 12500 * 0, CalMen)
                    CalMen = IIf(mBeca, 12500 * 0.5, CalMen)
                Case "996"
                    ValCuota = 15000
                    CalMen = 15000
                    CalMen = IIf(Beca, 15000 * 0, CalMen)
                    CalMen = IIf(mBeca, 15000 * 0.5, CalMen)
            End Select
        Case Is > 1 ' ###### 2 O MÁS hermanos
            'a partir del 2° hermano existe un descuento del 50%
            Select Case ColoPK 'Tipo de modalidad
                Case "010"
                    ValCuota = 11500
                    CalMen = 11500 * 0.5
                    CalMen = IIf(Beca, 11500 * 0, CalMen)
                    CalMen = IIf(mBeca, 11500 * 0.5, CalMen)
                Case "110"
                    ValCuota = 12000
                    CalMen = 12000 * 0.5
                    CalMen = IIf(Beca, 12000 * 0, CalMen)
                    CalMen = IIf(mBeca, 12000 * 0.5, CalMen)
                Case "310"
                    ValCuota = 12500
                    CalMen = 12500 * 0.5
                    CalMen = IIf(Beca, 12500 * 0, CalMen)
                    CalMen = IIf(mBeca, 12500 * 0.5, CalMen)
                Case "996"
                    ValCuota = 15000
                    CalMen = 15000
                    'CalMen = CalMen * 0.5
                    CalMen = IIf(Beca, 15000 * 0, CalMen)
                    CalMen = IIf(mBeca, 15000 * 0.5, CalMen)
                    'No estoy seguro si el prekinder tiene descuentos por hermanos                    'si LOS TIENE, dejas el Case "996" tal cual, SI NO, comentas la línea
                    'CalMen = 15000 * 0.5
            End Select
    End Select

End Select 'Lincol
'End Select

MenExe(0) = CalMen
MenExe(1) = ValCuota - CalMen
CalMenM = MenExe

End Function

Public Function FillconStr(cod As String, largo As Integer, CaracterFill As String, IzqDer As String)
Select Case UCase(IzqDer)
    Case "IZQ"
        cod = String(largo, CaracterFill) & Trim(cod)
        FillconStr = Right(cod, largo)
    Case "DER"
        cod = cod & String(largo, CaracterFill)
        FillconStr = Left(cod, largo)
    End Select
End Function


Public Function TraeMensualidad(ci_alu As String, mes As String) As Long()
'## Esta funcion en tregando el CI_alu y el mes devuelve ###
'## - Mensualid                                          ###
'## - Descuento                                          ###
'## ### ### ### ### ### ### ### ### ### ### ### ### ###  ###

'Dim RsMensualidad As ADODB.Recordset
'Dim MesCounter As Integer
'Dim MesConsulta As Integer
'Set RsMensualidad = New ADODB.Recordset
'RsMensualidad .CursorLocation = adUseClient

'For MesCounter = Val(Mes) To 3 Step -1
'    a = "select * from cuotas_x_alu where ci_alu ='" & Ci_alu & "' and mes_cuota ='" & MesConsulta & "'"
'    RsMensualidad.Open a, conn
'    If RsMensualidad.RecordCount > 0 Then
'        Dim Mensualidad(4)
'        Mensualidad(0) = RsMensualidad!cuota_sis
'        Mensualidad(1) = RsMensualidad!cuota_alu
'        Mensualidad(2) = RsMensualidad!exe_alu
'        Mensualidad(3) = RsMensualidad!mes_cuota
'        RsMensualidad.Close
'        Exit For
'    Else
'        RsMensualidad.Close
'    End If
'Next MesCounter

Set Rscuotas = New ADODB.Recordset
Rscuotas.CursorLocation = adUseClient
Dim MesCuota As Integer
MesCuota = val(mes)
        While MesCuota > 2
            a = "select * from cuotas_x_alu where ci_alu ='" & ci_alu & "' and mes_cuota ='" & FillconStr(str(MesCuota), 2, "0", "IZQ") & "'"
            Rscuotas.Open a, conn
            If Rscuotas.RecordCount > 0 Then
                Dim Mensualidad(4) As Long
                'MSFlexGrid1.TextMatrix(alumno, 7) = IIf(Not IsNull(Rscuotas!cuota_alu) Or Rscuotas!cuota_alu <> 0, Rscuotas!cuota_alu, Rscuotas!cuota_sis)
                'MSFlexGrid1.TextMatrix(alumno, 6) = Rscuotas!exe_alu

                Mensualidad(0) = IIf(Not IsNull(Rscuotas!cuota_sis) Or Rscuotas!cuota_sis <> 0, Rscuotas!cuota_sis, 0)
                Mensualidad(1) = IIf(Not IsNull(Rscuotas!cuota_alu) Or Rscuotas!cuota_alu <> 0, Rscuotas!cuota_alu, 0)
                Mensualidad(2) = IIf(Not IsNull(Rscuotas!exe_alu) Or Rscuotas!exe_alu <> 0, Rscuotas!exe_alu, 0)
                Mensualidad(3) = Rscuotas!mes_cuota
                MesCuota = 0
            Else
                MesCuota = MesCuota - 1
            End If
            Rscuotas.Close
        Wend
TraeMensualidad = Mensualidad
End Function
Public Function EselMayor(Rutalu As String, AnhoMat As String) As Boolean
RutApo = DevuelveCampo("apo_x_alu", "", "rut_apo", "agno=" & AnhoMat & " AND ci_alu ='" & Rutalu & "'", conn)
Set RsFuncion = New ADODB.Recordset
RsFuncion.CursorLocation = adUseClient
a = "select p.ci_alu from postulantes p, apo_x_alu aa, matriculas m, codigos_ensenanza c where aa.ci_alu=p.ci_alu and p.ci_alu = m.ci_alu and m.cod_ens=c.cod_ens and aa.rut_apo = '" & RutApo & "' and m.anno_mat=aa.agno and m.anno_mat ='" & AnhoMat & "' and ucase(m.activo_alu) ='SI' order by c.ord_ens DESC, m.num_gra DESC, p.fec_nacalu DESC limit 1"
RsFuncion.Open a, conn
'If RsFuncion.RecordCount > 1 Then
'    MsgBox ("mas de uno")
'End If

If RsFuncion.RecordCount > 0 Then
    If RsFuncion!ci_alu = Rutalu Then
        EselMayor = True
    Else
        EselMayor = False
    End If
Else
    'MsgBox ("No encontro datos para el rut del alumno " & Rutalu)
End If
RsFuncion.Close
Set RsFuncion = Nothing
End Function
Sub RptGrillaText(grilla As MSFlexGrid, Nfilas As Long, BDD As String, tabla)
Set Rendim = DBEngine.Workspaces(0).OpenDatabase(DirAplicacion & BDD)
For R = 1 To Nfilas
    detal = "": ins = "": horiz = ""
    For t = 0 To grilla.Cols - 1
        If grilla.TextMatrix(R, t) = "" Then
            detal = detal & "Null , "
            'horiz = horiz & "'____________________________________' ,"
        Else
            detal = detal & "'" & grilla.TextMatrix(R, t) & "' , "
            'horiz = horiz & "'____________________________________' ,"
        End If
        ins = ins & "C" & CStr(t + 1) & ", "
    Next t
    ins = Left(ins, Len(ins) - 2): ins = "(" & ins & ")"
    detal = Left(detal, Len(detal) - 2): detal = "(" & detal & ")"
    a = "insert into " & tabla & " " & ins & " values " & detal
    Rendim.Execute a
Next R
Rendim.Close
End Sub
Public Function Fecha(sFecha As String) As String
    Dim dd As String
    Dim mm As String
    Dim yy As String
    
    If DatePart("d", CDate(sFecha)) < 10 Then
        dd = "0" + CStr(DatePart("d", CDate(sFecha)))
    Else
        dd = CStr(DatePart("d", CDate(sFecha)))
    End If
    If DatePart("m", CDate(sFecha)) < 10 Then
        mm = "0" + CStr(DatePart("m", CDate(sFecha)))
    Else
        mm = CStr(DatePart("m", CDate(sFecha)))
    End If
    yy = DatePart("yyyy", CDate(sFecha))
    If (yy >= 1900) And (yy <= 2100) Then
       Fecha = dd & "/" & mm & "/" & yy
    Else
        Fecha = ""
    End If
End Function
Function CalculaCuotaalu(Rutalu As String, CodEmpresa As String, Anho As Integer, EsAnhoProximo As Boolean) As Long()
Dim Tipens As String, Numg As String, Convenio As Boolean, PorcentBeca As Single, EsMayor As Boolean
Dim Anhoactual As Integer, CuotaAlu As Long, PorcentHmnos As Single, PorcentConv As Single
Dim CodInt As String ' Codigo interno del tipo de enseñanza
Dim colegio As String ' Cadena que discrima que colegio consultar en la query de fnza_descuento
Dim MatrizVal(0, 5) As Long
Dim Base As Single, ExenBeca As Long, ExenHmno As Long, ExenConv As Long, Cuotafinal As Long
Dim ExenDescto As Long
' Si aumento nivel es porque anho es el proximo
Base = 0: ExenBeca = 0: ExenHmno = 0: ExenConv = 0: ExenDescto = 0: CuotaAlu = 0
Anhoactual = IIf(EsAnhoProximo, Anho - 1, Anho)
Set RsFuncion2 = New ADODB.Recordset
RsFuncion2.CursorLocation = adUseClient
' Consulta reemplazada para usar matriculas en vez de alu_x_cur (y anno_mat por agno)
 RsFuncion2.Open "select ac.ci_alu, c.cod_des, ac.cod_ens, ac.num_gra, a.cod_conv from apoderados a, apo_x_alu ap, matriculas ac, codigos_ensenanza c where a.rut_apo = ap.rut_apo and ap.ci_alu=ac.ci_alu and ap.agno=ac.anno_mat and ac.anno_mat=" & Anho & " and ac.cod_ens=c.cod_ens and ac.activo_alu = 'SI' and ac.ci_alu='" & Rutalu & "' order by ac.fec_mat Desc", conn
If RsFuncion2.RecordCount > 0 Then
    If EsAnhoProximo Then ' Traigo nuevo nivel a cursar
        strnewcurso = TraeCambionivel(RsFuncion2!Cod_Ens, RsFuncion2!Num_Gra)
        If UCase(strnewcurso) = "NULO" Then
             MatrizVal(0, 5) = -1
            'CalculaCuotaalu = -1 ' si cadena es nulo, es porque alumno
            'no tiene curso para próximo año, ejemplo va en 4º medio.
            ' cierro objeto recordset y salgo
            RsFuncion2.Close: Set RsFuncion2 = Nothing
            Exit Function
        End If
        Tipens = Mid(strnewcurso, 1, 3)
        Numg = Mid(strnewcurso, 5, 1)
        CodInt = Mid(strnewcurso, 7, 2)
    Else
        Tipens = RsFuncion2!Cod_Ens
        Numg = RsFuncion2!Num_Gra
        CodInt = RsFuncion2!cod_des
    End If
    ' si el niño es de prekinder
    colegio = ""
    If UCase(CodInt) = "PK" Then
        colegio = " mid(colegio,1,6) = '" & Mid(CodEmpresa, 1, 6) & "' and length(colegio) > 6 "
    Else
        colegio = " mid(colegio,1,6) = '" & Mid(CodEmpresa, 1, 6) & "' and length(colegio) = 6 "
    End If
    
    porbecaparcial = DevuelveCampo("becas", "", "monto_excencion", "run_alu ='" & Rutalu & "' and agno=" & Anho, conn)
    PorcentBeca = CSng(IIf(porbecaparcial = "", 0, porbecaparcial))
    EsMayor = EselMayor(Rutalu, CStr(Anhoactual))
    Convenio = IIf(UCase(RsFuncion2!cod_conv) = "N", False, True)
    
    Set RsAux = New ADODB.Recordset
    RsAux.CursorLocation = adUseClient
    RsAux.Open "select convenio1, hermanos, arancel_base from fnza_descuento where " & colegio & " and mid(curso,1,3)='" & Tipens & "' and mid(curso,4,2) ='" & Numg & "' and agno = " & Anho, conn
   
   If RsAux.RecordCount > 0 Then
        Base = RsAux!arancel_base
        PorcentHmnos = RsAux!hermanos
        PorcentConv = RsAux!Convenio1
        If PorcentBeca > 0 Then
            CuotaAlu = Base - (Base * (PorcentBeca / 100))
            ExenBeca = Base - CuotaAlu
        Else
            If Not EsMayor Then
                CuotaAlu = Base - (Base * (PorcentHmnos / 100))
                CuotaAlu = (Int((CuotaAlu / 100) * -1) * 100) * -1 'Aquí redondeo a la centena superior!!!!!
            Else
                CuotaAlu = Base
            End If
            ExenHmno = Base - CuotaAlu
            If Convenio Then
                ExenConv = (CuotaAlu * (PorcentConv / 100))
                CuotaAlu = CuotaAlu - ExenConv
            End If
            CuotaAlu = (Int((CuotaAlu / 100) * -1) * 100) * -1
            ExenConv = (Base - ExenHmno) - CuotaAlu
        End If
    End If
    MatrizVal(0, 0) = Base
    MatrizVal(0, 1) = ExenBeca
    MatrizVal(0, 2) = ExenHmno
    MatrizVal(0, 3) = ExenConv
    MatrizVal(0, 4) = ExenDescto
    MatrizVal(0, 5) = CuotaAlu
    RsAux.Close
End If
CalculaCuotaalu = MatrizVal
Set RsAux = Nothing
RsFuncion2.Close: Set RsFuncion2 = Nothing
End Function
Public Function TraeCambionivel(CodigoEns As String, nivel As String) As String
Dim ACodigos() As Variant, Niveles As Integer, Pos As Integer, ACodigosInt() As Variant
Niveles = 0: Indice = 0
Set RsFuncion = New ADODB.Recordset
RsFuncion.CursorLocation = adUseClient
RsFuncion.Open "select * from codigos_ensenanza order by ord_ens", conn
If RsFuncion.RecordCount > 0 Then
    For h = 0 To RsFuncion.RecordCount - 1
        Indice = Niveles
        Niveles = Niveles + val(RsFuncion!num_gra_max)
        ReDim Preserve ACodigos(Niveles): ReDim Preserve ACodigosInt(Niveles)
        For n = 1 To val(RsFuncion!num_gra_max)
            ACodigos(Indice) = RsFuncion!Cod_Ens & "," & n
            ACodigosInt(Indice) = RsFuncion!cod_des
            'Form_Cuponeras.List1.AddItem ACodigos(Indice)
            Indice = Indice + 1
        Next n
        RsFuncion.MoveNext
    Next h
    RsFuncion.Close
End If
      Pos = ValorenArray(ACodigos, CodigoEns & "," & nivel)
      If Pos > -1 Then ' encontro el valor
        If Pos + 1 <= UBound(ACodigos, 1) Then
            TraeCambionivel = ACodigos(Pos + 1) & "," & ACodigosInt(Pos + 1)
        Else
            TraeCambionivel = "NULO"
        End If
      Else
        TraeCambionivel = "NULO"
      End If
Set RsFuncion = Nothing
'MsgBox ("de " & CodigoEns & " " & Nivel & " a " & TraeCambionivel)
End Function
Public Function ValorenArray(Arreglo As Variant, valor As String) As Integer
Dim largo As Variant
ValorenArray = -1
largo = UBound(Arreglo, 1)
For t = 0 To largo
    If UCase(Arreglo(t)) = UCase(valor) Then
        ValorenArray = t
        Exit For
    End If
Next t
End Function
Public Function Tamaño(ByVal valor As String, ByVal Tamano As Long) As String
    Dim dif As Long, i As Long, aux As String
    If Len(valor) = Tamano Then
        Tamaño = valor
        Exit Function
    End If
    
    If Len(valor) > Tamano Then
        Tamaño = Mid(valor, 1, Tamano)
        Exit Function
    Else
        dif = Tamano - Len(valor)
        
        For i = 1 To dif
            aux = aux & " "
        Next i
        Tamaño = valor & aux
    End If
End Function
Public Function largo(ByVal valor As String, ByVal Tamano As Long) As String
    Dim dif As Long, i As Long, aux As String
    If Len(valor) = Tamano Then
        largo = valor
        Exit Function
    End If
    
    If Len(valor) > Tamano Then
        largo = valor
        Exit Function
    Else
        dif = Tamano - Len(valor)
        
        For i = 1 To dif
            aux = aux & 0
        Next i
        largo = aux & valor
    End If
End Function
Public Function addCeros(ByVal valor As String, ByVal cantCeros As Integer) As String
 Dim intPosComa As Integer, strParDecimal As String
 Dim strParEntera As String, i As Integer, totalCeros As Integer
   
  
    If Len(valor) = 0 Then
        valor = 0
    End If
  
    intPosComa = InStr(1, valor, ",")
  
    If intPosComa > 1 Then
        strParDecimal = Mid$(valor, intPosComa)
        strParEntera = Mid$(valor, 1, intPosComa - 1)
    ElseIf intPosComa = 0 Then
        For i = 1 To cantCeros
            strParDecimal = strParDecimal & "0"
        Next
        strParEntera = valor
        addCeros = strParEntera & "," & strParDecimal
        Exit Function
    Else
        strParDecimal = valor
        strParEntera = 0
    End If
  
    'Formatearemos los decimales con la cantidad de ceros pasados por parametro
    If cantCeros > 0 Then
        If Len(strParDecimal) <> 0 Then
            If (Len(strParDecimal) - 1) < cantCeros Then
                totalCeros = cantCeros - (Len(strParDecimal) - 1)
            End If
        Else
            totalCeros = totalCeros
            
        End If
        If Trim(strParDecimal) = "" Then
            strParDecimal = ","
        Else
            If totalCeros > 0 Then
                totalCeros = totalCeros + 1
            End If
        End If
        For i = 1 To totalCeros - 1
            strParDecimal = strParDecimal & "0"
        Next
    End If
  addCeros = strParEntera & strParDecimal
End Function

Public Sub CreateFile(ByVal linea As String, Optional nombre As String)
    Dim obj As Object, sruta As String, a As Object, aux As Variant
    If Len(nombre) = 0 Then nombre = ""
    Set obj = CreateObject("scripting.FileSystemObject")
    sruta = nombre
    If obj.FileExists(sruta) Then
        Set a = obj.OpenTextFile(sruta, 8, True)
        a.WriteLine (linea)
        a.Close
    Else
        Set a = obj.CreateTextFile(sruta, True)
        a.WriteLine (linea)
        a.Close
   
    End If
    Set obj = Nothing
    Set a = Nothing
End Sub
Public Function MesATexto(NumeroMes As Integer) As String
    Select Case NumeroMes
        Case Is = 1
            MesATexto = "Enero"
        Case Is = 2
            MesATexto = "Febrero"
        Case Is = 3
            MesATexto = "Marzo"
        Case Is = 4
            MesATexto = "Abril"
        Case Is = 5
            MesATexto = "Mayo"
        Case Is = 6
            MesATexto = "Junio"
        Case Is = 7
            MesATexto = "Julio"
        Case Is = 8
            MesATexto = "Agosto"
        Case Is = 9
            MesATexto = "Septiembre"
        Case Is = 10
            MesATexto = "Octubre"
        Case Is = 11
            MesATexto = "Noviembre"
        Case Is = 12
            MesATexto = "Diciembre"
    End Select
End Function
Public Function CabeceraBci(archivo As String) As String
Dim Numeroarchivo As Integer
Dim linea1 As String
Numeroarchivo = FreeFile
 If dir$(archivo) <> "" Then
    Open archivo For Input As #Numeroarchivo
    Line Input #Numeroarchivo, linea1
    CabeceraBci = linea1
    Close #Numeroarchivo
  Else
    CabeceraBci = ""
 End If
End Function

Public Sub LimpiaFormulas(ByRef ControlVB As CrystalReport, NFormulas As Integer)
    For te = 0 To NFormulas
        ControlVB.Formulas(te) = ""
    Next te
End Sub
Sub RptGrillaTextH(grilla As MSHFlexGrid, Nfilas As Long, BDD As String, tabla)
Set Rendim = DBEngine.Workspaces(0).OpenDatabase(DirAplicacion & BDD)
For R = 1 To Nfilas
    detal = "": ins = "": horiz = ""
    For t = 0 To grilla.Cols - 1
        If grilla.TextMatrix(R, t) = "" Then
            detal = detal & "Null , "
            'horiz = horiz & "'____________________________________' ,"
        Else
            detal = detal & "'" & grilla.TextMatrix(R, t) & "' , "
            'horiz = horiz & "'____________________________________' ,"
        End If
        ins = ins & "C" & CStr(t + 1) & ", "
    Next t
    ins = Left(ins, Len(ins) - 2): ins = "(" & ins & ")"
    detal = Left(detal, Len(detal) - 2): detal = "(" & detal & ")"
    a = "insert into " & tabla & " " & ins & " values " & detal
    Rendim.Execute a
Next R
Rendim.Close
End Sub
Function TraeInstal(archivo) As String
Dim Numeroarchivo As Integer
Dim linea1 As String
Numeroarchivo = FreeFile
 If dir$(archivo) <> "" Then
    Open archivo For Input As #Numeroarchivo
    Line Input #Numeroarchivo, linea1
    TraeInstal = linea1
    Close #Numeroarchivo
  Else
    Open archivo For Output As #Numeroarchivo
        Print #Numeroarchivo, ""
    Close #Numeroarchivo
    TraeInstal = ""
 End If
End Function
Public Function MesRetiroContable(FechaRetiro As Date) As Integer ' Desde que mes debe pagar
If Year(FechaRetiro) = "1111" And Month(FechaRetiro) = "11" And Day(FechaRetiro) = "11" Then
    MesRetiroContable = 12
Else
    If Month(FechaRetiro) >= 3 Then
        If Day(FechaRetiro) <= 15 Then
            MesRetiroContable = val(Month(FechaRetiro)) - 1
        Else
            MesRetiroContable = val(Month(FechaRetiro))
        End If
    End If
End If
End Function
Public Function MesIngresoContable(FechaMatricula As Date) As Integer ' Desde que mes debe pagar
'If Year(FechaRetiro) = "1111" And Month(FechaRetiro) = "11" And Day(FechaRetiro) = "11" Then
'    MesRetiroContable = 12
'Else
    If Month(FechaMatricula) >= 2 Then
        If Day(FechaMatricula) <= 15 Then
            MesIngresoContable = val(Month(FechaMatricula))
        Else
            MesIngresoContable = val(Month(FechaMatricula)) + 1
        End If
    End If
'End If
End Function

Public Function ValorenCombo(Control As ComboBox, valor As String) As Integer
ValorenCombo = -1
For t = 0 To Control.ListCount
    If UCase(Control.List(t)) = UCase(valor) Then
        ValorenCombo = t
        Exit For
    End If
Next t
End Function

Public Function EselMayoraxc(Rutalu As String, AnhoMat As String) As Boolean

RutApo = DevuelveCampo("apo_x_alu", "", "rut_apo", "agno=" & AnhoMat & " AND ci_alu ='" & Rutalu & "'", conn)
Set RsFuncion = New ADODB.Recordset
RsFuncion.CursorLocation = adUseClient
a = " SELECT rut_apo,ci_alu FROM apo_x_alu WHERE ci_alu='" & Rutalu & "' AND agno=" & AnhoMat & ";"
RsFuncion.Open a, conn
RutApo = RsFuncion!rut_apo
RsFuncion.Close
a = " SELECT p.ci_alu, c.ord_ens , m.num_gra , p.fec_nacalu FROM postulantes p, apo_x_alu aa, matriculas m, codigos_ensenanza c LEFT JOIN alu_x_cur AS axc ON axc.ci_alu = p.ci_alu WHERE aa.ci_alu=p.ci_alu AND p.ci_alu = m.ci_alu AND m.cod_ens=c.cod_ens AND aa.rut_apo = '" & RutApo & "' AND aa.agno=m.anno_mat AND m.anno_mat ='" & AnhoMat & "' AND ucase(m.activo_alu) ='SI' AND axc.let_cur IS NOT NULL " & _
    " ORDER BY c.ord_ens DESC, m.num_gra DESC, p.fec_nacalu;"
RsFuncion.Open a, conn
If RsFuncion.RecordCount > 0 Then
    If RsFuncion!ci_alu = Rutalu Then
        EselMayoraxc = True
    Else
        EselMayoraxc = False
    End If
Else
    MsgBox ("No encontro datos para el rut del alumno " & Rutalu)
End If
RsFuncion.Close
Set RsFuncion = Nothing

End Function

Public Sub Reco2Grid(ByRef REC As ADODB.Recordset, ByRef grid As Object, ByRef Formulario As Form, Optional ByVal Numeracion As Boolean = True)
    grid.ClearStructure
    If REC.RecordCount > 0 Then
        grid.Cols = REC.Fields.count + 1
        grid.Rows = REC.RecordCount + 1
        grid.FixedCols = 1
        grid.FixedRows = 1
        grid.TextMatrix(0, 0) = "Nº"
        grid.ColWidth(0) = IIf(Numeracion, Formulario.TextWidth(grid.TextMatrix(0, 0)) + 100, 0)
        For i = 1 To REC.Fields.count
            grid.TextMatrix(0, i) = UCase(REC.Fields(i - 1).Name)
            grid.ColWidth(i) = Formulario.TextWidth(grid.TextMatrix(0, i)) + 100
        Next i
        REC.MoveFirst
        For i = 1 To REC.RecordCount
            grid.TextMatrix(i, 0) = i
            grid.ColWidth(0) = IIf(Numeracion, IIf(Formulario.TextWidth(grid.TextMatrix(i, 0)) + 100 > grid.ColWidth(0), Formulario.TextWidth(grid.TextMatrix(i, 0)) + 100, grid.ColWidth(0)), 0)
            For j = 1 To REC.Fields.count
                grid.TextMatrix(i, j) = IIf(IsNull(REC(j - 1)), "Null", REC(j - 1))
                grid.ColWidth(j) = IIf(Formulario.TextWidth(grid.TextMatrix(i, j)) + 100 > grid.ColWidth(j), Formulario.TextWidth(grid.TextMatrix(i, j)) + 100, grid.ColWidth(j))
            Next j
            REC.MoveNext
        Next i
    Else
        grid.Cols = 2
        grid.Rows = 2
    End If
End Sub

Public Function CalcAsis(run_alu As String, Codens As String, NumGra As String, LetCur As String, agno As String, cnBase As ADODB.Connection)
    Dim Consulta As String
    Dim PorcentajeAsistido As Double
    Dim rsAsi As ADODB.Recordset
    Dim FECMAT As String
    Consulta = "ci_alu ='" & run_alu & "' and cod_ens ='" & Codens & "' and num_gra ='" & NumGra & "' and agno = " & agno
    Set rsAsi = cnBase.Execute("SELECT fec_mat from alu_x_cur WHERE " & Consulta)
    FECMAT = InvierteFecha(rsAsi("Fec_Mat"), "R")
    rsAsi.Close
    Set rsAsi = cnBase.Execute("SELECT SUM(ASI_R) as Ideal , SUM(ASI_T) AS Asistido FROM ASISTENCIA WHERE " & Consulta)
    '*****************************************************************************
    'parche agregado para solucionar alumnos con cambio de curso erroneos
    'By Mahu
    'Fecha : 20051118
    'Set rsAsi = cnBase.Execute("SELECT SUM(ASI_R) as Ideal , SUM(ASI_T) AS Asistido FROM ASISTENCIA WHERE ci_alu ='" & run_alu & "'")
    If rsAsi.RecordCount = 0 Or IsNull(rsAsi("ideal")) Then
        PorcentajeAsistido = 100
    Else
        If rsAsi("ideal") = 0 Then
            PorcentajeAsistido = 100
        Else
            PorcentajeAsistido = rsAsi("asistido") * 100 / rsAsi("ideal")
        End If
    End If
    ' fin cambio
    '*****************************************************************************
    rsAsi.Close
    CalcAsis = PorcentajeAsistido
End Function

Public Function ComputerName() As String
    'Devuelve el nombre del equipo actual
    Dim sComputerName As String
    Dim ComputerNameLength As Long

    sComputerName = String(MAX_COMPUTERNAME_LENGTH + 1, 0)
    ComputerNameLength = MAX_COMPUTERNAME_LENGTH
    Call GetComputerName(sComputerName, ComputerNameLength)
    ComputerName = Mid(sComputerName, 1, ComputerNameLength)
End Function

Public Function Inserta_Vitacora_Alumno(ci_alu As String, accion_realizada As String) As Boolean
    
    Dim var_sql As String
    Inserta_Vitacora_Alumno = False
    
    var_sql = "insert into hist_vitacora_alumno(login_usuario,nombre_usuario,IP,PC,Fecha," _
            & "Hora,ci_alu,accion_realizada) values ('" _
            & Nom_usu_ses & "','" & Nom_com_usu_ses & "','" _
            & Form_main.Winsock1.LocalIP & "','" & ComputerName & "'," _
            & "current_date,current_time,'" _
            & ci_alu & "','" & accion_realizada & "');"
    conn.Execute var_sql
    Inserta_Vitacora_Alumno = True
End Function

Public Function Inserta_Vitacora_Finanza(ci_alu As String, run_apo As String, _
                                         accion As String, accion_detalle As String, folio_inicial, folio_final) As Boolean
    Dim var_sql As String
    Inserta_Vitacora_Finanza = False
    
    var_sql = "insert into fnza_historico_log(login_usuario,nombre_usuario,IP,PC,Fecha," _
            & "Hora,ci_alu,run_apo,accion,accion_detalle,folio_inicial,folio_final) values ('" _
            & Nom_usu_ses & "','" & Nom_com_usu_ses & "','" _
            & Form_main.Winsock1.LocalIP & "','" & ComputerName & "'," _
            & "current_date,current_time,'" _
            & ci_alu & "','" & run_apo & "','" & accion & "','" _
            & accion_detalle & "'," & folio_inicial & "," & folio_final & ");"
    conn.Execute var_sql
    Inserta_Vitacora_Finanza = True
End Function

Public Function Inserta_Vitacora_Profesores(rut_prof As String, _
                                            accion As String, accion_detalle As String) As Boolean
    Dim var_sql As String
    Inserta_Vitacora_Profesores = False
    
    var_sql = "insert into hist_vitacora_profesores(login_usuario,nombre_usuario,IP,PC,Fecha," _
            & "Hora,rut_prof,accion,accion_detalle) values ('" _
            & Nom_usu_ses & "','" & Nom_com_usu_ses & "','" _
            & Form_main.Winsock1.LocalIP & "','" & ComputerName & "'," _
            & "current_date,current_time,'" _
            & rut_prof & "','" & accion & "','" _
            & accion_detalle & "');"
    conn.Execute var_sql
    Inserta_Vitacora_Profesores = True
End Function

Public Function Mes2Texto(ByVal mes As Integer) As String
    Mes2Texto = ""
    Select Case mes
    Case 1
        Mes2Texto = "Enero"
    Case 2
        Mes2Texto = "Febrero"
    Case 3
        Mes2Texto = "Marzo"
    Case 4
        Mes2Texto = "Abril"
    Case 5
        Mes2Texto = "Mayo"
    Case 6
        Mes2Texto = "Junio"
    Case 7
        Mes2Texto = "Julio"
    Case 8
        Mes2Texto = "Agosto"
    Case 9
        Mes2Texto = "Septiembre"
    Case 10
        Mes2Texto = "Octubre"
    Case 11
        Mes2Texto = "Noviembre"
    Case 12
        Mes2Texto = "Diciembre"
    Case Else
        Mes2Texto = mes & " no es un mes."
    End Select
End Function

Public Function verifica_alumno_protestados(ci_alu As String) As Boolean
    Dim var_sql As String
    Dim objRS As ADODB.Recordset
    Set objRS = New ADODB.Recordset
    verifica_alumno_protestados = False
    var_sql = "SELECT * FROM fnza_protestados_alumno" _
            & " where rut = '" & ci_alu & "'"
    objRS.Open var_sql, conn
    If Not objRS.EOF Then
        verifica_alumno_protestados = True
    End If
    objRS.Close
End Function


' declaraciones

'Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long

' Variables de Conecccion





'******************************************************************
' Funciones para el Funcionamiento del modulo de Asistencia
'******************************************************************
Public Function GeneraConsulta(nOpcion As Integer, agno As String, Optional strModal As String = "", Optional strGrado As String = "", Optional strLetra As String = "", Optional strRunAlumno As String = "", Optional strMes As String, Optional strDias As String, Optional nJornada As Integer) As String
    Dim strResp As String
    Dim nModal As Integer, Ngrado As Integer, nLetra As Integer, nRunAl As Integer, nMeses As Integer, nDias As Integer
    Dim i As Integer
    Dim strCP As String
    nModal = Len(strModal)
    Ngrado = Len(strGrado)
    nLetra = Len(strLetra)
    nMeses = Len(strMes)
    nRunAl = Len(strRunAlumno)
    nDias = Len(strDias)
    Select Case nOpcion
    
        ' Consulta Basica para obtener cartolas completas
        Case Is = gesCartola
            
            If nModal > 0 And Ngrado > 0 And nLetra > 0 Then
                strResp = "SELECT A.CI_ALU, M.NUM_MAT,  P.APE_PAT_ALU, P.APE_MAT_ALU, P.NOM_ALU, P.SEX_ALU, M.FEC_MAT, M.FEC_RETIRO, A.FEC_CAM, A.FEC_ING_CURSO, A.ACTIVO_ALU " & _
                    "FROM ALU_X_CUR A, MATRICULAS M, POSTULANTES P " & _
                    "WHERE A.CI_ALU = M.CI_ALU AND  A.CI_ALU=P.CI_ALU AND ((A.ACTIVO_ALU=M.ACTIVO_ALU) OR (A.ACTIVO_ALU='NO' AND M.FEC_RETIRO='1111-11-11')) AND A.FEC_MAT=M.FEC_MAT AND A.COD_ENS='" & strModal & "' AND A.NUM_GRA='" & strGrado & "' AND A.LET_CUR='" & strLetra & "' and m.anno_mat = " & agno & " AND a.agno = m.anno_mat " & _
                    "ORDER BY A.FEC_ING_CURSO, M.NUM_MAT, P.APE_PAT_ALU, P.APE_MAT_ALU, P.NOM_ALU"
            Else
                GoSub FallaAutoSel
            End If
            
        Case Is = gesCalendarioCurso
        
            If nModal > 0 And Ngrado > 0 And nLetra > 0 And nMeses > 0 Then
                strResp = "SELECT * FROM CAL_X_CUR WHERE COD_ENS = '" & strModal & "' AND NUM_GRA = '" & strGrado & "' AND LET_CUR ='" & strLetra & "' AND MES = '" & UCase(strMes) & "' and agno = " & agno
            Else
                GoSub FallaAutoSel
            End If
        
        Case Is = gesNombreModalXmes
            
            strResp = "SELECT DISTINCT C.COD_ENS, N.DES_ENS FROM CAL_X_CUR C, CODIGOS_ENSENANZA N WHERE C.COD_ENS = N.COD_ENS AND UCASE(LEFT(C.MES,3))='" & UCase(strMes) & "' and c.agno = " & agno
        
        Case Is = gesGradoXmes
            
            strResp = "SELECT DISTINCT NUM_GRA FROM CAL_X_CUR WHERE COD_ENS = '" & strModal & "' AND MES = '" & UCase(strMes) & "' and agno = " & agno
    
        Case Is = gesLetraXmes
        
            strResp = "SELECT LET_CUR FROM CAL_X_CUR WHERE COD_ENS ='" & strModal & "' AND NUM_GRA = '" & strGrado & "' AND MES = '" & strMes & "' and agno = " & agno
        
        Case Is = gesNombreMes
        
            strResp = "SELECT DISTINCT MES FROM CAL_X_CUR WHERE agno = " & agno
            
        Case Is = gesAsisOK
        
            strResp = ""
            
        Case Is = gesAsisBad
        
            strResp = ""
            
        Case Is = gesAsisNoTerminadaXjornada
        
            strResp = "SELECT C.LET_CUR FROM CAL_X_CUR C, CURSOS L WHERE L.COD_ENS = C.COD_ENS AND L.NUM_GRA=C.NUM_GRA AND L.LET_CUR =C.LET_CUR AND L.COD_ENS = '" & strModal & "' AND L.NUM_GRA = '" & strGrado & "' AND C.MES ='" & strMes & "' AND C.agno = " & agno & " AND C.agno = L.agno"
            strCP = ""
            
    End Select
    GeneraConsulta = strResp

Exit Function

FallaAutoSel:
    MsgBox "Error Interno: Problemas con los parametros para generar las Listas" & vbCrLf & "El programa se detendra." & vbCrLf & "Notifique el problema para establecer soluciones", vbCritical + vbOKOnly, "Error de Seleccion"
    GeneraConsulta = ""
    
End Function


Public Function FinMes(NumeroMes As Integer, Año As Integer) As Integer
    Dim uDia As Integer
    Select Case NumeroMes
        Case Is = 1
            uDia = 31
        Case Is = 2
            If Año / 4 = Int(Año / 4) Then
                uDia = 29
            Else
                uDia = 28
            End If
        Case Is = 3
            uDia = 31
        Case Is = 4
            uDia = 30
        Case Is = 5
            uDia = 31
        Case Is = 6
            uDia = 30
        Case Is = 7
            uDia = 31
        Case Is = 8
            uDia = 31
        Case Is = 9
            uDia = 30
        Case Is = 10
            uDia = 31
        Case Is = 11
            uDia = 30
        Case Is = 12
            uDia = 31
    End Select
    FinMes = uDia
End Function

Public Function MesToNumber(Nombre_del_Mes As String) As Integer
    Dim Tm As String
    Dim NuMes As Integer
    Tm = UCase(Nombre_del_Mes)
    If Len(Tm) > 3 Then
        Tm = Left(Tm, 3)
    End If
    Select Case Tm
        Case Is = "ENE"
            NuMes = 1
        Case Is = "FEB"
            NuMes = 2
        Case Is = "MAR"
            NuMes = 3
        Case Is = "ABR"
            NuMes = 4
        Case Is = "MAY"
            NuMes = 5
        Case Is = "JUN"
            NuMes = 6
        Case Is = "JUL"
            NuMes = 7
        Case Is = "AGO"
            NuMes = 8
        Case Is = "SEP"
            NuMes = 9
        Case Is = "OCT"
            NuMes = 10
        Case Is = "NOV"
            NuMes = 11
        Case Is = "DIC"
            NuMes = 12
        Case Else
            NuMes = 0
    End Select
    MesToNumber = NuMes
End Function

Public Function PrimerDia(NumeroMes As Integer, AgnoProceso As Integer) As Integer
    Dim Fecha As Date, DiaSem As Integer
    Fecha = CDate("01/" + str(NumeroMes) + "/" + str(AgnoProceso))
    dia = Weekday(Fecha, vbMonday)
    PrimerDia = dia
End Function


Public Function MesCortoLargo(MesCorto As String) As String
    Select Case MesCorto
        Case Is = "ENE"
            MesCortoLargo = "Enero"
        Case Is = "FEB"
            MesCortoLargo = "Febrero"
        Case Is = "MAR"
            MesCortoLargo = "Marzo"
        Case Is = "ABR"
            MesCortoLargo = "Abril"
        Case Is = "MAY"
            MesCortoLargo = "Mayo"
        Case Is = "JUN"
            MesCortoLargo = "Junio"
        Case Is = "JUL"
            MesCortoLargo = "Julio"
        Case Is = "AGO"
            MesCortoLargo = "Agosto"
        Case Is = "SEP"
            MesCortoLargo = "Septiembre"
        Case Is = "OCT"
            MesCortoLargo = "Octubre"
        Case Is = "NOV"
            MesCortoLargo = "Noviembre"
        Case Is = "DIC"
            MesCortoLargo = "Diciembre"
    End Select
End Function

Public Function About(strPrograma As String, strVersion As String, strTitle As String)
    AcercaDe strPrograma, strVersion, strTitle
End Function

'Public Function MuestraDia(strDia As String, strServ As String, strBase As String, strUser As String, strPass As String)
'    Dim Conec As New ADODB.Connection
'    Dim rsDia As New ADODB.Recordset
'    Conec = LevantaConeccion(strServ, strBase, strUser, strPass)
'    Conec.Open
'    rsDia.Open "SELECT * FROM MATRICULAS ", Conec
'        MsgBox "conectado"
'    Conec.Close
'End Function

'Public Function IniGet(ByVal lpFileName As String, ByVal lpAppName As String, _
'                       ByVal lpKeyName As String, _
'                       Optional ByVal lpDefault As String = "") As String
'    IniGet = IniGets(lpFileName, lpAppName, lpKeyName, lpDefault)
'End Function

'Public Sub IniWrite(ByVal lpFileName As String, ByVal lpAppName As String, _
'                    ByVal lpKeyName As String, ByVal lpString As String)
'    IniWritte lpFileName, lpAppName, lpKeyName, lpString
'End Sub

'Public Function ComputerName() As String
'    'Devuelve el nombre del equipo actual
'    Dim sComputerName As String
'    Dim ComputerNameLength As Long
'
'    sComputerName = String(MAX_COMPUTERNAME_LENGTH + 1, 0)
'    ComputerNameLength = MAX_COMPUTERNAME_LENGTH
'    Call GetComputerName(sComputerName, ComputerNameLength)
'    ComputerName = Mid(sComputerName, 1, ComputerNameLength)
'End Function

Public Function Inserta_Vitacora_Asistencia(rut_prof As String, _
                                            accion As String, accion_detalle As String) As Boolean
    Dim var_sql As String
    Inserta_Vitacora_Asistencia = False
    
    var_sql = "insert into hist_vitacora_asistencia(login_usuario,nombre_usuario,IP,PC,Fecha," _
            & "Hora,rut_usu,accion,accion_detalle) values ('" _
            & Nom_usu_ses & "','" & Nom_com_usu_ses & "','" _
            & Form_main.Winsock1.LocalIP & "','" & ComputerName & "'," _
            & "current_date,current_time,'" _
            & rut_prof & "','" & accion & "','" _
            & accion_detalle & "');"
    conn.Execute var_sql
    Inserta_Vitacora_Asistencia = True
    
End Function

Public Function Inserta_Vitacora_Atrasos(rut_prof As String, _
                                            accion As String, accion_detalle As String) As Boolean
    Dim var_sql As String
    Inserta_Vitacora_Atrasos = False
    
    var_sql = "insert into hist_vitacora_atrasos(login_usuario,nombre_usuario,IP,PC,Fecha," _
            & "Hora,rut_usu,accion,accion_detalle) values ('" _
            & Nom_usu_ses & "','" & Nom_com_usu_ses & "','" _
            & Form_main.Winsock1.LocalIP & "','" & ComputerName & "'," _
            & "current_date,current_time,'" _
            & rut_prof & "','" & accion & "','" _
            & accion_detalle & "');"
    conn.Execute var_sql
    Inserta_Vitacora_Atrasos = True
    
End Function

Public Function Validar_Email(ByVal email As String) As Boolean
    
    Dim i As Integer, ILen As Integer, caracter As String
    Dim Pos As Integer, bp As Boolean, iPos As Integer, iPos2 As Integer

    On Local Error GoTo Err_Sub

    email = Trim$(email)

    If email = vbNullString Then
        Exit Function
    End If

    email = LCase$(email)
    ILen = Len(email)

    
    For i = 1 To ILen
        caracter = Mid(email, i, 1)

    'formulario modificado 24-03-2022

        If (Not (caracter Like "[a-z]")) And (Not (caracter Like "[0-9]")) Then
            
            If InStr("," & "´" & "ñ" & "Ñ" & "(" & ")" & ">" & "<" & "&", caracter) > 0 Then
                Validar_Email = False
                Exit Function
            End If
            
            If InStr(1, "_-" & "." & "@", caracter) > 0 Then
                If bp = True Then
                   Exit Function
                Else
                    bp = True
                   
                    If i = 1 Or i = ILen Then
                        Exit Function
                    End If
                    
                    If caracter = "@" Then
                        If iPos = 0 Then
                            iPos = i
                        Else
                            
                            Exit Function
                        End If
                    End If
                    If caracter = "." Then
                        iPos2 = i
                    End If
                    
                End If
            Else
                
                Exit Function
            End If
        Else
            bp = False
        End If
    Next i
    If iPos = 0 Or iPos2 = 0 Then
        Exit Function
    End If
    
    If iPos2 < iPos Then
        Exit Function
    End If

    
    Validar_Email = True

    Exit Function
Err_Sub:
    On Local Error Resume Next
    
    Validar_Email = False
End Function


