Ayuda con ejercicio Pascal
{Espero te sirva como ayuda para lo que tienes que realizar }
program comfeci;
uses
crt;
type
datosreg = record
numero : integer;
fecha : string[10];
marca : string[20];
modelo : string[20];
vendido : boolean;
end;
var
auto : array[1..200] of datosreg;
f : file of datosreg;
elec : char;
procedure entrada;
var
tec : char;
mas : boolean;
z, n : integer;
begin
mas := true;
n := 1;
repeat
clrscr;
if mas = true then
begin
gotoxy(10,2);write('Entre Marca : ');
readln(auto[n].marca);
gotoxy(10,3);write('Entre Modelo : ');
readln(auto[n].modelo);
gotoxy(10,4);write('Entre Fecha Dia/Mes/A¤o : ');
readln(auto[n].fecha);
gotoxy(10,5);write('Entre Numero Asignacion : ');
readln(auto[n].numero);
auto[n].vendido := false;
mas := false;
end;
writeln;
writeln('Desea Entrar Mas [S/N].....');
tec := readkey;
if tec in ['S','s'] then
begin
n := n + 1;
if n > 200 then
n := 200;
mas := true;
end;
until tec in ['N','n'];
assign(f,'datosven.bsc');
{$i-} reset(f); {$i+}
if ioresult <> 0 then
begin
rewrite(f);
for z := 1 to n do
begin
seek(f,z - 1);
write(f, auto[z]);
end;
close(f);
end
else
begin
for z := 1 to n do
begin
seek(f,filesize(f) + (z - 1));
write(f,auto[z]);
end;
close(f);
end;
end;
procedure presentaventasmax;
var
c : integer;
asta, reg : longint;
begin
assign(f,'datosven.bsc');
{$i-} reset(f); {$i+}
if ioresult <> 0 then
begin
halt(1);
end
else
begin
reg := filesize(f) - 1;
if reg < 200 then
asta := reg
else
asta := 200;
c := 0;
repeat
seek(f,c);
read(f,auto[c + 1]);
c := c + 1;
until c > asta;
close(f);
for c := 1 to asta + 1 do
if auto[c].vendido = true then
begin
writeln(auto[c].numero,' ',auto[c].marca,' ',
auto[c].modelo,' ',auto[c].fecha);
end;
end;
writeln;
writeln('Fin de lista');
end;
procedure presentaventasmin;
var
c : integer;
asta, reg : longint;
begin
assign(f,'datosven.bsc');
{$i-} reset(f); {$i+}
if ioresult <> 0 then
begin
halt(1);
end
else
begin
reg := filesize(f) - 1;
if reg < 200 then
asta := reg
else
asta := 200;
c := 0;
repeat
seek(f,c);
read(f,auto[c + 1]);
c := c + 1;
until c > asta;
close(f);
for c := 1 to asta + 1 do
if auto[c].vendido = false then
begin
writeln(auto[c].numero,' ',auto[c].marca,' ',auto[c].modelo,' ',auto[c].fecha);
end;
end;
writeln;
writeln('Fin de lista');
end;
procedure listaventas;
var
pul : char;
begin
clrscr;
writeln('[1]=MAS VENDIDOS [2]=MENOS VENDIDOS [3]=SALIR');
repeat
pul := readkey;
if pul in[#49..#50] then
begin
case pul of
#49 : presentaventasmax;
#50 : presentaventasmin;
end;
end;
until pul = #51;
clrscr;
end;
procedure bajas;
var
num, ver, h : integer;
nn : longint;
f1 : file of datosreg;
borra : datosreg;
te : char;
begin
assign(f,'datosven.bsc');
{$i-} reset(f); {$i+}
if ioresult <> 0 then
begin
halt(1);
end
else
begin
h := 0;
repeat
seek(f,h);
read(f,auto[h + 1]);
h := h + 1;
until h > filesize(f) - 1;
close(f);
ver := 1;
writeln('Para anular pulse el numero de la Izquierda o ESC salir');
writeln;
repeat
writeln(auto[ver].numero,' ',auto[ver].marca,' ',auto[ver].modelo);
ver := ver + 1;
until ver > h;
writeln;
writeln('Registro a Borrar N§ :');
readln(num);
assign(f1,'temp.tmp');
rewrite(f1);
assign(f,'datosven.bsc');
reset(f);
nn := 0;
for h := 0 to filesize(f) - 1 do
begin
seek(f,h);
read(f,borra);
if borra.numero <> num then
begin
seek(f1,nn);
write(f1,borra);
nn := nn + 1;
end;
end;
close(f);
erase(f);
close(f1);
rename(f1,'datosven.bsc');
end;
end;
procedure vendidos;
var
ki : integer;
fil, h : longint;
actua : boolean;
actualiza : datosreg;
begin
assign(f,'datosven.bsc');
{$i-} reset(f); {$i+}
if ioresult <> 0 then
begin
halt(1);
end
else
begin
fil := filesize(f) - 1;
actua := false;
clrscr;
h := 0;
writeln('Entre N§ de Coche vendido : ');
readln(ki);
repeat
seek(f,h);
read(f,actualiza);
if actualiza.numero = ki then
begin
actualiza.vendido := true;
seek(f,h);
write(f,actualiza);
close(f);
actua := true;
end;
h := h + 1;
until (h > fil) or (actua = true);
if actua = false then
begin
close(f);
end;
end;
end;
begin
repeat
clrscr;
textcolor(15);
writeln('[1]=Altas [2]=Bajas [3]=Ventas [4]=Listas [5]=Salir');
elec := readkey;
if elec in [#49..#52] then
begin
case elec of
#49 : entrada;
#50 : bajas;
#51 : vendidos;
#52 : listaventas;
end;
end;
until elec = #53;
end.