archivo de baja
Publicado por gabriel (4 intervenciones) el 25/11/2011 21:21:21
hola tengo un problema con archivo de tipo registro el mismo tendria que dar de baja los encuestados que se encuentran en el maestro mediante lo especificado en el detalle. la verdad que en la prueba de escritorio me sale bien y no se que honda.
program dasf;
uses crt;
type
maestro=record
dept:integer;
nencu:integer;
nya:string;
fdn:string;
end;
baja=record
dept:integer;
nencu:integer;
end;
archivo=file of maestro;
archivo2=file of baja;
archivo3=file of maestro;
var
arc3:archivo3;
arc2:archivo2;
arc:archivo;
opcion:char;
procedure alta (var arcalu:archivo);
var
regalu:maestro;
tecla:char;
begin
Seek(arcalu,filesize(arcalu));
tecla:='S';
while ('N' <> upcase (tecla)) do
begin
writeln('Ingrese los datos del cliente...');
writeln('departamento:');
readln(regalu.dept);
writeln('numero de encuestado:');
readln(regalu.nencu);
writeln('Nombre y apellido del encuestado');
readln(regalu.nya);
writeln('fecha de nacimiento del encuestado');
readln(regalu.fdn);
write(arcalu,regalu);
writeln('Cargara otro registro? S/N.');
read(tecla);
end;
ClrScr;
close (arcalu);
end;
procedure baja1(var arcalu:archivo2);
var
regdet:baja;
tecla:char;
begin
Seek(arcalu,filesize(arcalu));
tecla:='S';
while ('N' <> upcase (tecla)) do
begin
writeln('Ingrese los datos de los encuestados que quiere dar de baja...');
writeln('departamento:');
readln(regdet.dept);
writeln('numero de encuestados:');
readln(regdet.nencu);
write(arcalu,regdet);
writeln('dar de baja otro registro? S/N.');
read(tecla);
end;
ClrScr;
close (arcalu);
end;
procedure visualizar(var arcalu:archivo3);
var
regalu:maestro;
begin
reset(arcalu);
writeln('Inicio de lectura de Archivo.');
while not (EoF(arcalu))do
begin
read(arcalu,regalu);
writeln('... - ...');
writeln('departamento: ',regalu.dept);
writeln('numero de encuestado: ',regalu.nencu);
writeln('nombre y Apellido: ',regalu.nya);
writeln('fecha de nacimiente: ',regalu.fdn);
end;
close(arcalu);
writeln('Fin de lectura de archivo.');
end;
function Existe(var archalu:archivo):boolean;
begin
Existe:=true;
assign(arc,'/home/adrian/Escritorio/alta.doc');
{$I-}
RESET(arc);
{$I+}
if IOresult <> 0 then
begin
Existe:=false;
end;
end;
function Existe2(var archalu:archivo2):boolean;
begin
Existe2:=true;
assign(arc2,'/home/adrian/Escritorio/baja.doc');
{$I-}
RESET(arc2);
{$I+}
if IOresult <> 0 then
begin
Existe2:=false;
end;
end;
function Existe3(var archalu:archivo3):boolean;
begin
Existe3:=true;
assign(arc3,'/home/adrian/Escritorio/resultado.doc');
{$I-}
RESET(arc3);
{$I+}
if IOresult <> 0 then
begin
Existe3:=false;
end;
end;
procedure modificar(var arc3:archivo3 ; var arc2:archivo2; var arc1:archivo);
var
b:integer;
be:integer;
regalu:maestro;
regdet:baja;
begin
b:=0;
be:=0;
reset (arc1);
read(arc1,regalu);
reset (arc2);
read(arc2,regdet);
reset(arc3);
while (not (EoF (arc1))) and (not (EoF (arc2))) do
begin
while (regalu.dept = regdet.dept) do
begin
if (regalu.nencu = regdet.nencu)then
begin
b:=b+1;
read(arc1,regalu);
read(arc2,regdet);
end
else
if (regalu.nencu < regdet.nencu) then
begin
write(arc3,regalu);
read(arc1,regalu);
end
else
if (regdet.nencu<regalu.nencu) then
begin
be:=be+1;
read(arc2,regdet);
end;
end;
while regalu.dept < regdet.dept do
begin
write(arc3,regalu);
read(arc1,regalu);
end;
while regdet.dept < regalu.dept do
begin
be:=be+1;
read(arc2,regdet);
end;
end;
writeln('numero de bajas correctas',b);
writeln('numero de bajas incorrectas',be);
close(arc1);
close(arc2);
close(arc3);
end;
begin
if(Existe(arc))then
begin
writeln('Quiere agregar registros? S/N.');
readln(opcion);
if('N' <> upcase (opcion))then
begin
reset(arc);
alta(arc);
end;
end
else
begin
rewrite(arc);
alta(arc);
end;
if(Existe2(arc2))then
begin
writeln('Quiere dar de bajas registros? S/N.');
readln(opcion);
if('N' <> upcase (opcion))then
begin
reset(arc2);
baja1(arc2);
end;
end
else
begin
rewrite(arc2);
baja1(arc2);
end;
if(Existe3(arc3))then
reset(arc3)
else
begin
rewrite(arc3);
end;
modificar(arc3,arc2,arc);
visualizar(arc3);
end.
no me da error de compilacion pero me da un error al ejecutar que es el 100 y nc que honda.
program dasf;
uses crt;
type
maestro=record
dept:integer;
nencu:integer;
nya:string;
fdn:string;
end;
baja=record
dept:integer;
nencu:integer;
end;
archivo=file of maestro;
archivo2=file of baja;
archivo3=file of maestro;
var
arc3:archivo3;
arc2:archivo2;
arc:archivo;
opcion:char;
procedure alta (var arcalu:archivo);
var
regalu:maestro;
tecla:char;
begin
Seek(arcalu,filesize(arcalu));
tecla:='S';
while ('N' <> upcase (tecla)) do
begin
writeln('Ingrese los datos del cliente...');
writeln('departamento:');
readln(regalu.dept);
writeln('numero de encuestado:');
readln(regalu.nencu);
writeln('Nombre y apellido del encuestado');
readln(regalu.nya);
writeln('fecha de nacimiento del encuestado');
readln(regalu.fdn);
write(arcalu,regalu);
writeln('Cargara otro registro? S/N.');
read(tecla);
end;
ClrScr;
close (arcalu);
end;
procedure baja1(var arcalu:archivo2);
var
regdet:baja;
tecla:char;
begin
Seek(arcalu,filesize(arcalu));
tecla:='S';
while ('N' <> upcase (tecla)) do
begin
writeln('Ingrese los datos de los encuestados que quiere dar de baja...');
writeln('departamento:');
readln(regdet.dept);
writeln('numero de encuestados:');
readln(regdet.nencu);
write(arcalu,regdet);
writeln('dar de baja otro registro? S/N.');
read(tecla);
end;
ClrScr;
close (arcalu);
end;
procedure visualizar(var arcalu:archivo3);
var
regalu:maestro;
begin
reset(arcalu);
writeln('Inicio de lectura de Archivo.');
while not (EoF(arcalu))do
begin
read(arcalu,regalu);
writeln('... - ...');
writeln('departamento: ',regalu.dept);
writeln('numero de encuestado: ',regalu.nencu);
writeln('nombre y Apellido: ',regalu.nya);
writeln('fecha de nacimiente: ',regalu.fdn);
end;
close(arcalu);
writeln('Fin de lectura de archivo.');
end;
function Existe(var archalu:archivo):boolean;
begin
Existe:=true;
assign(arc,'/home/adrian/Escritorio/alta.doc');
{$I-}
RESET(arc);
{$I+}
if IOresult <> 0 then
begin
Existe:=false;
end;
end;
function Existe2(var archalu:archivo2):boolean;
begin
Existe2:=true;
assign(arc2,'/home/adrian/Escritorio/baja.doc');
{$I-}
RESET(arc2);
{$I+}
if IOresult <> 0 then
begin
Existe2:=false;
end;
end;
function Existe3(var archalu:archivo3):boolean;
begin
Existe3:=true;
assign(arc3,'/home/adrian/Escritorio/resultado.doc');
{$I-}
RESET(arc3);
{$I+}
if IOresult <> 0 then
begin
Existe3:=false;
end;
end;
procedure modificar(var arc3:archivo3 ; var arc2:archivo2; var arc1:archivo);
var
b:integer;
be:integer;
regalu:maestro;
regdet:baja;
begin
b:=0;
be:=0;
reset (arc1);
read(arc1,regalu);
reset (arc2);
read(arc2,regdet);
reset(arc3);
while (not (EoF (arc1))) and (not (EoF (arc2))) do
begin
while (regalu.dept = regdet.dept) do
begin
if (regalu.nencu = regdet.nencu)then
begin
b:=b+1;
read(arc1,regalu);
read(arc2,regdet);
end
else
if (regalu.nencu < regdet.nencu) then
begin
write(arc3,regalu);
read(arc1,regalu);
end
else
if (regdet.nencu<regalu.nencu) then
begin
be:=be+1;
read(arc2,regdet);
end;
end;
while regalu.dept < regdet.dept do
begin
write(arc3,regalu);
read(arc1,regalu);
end;
while regdet.dept < regalu.dept do
begin
be:=be+1;
read(arc2,regdet);
end;
end;
writeln('numero de bajas correctas',b);
writeln('numero de bajas incorrectas',be);
close(arc1);
close(arc2);
close(arc3);
end;
begin
if(Existe(arc))then
begin
writeln('Quiere agregar registros? S/N.');
readln(opcion);
if('N' <> upcase (opcion))then
begin
reset(arc);
alta(arc);
end;
end
else
begin
rewrite(arc);
alta(arc);
end;
if(Existe2(arc2))then
begin
writeln('Quiere dar de bajas registros? S/N.');
readln(opcion);
if('N' <> upcase (opcion))then
begin
reset(arc2);
baja1(arc2);
end;
end
else
begin
rewrite(arc2);
baja1(arc2);
end;
if(Existe3(arc3))then
reset(arc3)
else
begin
rewrite(arc3);
end;
modificar(arc3,arc2,arc);
visualizar(arc3);
end.
no me da error de compilacion pero me da un error al ejecutar que es el 100 y nc que honda.
Valora esta pregunta


0