Archivo secuencial en Pascal
{Empecemos por partes te realice algunos cambios para dejar que el programa te detecte
el año y fecha actual para después te realice el calculo según los años en la entidad.
Después informarte que los archivos de registros no se manejan como tu lo haces
puesto que si quieres localizar a una persona el exclusiva veras que te se complican
las cosas puesto que la instrucción not eof(archivo) no para asta el final del archivo con
lo cual tienes que presentar a todas las personas del archivo.
Eso se realiza de esta manero:
assign(archivo,'nombre');
{$I-} reset(archivo) {$I+}
if ioresult <> 0 then
begin
writeln('Error de Archivo');
end
else
begin
seekj(archivo,n); (n sera el archivo a cargar el que tu desees del 0 al filesize(archivo) - 1)
read(archivo,dato);
end;
close(archivo);
o es su defecto todos con (for n := 0 to filesize(archivo) - 1 do pero en caso de tener mas
datos delos que entran en pantalla puedes manejar los para presentarlos por bloques}
program empleado;
uses
crt, dos;
type
RFecha = record
dia : word;
mes : word;
anio : word;
end;
REmpleado = record
legajo : integer;
nombre : string[20];
apellido : string[20];
dom : string[30]; {domicilio}
Fing: RFecha;{fecha de ingreso a la empresa}
sueldo : real;
end;
Aempleados = file of REmpleado;
var
archivo : Aempleados; {variables globales}
anioactu, mesactu, diaactu, diasemactu : word;
procedure EntradaDatos;
var
reg : REmpleado;
legajo : integer;
opc : char;
begin
clrscr;
assign(archivo,'empleados.dat');
{$I-} reset(archivo);{$I+}
if ioresult <> 0 then
rewrite(archivo);
writeln('Carga de datos de empleados');
repeat
writeln('Numero de legajo: ');readln(legajo);
while not eof(archivo) do
begin
read(archivo,reg);
if (reg.legajo = legajo) then
begin
writeln('Registro duplicado');
writeln('Precione una tecla para continuar');
readkey;
exit;
end;
end;
reg.legajo := legajo;
write('Nombre : ');readln(reg.nombre);
write('Apellido : ');readln(reg.apellido);
write('Domicilio : ');readln(reg.dom);
repeat
write('Dia de ingreso : ');readln(reg.Fing.dia);
until (reg.Fing.dia in [1..31]);
repeat
write('Mes de ingreso : ');readln(reg.Fing.mes)
until (reg.Fing.mes in [1..12]);
write('Anio de ingreso : ');readln(reg.Fing.anio);
write('Sueldo : ');readln(reg.sueldo);
write(archivo,reg);
repeat
writeln('Desea agregar otro registro (S/N): ');
opc := upcase(readkey);
until opc in ['S','N'];
clrscr;
until (opc = 'N');
close(archivo);
end;
function ObtAsignacionAntiguedad(anio : word; salario : real) : real;
var
dife : word;
begin
getdate(anioactu,mesactu,diaactu,diasemactu);
dife := anioactu - anio;
case dife of
0 : ObtAsignacionAntiguedad := salario;
1..3 : ObtAsignacionAntiguedad := salario + (salario * 5 / 100);
4..6 : ObtAsignacionAntiguedad := salario + (salario * 10 / 100);
7..50 : ObtAsignacionAntiguedad := salario + (salario * 20 / 100);
end;
end;
procedure Lista;
var
reg:REmpleado;m,a,d : integer;neto,s : real;
begin
clrscr;
assign(archivo,'empleados.dat');
{$I-} reset(archivo);{$I+}
if ioresult <> 0 then
begin
writeln('No se encontro el archivo');
writeln('Oprima una tecla para continuar');
readkey;
exit;
end;
writeln('***LISTADO DE EMPLEADOS***');
while not eof(archivo) do
begin
read(archivo,reg);
d := reg.Fing.dia;
m := reg.Fing.mes;
a := reg.Fing.anio;
s := reg.sueldo;
neto := ObtAsignacionAntiguedad(reg.fing.anio,reg.sueldo);
write('Legajo : ');writeln(reg.legajo);
write('Nombre : ');writeln(reg.nombre,' ',reg.apellido);
write('Sueldo neto : ');writeln(neto:6:2);
d := 0;m := 0; a:= 0; s := 0; neto := 0;
end;
close(archivo);
writeln;
writeln('Oprima una tecla para continuar');
readkey;
end;
procedure menu;
var
op : char;salir : boolean;
begin
repeat
clrscr;
writeln('****MENU GENERAL***');
writeln('1) Entrada de datos');
writeln('2) Listado de empleados');
writeln('3) Salir');
writeln;
repeat
writeln('***Elija una opcion***');
op := readkey;
until op in [#49..#51];
case op of
#49 : EntradaDatos;
#50 : Lista;
#51 : salir := true;
end;
until salir = true;
end;
BEGIN
clrscr;
menu;
END.
{Espero te sirva esto de ayuda}