Pregunta1 PC3 2014-1

program project1;
Type ArrStrP = array[1..500] of String;
  ArrStrG = array[1..1100] of String;    // P = pequeño
  ArrIntP = array[1..500] of Integer;    // G = grande
  ArrIntG = array[1..1100] of Integer;
  ArrReal = array[1..1100] of Real;

  procedure prepararArchivos(var archIn,archCli,archProd,archBol:Text);
  var nomb:String;
    begin
     writeln('Ingrese el nombre del archivo de boletas');
     readln(nomb);
     assign(archIn,nomb);
     reset(archIn);
     assign(archCli,'clientes.txt');
     assign(archProd,'productos.txt');
     assign(archBol,'boletas.txt');
     rewrite(archCli);
     rewrite(archProd);
     rewrite(archBol);
    end;

procedure cerrarArchivos(var archIn,archCli,archProd,archBol:Text);
begin
 close(archIn);
 close(archCli);
 close(archProd);
 close(archBol);
end;

procedure imprimir(fact,dd,mm,aa,dni:Integer;var archBol:Text);
begin
 writeln(archBol,fact);
 writeln(archBol,dd,'/',mm,'/',aa);
 writeln(archBol,dni);
end;

procedure verificar(var i,dni:Integer;nomb,dir:String;var dniC:ArrIntP;
  var nombC,dirC:ArrStrP);
var j:Integer; repetido: Boolean;
begin
 repetido:=false;
 if (i = 0) then begin
   inc(i);
   dniC[i] := dni;
   nombC[i] := nomb;
   dirC[i] := dir;
 end else begin
   for j:=1 to (i) do begin
      if(dniC[j]=dni) then repetido:=true;
   end;
   if (repetido=false) then begin
     inc(i);
     dniC[i]:= dni;
     nombC[i]:=nomb;
     dirC[i]:= dir;
   end;
 end;
end;

procedure verificar2(var j,cod:Integer; desc:String; pu:Real;
          codP:ArrIntG; descP:ArrStrG; puP:ArrReal);
var k:Integer;
  repetido: Boolean;
begin
 repetido:=false;
 if(j=0) then begin
   inc(j);
   codP[j]:= cod;
   descP[j]:= desc;
   puP[j]:= pu;
 end else begin
    for k:=1 to j do begin
       if(codP[k]=cod) then repetido:=true;
    end;
    if (repetido=false) then begin
      inc(j);
      codP[j] := cod;
      descP[j]:= desc;
      puP[j] := pu;
    end;
 end;
end;

procedure imprimirArch1(nd:Integer;var dniC:ArrIntP;
          var nombC,dirC:ArrStrP; var archCli:Text);
var i:Integer;
begin
 for i:=1 to nd do begin
     writeln(archCli,dniC[i]);
     writeln(archCli,nombC[i]);
     writeln(archCli,dirC[i]);
 end;
end;

procedure imprimirArch2(nd:Integer; var codP:ArrIntG; var descP:ArrStrG;
          var puP:ArrReal; var archProd:Text);
var i:Integer;
begin
 for i:=1 to nd do begin
     writeln(archProd,codP[i]);
     writeln(archProd,descP[i]);
     writeln(archProd,puP[i]);
 end;
end;

procedure emitirReporte(var archIn,archCli,archProd,archBol:Text);
var  codP : ArrIntG;
  descP : ArrStrG;
  puP : ArrReal;
  dniC : ArrIntP;
  nombC,dirC : ArrStrP;
  nomb,dir,desc : String;
  i,j,fact,dd,mm,aa,dni,cod,cant : Integer;
  pu,x:Real;
begin
 i:= 0;
 j:= 0;
 while not eof(archIn) do begin
   readln(archIn,fact,dd,mm,aa,dni);
   readln(archIn,nomb);
   readln(archIn,dir);
   verificar(i,dni,nomb,dir,dniC,nombC,dirC);
   imprimir(fact,dd,mm,aa,dni,archBol);
   repeat
     readln(archIn,cod);
     if (cod <> -1) then begin
       readln(archIn,cod);
       readln(archIn,desc);
       readln(archIn,cant,pu,x);
       verificar2(j,cod,desc,pu,codP,descP,puP);
       writeln(archBol,cod);
       writeln(archBol,cant);
     end;
   until (cod=-1) ;
 end;
 imprimirArch1(i,dniC,nombC,dirC,archCli);
 imprimirArch2(j,codP,descP,puP,archProd);

end;

var archIn,archCli,archProd,archBol:Text;
begin
  prepararArchivos(archIn,archCli,archProd,archBol);
  emitirReporte(archIn,archCli,archProd,archBol);
  cerrarArchivos(archIn,archCli,archProd,archBol);
end.