CAI - Visual Basic - Ej. Citas Reloaded, Visual Basic

CAI - Visual Basic - Ej. Citas Reloaded

' CITAS RELOADED

' Desarrollar la función PosiblesParejasEnProvincia que recibe como parámetro el
' código de persona de quien está buscando, el código de su provincia, y el código de
' sexo buscado por esta persona. Con esta información, devolver la cantidad de
' personas que serían parejas viables para esta persona (sin contar a la persona actual)

Private Function PosiblesParejasEnProvincia(codPersona as Integer, codProvincia as Integer, codSexoBuscado as Integer) as Integer
    Dim totalPosiblesParejas as Integer
    totalPosiblesParejas = 0
    
    Dim sexoPerActual as Integer
    sexoPerActual = buscarSexoPersona(codPersona)
    
    Dim amistades as RecordSet
    Set amistades = abrirTabla("Amistades", oDB)
    
    Dim criterioAmistades as String
    criterioAmistades = "ami_Activo = True" _
        & " AND (ami_Origen = " & codPersona & " OR ami_Destino = " & codPersona & ")"
    
    amistades.FindFirst criterioAmistades
    Do while Not amistades.NoMatch
        Dim personas as RecordSet
        Set personas = abrirTabla("Persona", oDB)
        
        Dim codAmigo as Integer
        If amistades("ami_Origen") = codPersona Then
            codAmigo = amistades("ami_Destino")
        Else
            codAmigo = amistades("ami_Origen")
        End If
        
        Dim criterioPosiblePareja as String
        criterioPosiblePareja = _
            "per_Activo = True" _
            & " AND per_Codigo = " & codAmigo _
            & " AND per_Provincia = " & codProvincia _
            & " AND per_Sexo = " & codSexoBuscado _
            & " AND per_SexoBuscado = " & sexoPerActual
        
        personas.FindFirst criterioPosiblePareja
        Do while Not personas.NoMatch
            totalPosiblesParejas = totalPosiblesParejas + 1
            personas.FindNext criterioPosiblePareja
        Loop
        
        cerrarTabla personas
        amistades.FindNext criterioAmistades
    Loop
    
    cerrarTabla amistades
    
    PosiblesParejasEnProvincia = totalPosiblesParejas
End Function

Private Function buscarSexoPersona(codPersona as Integer) as Integer
    Dim sexoPersona as Integer

Dim personas as Recordset
    Set personas = abrirTabla("Persona", oDB)
    
    Dim criterioPersona as String
    criterioPersona = "per_Activo = True AND per_Codigo = " & codPersona
    
    personas.FindFirst criterioPersona
    Do While Not personas.NoMatch
        sexoPersona = personas("per_Sexo")
        personas.FindNext criterioPersona
    Loop
    
    cerrarTabla personas
    
    buscarSexoPersona = sexoPersona
End Function

' Implementar la rutina ObtenerAmigosPorNombre, que carga un listbox de resultados
' en base al ingreso parcial del nombre de los mismos (solo con el nombre completo y su
' código asociado). Esta función recibe como parámetro el código de la persona que está
' buscando, una cadena de texto con el nombre a buscar, un indicador booleano que
' determina si se debe buscar solo entre amigos (true) o en toda la base de datos (false),
' y una referencia al listbox en donde deben cargarse los resultados.

Private Sub ObtenerAmigosPorNombre(codPersona as Integer, txtNombreABuscar as String, soloAmigos as Boolean, lstResultados as ListBox)
    lstResultados.Clear
    If soloAmigos = True Then
        Dim amistades as RecordSet
        amistades = abrirTabla("Amistades", oDB)

Dim criterioAmistades as String
        criterioAmistades = "ami_Activo = True" _
            & " AND (ami_Origen = " & codPersona & " OR ami_Destino = " & codPersona & ")"

amistades.FindFirst criterioAmistades
        Do while Not amistades.NoMatch
            Dim personas as RecordSet
            Set personas = abrirTabla("Persona", oDB)

Dim codAmigo as Integer
            If amistades("ami_Origen") = codPersona Then
                codAmigo = amistades("ami_Destino")
            Else
                codAmigo = amistades("ami_Origen")
            End If

Dim criterioAmigo as String
            criterioAmigo = "per_Activo = True AND per_Codigo = " & codAmigo & " AND per_Nombre LIKE '*" & txtNombreABuscar & "*'"
            
            personas.FindFirst criterioAmigo
            Do while Not personas.NoMatch
                agregarItemLista lstResultados, personas("per_Nombre"), personas("per_Codigo")
                personas.FindNext criterioAmigo
            Loop
            
            cerrarTabla personas
            amistades.FindNext criterioAmistades
        Loop

cerrarTabla amistades
    Else
        Dim personas as RecordSet
        Set personas = abrirTabla("Persona", oDB)
        
        Dim criterioPersonas as String
        criterioPersonas = _
            "per_Activo = True" _
            & " AND per_Codigo <> " codPersona _
            & " AND per_Nombre LIKE '*" & txtNombreABuscar & "*'"
            
        personas.FindFirst criterioPersonas
        Do while not personas.NoMatch
            agregarItemLista lstResultados, personas("per_Nombre"), personas("per_Codigo")
            personas.FindNext criterioPersonas
        Loop
        
        cerrarTabla personas
    End If
End Sub

' Asignar a la variable strCriterio cada uno de los criterios solicitados a continuación,
' considerando que se cuenta con la variable oRSPersona posicionada sobre el registro
' de la persona actual (ejemplo: strCriterio = “…”).
' Nota I: Tener presente que todos los selectores tienen un primer elemento con código inválido
' (-1) que solicitan al usuario que lleve a cabo la selección.
' Nota II: Tener en cuenta que el campo “activo” indica una baja lógica, por lo que siempre debe
' obtenerse registros “activos” a menos que se indique lo contrario

' A) Criterio que obtenga un recordset con las personas activas que están dentro
' de la misma provincia que el usuario actual, que estén activas y que hayan
' ingresado al sistema en los últimos X meses (donde X es intMesesInactividad),
' sin importar el sexo de las mismas.

strCriterio = _
    "per_Activo = True" _
    & " AND per_Codigo <> " & oRSPersona("per_Codigo") _
    & " AND per_Provincia = " & oRSPersona("per_Provincia") _
    & " AND per_UltimoIngreso > " & Format(DateAdd("m", -intMesesInactividad, Date()), "yyyy-mm-dd")

' B) Criterio con todas las personas que tengan la cadena X dentro del nombre
' (donde X es strNombre) y que, estén activas y hayan ingresado hace menos de
' un mes.

strCriterio = _
    "per_Activo = True" _
    & " AND per_Codigo <> " & oRSPersona("per_Codigo") _
    & " AND per_Nombre LIKE '*" & strNombre & "*'" _
    & " AND per_UltimoIngreso > " & Format(DateAdd("m", -1, Date()), "yyyy-mm-dd")


run \| edit \| history \| help	0