Pascal/Turbo Pascal - Ayuda con ejercicio de pascal

program main;

{$mode objfpc}

uses SysUtils;

const

{ meses del anio }

M_01 = '01';

M_02 = '02';

M_03 = '03';

M_04 = '04';

M_05 = '05';

M_06 = '06';

M_07 = '07';

M_08 = '08';

M_09 = '09';

M_10 = '10';

M_11 = '11';

M_12 = '12';

{ estructura de datos }

type registro = record

dia:string[2];

mes:string[2];

anio:string[4];

beneficio: string[1];

nombre: string[30];

origen: string[2];

destino: string[2];

end;

{ declaracion de datos a usar }

var fichero: Text;

salida: Text;

row:registro;

cant:integer;

op,s:integer;

orig:  string;

contador,ind: integer;

mes: string[2];

arr: Array [1..12] of integer;

//

procedure escribir_registro(var rec:registro;var tam: integer);

var caracter: char;

    i: integer;

begin

i:=0;

{ inprime caracter a caracter, acordar que la posicion 0

* del string representa  la longitud del string                       }

if not eof(fichero) then begin

        caracter:='-';

		write(salida,rec.origen[1]);

		write(salida,rec.origen[2]);

		write(salida,rec.destino[1]);

		write(salida,rec.destino[2]);

		write(salida,caracter);

		i:=i+5;

	end;

tam:=i;

end;

//

procedure leer_registro(var rec:registro;var tam: integer);

var caracter: char;

    i: integer;

begin

{ lee caracter a caracter , para los string, lee cada caracter, y luego

* los concatena, y sobre escribe el dato,

* ej , string[2]  tiene tres caracteres,

* la posicion  0 tiene la longitud del string

* la posicion  2 tiene el caracter 1 del string

* la posicion 3 tiene el caracter 2 del string }

i:=0;

if not eof(fichero) then begin

		read(fichero,rec.dia[0]);

		read(fichero,rec.dia[1]);

		rec.dia:=concat(rec.dia[0],rec.dia[1]);

		read(fichero,rec.mes[0]);

		read(fichero,rec.mes[1]);

		rec.mes:=concat(rec.mes[0],rec.mes[1]);

		read(fichero,rec.anio[0]);

		read(fichero,rec.anio[1]);

		read(fichero,rec.anio[2]);

		read(fichero,rec.anio[3]);

		rec.anio:=concat(rec.anio[0],rec.anio[1],rec.anio[2],rec.anio[3]);

		read(fichero,rec.beneficio[0]);

		rec.beneficio:=concat('',rec.beneficio[0]);

		rec.nombre:='';

		i:=9;

		rec.nombre:='';

		caracter :='f';

		while ((caracter<>'-') and not (eof(fichero))) do

		begin

			read(fichero,caracter);

			i:=i+1;

			if(caracter<>'-')then begin

			rec.nombre:=Concat(rec.nombre,caracter);

			end;

		end;

		read(fichero,rec.origen[0]);

		read(fichero,rec.origen[1]);

		rec.origen:=concat(rec.origen[0],rec.origen[1]);

		read(fichero,rec.destino[0]);

		read(fichero,rec.destino[1]);

		rec.destino:=concat(rec.destino[0],rec.destino[1]);

		read(fichero,caracter);

		i:=i+5;

	end;

tam:=i;

end;

//

procedure punto1();

begin

{punto uno del ejercicio }

reset(fichero);

assign(salida,'salida.txt');//asigna el nombre fisico al logico

writeln('imprime las localidades de origen y destino de todos los pasajes de los meses enero y febrero.');

rewrite(salida);//crea archivo  y borra el anterior si es que existe

leer_registro(row,s);//lee un nuevo registro, s es la cantidad de caracteres leidas

while s<>0 do begin

	//try

	write('*');

	//pregunta si es menor a 10, la funcion para convetir a entero me da excepcion , la funcion es strtoint(row.dia)

	if (  (row.mes[1]='0') and (( row.mes[2]='1' ) or (row.mes[2]='2') ))  then begin

	escribir_registro(row,s);//escribe el registro

	end;

	//except

	//     On E : EConvertErRor do

	//     writeln('numero invalido');

	//     close(fichero);

    //     close(salida);

	//     end;

	leer_registro(row,s);//lee un nuevo registro, s es la cantidad de caracteres leidas

end;

writeln('se genero el fichero........      salida.txt');

close(salida);//close salida

end;

//

procedure punto2();

begin

{punto dos del ejercicio }

reset(fichero);// reset de fichero

writeln('Comienzo de proceso porcentages:       ........ ');

//inicializa array de los beneficio

arr[1]:=0;

arr[2]:=0;

leer_registro(row,s);//lee un nuevo registro,s es la cantidad de letras leidas

while s<>0 do begin

   if  (row.beneficio='S') then begin

	        arr[1]:=arr[1]+1;//incrementa en uno los pasajes con descuento

   end;

   if (row.beneficio='n') then

		   arr[2]:=arr[2]+1;//incrementa en uno los sin descuentos

	end;

	leer_registro(row,s);//lee un nuevo registro,s es la cantidad de letras leidas

end;

 {$I-}

contador:=0;

for ind :=1 to 2 do begin contador:=contador + arr[ind]; end;//suma 

if(contador<>0)then begin

writeln('% pasajes con descuento:                                                   ');

writeln((((arr[1])/contador)*100):0:2);//porcentage de enero

writeln('% sin descuento:                                                 ');

writeln((((arr[2])/contador)*100):0:2);//porcentage de febrero

writeln('% total de pasajes :                                         ');

writeln((((arr[1]+arr[2])/contador)*100):0:2);

end;

end;

//

procedure punto3();

begin

{ punto 3 del ejercicio }

reset(fichero); //inicializa archivo

writeln('leer codigo de localidad:                                   ');

readln(orig);// lee el codigo de localidad 

leer_registro(row,s);//lee un nuevo registro,s es la cantidad de letras leidas

cant:=0;

while s<>0 do begin

	//try

	//pregunta si el origen es el leido por teclado

	if(row.origen=orig)then begin

		cant:=cant +1;//incrementa en uno

	end;

	//except

	//     On E : EConvertErRor do

	//     writeln('numero invalido');

	//     close(fichero);

    //     close(salida);

	//     end;

	leer_registro(row,s);//lee un nuevo registro,s es la cantidad de letras leidas

end;

writeln('arriba de:  ',orig,'    un total de:  ',cant,'    personas.');//imprime lo pedido en punto 3

end;

{

* hacer un ejercicio en el codigo pascal que resuelvan lo siguiente:

hay una secuencia en un fichero texto.txt y dentro esta contiene esto:

ejemplo: 01012017Sjuan Pablo-2356/02012017NPablo Lopez-1001/*

Dicha secuencia posee la siguiente estructura:

Al principio la fecha del pasaje (ddmmaaaa) seguido de un caracter

que inidica si el pasajero uso descuento de estudiante ("S" o "N");

a continuacion sigue el apellido y nombre del pasajero. separado

por un guion ("-") luego se encuentran las localidades de origen

y el destino representadas por dos caracteres cada una

("0103; representa un pasaje que va de 01-buenos aires a 03-rosario, por ejemplo).

se usa el caracter "/" para separar un pasaje del siguiente.

los tickets estan ordenados en la secuencia por la fecha en que fueron relizados.

1) generar una secuencia que solo contenga el codigo de las localidades de origen y destino de todos los pasajes de los meses de enero y febrero, separados por un "-"

2) informar al finalizar el porcentaje de los pasajes que fueron vendidos con o sin descuento del estudiante

3) informe la cantidad de pasajeros que ariban desde el codigo de una localidad solicitada por el usuario

}

begin

assign(fichero,'texto.txt');// asigna nombre logico

reset(fichero);// asigna el fichero al nombre logico

writeln('para salir escriba 0, sino cualquier numero.');

readln(op);// lee operacion un numero entre 0 y 9

while(op<>0)do begin// imprime el menu mientras op sea distinto de 0

writeln('1:generar salida.txt;');

writeln('2:porcentaje de pasajes vendidos con y sin descuentos;');

writeln('3:cantidad que arriba de localidad ');

writeln('0: para salir.');

readln(op);//lee de nuevo op

case op of 

1:punto1();//ejecuta punto 1

3:punto3();//ejecuta punto 3

2:punto2();//ejecuta punto 2

end;

end;

close(fichero);// cierra fichero

end.

procedure punto2();

var SumaConBenef, SumaSinBenef, Suma: integer;

begin

{punto dos del ejercicio }

  reset(fichero);// reset de fichero

  writeln('Comienzo de proceso porcentages:       ........ ');

//inicializa los contadores

  SumaConBenef := 0;

  SumaSinBenef := 0;

  leer_registro(row,s);  //lee un nuevo registro,s es la cantidad de letras leidas

  while s<>0 do begin

     if  (row.beneficio='S') or (row.beneficio='s') then Inc(SumaConBenef);

     if  (row.beneficio='N') or (row.beneficio='n') then Inc(SumaSinBenef);

    leer_registro(row,s);  //lee un nuevo registro,s es la cantidad de letras leidas

  end;

 {$I-}

  Suma := SumaConBenf + SumaSinBenef;

  if (Suma <> 0) then begin

    writeln('% pasajes con descuento:                                                   ');

    writeln((SumaConBenef * 100.0 / Suma):0:2);  //porcentage con beneficio

    writeln('% sin descuento:                                                 ');

    writeln((SumaSinBenef  * 100.0 / Suma):0:2);  //porcentage sin beneficio

    writeln('% total de pasajes :                                         ');

    writeln('100%');

  end;

end;

{Te comento estas trabajando con registros no con texto y estos se manejan de diferente manera mira esto por si te ayuda }

program archivos;

uses

   crt;

type

   registro = record

            dia:string[2];

            mes:string[2];

            anio:string[4];

            beneficio: string[1];

            nombre: string[30];

            origen: string[2];

            destino: string[2];

            estado : boolean;   {Informacion De Activo O Nulo}

       end;

var

  row:registro;

  archivo : file of registro;

procedure escribir_registro(var rec:registro);

begin

   writeln('   Entrada De Datos');

   writeln;

   write('  Dia       : ');readln(rec.dia);

   write('  Mes       : ');readln(rec.mes);

   write('  Anio      : ');readln(rec.anio);

   write('  Beneficio : ');readln(rec.beneficio);

   write('  Nombre    : ');readln(rec.nombre);

   write('  Origen    : ');readln(rec.origen);

   write('  Destino   : ');readln(rec.destino);

   rec.estado := true;

   assign(archivo,'datos.txt');

   {$I-} reset(archivo); {$I+}

   if ioresult <> 0 then

   begin

      rewrite(archivo);

      seek(archivo,0);

      write(archivo,rec);

      close(archivo);

   end

 else

    begin

       seek(archivo,filesize(archivo));

       write(archivo,rec);

       close(archivo);

    end;

end;

procedure leer_registro(nom : string);

var

   t, d : integer;

   toma, entra : string;

begin

    assign(archivo,'datos.txt');

   {$I-} reset(archivo); {$I+}

   if ioresult <> 0 then

   begin

      writeln('  Error De Archivo Pulse Una Tecla');

      readkey;

   end

 else

    begin

    for d := 0 to filesize(archivo) - 1 do

    begin

        seek(archivo,d);

        read(archivo,row);

        for t := 1 to length(row.nombre) do

        toma[t] := upcase(row.nombre[t]);

        for t := 1 to length(nom) do

        entra[t] := upcase(nom[t]);

        if (toma = entra) and (row.estado = true) then

        begin

           clrscr;

          writeln('   Entrada De Datos');

          writeln;

          writeln('  Dia       : ',row.dia);

          writeln('  Mes       : ',row.mes);

          writeln('  Anio      : ',row.anio);

          writeln('  Beneficio : ',row.beneficio);

          writeln('  Nombre    : ',row.nombre);

          writeln('  Origen    : ',row.origen);

          writeln('  Destino   : ',row.destino);

          writeln;

          writeln('  Pulse Una Tecla');

          readkey;

          break;

        end;

    end;

      close(archivo);

   end;

 end;

 procedure anularregistro;

 var

   nombr : string;

   r, cont : integer;

   begin

      writeln(' Entre Nombre A Suprimir');

      writeln;

      write(' Nombre : ');

      readln(nombr);

      for cont := 1 to length(nombr) do

      nombr[cont] := upcase(nombr[cont]);

       assign(archivo,'datos.txt');

   {$I-} reset(archivo); {$I+}

   if ioresult <> 0 then

   begin

      writeln('  Error De Archivo Pulse Una Tecla');

      readkey;

   end

 else

    begin

       for cont := 0 to filesize(archivo) - 1 do

       begin

       seek(archivo,cont);

       read(archivo,row);

       for r := 1 to length(row.nombre) do

       row.nombre[r] := upcase(row.nombre[r]);

       if (nombr = row.nombre) and (row.estado = true) then

       begin

          row.estado := false;

          seek(archivo,cont);

          write(archivo,row);

          break;

       end;

    close(archivo);

    end;

   end;

  end;

  procedure presentatodo;

  var

    y : integer;

    begin

       assign(archivo,'datos.txt');

     {$I-} reset(archivo); {$I+}

   if ioresult <> 0 then

   begin

      writeln('  Error De Archivo Pulse Una Tecla');

      readkey;

   end

 else

    begin

      for y := 0 to filesize(archivo) - 1 do

      begin

        seek(archivo,y);

        read(archivo,row);

        if row.estado = true then

        writeln(row.dia,'  ',row.mes,'  ',row.anio,'  ',row.beneficio,

        '  ',row.nombre,'  ',row.origen,'  ',row.destino);

      end;

       writeln;

       writeln(' Pulse Una Tecla');

       readkey;

       close(archivo);

    end;

  end;

  procedure menu;

  var

     tecla : char;

     sal : boolean;

     nomb : string;

     i : integer;

   begin

      sal  := false;

   repeat

      clrscr;

      writeln(' ****** Menu Jeneral ******');

      writeln;

      writeln('  [E] = Entradas');

      writeln('  [V] = Visualiza Por Nombre');

      writeln('  [T] = Visualiza Todas');

      writeln('  [X] = Anula Un Registro');

      writeln('  [S] = Salir');

      writeln;

      writeln(' <<<< Elije Opcion >>>>');

      repeat

          tecla := upcase(readkey);

      until tecla in['E','V','T','X','S'];

      clrscr;

     case tecla of

  'E' : escribir_registro(row);

  'V' : begin

          write('  Entre Nombre : ');

          readln(nomb);

          leer_registro(nomb);

        end;

  'T' : presentatodo;

  'X' : anularregistro;

  'S' : sal := true;

    end;

   until sal = true;

   end;

  begin

     menu;

  end.