Pascal: Agenda básica en Pascal (3: ficheros)

Agenda básica, para guardar datos de hasta 1000 personas. Permite añadir y buscar. Versión con funciones y procedimientos, que guarda en fichero.

Lenguaje: Pascal (compilador: Free Pascal 2.4)

Categoría: Ficheros

(* Fuente procedente de ErrorDeSintaxis.es *)

(* Agenda básica, para guardar datos de hasta *)

(*  1000 personas. Permite añadir y buscar. *)

(*  Versión con funciones y procedimientos, *)

(*  que guarda en fichero. *)

(* Lenguaje: Pascal *)

(* Compilador: Free Pascal 2.4 *)

(* Nivel: Básico *)

(* Disponible desde 27/12/2011 *)

(* Aportado por Nacho *)

(* Autor original: Nacho Cabanes *)

(* Web original: http://www.aprendeaprogramar.com *)

{--------------------------}
{  Ejemplo en Pascal:      }
{                          }
{    Ejemplo de "Agenda":  }
{    Permite añadir datos, }
{    mostrar, buscar.      }
{    Usa funciones.        }
{    AGENDA3.PAS           }
{                          }
{  Este fuente procede de  }
{  CUPAS, curso de Pascal  }
{  por Nacho Cabanes       }
{                          }
{  Comprobado con:         }
{    - Free Pascal 2.4.0   }
{--------------------------}
 
program Agenda3;
 
type
    tipoPersona = record
        nombre: string;
        email: string;
        anyoNacimiento: integer;
    end;
 
const
    capacidad = 1000;
 
var
    gente: array[1..capacidad] of tipoPersona;  { Los datos }
    cantidad: integer;       { Cantidad de datos existentes }
    terminado: boolean;
 
procedure MostrarMenu;
begin
    WriteLn('Agenda');
    WriteLn;
    WriteLn('1- Añadir una nueva persona');
    WriteLn('2- Ver nombres de todos');
    WriteLn('3- Buscar una persona');
    WriteLn('0- Salir');
end;
 
function LeerOpcion: integer;
var
    opcion: integer;
begin
    Write('Escoja una opción: ');
    ReadLn(opcion);
    WriteLn;
    if (opcion = 0) then terminado := true;
    LeerOpcion := opcion;    
end;
 
 
procedure CargarDatos;
var
    fichero: file of tipoPersona;
    i: integer;
begin
    assign(fichero, 'agenda.dat');
    {$I-} 
    reset(fichero);
    {$I+}
    if ioResult <> 0 then  
        WriteLn('No había fichero de datos. Se creará.')
    else
    begin
        cantidad := filesize(fichero);
        for i := 1 to cantidad do
            Read(fichero, gente[i]);
        close(fichero);
    end;
end;
 
procedure GrabarDatos;
var
    fichero: file of tipoPersona;
    i: integer;
begin
    assign(fichero, 'agenda.dat');
    {$I-} 
    rewrite(fichero);
    {$I+}
    if ioResult <> 0 then  
        WriteLn('No se ha podido grabar!')
    else
    begin
        for i := 1 to cantidad do
            Write(fichero, gente[i]);
        close(fichero);
    end;
end;
 
procedure NuevoDato;
begin
    if (cantidad < capacidad) then
    begin
        inc(cantidad);
        WriteLn('Introduciendo la persona ', cantidad);
 
        Write('Introduzca el nombre: ');
        ReadLn(gente[cantidad].nombre);
 
        Write('Introduzca el correo electrónico: ');
        ReadLn(gente[cantidad].email);
 
        Write('Introduzca el año de nacimiento: ');
        ReadLn(gente[cantidad].anyoNacimiento);
 
         WriteLn;
         GrabarDatos;
     end
     else
            WriteLn('Base de datos llena');
end;
 
procedure MostrarDatos;
var
    i: integer;
begin
    if cantidad = 0 then
        WriteLn('No hay datos')
    else
        for i := 1 to cantidad do
            WriteLn(i, ' ', gente[i].nombre);
    WriteLn;
end;
 
procedure BuscarDatos;
var
    textoBuscar: string;
    encontrado: boolean;
    i: integer;
begin
    Write('¿Qué texto busca? ');
    ReadLn( textoBuscar );
    encontrado := false;
    for i := 1 to cantidad do
        if pos (textoBuscar, gente[i].nombre) > 0 then
        begin
            encontrado := true;
            WriteLn( i,' - Nombre: ', gente[i].nombre,
              ', Email: ', gente[i].email,
              ', Nacido en: ', gente[i].anyoNacimiento);
        end;
    if not encontrado then
        WriteLn('No se ha encontrado.');
    WriteLn;
end;
 
procedure AvisarFin;
begin
    WriteLn;
    WriteLn('Saliendo...');
    WriteLn;
end;
 
procedure AvisarError;
begin
    WriteLn;
    WriteLn('Opción incorrecta!');
    WriteLn;
end;
 
 
{Cuerpo del programa principal}
begin
    terminado := false;
    cantidad := 0;
    CargarDatos;
    repeat
 
        MostrarMenu;
        case LeerOpcion of
            1: NuevoDato;
            2: MostrarDatos;
            3: BuscarDatos;
            0: AvisarFin;                
            else AvisarError;
        end;  { Fin de "case" }
 
    until terminado;
end.
 

 
Resultado:

No había fichero de datos. Se creará.
Agenda

1- Añadir una nueva persona
2- Ver nombres de todos
3- Buscar una persona
0- Salir
Escoja una opción: 1

Introduciendo la persona 1
Introduzca el nombre: Juan
Introduzca el correo electrónico: 1@1.1
Introduzca el año de nacimiento: 1

Agenda

1- Añadir una nueva persona
2- Ver nombres de todos
3- Buscar una persona
0- Salir
Escoja una opción: 2

1 Juan

Agenda

1- Añadir una nueva persona
2- Ver nombres de todos
3- Buscar una persona
0- Salir
Escoja una opción: 0


Saliendo...

------------------------------

Agenda

1- Añadir una nueva persona
2- Ver nombres de todos
3- Buscar una persona
0- Salir
Escoja una opción: 2

1 Juan

Agenda

1- Añadir una nueva persona
2- Ver nombres de todos
3- Buscar una persona
0- Salir
Escoja una opción: 0


Saliendo...