Data update

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

@@ -0,0 +1,191 @@
+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