Ejemplo Archivos En Pascal

program MPPPS;

uses crt;

type

sintoma=record

temp_m:real;

temp_t:real;

ev:integer;

end;

semana=array[1..5]of sintoma;

info=record

nomb_a:string;

nomb_r:string;

telef:string;

sint:semana;

end;

arch=file of info;

var

escuela:arch; data:info; op,exit:char;

procedure crear;

var nombre,ext:string; op:char;

procedure cargar_data;

var i,j,c:integer;

begin

write('Cantidad de alumnos: '); readln(c);

for i:=1 to c do

begin

clrscr;

writeln('ALUMNO ',i);

write('Nombre del alumno: '); readln(data.nomb_a);

write('Nombre del representante: '); readln(data.nomb_r);

write('Numero de Telefono: '); readln(data.telef);

writeln('SINTOMAS: ');

for j:=1 to 5 do

begin

writeln('DIA: ',j);

write('Temperatura(manana): '); readln(data.sint[j].temp_m);

write('Temperatura(tarde): '); readln(data.sint[j].temp_t);

write('Diarrea?? S=SI N=NO...');

repeat op:=readkey; until((upcase(op)='S')or(upcase(op)='N'));

if(op='S')then

begin write('Cant de evacuaciones: '); readln(data.sint[j].ev); end

else writeln;

end;

write(escuela,data);

end;

end;

begin clrscr; ext:='.TXT';

repeat clrscr;

write('Nombre de la Escuela a ingresar al sistema: ');

textcolor(lightgreen); readln(nombre); textcolor(white);

assign(escuela,nombre+ext);

{$I-}

reset(escuela);

{$I+}

IF(IOResult<>0)THEN

begin

rewrite(escuela);

cargar_data;

close(escuela);

op:='M';

end

else

begin

close(escuela);

textcolor(lightred);

writeln('LA ESCUELA YA EXISTE');

textcolor(white);

writeln('Presione '); textcolor(lightgreen); write('"P" ');

textcolor(white); write('para probar con otro nombre o presione ');

textcolor(lightgreen); write('"M"'); textcolor(white);

write('para volver al menu');

repeat OP:=readkey; until((upcase(OP)='P')or(upcase(OP)='M'));

end;

until(upcase(OP)='M');

end;

{------------------------------------------------------------------------------------------------------------------------------------}

procedure listar;

var i,j,k,c:integer; dat:info; nombre,ext:string; op:char;

procedure limpiar;

var i:integer;

begin

dat.nomb_a:='0';

dat.nomb_r:='0';

dat.telef:='0';

for i:=1 to 5 do

begin

dat.sint[i].temp_m:=0;

dat.sint[i].temp_t:=0;

dat.sint[i].ev:=0;

end;

end;

begin clrscr; ext:='.txt';

...