RosettaCodeData/Task/Simple-database/FreeBASIC/simple-database.basic

Const filename = "contacts.dat"

Type Contact
    nombre As String
    cumpleano As String
    ciudad As String
    relacion As String
    email As String

    Declare Constructor ()
    Declare Constructor (Byref aNombre As String, Byref aCumpleano As String, Byref aCiudad As String, Byref aRelacion As String, Byref aEmail As String)
    Declare Function obtenerRelacion() As String
    Declare Function toString() As String
End Type

Constructor Contact ()
nombre = ""
cumpleano = ""
ciudad = ""
relacion = ""
email = ""
End Constructor

Constructor Contact (Byref aNombre As String, Byref aCumpleano As String, Byref aCiudad As String, Byref aRelacion As String, Byref aEmail As String)
nombre = aNombre
cumpleano = aCumpleano
ciudad = aCiudad
relacion = aRelacion
email = aEmail
End Constructor

Function Contact.obtenerRelacion() As String
    Return relacion
End Function

Function Contact.toString() As String
    Return nombre & ", " & cumpleano & ", " & ciudad & ", " & relacion & ", " & email
End Function

Dim Shared As Contact contactos()
Dim Shared As Integer numContactos = 0

Function Parse(Byref entry As String) As Contact
    Dim As String parts(4)
    Dim As Integer position = 0, index = 0

    While ((position = Instr(entry, ", ")) <> 0 And index < 4)
        parts(index) = Left(entry, position - 1)
        entry = Mid(entry, position + 2)
        index += 1
    Wend
    parts(index) = entry

    Return Contact(parts(0), parts(1), parts(2), parts(3), parts(4))
End Function

Sub escribeFichero(Byref newEntry As String)
    Dim As Integer file = Freefile
    If Open(filename For Append As #file) = 0 Then
        Print #file, newEntry
        Close #file
    Else
        Print "Unable to open database '" & filename & "' for writing"
    End If
End Sub

Sub leeFichero()
    Dim As Integer file = Freefile
    If Open(filename For Input As #file) <> 0 Then
        Print "The file '" & filename & "' does not exist. Do you want to create it? (y/n)"
        Dim As String response
        Input response
        If Lcase(response) = "y" Then
            If Open(filename For Output As #file) = 0 Then
                Print "File '" & filename & "' created successfully."
                Close #file
                Cls
            Else
                Print "Unable to create the file '" & filename & "'."
            End If
        Else
            Print "File not created."
        End If
    Else
        Dim As String entry
        While Eof(file) = 0
            Line Input #file, entry
            numContactos += 1
            Redim Preserve contactos(numContactos)
            contactos(numContactos - 1) = Parse(entry)
        Wend
        Close #file
    End If
End Sub

Sub anadirNuevaEntrada()
    Print "Type the new entry, without inverted commas, in the format:"
    Print "Name, Birth_Date, State, Relation, Email"
    Dim As String newEntry
    Line Input newEntry
    Dim As Contact contacto = Parse(newEntry)
    numContactos += 1
    Redim Preserve contactos(numContactos)
    contactos(numContactos - 1) = contacto
    escribeFichero(newEntry)

    Print "The contact '" & newEntry & "' has been added to the database"
End Sub

Sub mostrarUltimaEntrada()
    If numContactos > 0 Then
        Print "The latest entry is: " & contactos(numContactos - 1).toString()
    Else
        Print "There are currently no entries in the database"
    End If
End Sub

Sub mostrarUltimaEntradaEspecial(Byref search As String)
    Dim As Integer index = numContactos - 1
    While (index >= 0 And contactos(index).obtenerRelacion() <> search)
        index -= 1
    Wend

    If index >= 0 Then
        Print "The latest " & search & " entry is " & contactos(index).toString()
    Else
        Print "There are currently no " & search & " entries"
    End If
End Sub

Sub showLatestFriendEntry()
    mostrarUltimaEntradaEspecial("Friend")
End Sub

Sub showLatestFamilyEntry()
    mostrarUltimaEntradaEspecial("Family")
End Sub

Sub ListarTodasEntradasXEdad()
    '? numContactos
    Dim As Integer  i, j
    If numContactos > 0 Then
        Dim As Contact copiaContactos(numContactos - 1)
        For i = 0 To numContactos - 1
            copiaContactos(i) = contactos(i)
        Next

        For i = 0 To numContactos - 2
            For j = i + 1 To numContactos - 1
                If copiaContactos(j).cumpleano > copiaContactos(i).cumpleano Then
                    Swap copiaContactos(i), copiaContactos(j)
                End If
            Next
        Next

        For i = 0 To numContactos - 1
            Print copiaContactos(i).toString()
        Next
    Else
        Print "There are currently no entries in the database"
    End If
End Sub

Sub Main()
    leeFichero()
    Dim As Integer opc = 0
    While opc <> 6
        Print !"\n            Menu            "
        Print " 1: Add a new entry"
        Print " 2: Show latest entry"
        Print " 3: Show latest Friend entry"
        Print " 4: Show latest Family entry"
        Print " 5: List all entries by age"
        Print !" 6: Close the program \n"

        Input "> ", opc
        Select Case opc
        Case 1 : anadirNuevaEntrada()
        Case 2 : mostrarUltimaEntrada()
        Case 3 : showLatestFriendEntry()
        Case 4 : showLatestFamilyEntry()
        Case 5 : ListarTodasEntradasXEdad()
        Case 6 : Print !"\nProgram closed"
        Case Else : Print !"\nPlease enter a number in the range 1..6"
        End Select
    Wend
End Sub

Main()

Sleep