Pascal/Turbo Pascal - No funciona el agregar

 
Vista:

No funciona el agregar

Publicado por yoo (2 intervenciones) el 05/06/2008 21:04:53
Los demás procedimientos funcionan bien, pero no puedo hacer que funcione el procedimiento que agrega los registros una vez que el archivo ya esta creado.
Si me pueden ayudar..
Gracias

program LonVar;
uses wincrt;
Const
TamBloque = 64;
CapacBloque = TamBloque - SizeOf(word);
PorcCarga = 0.9;
Fin = 'fin';
Type
tRegistro = record
nombre: String[24];
fecha: LongInt;
stock: Word;
end;
tBloque = record
cantRegs: word;
contenido: Array[1..CapacBloque] of Byte;
end;
tMedicamentos = record
arch: File of tBloque;
espLibre: File of Word;
bloque: tBloque;
iBloque: Word;
espLibreBloque: Word;
end;

Procedure Agregar(var mm: tMedicamentos; dato: tRegistro);
var
tamReg: Byte;
libres, disponibles: word;
begin
with mm do begin
reset(arch);
reset(espLibre);
TamReg:= Length(dato.nombre) + 1;
repeat
read(espLibre, libres);
disponibles:= libres - Round((1 - PorcCarga ) * CapacBloque);
until EOF(espLibre) or (disponibles >= TamReg);
if (disponibles < TamReg) then begin
bloque.cantregs:= 0;
iBloque:= 1;
end
else begin
seek(arch, FilePos(espLibre) - 1);
read(arch, bloque);
iBloque:= CapacBloque - libres + 1;
Seek(arch, filePos(espLibre) - 1);
Seek(espLibre, filePos(espLibre) - 1)
end;
Move(dato.nombre, bloque.contenido[iBloque], tamReg);
Inc(bloque.cantregs);
Dec(libres, tamReg);
tamReg:= SizeOf(LongInt);
Move(dato.fecha, bloque.contenido[iBloque], tamReg);
Dec(libres, SizeOf(LongInt));
tamReg:= SizeOf(Integer);
Move(dato.stock, bloque.contenido[iBloque], tamReg);
Dec(libres, SizeOf(Integer));
write(arch, bloque);
write(espLibre, libres);
close(arch);
close(espLibre);
end;
end;
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

RE:No funciona el agregar

Publicado por Diego Romero (996 intervenciones) el 06/06/2008 18:54:52
¿Podrías explicar qué es lo que intentas hacer con lujo de detalles?, no me es evidente de solo leer este procedimiento.
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