Decodificar fichero de texto

 Partiendo de la base del programa de encriptación, pero invirtiendo los pasos para encriptar, se llega al programa que desencripta los textos encriptados, siempre y cuando la clave sea la misma que de encriptación.

program desencripta(input,output);
const
  min=32;
  max=126;
type
  NomFich=string[50];
  tpContador=1..maxint;
var
  nom:NomFich;
  codificado,decodificado:text;
  aux:char;
  contador:integer;

procedure Decodificar(VAR a:char; c:tpContador);
  const
    clave='AquiSeIntroduceLaClave';{debe ser la misma que la usada para encriptar}
  var
    n:integer;
  begin {mirando en las tablas del codigo ASCII}
    if (ord(a)>=min) and (ord(a)<=max) then begin
      n:=((c-1) mod ord(clave[0])) + 1;
      n:=ord(a)-ord(clave[n])+(max-min+1);
      n:=(n mod (max-min+1))+min;
      a:=chr(n)
    end
  end;

begin
  write('Introduzca el nombre del fichero de texto a decodificar: ');
  readln(nom);
  assign(decodificado,nom);
  assign(codificado,'decodificado.txt');
  reset(decodificado); rewrite(codificado);
  contador:=0;
  while not eof(decodificado) do begin
    while not eoln(decodificado) do
    begin
      contador:=contador+1;
      read(decodificado,aux);
      Decodificar(aux,contador);
      write(codificado,aux)
    end;
    readln(decodificado);writeln(codificado)
  end;
  close(codificado); close(decodificado);
  readln
end.

Codificar fichero de texto

Este programa codifica con un método muy sencillo, y poco eficaz si la clave de codificación es corta, pero muy eficaz si es larga y se utilizan varias claves(intentare colgar otro programa que use varias claves). El programa, codifica un fichero de texto (extensión .txt) y el texto codificado lo guarda en un fichero que crea y se llama codificado.txt. Groso modo, el mecanismo consiste en sumar el valor de la letra a codificar y el de la letra que corresponda de la clave, usando valores del codigo ASCII. El programa resultante es el siguiente:

program encripta(input,output);
const
  min=32;
  max=126;
type
  NomFich=string[50];
  tpContador=1..maxint;
var
  nom:NomFich;
  codificado,decodificado:text;
  aux:char;
  contador:integer;

procedure Codificar(VAR a:char; c:tpContador);
  const
    clave='AquiSeIntroduceLaClave';{Aqui se pone el texto a usar como clave}
  var
    n:integer;
  begin {mirando en las tablas del codigo ASCII}
    if (ord(a)>=min) and (ord(a)<=max) then begin
      n:=((c-1) mod ord(clave[0])) + 1;
      {En la posicion 0 de la cadena clave se guarda su longitud}
      n:=(ord(clave[n])+ord(a)-(min*2)) mod (max-min+1);
      n:=n+min;
      a:=chr(n)
    end
  end;

begin
  write('Introduzca el nombre del fichero de texto a decodificar: ');{Se debe poner la extensión .txt}
  readln(nom);
  assign(decodificado,nom);
  assign(codificado,'codificado.txt');
  reset(decodificado); rewrite(codificado);
  contador:=0;
  while not eof(decodificado) do begin
    while not eoln(decodificado) do
    begin
      contador:=contador+1;
      read(decodificado,aux);
      Codificar(aux,contador);
      write(codificado,aux)
    end;
    readln(decodificado);writeln(codificado)
  end;
  close(codificado); close(decodificado);
  readln
end.

Si alguien tiene alguna duda o quiere detalles sobre el método que pregunte por aquí.
Salud.

Triangularizar matriz

Programa que se utiliza como función en otros, como es el caso de resolución de sistemas mediante eliminación gaussiana, ortogonalización... Pienso que puede ser útil por si alguien lo quisiera utilizar como función en otro programa principal.

program triangulariza(input,output);
Const
  tanMax=20;
  precision=0.000001;

Type
  tpVector=array[1..tanMax] of real;
  tpMatriz=array[1..tanMax] of tpVector;
  tpDimension=1..tanMax;
  tpContador=1..MAXINT;

Var
  matriz:tpMatriz;
  min,pasoF,pasoC,filas,columnas:tpDimension;
  cont:tpContador;


Procedure LeerDatos(VAR f,c:tpDimension; VAR m:tpMatriz);
  Var
    i,j:tpContador;

  begin
    writeln('Introduzca el numero de filas: '); readln(f); writeln;
    writeln('Introduzca el numero de columnas: '); readln(c); writeln;
    for i:=1 to f do begin
      writeln('Termino de la fila ',i,': ');
      for j:=1 to c do begin
        write('Termino (',i,',',j,'): ');readln(m[i,j])
      end;
      writeln
    end;
    writeln
  end;


Procedure SeleccionarFila(f,c,pF,pC:tpDimension; VAR m:tpMatriz);
  Var
    i,j:tpContador;
    aux:real;

  Begin
    i:=pF;
    while (m[i,pC]<precision) and (i<f) and (m[i,pC]>-precision) do
      i:=i+1;
    If i<>f then
      begin
        for j:=pC to c do begin
          aux:=m[pF,j];
          m[pF,j]:=m[i,j];
          m[i,j]:=aux
        end
      end
  end;


Procedure restarFilas(f,c:tpDimension; VAR pF:tpDimension; VAR pC:tpDimension; VAR m:tpMatriz);
  var
    i,j:tpContador;
    aux:real;

  begin
    if m[pF,pC]<>0 then begin
      for i:=(pF+1) to f do begin
        aux:=m[i,Pc];
        for j:=pC to c do
          m[i,j]:=m[i,j]-aux*(m[pF,j]/m[pF,pC]);
      end;
      pF:=pF+1
    end;
    pC:=pC+1
  end;


procedure MinDim(f,c:tpDimension; VAR mini:tpDimension);
  begin
    if c<f then mini:=c else mini:=f
  end;


procedure EscribirMatriz(m:tpMatriz);
  var
    i,j:tpContador;

  begin
    for i:=1 to filas do begin
      for j:=1 to columnas do
        write(m[i,j]:7:2);
      writeln
    end
  end;

begin
  LeerDatos(filas,columnas,matriz);
  MinDim(filas,columnas,min);
  EscribirMatriz(matriz);writeln; writeln;
  pasoF:=1; pasoC:=1;
  for cont:=1 to min do
    begin
      SeleccionarFila(filas,columnas,pasoF,pasoC,matriz);
      restarFilas(filas,columnas,pasoF,pasoC,matriz)
    end;
  EscribirMatriz(matriz);
  readln
end.


Un saludo y que les sirva.

Cálculo del factorial de un número mediante función recursiva

Este programa esta creado con el único fin de servir de ejemplo para la programación mediante el uso de funciones recursivas, que puedan servir para posteriormente para programar otros como el programa del determinante expuesto en esta misma página.

program factorial(input,output);
var
  n:integer;

function fact(m:integer):integer;
begin
  if m>0 then
    fact:=m*fact(m-1)
  else
    fact:=1;
end;

begin
  write('Introduzca el numero: '); readln(n);
  n:=fact(n);
  write('El factorial vale: ',n);
  readln
end.

Aqui les dejo un video con algo de explicacion:




Espero que les sirva. Salud.