Pascal/Turbo Pascal - Ayuda para desarrollar ejercicios

program Ejercicio2;

Uses

crt;

type TPalabra = record

Palabra: string[20];

Cantidad: integer;

end;

var

fPal : file of TPalabra;

RegPal:TPalabra;

RegNum:TPalabra;

fNum : file of TPalabra;

cPalabra:string[20];

cNumero:string[20];

cadnum,cadesp,cadmin,cadmay : set of char;

Fichero1, Fichero2 : Text ;

v : char;

bEncontrePalabra:boolean;

nfila:integer;

bEsNumero:boolean;

cantreg : integer;

function ValidarTexto() : boolean ;

begin

cadmay := ['A'..'Z'];

cadmin := ['a'..'z'];

cadesp := [' ',':',',','.','(',')',chr(160),chr(161),chr(162),chr(163),chr(130),chr(237),chr(225),chr(233),chr(243)]   ;

cadnum := ['0'..'9'];

Assign (Fichero1, 'N:\UTN\DATOS\TEXTO.TXT');

Reset(Fichero1); {Intenta abrir el archivo PRODUCTO.DIR}

Read (Fichero1, v);

ValidarTexto:=true;

while not (eof(Fichero1)) do  // v <> '*'

begin

if ( not (v in cadmay) and not (V in cadmin) and not (V in cadesp) and not (V in cadnum)  ) then

begin

  write('El Caracter : ',V, ' no es valido ');

  readkey;

  ValidarTexto:=false;

  break;

end ;

Read (Fichero1, v);

end;

Close (Fichero1);

end;

begin

ClrScr;

// Valido el archivo para determinar si hay caracteres invalidos

if (ValidarTexto()=false) then

begin

   exit;

end;

Assign(fPal,'N:\UTN\DATOS\PALABRAS.DAT');

{$I-}

reset(fPal);

{$I+}

If(IoResult<>0) Then

Begin

   Rewrite(fPal);

End;

Assign(fNum,'N:\UTN\DATOS\NUMEROS.DAT');

{$I-}

reset(fNum);

{$I+}

If(IoResult<>0) Then

Begin

   Rewrite(fNum);

End;

//Read(fPal,RegPal);

bEsNumero:=false;

nfila:=0;

Assign(Fichero1, 'N:\UTN\DATOS\TEXTO.TXT');

Reset(Fichero1); {Intenta abrir el archivo PRODUCTO.DIR}

Read(Fichero1, v);

while not (eof(Fichero1)) do  // v <> '*'

begin

    //Avanzo blancos

    while v = ' ' do

    begin

      Read (Fichero1, v);

    End;

    while (v <> ' ') and not (eof(Fichero1)) do

    begin

    if (V in cadnum) then

    begin

        bEsNumero:=true;

        cNumero:=cNumero+v;

    end

     else

      begin

         cPalabra:=cPalabra+v;

      end;

      Read (Fichero1, v);

    End;

    if (eof(Fichero1)=true) then

    begin

          if (bEsNumero=true) then

          begin

              cNumero:=cNumero+v;

          end

          else

          begin

            cPalabra:=cPalabra+v;

          end;

    end;

    bEncontrePalabra:=false;

    if (bEsNumero=false) then

       Begin    //para palabras

              seek(fPal,0);

             while not(EOF(fPal)) do   //Busco si ya existe la palabra en mi archivo

             begin

                READ(fPal,RegPal);

                if RegPal.Palabra = cPalabra then

                begin

                  bEncontrePalabra:=true;

                  break;

                end;

                nfila:=nfila+1;

            end;

       end

       else

       Begin     // para numeros

           seek(fNum,0);

           while not(EOF(fNum)) do   //Busco si ya existe la palabra en mi archivo

           begin

              READ(fNum,RegNum);

              if RegNum.Palabra = cNumero then

              begin

                bEncontrePalabra:=true;

                break;

              end;

              nfila:=nfila+1;

          end;

       end;

    if (bEsNumero=false) then

      begin

       if (bEncontrePalabra=false) then

           begin

            reset(fPal);

           cantreg := filesize(fPal);

           seek(fPal,cantreg);  //voy al final y agrego

           RegPal.Cantidad :=0;

           RegPal.Palabra :='                    ';

           RegPal.Cantidad :=1;

           RegPal.Palabra :=cPalabra;

           write(fPal,RegPal);

           end

       else

          begin

           seek(fPal,nfila);   //me posiciono en el archivo

           RegPal.Cantidad :=RegPal.Cantidad +1;

           write(fPal,RegPal); //realizo la actualizacion

          end;

      end

      else

      Begin

                 if (bEncontrePalabra=false) then

                     begin

                     seek(fNum,filesize(fNum));  //voy al final y agrego

                     RegNum.Cantidad :=1;

                     RegNum.Palabra :=cNumero;

                     write(fNum,RegNum);

                     end

                 else

                    begin

                     seek(fNum,nfila);   //me posiciono en el archivo

                     RegNum.Cantidad :=RegPal.Cantidad +1;

                     write(fNum,RegNum); //realizo la actualizacion

                    end;

       end;

    bEsNumero:=false;

    cNumero:='';

    cPalabra:='';

    nfila:=0;

end;

close (fNum);

close (fPal) ;

Close (Fichero1);

end.

program Ejercicio1;

USES crt,sysutils;

{

Código, string de largo 10

Título, string de largo 50

Autor, string de largo 30

Número de páginas, numérico de largo 4

 }

type TLibros = record

Codigo: string[10];

Titulo: string[50];

Autor: string[50];

NumPag: integer;

end;

type TIndTem = record

Clave: string[10];

Codigo: string[10];

Titulo: string[50];

Autor: string[50];

NumPag: integer;

end;

  var

  alias : file of TLibros;

  Indice : file of TIndTem;

  Registro:TLibros;

  RegSal:TIndTem;

  nOpc : integer;

  Procedure Menus;

  Begin

  clrscr;

  writeln('-------MENU DE OPCIONES--------');

  writeln('1 - ALTA ');

  writeln('2 - GENERAR INDICE TEMATICO ');

  writeln('3 - LISTAR INDICE TEMATICO ');

  writeln('4 - ORDENAR INDICE TEMATICO ');

  writeln('5 - SALIR ');

  end;

procedure  ListarIndice ;

Begin

clrscr;

writeln(' LISTAR INDICE TEMATICO');

Assign(Indice,'N:\UTN\DATOS\INDICE.DAT');

Reset(Indice); {Intenta abrir el archivo PRODUCTO.DIR}

Read(Indice,RegSal);

while (not eof(Indice)) do

begin

     writeln(regSal.Clave, '   ',regsal.Titulo,'  ',regsal.Codigo , '  ',regsal.Autor );

     Read(Indice,RegSal);

end;

writeln(regSal.Clave, '   ',regsal.Titulo,'  ',regsal.Codigo , '  ',regsal.Autor );

writeln('<<< Oprima cualquier tecla para continuar >>>');

Readkey;

close(Indice);

end;

procedure ordenar;

  var

    hl, il, len : longint;

    reg1 : TIndTem;

    reg2 : TIndTem;

    regaux : TIndTem;

  begin

     Assign(Indice,'N:\UTN\DATOS\INDICE.DAT');

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

     if ioresult <> 0 then

     begin

        writeln('Archivo <', 'N:\UTN\DATOS\INDICE.DAT', ' > no Encontrado');

        halt(1);

       end

     else

         begin

            len := filesize(Indice) - 1;

            for il := 0 to len do

            begin

              seek(Indice,il);

              read(Indice,reg1);

              for hl := len downto il do

              begin

                 seek(Indice,hl);

                 read(Indice,reg2);

                 if reg1.clave > reg2.clave then

                 begin

                     regaux.clave:=reg1.clave;

                     regaux.Titulo:= reg1.Titulo ;

                     regaux.Autor:=reg1.Autor;

                     regaux.Codigo:=reg1.Codigo;

                     regaux.NumPag:=reg1.NumPag;

                     reg1.clave:=reg2.clave;

                     reg1.Titulo:= reg2.Titulo ;

                     reg1.Autor:=reg2.Autor;

                     reg1.Codigo:=reg2.Codigo;

                     reg1.NumPag:=reg2.NumPag;

                     reg2.clave:=regaux.clave;

                     reg2.Titulo:= regaux.Titulo ;

                     reg2.Autor:=regaux.Autor;

                     reg2.Codigo:=regaux.Codigo;

                     reg2.NumPag:=regaux.NumPag;

                     seek(Indice,il);

                     write(Indice,reg1);

                     seek(Indice,hl);

                     write(Indice,reg2);

                 end;

              end;

            end;

            close(Indice);

       end;

  end;

Procedure GENERAR_INDICE_TEMATICO;

Var Codigo : string[10] ; { Variable local para el numero de producto}

ii,i : Integer;

cantreg : Longint;

tot:integer;

clave:string[10] ;

cadini:string;

cadfinal:string;

cadfinal2:string;

caract:char;

aparicion:integer;

bBand2,bBand:Boolean;

Begin

   clrscr;

   writeln('GENERAR ARCHIVO DE INDICE TEMATICO');

   Assign(Indice,'N:\UTN\DATOS\INDICE.DAT');

   Rewrite(Indice);

   Assign(alias,'N:\UTN\DATOS\LIBROS.DAT'); { Asignacion del nombre del archivo al

   alias}

   {$I-} { <--- Directivas para deshabilitar mensajes de error del Sist.

   Operativo }

   Reset(alias); {Intenta abrir el archivo PRODUCTO.DIR

   en modo de lectura/escritura}

   {$I+}

If(IoResult<>0) Then

begin

   writeln('ERROR AL INTENTAR ABRIR EL ARCHIVO');

   writeln('<<< Oprima cualquier tecla para continuar >>>');

   Readkey;

   exit;

end;

   i:=0;

   bBand:=false;

   bBand2:=false;

   ii:=0;

   clave:='';

   cadini:='';

   cadfinal:='';

   cadfinal2:='';

   aparicion:=0;

   while (not eof(alias)) do

begin

     Read(alias,Registro);

     tot:=Length(Registro.Titulo);

     i:=1;

     caract:=Registro.Titulo[i]  ;

     bBand:=true;

     while (bBand) do

     begin

         while (caract<>'#') do

           begin

              cadini:=cadini+caract;

              i:=i+1;

              caract:=Registro.Titulo[i]  ;

           end;

         i:=i+1;

         caract:=Registro.Titulo[i]  ;

         while (caract<>'#') do

           Begin

               clave:=clave+caract;

               i:=i+1;

               caract:=Registro.Titulo[i]  ;

            end;

         i:=i+1;

         caract:=Registro.Titulo[i]  ;

         while (i<=tot) do

           Begin

               if (caract='#') then

               begin

                  cadfinal2:=cadfinal2+caract;

                  i:=i+1;

                  caract:=Registro.Titulo[i]  ;

                  continue;

               end;

               cadfinal:=cadfinal+caract;

               cadfinal2:=cadfinal2+caract;

               i:=i+1;

               caract:=Registro.Titulo[i]  ;

            end;

          Registro.Titulo := cadini+ clave+ cadfinal2 ;

          RegSal.clave:=clave;

          RegSal.Titulo:= cadfinal + '/' +cadini;

          RegSal.Autor:=Registro.Autor;

          RegSal.Codigo:=Registro.Codigo;

          RegSal.NumPag:=REgistro.NumPag;

          write(Indice,RegSal);

          tot:=Length(Registro.Titulo);

          i:=1;

          caract:=Registro.Titulo[i]  ;

          bBand:=false  ;

          while(i<tot) do

            begin

               if caract = '#' then

                 begin

                  bBand:=true;

                  break;

                 end;

               i:=i+1;

               caract:=Registro.Titulo[i]  ;

            end;

            cadini:='';

            cadfinal:='';

            cadfinal2:='';

            clave:='';

            i:=1;

            caract:=Registro.Titulo[i]  ;

     end;

end;

     Close(alias);

     Close(Indice);

End;

  Procedure ALTA_DIRECTA;

  Var Codigo : string[10] ; { Variable local para el numero de producto}

  i : Integer;

  cantreg : Longint;

  bEncontre:boolean;

  pos:integer;

  Begin

  clrscr;

  writeln('ALTAS DE LIBROS NUEVOS');

  Assign(alias,'N:\UTN\DATOS\LIBROS.DAT'); { Asignacion del nombre del archivo al

  alias}

  {$I-} { <--- Directivas para deshabilitar mensajes de error del Sist.

  Operativo }

  Reset(alias); {Intenta abrir el archivo PRODUCTO.DIR

  en modo de lectura/escritura}

  {$I+}

  If(IoResult<>0) Then

       Rewrite(alias); { Crea el archivo en caso de no existir }

     write(' Codigo de Libro : '); readln(Codigo);

     Registro.Codigo:=Codigo;

     cantreg := FileSize(alias) ; // div sizeof(Registro));

     bEncontre:=false;

     IF  NOT EOF(alias)  THEN

       begin

          while (not eof(alias)) and (bEncontre=false) do

          begin

               Read(alias,Registro);

               If(Registro.Codigo=Codigo) Then

               begin

                    pos:=filepos(alias);

                    bEncontre:=true;

               end

               else

                   bEncontre:=false;

               end;

        end;

           If(bEncontre=true) Then

           Begin

              writeln('Registro duplicado !!!');

              writeln('<<< Oprima cualquier tecla para continuar >>>');

              Close(alias);

              Readkey;

              Exit;

           end;

     Registro.Codigo:=Codigo;

     write('Titulo    : '); readln(Registro.Titulo);

     write('Autor     : '); readln(Registro.Autor);

     write('Cant. Pag : '); readln(Registro.NumPag);

     Write(alias,Registro); { Grabar el Registro completo }

     Close(alias); { Cierra el archivo }

     writeln('Libro registrado !!!');

     writeln('<<< Oprima cualquier tecla para continuar >>>');

     readkey;

  end;

  begin

  Menus();

  nOpc:=0;

  while nOpc<>5 do

  begin

  READLN(nOpc);

  case nOpc OF

          1:

            begin

              writeln('Comando ALTA ');

              ALTA_DIRECTA();

            end;

          2:

            begin

              writeln('Comando Generar Indice Tematico  ');

              GENERAR_INDICE_TEMATICO();

            end;

          3:

           begin

              writeln('Comando Listar Indice Tematico  ');

              ListarIndice();

            end;

          4:

           begin

              writeln('Comando Ordenar Indice Tematico  ');

              Ordenar();

            end;

        5:

         writeln('Gracias por usar el programa...');

  end ;

  Menus();

  end;

end.

program Ejercicio3_oav;

Uses crt,sysutils,strutils;

type TLibros = record

msg: string[200];

end;

var

Fichero1 : file of TLibros;

v : TLibros;

canttotal,cantfinal,cant1,cant2,cant3,n:integer;

cad1,cad2,cad3,cad4,cad5:string;

function OctToDec_oav(OctStr: string): integer;

var

  sal,c:string;

  i:integer;

 Begin

i:=1;

 while  i<Length(OctStr)  do

 begin

      c:= MidStr(OctStr,i,4);

      case c of

       '0001': sal:=sal+'1';

       '0010': sal:=sal+'2';

       '0011': sal:=sal+'3';

       '0100': sal:=sal+'4';

       '0101': sal:=sal+'5';

       '0110': sal:=sal+'6';

       '0111' : sal:=sal+'7';

       end;

  //    writeln(c)  ;

   //    writeln(sal)  ;

      i:=i+4;

 end;

      Result:=strtoint(sal);

end;

function ExtraerTextoOAV(OctStr: string): string;

var

  sal,c:string;

  i:integer;

 Begin

i:=1;

 while  i<Length(OctStr)  do

 begin

      c:= MidStr(OctStr,i,4);

      case c of

       '1000': sal:=sal+'O';

       '1001': sal:=sal+'I';

       '1010': sal:=sal+'A';

       '1011': sal:=sal+'B';

       '1100': sal:=sal+'C';

       '1101': sal:=sal+'D';

       '1110' : sal:=sal+'E';

       '1111' : sal:=sal+'F';

       end;

//      writeln(c)  ;

//       writeln(sal)  ;

      i:=i+4;

 end;

      Result:=sal;

end;

begin

  Assign (Fichero1, 'N:\UTN\DATOS\MENSAJE.TXT');

  Reset(Fichero1);

  {

  rewrite(Fichero1);

  v.msg:='000101000111001011111010000101000111001010111000000101000111001000010100011100101111101000010100011100101011100000010100011100100001010001110010111110100001010001110010101110000001010001110010';

  write(Fichero1,v);

  v.msg:='110101000111001011111010000101000111001010111000000101000111001000010100011100101111101000010100011100101011100000010100011100100001010001110010111110100001010001110010101110000001010001110010';

  write(Fichero1,v);

  close(Fichero1);

  }

  Repeat

       Read(Fichero1, v);

      // writeln(v.msg);

      // readkey;

       cad1:= leftstr(v.msg,16);

       cant1:=OctToDec_oav(cad1);

       cad2:=ExtraerTextoOAV(midstr(v.msg,17,8));

       cad3:= midstr(v.msg,25,16);

       cant2:=OctToDec_oav(cad3);

       cad4:=ExtraerTextoOAV(midstr(v.msg,41,8));

       cad5:= midstr(v.msg,49,16);

       cant3:=OctToDec_oav(cad5);

       if (cant1=cant2)  then

         begin

              cantfinal:=cant1;

         end

         else

         begin

              if (cant1=cant3) then

              begin

                  cantfinal:=cant1;

              end

              else

              begin

                  if cant2=cant3 then

                  begin

                    cantfinal:=cant2;

                  end

                  else

                  begin

                     writeln('Mensaje erroneo esta muy dañado');

                  end;

              end;

         end;

         canttotal:=canttotal+ cantfinal;

         writeln('Cantidad de Habitantes : ',cantfinal, '  Nombre del Pueblo : ' , cad2 , ' Nombre  del Lider : ',cad4);

  until (eof(Fichero1))  ;

  writeln('Cantidad total de nexurianos ',canttotal);

  readkey;

end.