Pascal/Turbo Pascal - Ayuda con archivos

 
Vista:
sin imagen de perfil

Ayuda con archivos

Publicado por Luis (1 intervención) el 27/07/2021 22:05:30
3E03F65F-91A9-452E-B6F9-FA353F7CE536
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder

Ayuda con archivos

Publicado por ramon (2158 intervenciones) el 02/08/2021 15:46:30
Espero esto te ayude.

program archivovacio;
uses
crt;

type
string8 = string[8];

estudiantes = record
cedula : longint;
nombre : string;
direccion : string;
codipost : string[70];
promnota : real;
edad : integer;
estatus : char;
end;

const
esta : array[1..3] of string8 = ('activo','retirado','egresado');
nombre : string = 'ucsb.dat';

var
f : file of estudiantes;
dato : estudiantes;
cedul : longint;





procedure inicioarchivo(da : estudiantes);
begin
assign(f,nombre);
{$I-} reset(f); {$I+}
if ioresult <> 0 then
begin
rewrite(f);
seek(f,0);
write(f,da);
close(f);
writeln('\\\\\\ Archivo Inicializado \\\\\\');
writeln('Pulse Una Tecla');
readkey;
end
else
begin
seek(f,filesize(f));
write(f,da);
close(f);
writeln('<<<<< Archivo Guardado >>>>>');
writeln('Pulse Una Tecla');
readkey;
end;
end;


procedure insertar(rg : estudiantes);
var
dec : char;
begin
clrscr;
writeln('***** A¤adir Estudiante *****');
writeln;
write('Entre Cedula : ');
readln(rg.cedula);
write('Entre Nombre : ');
readln(rg.nombre);
write('Entre Direccion : ');
readln(rg.direccion);
write('Entre Codigo Postal : ');
readln(rg.codipost);
write('Entre promedio nota : ');
readln(rg.promnota);
write('Entre edad : ');
readln(rg.edad);
writeln('Estatus = [1] = activo [2] = retirado [3] = egresado');
write('Entre Estatus : ');
readln(rg.estatus);
writeln;
writeln('Datos Correctos [S\N]');
repeat
dec := upcase(readkey);
until dec in['S','N'];
if dec = 'S' then
inicioarchivo(rg);
if dec = 'N' then
insertar(rg);
end;

procedure eliminar;
var
bo : char;
zz : longint;
begin
clrscr;
writeln('>>>> Eliminar Registro <<<<');
writeln;
write('Entre La Cedula : ');
readln(cedul);
writeln('Se Anulara Los Datos Y El Registro Indicado [S\N');
repeat
bo := upcase(readkey);
until bo in['S','N'];
if bo = 'S' then
begin
assign(f,nombre);
{$I-} reset(f); {$I+}
if ioresult <> 0 then
begin
writeln('Error De Archivo O No Existe Pulse Una Tecla');
readkey;
end
else
begin
for zz := 0 to filesize(f) - 1 do
begin
seek(f,zz);
read(f,dato);
if dato.cedula = cedul then
begin
dato.cedula := 0;
write(f,dato);
break;
end;
end;
close(f);
end;
end;
end;

procedure actualizar;
var
ss, act : longint;
encontrado : boolean;
mo : char;
z : integer;
begin
clrscr;
writeln('@@@@@ Actualizar Registro @@@@@');
writeln;
write('Entre La Cedula : ');
readln(act);
assign(f,nombre);
{$I-} reset(f); {$I+}
if ioresult <> 0 then
begin
writeln('Error De Archivo O No Existe Pulse Una Tecla');
readkey;
end
else
begin
encontrado := false;
for ss := 0 to filesize(f) - 1 do
begin
seek(f,ss);
read(f,dato);
if dato.cedula = act then
begin
encontrado := true;
break;
end;
end;
repeat
clrscr;
writeln(',,,,, Los Datos Son ....');
writeln;
writeln('[1] = ',dato.cedula);
writeln('[2] = ',dato.nombre);
writeln('[3] = ',dato.direccion);
writeln('[4] = ',dato.codipost);
writeln('[5] = ',dato.promnota:0:2);
writeln('[6] = ',dato.edad);
writeln('[7] = ',esta[ord(dato.estatus) - 48]);
writeln('[8] = Finalizar Y Guarda');
writeln('[ESC] = Avandona Sin Cambios');
writeln;
writeln('\\\\ Elije Modificar N. ////');
repeat
mo := readkey;
until mo in[#49..#56,#27];

case mo of
#49 : begin
clrscr;
write('Cedula : ');
readln(dato.cedula);
end;
#50 : begin
clrscr;
write('Nombre : ');
readln(dato.nombre);
end;
#51 : begin
clrscr;
write('Direccion : ');
readln(dato.direccion);
end;
#52 : begin
clrscr;
write('Codigo Postal : ');
readln(dato.Codipost);
end;
#53 : begin
clrscr;
write('Promedio Nota : ');
readln(dato.promnota);
end;
#54 : begin
clrscr;
write('Edad : ');
readln(dato.edad);
end;
#55 : begin
clrscr;
for z := 1 to 3 do
writeln('[',z,'] ',esta[z]);
write('Estado : ');
readln(dato.estatus);
end;
end;
if mo = #56 then
begin
seek(f,ss);
write(f,dato);
close(f);
end;
if mo = #27 then
close(f);
until (mo = #56) or (mo = #27);
end;
end;

procedure consultar;
var
ss : longint;
cons : longint;
encontrado : boolean;
begin
clrscr;
writeln('$$$$ Consultar Registro $$$$');
writeln;
write('Entre La Cedula : ');
readln(cons);
assign(f,nombre);
{$I-} reset(f); {$I+}
if ioresult <> 0 then
begin
writeln('Error De Archivo O No Existe Pulse Una Tecla');
readkey;
end
else
begin
encontrado := false;
for ss := 0 to filesize(f) - 1 do
begin
seek(f,ss);
read(f,dato);
if dato.cedula = cons then
begin
encontrado := true;
break;
end;
end;
close(f);
if encontrado = true then
begin
clrscr;
writeln(',,,,, Los Datos Son ....');
writeln;
writeln('N. Cedula = ',dato.cedula);
writeln('Nombre = ',dato.nombre);
writeln('Direccion = ',dato.direccion);
writeln('Cogigo Postal = ',dato.codipost);
writeln('Promedio Nota = ',dato.promnota:0:2);
writeln('Edad = ',dato.edad);
writeln('Estatus = ',esta[ord(dato.estatus) - 48]);
writeln;
writeln('\\\\ Pulse Una Tecla ////');
readkey;
end;
end;
end;

procedure menu;
var
salir : boolean;
op : char;
begin
salir := false;
fillchar(dato,sizeof(dato),0);
repeat
clrscr;
writeln('******* Menu *******');
writeln;
writeln('[K] Crear Archivo');
writeln('[E] Eliminar Dato');
writeln('[A] Actualizar Dato');
writeln('[C] Consultar Dato');
writeln('[I] Insetar');
writeln('[S] Salir');
writeln;
writeln('<<<< Elije Opcion >>>>');
repeat
op := upcase(readkey);
until op in['K','E','A','C','I','S'];
case op of
'K' : inicioarchivo(dato);
'E' : eliminar;
'A' : actualizar;
'C' : consultar;
'I' : insertar(dato);
'S' : salir := true;
end;
until salir = true;
end;



begin
menu;
end.
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar