Ex2 2015-1 Pregunta 1

program project1;
Const MAXINGR = 30;
Type TIngred = Record
    codigo : Integer;
    cantidad : Real;
    end;
  ArrIngred = array[0..MAXINGR] of TIngred;
  Str25 = String[25];
  TPlato = Record
    codigo : Integer;
    nombre : Str25;
    ingreds : ArrIngred;
  end;
  TArchBin = File of TPlato;



//procedure BorrarEspacios(var cadenota: St60);
//var p:Integer;
//begin
//
//  p := pos('  ',cadenota);
//  while p <> 0 do begin
//    delete(cadenota,p,1);
//    p := pos('  ',cadenota);
//  end;
//  p := pos(' ',cadenota);
//  if p=1 then delete(cadenota,1,1);
//end;


//function sacaPalabra(cadena:string):string;
//  const control: String ='';
//  delimitador:Integer = 0;
//  var cadAux:String;
//  posIni,cantCar:Integer;
//
//begin
//  //verificamos si el contenido de la variable de control estatica
//  //coincide con el contenido del argumento
//  if cadena <> control then begin
//  //si son diferentes se establece el delimitador de palabras
//  //en el primer caracter de la cadena y
//  delimitador := 1;
//  //se guarda la nueva cadena para ser comparada en el
//  //siguiente llamado a la función
//  control := cadena;
//  end;
//  //si las cadenas son iguales se mantiene el valor del delimitador
//  //que se estableció en el llamado anterior
//  //movemos la delimitador de modo de saltar los espacios en blanco iniciales
//  while (delimitadr <=length(cadena)) and (cadena[delimitador] = ' ') do
//  inc(delimitador);
//  //marcamos el inicio de la palabra
//  posIni := delimitador;
//  //buscamos el fin de la palabra
//  contCar:=0;
//
//  while (delimitador<length(cadena)) and (cadena[delimitador]<>' ') do begin
//  inc(delimitador);
//  inc(cantCar);
//  end;
//  sacaPaalabra := copy(cadena,posIni,cantCar);
//end;


//ORDENAR BINARIO
//
//n := filesize(arch);
//for i:=0 to n-2 do begin
//  for j:=i+1 to n-1 do begin
//      seek(arch,i); read(arch,regI);
//      seek(arch,j); read(arch,regJ);
//      if CONDICION  then begin
//         seek(arch,i); write(arch,regJ);
//         seek(arch,j); write(arch,regI)
//      end;
//  end;
//end;

procedure prepararArchivos(var archT:Text; var archB:TArchBin);
var nomb:String;
begin
  writeln('Ingrese el nombre del archivo');
  readln(nomb);
  assign(archT,nomb);
  reset(archT);

  assign(archB,'platos.bin');
  rewrite(archB);
end;

procedure cerrarArchivos(var archT:Text; var archB:TArchBin);
begin
  close(archT);
  close(archB);
end;


procedure borrarEspacios(var cad:String);
var p:Integer;
begin
  cad := cad+ ' ';
  p := pos('  ',cad);
  while p<>0 do begin
    delete(cad,p,1);
    p := pos('  ',cad);
  end;
  p := pos(' ',cad);
  if p=1 then delete(cad,1,1);
  p := pos(' ',cad);
end;

function sacaPalabra(var cad:String):String;
var p:Integer;
begin
  p := pos(' ',cad);
  if p<>0 then begin
    sacaPalabra := copy(cad,1,p-1);
    delete(cad,1,p);
  end else sacaPalabra := '';
end;

procedure separarDatos(var cad:String; var nombPl:Str25; var ingreds: ArrIngred);
var aux :String;
  nomb : Str25;
  cod,cErr,i,numIng:Integer;
  cant:Real;
  ing:ArrIngred;
begin
  borrarEspacios(cad);
  nomb := '';
  repeat
    aux := sacaPalabra(cad);
    val(aux,cod,cErr);
    if(cErr<>0) then nomb := nomb + aux;
  until (cErr=0);
  numIng := 0;
  aux := sacaPalabra(cad);
  val(aux,cant);
  numIng:=0;
  while (cod<>0) do begin
    inc(numIng);
    ing[numIng].codigo := cod;
    ing[numIng].cantidad := cant;
    aux := sacaPalabra(cad);
    val(aux,cod);
    aux := sacaPalabra(cad);
    val(aux,cant,cErr);
    if(cErr<>0) then cod:=0;
  end;
  ing[0].codigo := numIng;
  nombPl := nomb;
  ingreds := ing;
end;

procedure insertarOrdenado(var plato:TPlato; var archB:TArchBin);
var n:Integer;
  reg:TPlato;
begin
  n := filesize(archB)-1;
  repeat
    seek(archB,n);
    read(archB,reg);
    if(reg.nombre >= plato.nombre) then write(archB,reg)
    else write(archB,plato);
    dec(n);
  until (reg.nombre < plato.nombre) or (n=-1);
  if (n=-1) then begin
    seek(archB,0);
    write(archB,plato);
  end;
end;

procedure procesarDatos(var archT:Text; var archB:TArchBin);
var cod,i :Integer;
  car : Char;
  plato : TPlato;
  cad : String;
begin
  i:=0;
  while not eof(archT) do begin
    read(archT,cod,car);
    plato.codigo:=cod;
    readln(archT,cad);
    separarDatos(cad,plato.nombre,plato.ingreds);
    if i=0 then begin
      write(archB,plato);
      inc(i);
    end
    else insertarOrdenado(plato,archB);
  end;
end;

var archB : TArchBin;
  archT : Text;
begin
  prepararArchivos(archT,archB);
  procesarDatos(archT,archB);
  cerrarArchivos(archT,archB);

end.