Pascal/Turbo Pascal - archivo de baja

 
Vista:

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.
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

archivo de baja

Publicado por ramon (2158 intervenciones) el 26/11/2011 17:00:28
{Perdona pero mira esto es tu asignación assign(arc,'/home/adrian/Escritorio/alta.doc'); como
puedes apreciar te falta asignarle la unidad o sea assign(arc,'C:\home\adrian\Escritorio\alta.doc');
a sin como las barras de directorio}
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

respuesta

Publicado por gabriel (4 intervenciones) el 26/11/2011 17:29:15
hola el archivo me lo crea bien el problema es que me da error en el eof digamos que parece que se pasa de linea pero todabia no encuentro el problema muchas gracias por tu respuesta.
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

respuesta

Publicado por ramon (2158 intervenciones) el 26/11/2011 20:27:29
Los archivos de registros no se devén de leer con esta instrucción while (not (EoF (arc1))) and (not (EoF (arc2))) do sino con esta

registro = record
nombre : string[30];
numero : interger;
end;
var
i : longint;
dat : registro;
f : file of registro;


assign(f,'C:\archi.dat');
{$I-} reset(f); {$I+}
if ioresult <> 0 then
halt(1);

i ;= 0;
repeat
seek(f,i);
read(f,dat);
writeln(dat.nombre,' ',dat.numero);
i := i + 1;
until i > filesize(f) - 1;
close(f);

Esto seria la forma de leer un archivo de registros la otra forma es para archivos de texto
el filesize(f) - 1 nos da la longitud del archivo en registros tienes que tener en cuenta que
filesize marca la longitud + 1 asín si queremos insertar un registro mas solo tenemos que
poner seek(f,filesize(f)) .
Por eso te marcara error 100 leyendo fuera de la longitud del fichero.
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