[[nlsgarcia]]

principiodual

Empezado por principiodual

...me gustaría probar un método que solo cifre con caracteres ASCII o Alfanuméricos...

Revisa este código:

Código Delphi [-]
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Memo1: TMemo;
    Memo2: TMemo;
    Memo3: TMemo;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  TState = Array[0..3,0..3] of Byte;

var
  Form1: TForm1;

implementation

{$R *.dfm}

// Realiza operaciones matriciales de intercambio de filas
procedure ShiftRows(var State: TState);
var
   i,j,k : Integer;
begin
   for j := 1 to 3 do
   begin
      k := State[0,j];
      State[0,j] := State[1,j];
      State[1,j] := State[2,j];
      State[2,j] := State[3,j];
      State[3,j] := k;
   end;
end;

// Realiza operaciones matriciales de intercambio de columnas
procedure ShiftCols(var State: TState);
var
   i,j,k : Integer;
begin
   for j := 1 to 3 do
   begin
      k := State[j,0];
      State[j,0] := State[j,1];
      State[j,1] := State[j,2];
      State[j,2] := State[j,3];
      State[j,3] := k;
   end;
end;

// Realiza operaciones matriciales inversas de intercambio de filas
procedure InvShiftRows(var State: TState);
var
   i,j,k : Integer;
begin
   for j := 1 to 3 do
   begin
      k := State[3,j];
      State[3,j] := State[2,j];
      State[2,j] := State[1,j];
      State[1,j] := State[0,j];
      State[0,j] := k;
   end;
end;

// Realiza operaciones matriciales inversas de intercambio de columnas
procedure InvShiftCols(var State: TState);
var
   i,j,k : Integer;
begin
   for j := 1 to 3 do
   begin
      k := State[j,3];
      State[j,3] := State[j,2];
      State[j,2] := State[j,1];
      State[j,1] := State[j,0];
      State[j,0] := k;
   end;
end;

// Convierte una cadena de carácteres ASCII a su equivalente Hexadecimal
function StringToHex(S : String): String;
var
   i: Integer;
begin
   for i := 1 to Length(S) do
      Result := Result + IntToHex(Ord(S[i]), 2);
end;

// Convierte una cadena de carácteres Hexadecimal a su equivalente ASCII
function HexToString(S : String): String;
var
   i : Integer;
begin
   for i := 1 to Length(S) do
      if ((i mod 2) = 1) then
         Result := Result + Chr(StrToInt('0x' + Copy(S, i, 2)));
end;

// Cifra un String por medio de una clave con operaciones matriciales y funciones lógicas
function Encode(DataStr, Key : String) : String;
var
   i : Integer;
   AuxStr : String;
   AuxKey : LongWord;
   Src, Dst : TStringStream;
   State : TState;

begin

   Src := TStringStream.Create(DataStr);
   Dst := TStringStream.Create('');

   FillChar(State,Sizeof(State),#0);

   while Src.Read(State,Sizeof(State)) > 0 do
   begin
      ShiftRows(State);
      ShiftCols(State);
      Dst.WriteBuffer(State,Sizeof(State));
      FillChar(State,Sizeof(State),#0);
   end;

   AuxKey := 0;

   for i := 1 to length(Key) do
      AuxKey := (AuxKey + ord(Key[i])) xor Length(Key);

   for i:=1 to length(Dst.DataString) do
      AuxStr := AuxStr + chr(ord(Dst.DataString[i]) xor AuxKey);

   Result := StringToHex(AuxStr);

end;

// Descifra un String por medio de una clave con operaciones matriciales y funciones lógicas
function Decode(DataStr, Key : String) : String;
var
   i : Integer;
   AuxStr : String;
   AuxKey : LongWord;
   Src, Dst : TStringStream;
   State : TState;

begin

   DataStr := HexToString(DataStr);

   Src := TStringStream.Create(DataStr);
   Dst := TStringStream.Create('');

   FillChar(State,Sizeof(State),#0);

   while Src.Read(State,Sizeof(State)) > 0 do
   begin
      InvShiftCols(State);
      InvShiftRows(State);
      Dst.WriteBuffer(State,Sizeof(State));
      FillChar(State,Sizeof(State),#0);
   end;

   AuxKey := 0;

   for i := 1 to length(Key) do
      AuxKey := (AuxKey + ord(Key[i])) xor Length(Key);

   for i:=1 to length(Dst.DataString) do
      AuxStr := AuxStr + chr(ord(Dst.DataString[i]) xor AuxKey);

   Result := AuxStr;

end;

// Llama la función que Cifra una cadena de carácteres
procedure TForm1.Button1Click(Sender: TObject);
begin
   Memo2.Text := Encode(Memo1.Text, Edit1.Text);
end;

// Llama la función que Descifra una cadena de carácteres
procedure TForm1.Button2Click(Sender: TObject);
begin
   Memo3.Text := Decode(Memo2.Text, Edit1.Text);
end;

// Reset los controles del formulario
procedure TForm1.Button3Click(Sender: TObject);
begin
   Edit1.Text := EmptyStr;
   Memo1.Clear;
   Memo2.Clear;
   Memo3.Clear;
end;

end.

El código anterior en Delphi 7 sobre Windows 7 Professional x32, Cifra y Descifra una cadena de caracteres por medio de una clave utilizando operaciones matriciales y funciones lógicas, según se muestra en la siguiente imagen:



Nota: El código propuesto es útil como una opción de cifrado/descifrado de Strings, sin embargo si los requerimientos de la aplicación lo ameritan, te sugiero implementar el algoritmo Advanced Encryption Standard (AES) (Msg #16), el cual a sido adoptado como : El estándar de cifrado por el gobierno de los Estados Unidos.

Espero sea útil

Nelson.