Club Delphi  
    FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Principal > Varios
Registrarse FAQ Miembros Calendario Guía de estilo Temas de Hoy

Grupo de Teaming del ClubDelphi

 
 
Herramientas Buscar en Tema Desplegado
  #21  
Antiguo 01-10-2014
Avatar de Ñuño Martínez
Ñuño Martínez Ñuño Martínez is offline
Moderador
 
Registrado: jul 2006
Ubicación: Ciudad Catedral, Españistán
Posts: 6.000
Poder: 25
Ñuño Martínez Tiene un aura espectacularÑuño Martínez Tiene un aura espectacular
Cita:
Empezado por nlsgarcia Ver Mensaje
principiodual




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, (...)

Espero sea útil

Nelson.
Magnífico. Me lo apunto.

Yo hice un programita en C para cifrar datos, pero sólo funciona en binario. Vamos, que puede devolver cualquier cosa.
__________________
Proyectos actuales --> Allegro 5 Pascal ¡y Delphi!|MinGRo Game Engine
Responder Con Cita
 



Normas de Publicación
no Puedes crear nuevos temas
no Puedes responder a temas
no Puedes adjuntar archivos
no Puedes editar tus mensajes

El código vB está habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado
Saltar a Foro


La franja horaria es GMT +2. Ahora son las 01:47:22.


Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi
Copyright 1996-2007 Club Delphi