program program_contactos;
uses cmem, crt, sysutils;
{$ifdef LINUX}const aacute = #195#161;
const oacute = #195#179;
const uacute = #195#186;
const uuacute = #195#154;
{$else}const aacute = #160;
const oacute = #162;
const uacute = #163;
const uuacute = #233;
{$endif}
type Comparable = function (const dato1 : pointer; const dato2 : pointer) : integer;
type Funcion = procedure (dato : pointer; parametros : pointer);
type Contacto = object
alias : string;
telefono_fijo : string;
telefono_movil : string;
correo : string;
end;
type pContacto = ^Contacto;
function comparar_contacto (const contacto1 : pContacto; const contacto2 : pContacto) : integer;
begin
comparar_contacto := strcomp (@contacto1^.alias[1], @contacto2^.alias[1]);
end;
function leer_cadena (mensaje : string) : string;
var cadena : string;
begin
write (stdout, mensaje, ': ');
readln (cadena);
leer_cadena := cadena;
end;
function leer_entero (mensaje : string) : integer;
var entero : integer;
begin
write (stdout, mensaje, ': ');
readln (entero);
leer_entero := entero;
end;
function leer_campo (var archivo : text; var campo : string) : boolean;
var c : char;
begin
campo := '';
while not eof (archivo) do
begin
read (archivo, c);
if (c=#13) then
continue;
if (c=#9) or (c=#10) then
begin
leer_campo := true;
exit;
end
else
campo := campo + c;
end;
leer_campo := false;
end;
type pinteger = ^integer;
procedure imprimir_contacto (dato : pContacto; contador : pinteger);
begin
writeln (stdout, 'alias : ', dato^.alias);
writeln (stdout, 'telefono fijo : ', dato^.telefono_fijo);
writeln (stdout, 'telefono movil: ', dato^.telefono_movil);
writeln (stdout, 'correo : ', dato^.correo);
writeln (stdout);
inc (contador^);
end;
type pText = ^text;
procedure imprimir_en_archivo (dato : pContacto; archivo : pText);
begin
write (archivo^, dato^.alias, #9);
write (archivo^, dato^.telefono_fijo, #9);
write (archivo^, dato^.telefono_movil, #9);
write (archivo^, dato^.correo, #10);
end;
type ppointer = ^pointer;
type ppContacto = ^pContacto;
function arreglo_insertar (arreglo : ppointer; var tamano : integer; dato : pointer) : ppointer;
begin
arreglo := realloc (arreglo, sizeof (pointer) * (tamano+1));
arreglo[tamano] := dato;
inc (tamano);
arreglo_insertar := arreglo;
end;
function arreglo_buscar (arreglo : ppointer; tamano : integer; comparar: Comparable; const dato : pointer) : pointer;
begin
if tamano > 0 then
if comparar (arreglo[0], dato) = 0 then
arreglo_buscar := arreglo[0]
else
arreglo_buscar := arreglo_buscar (arreglo + 1, tamano - 1, comparar, dato)
else
arreglo_buscar := nil;
end;
function arreglo_quitar (arreglo : ppointer; var tamano : integer; const dato : pointer) : ppointer;
var i : integer = 0;
begin
while (i<tamano) and (dato<>arreglo[i]) do
inc (i);
if i<tamano then
begin
for i:=i+1 to tamano-1 do
arreglo[i-1] := arreglo[i];
dec (tamano);
arreglo := realloc (arreglo, sizeof (pointer) * tamano);
end;
arreglo_quitar := arreglo;
end;
procedure quick_sort (arreglo : ppointer; inicio : integer; fin : integer; comparar: Comparable);
var menor, mayor : integer;
var pivote : pointer;
begin
menor := inicio;
mayor := fin;
if fin>inicio then
begin
pivote := arreglo[(inicio+fin) div 2];
while menor <= mayor do
begin
while (menor < fin ) and (comparar (arreglo[menor], pivote)<0) do
inc (menor);
while (mayor > inicio) and (comparar (arreglo[mayor], pivote)>0) do
dec (mayor);
if menor <= mayor then
begin
pivote := arreglo[menor];
arreglo[menor] := arreglo[mayor];
arreglo[mayor] := pivote;
inc (menor);
dec (mayor);
end;
end;
if inicio < mayor then
quick_sort (arreglo, inicio, mayor, comparar);
if menor < fin then
quick_sort (arreglo, menor, fin, comparar);
end;
end;
procedure arreglo_recorrer (arreglo : ppointer; tamano : integer; parametros : pointer; func : Funcion);
begin
if tamano>0 then
begin
func (arreglo[0], parametros);
arreglo_recorrer (arreglo + 1, tamano - 1, parametros, func);
end;
end;
const ruta = 'contactos.tsv';
var dato : ^Contacto = nil;
var contacto1 : Contacto;
var opcion : char;
var contador, subopcion : integer;
var campo : string = '';
var archivo : text;
var contactos : ppContacto = nil;
var tamano : integer = 0;
begin
contador := 0;
if fileexists (ruta) then
begin
assign (archivo, ruta);
reset (archivo);
while leer_campo (archivo, campo) do
begin
new (dato);
dato^.alias := campo;
leer_campo (archivo, campo);
dato^.telefono_fijo := campo;
leer_campo (archivo, campo);
dato^.telefono_movil := campo;
leer_campo (archivo, campo);
dato^.correo := campo;
contactos := ppContacto (arreglo_insertar (ppointer (contactos), tamano, dato));
end;
close (archivo);
end;
repeat
clrscr;
writeln (stdout, 'MEN', uuacute, #10#13);
writeln (stdout, '1.- Altas');
writeln (stdout, '2.- Consultas');
writeln (stdout, '3.- Actualizaciones');
writeln (stdout, '4.- Bajas');
writeln (stdout, '5.- Ordenar registros');
writeln (stdout, '6.- Listar registros');
writeln (stdout, '7.- Salir');
write (stdout, 'Seleccione una opci', oacute, 'n: ');
repeat
opcion := readkey;
until (opcion>='1') and (opcion<='7');
writeln (stdout, opcion, #10#13);
if (contactos = nil) and (opcion <> '1') and (opcion <> '7') then
begin
write (stdout, 'No hay registros.'#10#13#10#13'Presione una tecla para continuar . . . ');
readkey;
continue;
end;
if opcion<'5' then
begin
contacto1.alias := leer_cadena ('Ingrese el alias del contacto'); dato := arreglo_buscar (ppointer (contactos), tamano, Comparable(@comparar_contacto), @contacto1);
if dato <> nil then
begin
writeln (stdout);
imprimir_contacto (dato, @contador);
end;
end;
if (opcion = '1') and (dato <> nil) then
writeln (stdout, 'El registro ya existe.')
else if (opcion>='2') and (opcion<='4') and (dato = nil) then
writeln (stdout, #10#13'Registro no encontrado.')
else case opcion of
'1':
begin
new (dato);
dato^.alias := contacto1.alias;
dato^.telefono_fijo := leer_cadena ('Ingrese el telefono fijo'); dato^.telefono_movil := leer_cadena ('Ingrese el telefono movil'); dato^.correo := leer_cadena ('Ingrese el correo'); contactos := ppContacto (arreglo_insertar (ppointer (contactos), tamano, dato));
writeln (stdout, #10#13'Registro agregado correctamente.');
end;
'3':
begin
writeln (stdout, 'Men', uacute, ' de modificaci', oacute, 'n de campos');
writeln (stdout, '1.- telefono fijo');
writeln (stdout, '2.- telefono movil');
writeln (stdout, '3.- correo');
repeat
subopcion := leer_entero ('Seleccione un n' + uacute + 'mero de campo a modificar'); if (subopcion<1) or (subopcion>3) then
writeln (stdout, 'Opci', oacute, 'n no v', aacute, 'lida.');
until (subopcion>=1) and (subopcion<=3);
case subopcion of
1: dato^.telefono_fijo := leer_cadena ('Ingrese el nuevo telefono fijo'); 2: dato^.telefono_movil := leer_cadena ('Ingrese el nuevo telefono movil'); 3: dato^.correo := leer_cadena ('Ingrese el nuevo correo'); end;
writeln (stdout, #10#13'Registro actualizado correctamente.');
end;
'4':
begin
contactos := ppContacto (arreglo_quitar (ppointer (contactos), tamano, dato));
dispose (dato);
writeln (stdout, 'Registro borrado correctamente.');
end;
'5':
begin
quick_sort (ppointer (contactos), 0, tamano - 1, Comparable(@comparar_contacto));
writeln (stdout, 'Registros ordenados correctamente.');
end;
'6':
begin
contador := 0;
arreglo_recorrer (ppointer (contactos), tamano, @contador, Funcion (@imprimir_contacto));
writeln (stdout, 'Total de registros: ', contador, '.');
end;
end;
if (opcion<'7') then
begin
write (stdout, #10#13'Presione una tecla para continuar . . . ');
readkey;
end;
until opcion = '7';
assign (archivo, ruta);
rewrite (archivo);
arreglo_recorrer (ppointer (contactos), tamano, @archivo, Funcion (@imprimir_en_archivo));
close (archivo);
end.
Crear cuenta
Comentarios sobre la versión: Versión 1 (0)
No hay comentarios