Const
     TAM_BLOQUE = 64;
     CAPAC_BLOQUE = TAM_BLOQUE-SizeOf(Word);
     PORC_CARGA = 0.9; {Porcentaje de carga de los bloques (se deja espacio disponible por si se actualizan
     registros aumentando su longitud, para no tener que cambiarlos de bloque)
     MARCA_FIN = 'fin'; {para representar el fin del archivo}
Type
    tNombre = String[31]; {para manejar personas en memoria}
    tBloque = Record
            cantRegs: Word; {cantidad actual de registros en el bloque}
            contenido: Array[1..CAPAC_BLOQUE] of Byte;
    end;
    tPersonas = Record
              arch: File of tBloque; {archivo de personas}
              archLibres: File of Word; {archivo de control de bytes libres por bloque del archivo de personas}
              bloque: tBloque; {ultimo bloque leido de personas}
              iBloque: Word; {indice del primer byte libre}
              archLibresBloque: Word
    end;

{Agrega una persona en el primer bloque que tenga
espacio o, si no hay ninguno,en un bloque nuevo al final del archivo}
Procedure Agregar(var pp: tPersonas; nombre: tNombre);
var
tamReg: Byte;
libres: Word;
disponibles: integer;
Begin
     With pp do begin
     Seek(pp.archLibres, 0);
     // tamaño del registro a agregar.
     tamReg:=Length(nombre)+1;
     // se busca el primer registro con suficiente espacio
     Repeat
           Read(pp.archLibres, libres);
           disponibles:=libres-Round((1-PORC_CARGA)*CAPAC_BLOQUE) {bytes libres menos los que no se pueden usar para altas}
     until eof(archLibres) or (disponibles>=tamReg);

     If tamReg>disponibles then
     begin {hay que agregar un nuevo bloque al final del archivo}
          bloque.cantRegs:=0; libres:=CAPAC_BLOQUE;
          iBloque:=1;  // somos idiotas y usamos one-based indexes
          Seek(arch, FileSize(arch))
     end
     else begin
          // se mueve a donde hay lugar en el archivo
          Seek(pp.arch, FilePos(pp.archLibres)-1);
          Read(pp.arch, pp.bloque);
          // indice del primer byte libre
          pp.iBloque:=CAPAC_BLOQUE-libres+1;
          // se mueve al lugar correspondiente de escritura en ambos archivos
          Seek(pp.arch, FilePos(pp.archLibres)-1);
          Seek(pp.archLibres, FilePos(archLibres)-1)
     end;
     Move(nombre, bloque.contenido[iBloque], tamReg);
     Inc(bloque.cantRegs);
     Dec(libres,tamReg);
     Write(arch, bloque);
     Write(archLibres, libres);
     end;
end;