Ayuda con altas y bajas en archivos
{Esto no es normal en archivos de una base de datos pues se podrían perder pero es como tu lo
pides}
program encuesta;
uses
crt;
const
nombremaes = 'maestro.bat'; {Archivo Maestro}
nombrebaja = 'bajas.bat'; {Archivo Bajas}
temporal = 'temporal.tmp'; {Archivo Imajem Maestro}
type
regmaes = record
DEPARTAMENTO : integer;
NENCUESTADO : integer;
NOMBRE_APELLIDO : string[60]; {Registro Maestro}
FECHA_NACIMIENTO : string[10];
Observaciones : string;
end;
regbaja = record
DEPARTAMENTO : integer;
NENCUESTADO : integer; {Registro Bajas}
Observaciones : string;
end;
var
f1 : file of regmaes;
f2 : file of regbaja;
datomaes : regmaes;
datobaja : regbaja;
i, k : longint;
function existen : boolean; { Comprovacion Existe}
var
es : integer;
begin
existen := false;
assign(f1,nombremaes);
{$I-} reset(f1); {$I+}
if ioresult <> 0 then
begin
es := 0;
end
else
begin
es := 1;
close(f1);
end;
assign(f2,nombrebaja);
{$I-} reset(f2); {$I+}
if ioresult <> 0 then
begin
es := 0;
end
else
begin
es := 2;
end;
if es = 2 then
begin
existen := true;
end;
end;
procedure anulacion; {Anulamos Registros Marcados}
var
ften : file of regmaes;
dten : regmaes;
nulo : boolean;
bs, bn : integer;
begin
if esisten = true then
begin
assign(ften,temporal);
rewrite(ften);
assign(f1,nombremaes);
reset(f1);
assign(f2,nombrebaja);
reset(f2);
i := 0;
k := 0;
repeat
seek(f2,i);
read(f2,datobaja);
for k := 0 to filesize(f1) - 1 do
begin
seek(f1,k);
read(f1,datomaes);
if datomaes.NENCUESTADO = datobaja.NENCUESTADO then
begin
datomaes.NENCUESTADO := 0;
seek(f1,k);
write(f1,datomaes);
nulo := true;
end;
end;
if nulo = true then
begin
datobaja.Observaciones := 'BAJA SI';
seek(f2,i);
write(f2,datobaja);
nulo := false;
end
else
begin
datobaja.Observaciones := 'BAJA ERRONEA';
seek(f2,i);
write(f2,datobaja);
nulo := false;
end;
i := i + 1;
until i > filesize(f2) - 1;
close(f2);
i := 0;
for k := 0 to filesize(f1) - 1 do
begin
seek(f1,k);
read(f1,datomaes);
if datomaes.NENCUESTADO <> 0 then
begin
dten := datomaes;
seek(ften,i);
write(ften,dten);
i := i + 1;
end;
end;
close(f1);
erase(f1);
close(ften);
rename(ften,nombremaes);
assign(f2,nombrebaja);
reset(f2);
bs := 0;
bn := 0;
for i := 0 to filesize(f2) - 1 do
begin
seek(f2,i);
read(f2,datobaja);
if datobaja.Observaciones = 'BAJA SI' then
begin
writeln(datobaja.NENCUESTADO,' = BAJA SI');
bs := bs + 1;
end;
if datobaja.Observaciones = 'BAJA ERRONEA' then
begin
writeln(datobaja.NENCUESTADO,' = BAJA erronea');
bn := bn + 1;
end;
end;
clrscr;
writeln('Total Bajas si = ',bs,' ','Total Bajas Error = ',bn);
writeln('Pulse Una Tecla');
repeat until keypressed;
close(f2);
erase(f2);
end;
end;
procedure entradadatosmaes; {Entramos Datos Maestro}
var
opci : char;
begin
gotoxy(23,2);write('<<<<<< Entrada de Datos >>>>>>>');
gotoxy(4,4);write('N§ DPT');
gotoxy(13,4);write('N§ ENCUS');
gotoxy(23,4);write('NOMBRE Y APELLIDO');
gotoxy(44,4);write('FECHA NACIMIENTO');
gotoxy(6,5);readln(datomaes.DEPARTAMENTO);
gotoxy(15,5);readln(datomaes.NENCUESTADO);
gotoxy(24,5);readln(datomaes.NOMBRE_APELLIDO);
gotoxy(46,5);readln(datomaes.FECHA_NACIMIENTO);
gotoxy(4,8);write('Desea Entrar Alguna Observacion [S/N]');
repeat
opci := readkey;
until opci in['S','s','N','n'];
if opci in['S','s'] then
begin
gotoxy(65,4);write('Observaciones');
gotoxy(66,5);readln(datomaes.Observaciones);
end;
assign(f1,nombremaes);
{$I-} reset(f1); {$I+}
if ioresult <> 0 then
begin
rewrite(f1);
seek(f1,0);
write(f1,datomaes);
close(f1);
end
else
begin
seek(f1,filesize(f1));
write(f1,datomaes);
close(f1);
end;
end;
procedure entradadatosbaja; {Entramos Datos Bajas}
begin
gotoxy(23,2);write('<<<<<< Entrada de Bajas >>>>>>>');
gotoxy(4,4);write('N§ DPT');
gotoxy(13,4);write('N§ ENCUS');
gotoxy(6,5);readln(datobaja.DEPARTAMENTO);
gotoxy(15,5);readln(datobaja.NENCUESTADO);
assign(f2,nombrebaja);
{$I-} reset(f2); {$I+}
if ioresult <> 0 then
begin
rewrite(f2);
seek(f2,0);
write(f2,datobaja);
close(f2);
end
else
begin
seek(f2,filesize(f2));
write(f2,datobaja);
close(f2);
end;
end;
procedure presentadatos; {Presentamos Registros Actuales}
var
y : integer;
cont : longint;
begin
assign(f1,nombremaes);
{$I-} reset(f1); {$I+}
if ioresult <> 0 then
halt(1)
else
begin
y := 4;
cont := 0;
repeat
seek(f1,cont);
read(f1,datomaes);
gotoxy(20,2);write('***** PANTALLA INFORMACION ******');
gotoxy(1,3);write(' Dpto / N§ Encuestado / Nombre y Apellido / Fecha Nacimiento',
' / Observaciones');
gotoxy(2,y);write(datomaes.DEPARTAMENTO);
gotoxy(10,y);write(datomaes.NENCUESTADO);
gotoxy(25,y);write(datomaes.NOMBRE_APELLIDO);
gotoxy(45,y);write(datomaes.FECHA_NACIMIENTO);
gotoxy(65,y);write(datomaes.Observaciones);
y := y + 1;
if y > 24 then
begin
gotoxy(2,25);write('PULSE UNA TECLA PARA VER MAS');
repeat until keypressed;
clrscr;
gotoxy(20,2);write('***** PANTALLA INFORMACION ******');
gotoxy(1,3);write(' Dpto / N§ Encuestado / Nombre y Apellido / Fecha Nacimiento',
' / Observaciones');
y := 4;
end;
cont := cont + 1;
until cont > filesize(f1) - 1;
close(f1);
gotoxy(2,25);write('Final de Archivo Pulse una tecla');
repeat until keypressed;
end;
end;
procedure menu; {Menu General}
var
tecla : char;
salir : boolean;
begin
clrscr;
salir := false;
repeat
gotoxy(6,2);write('*** Menu General ***');
gotoxy(4,4);write('[1] = Entrada Datos');
gotoxy(4,5);write('[2] = Entrada Bajas');
gotoxy(4,6);write('[3] = Ver Entradas');
gotoxy(4,7);write('[4] = Actualizar Datos');
gotoxy(4,8);write('[5] = Borra los 2 Archivos');
gotoxy(4,9);write('[6] = Salir');
gotoxy(4,11);write('<<< Elija Opcion >>>');
tecla := readkey;
case tecla of
#49 : begin
clrscr;
entradadatosmaes;
clrscr;
end;
#50 : begin
clrscr;
entradadatosbaja;
clrscr;
end;
#51 : begin
clrscr;
presentadatos;
clrscr;
end;
#52 : begin
anulacion;
clrscr;
end;
#53 : begin
clrscr;
gotoxy(5,5);write('Borrando Archivos');
assign(f1,nombremaes);
{$I-} reset(f1); {$I+}
if ioresult = 0 then
begin
gotoxy(5,6);write(nombremaes);
close(f1);
erase(f1);
end;
assign(f2,nombrebaja);
{$I-} reset(f2); {$I+}
if ioresult = 0 then
begin
gotoxy(5,7);write(nombrebaja);
close(f2);
erase(f2);
end;
delay(1299);
end;
#54 : salir := true;
end;
until salir = true;
end;
begin
clrscr; {Inicio del Proceso}
menu;
end.