Pascal/Turbo Pascal - Ayuda con altas y bajas en archivos

 
Vista:
sin imagen de perfil

Ayuda con altas y bajas en archivos

Publicado por Horacio Daniel Belardita (53 intervenciones) el 21/11/2011 22:44:25
hola quisiera si podrian a ayudarme a resolver este problema de archivos:

Altas y bajas
Cuando se producen altas y bajas se debe generar un nuevo archivo maestro con el mismo diseño que el original. Al terminar el proceso, el archivo original deberá ser eliminado.

1. Se dispone de un archivo maestro de una encuesta y un archivo de bajas con el siguiente diseño:

Archivo maestro: Un registro por encuestado

DEPARTAMENTO / Nº ENCUESTADO /NOMBRE Y APELLIDO /FECHA DE NACIMIENTO

Archivo de bajas: Uno o ningún registro por encuestado

DEPARTAMENTO / Nº ENCUESTADO

Aparear los archivos a fin de detectar los encuestados a dar de baja, grabando un archivo maestro actualizado sin las bajas. Si la baja no existe en el maestro, imprimir "BAJA ERRÓNEA" en Observaciones y contarlas. Informar la cantidad total de bajas correctas y erróneas.
Salida impresa en pantalla:

Departamento /Nº Encuestado /Nombre y Apellido / Fecha Nacimiento /Observaciones
xxxxxxxxxxx xxxxxxxx xxxxxxxxxx xx/xx/xxx xxxx
xxxxxxxxxx xxxxxxxx xxxxxxxxxxx xx/xx/xxx baja erronea
xxxxxxxx xxxxxxxx xxxxxxxxxxx xx/xx/xx xxxxxxx

Total General de Bajas Correctas: XXX Erróneas: XXX

desde ya gracias.saludos
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 altas y bajas en archivos

Publicado por ramon (2158 intervenciones) el 23/11/2011 16:17:02
{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.
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
sin imagen de perfil

Ayuda con altas y bajas en archivos

Publicado por Horacio Daniel Belardita (53 intervenciones) el 23/11/2011 18:15:56
Muchas gracias una vez mas Ramon quedo clarisimo.Se agradece saludos...
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