POR FAVOR! LO TENGO QUE ENTREGAR MAÑANA!
Publicado por florencia (3 intervenciones) el 18/10/2007 13:40:49
Procedure ObtInfractores(var BA: ArcZona; var rBA: RZona;
var Au1: ArcAuxi1; var rAu1: rAuxi1;
var Au2: ArcAuxi2; var rAu2: rAuxi2);
var
PosAnt: longint;
Begin
seek(BA,0);
while not eof(BA) do Begin
seek(Au1, RelBsAs(rBA.NroPat));
read(Au1, rAu1);
seek(Au1, filepos(Au1)-1);
if (rBA.FecInf.mm-rAu1.Meses)=1 then
rAu1.Meses:= rAu1.Meses+1;
if rAu1.PtrPri= -1 then Begin
rAu1.PtrPri:= filepos(Au2);
rAu1.PtrUlt:=filepos(Au2);
rAu2.Sgte:= -1;
write(Au1, rAu1);
write(Au2, rAu2)
end
else begin
PosAnt:= filepos(Au2);
seek(au2, rAu1.PtrUlt);
rAu2.Sgte:= PosAnt;
rAu1.PtrUlt:= PosAnt;
seek(Au2, PosAnt);
rAu2.sgte:= -1;
write(Au1, rAu1);
write(Au2, rAu2)
end
else (ACA TIRA ERROR!!!!)
if (rBA.FecInf.mm-rAu1.Meses)=0 then Begin
PosAnt:= filepos(Au2);
seek(au2, rAu1.PtrUlt);
rAu2.Sgte:= PosAnt;
rAu1.PtrUlt:= PosAnt;
seek(Au2, PosAnt);
rAu2.sgte:= -1;
write(Au1, rAu1);
write(Au2, rAu2)
end
end;
var Au1: ArcAuxi1; var rAu1: rAuxi1;
var Au2: ArcAuxi2; var rAu2: rAuxi2);
var
PosAnt: longint;
Begin
seek(BA,0);
while not eof(BA) do Begin
seek(Au1, RelBsAs(rBA.NroPat));
read(Au1, rAu1);
seek(Au1, filepos(Au1)-1);
if (rBA.FecInf.mm-rAu1.Meses)=1 then
rAu1.Meses:= rAu1.Meses+1;
if rAu1.PtrPri= -1 then Begin
rAu1.PtrPri:= filepos(Au2);
rAu1.PtrUlt:=filepos(Au2);
rAu2.Sgte:= -1;
write(Au1, rAu1);
write(Au2, rAu2)
end
else begin
PosAnt:= filepos(Au2);
seek(au2, rAu1.PtrUlt);
rAu2.Sgte:= PosAnt;
rAu1.PtrUlt:= PosAnt;
seek(Au2, PosAnt);
rAu2.sgte:= -1;
write(Au1, rAu1);
write(Au2, rAu2)
end
else (ACA TIRA ERROR!!!!)
if (rBA.FecInf.mm-rAu1.Meses)=0 then Begin
PosAnt:= filepos(Au2);
seek(au2, rAu1.PtrUlt);
rAu2.Sgte:= PosAnt;
rAu1.PtrUlt:= PosAnt;
seek(Au2, PosAnt);
rAu2.sgte:= -1;
write(Au1, rAu1);
write(Au2, rAu2)
end
end;
Valora esta pregunta


0