Club Delphi  
    FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Principal > Varios
Registrarse FAQ Miembros Calendario Guía de estilo Buscar Temas de Hoy Marcar Foros Como Leídos

Grupo de Teaming del ClubDelphi

Respuesta
 
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
  #22  
Antiguo 06-10-2014
Avatar de nlsgarcia
[nlsgarcia] nlsgarcia is offline
Miembro Premium
 
Registrado: feb 2007
Ubicación: Caracas, Venezuela
Posts: 2.206
Poder: 21
nlsgarcia Tiene un aura espectacularnlsgarcia Tiene un aura espectacular
Ñuño Martínez,

Cita:
Empezado por Ñuño Martínez
...Me lo apunto...


Revisa este código:
Código Delphi [-]
// NES (Nelson Encryption Standard )
// Cifra y Descifra Strings y Files

unit NES;

interface

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

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

  function EncodeString(StringData, Key : String) : String;
  function DecodeString(StringData, Key : String) : String;
  function EncodeFile(FileName, Key : String) : Boolean;
  function DecodeFile(FileName, Key : String) : Boolean;
  
implementation

// 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 EncodeString(StringData, Key : String) : String;
var
   i : Integer;
   AuxStr : String;
   AuxKey : LongWord;
   StreamSrc, StreamDst : TStringStream;
   State : TState;

begin

   StreamSrc := TStringStream.Create(StringData);
   StreamDst := TStringStream.Create('');

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

   while StreamSrc.Read(State,Sizeof(State)) > 0 do
   begin
      ShiftRows(State);
      ShiftCols(State);
      StreamDst.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(StreamDst.DataString) do
      AuxStr := AuxStr + chr(ord(StreamDst.DataString[i]) xor AuxKey);

   Result := StringToHex(AuxStr);

end;

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

begin

   StringData := HexToString(StringData);

   StreamSrc := TStringStream.Create(StringData);
   StreamDst := TStringStream.Create('');

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

   while StreamSrc.Read(State,Sizeof(State)) > 0 do
   begin
      InvShiftCols(State);
      InvShiftRows(State);
      StreamDst.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(StreamDst.DataString) do
      AuxStr := AuxStr + chr(ord(StreamDst.DataString[i]) xor AuxKey);

   Result := AuxStr;

end;

// Cifra un File por medio de una clave con operaciones matriciales y funciones lógicas
function EncodeFile(FileName, Key : String) : Boolean;
var
   i : Integer;
   S1, S2 : String;
   AuxKey : LongWord;
   FileSrc, FileDst : TFileStream;
   State : TState;
   AuxState : TStringStream;
   FileNameEnc : String;
   BytesRead : LongInt;

begin

   try

      try

         AuxKey := 0;

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

         FileSrc := TFileStream.Create(FileName, fmOpenRead);

         FileNameEnc := ExtractFilePath(FileName)
                        + ChangeFileExt(ExtractFileName(FileName),'')
                        + '_Enc'
                        + ExtractFileExt(FileName);

         FileDst := TFileStream.Create(FileNameEnc, fmCreate);
         FillChar(State,Sizeof(State),#0);

         BytesRead := FileSrc.Read(State,SizeOf(State));

         while BytesRead > 0 do
         begin

            S1 := EmptyStr;
            S2 := EmptyStr;

            if BytesRead = 16 then
            begin
               ShiftRows(State);
               ShiftCols(State);
            end;

            AuxState := TStringStream.Create('');
            AuxState.WriteBuffer(State,Sizeof(State));

            for i := 1 to BytesRead do
               S1 := S1 + chr(ord(AuxState.DataString[i]) xor AuxKey);

            S2 := StringToHex(S1);

            FileDst.Write(S2[1],Length(S2));

            FillChar(State,Sizeof(State),#0);
            AuxState.Free;

            BytesRead := FileSrc.Read(State,SizeOf(State));
            Application.ProcessMessages;

         end;

         Result := True;

      except

         Result := False;

      end;

   finally

      FileSrc.Free;
      FileDst.Free;

   end;

end;

// Cifra un File por medio de una clave con operaciones matriciales y funciones lógicas
function DecodeFile(FileName, Key : String) : Boolean;
var
   i : Integer;
   S1, S2, S3 : String;
   AuxKey : LongWord;
   FileSrc, FileDst : TFileStream;
   State : TState;
   AuxState : TStringStream;
   FileNameDec : String;
   AState : Array[0..31] of Char;
   BytesRead : LongInt;

begin

   if Pos('_Enc',FileName) = 0 then
      Exit;

   try

      try

         AuxKey := 0;

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

         FileSrc := TFileStream.Create(FileName, fmOpenRead);
         FileNameDec := StringReplace(FileName,'_Enc','_Dec',[]);

         FileDst := TFileStream.Create(FileNameDec, fmCreate);

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

         BytesRead := FileSrc.Read(AState,Length(AState));

         while BytesRead > 0 do
         begin

            S1 := EmptyStr;
            S2 := EmptyStr;
            S3 := EmptyStr;

            S1 := Copy(AState,0, BytesRead);
            S2 := HexToString(S1);

            Move(S2[1], State[0,0], Length(S2));

            if BytesRead = 32 then
            begin
               InvShiftCols(State);
               InvShiftRows(State);
            end;

            AuxState := TStringStream.Create('');
            AuxState.WriteBuffer(State,Sizeof(State));

            for i := 1 to BytesRead div 2 do
               S3 := S3 + chr(ord(AuxState.DataString[i]) xor AuxKey);

            FileDst.Write(S3[1],Length(S3));

            FillChar(State,Sizeof(State),#0);
            FillChar(AState,Length(AState),#0);
            AuxState.Free;

            BytesRead := FileSrc.Read(AState,Length(AState));
            Application.ProcessMessages;

         end;

         Result := True;

      except

         Result := False;

      end;

   finally

      FileSrc.Free;
      FileDst.Free;

   end;

end;

end.
Código Delphi [-]
// Ejemplo de uso de NES (Nelson Encryption Standard )

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;
    Button4: TButton;
    Button5: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

Uses NES;

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

// Llama la función que Descifra una cadena de carácteres
procedure TForm1.Button2Click(Sender: TObject);
begin
   Memo3.Text := DecodeString(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;

// Llama la función que Cifra una Archivo
procedure TForm1.Button4Click(Sender: TObject);
var
  openDialog : TOpenDialog;
  MsgUser : String;

begin

   openDialog := TOpenDialog.Create(self);
   openDialog.InitialDir := GetCurrentDir;
   openDialog.Options := [ofFileMustExist];
   openDialog.Filter := 'Files |*.*';

   if openDialog.Execute then
   begin

      Button4.Enabled := False;
      Button5.Enabled := False;

      if EncodeFile(openDialog.FileName, Edit1.Text) then
      begin
         MsgUser := Format('El Archivo %s fue Cifrado',[openDialog.FileName]);
         MessageDlg(MsgUSer,mtInformation,[mbOK],0)
      end
      else
      begin
         MsgUser := Format('Error en el Cifrado del Archivo %s',[openDialog.FileName]);
         MessageDlg(MsgUSer,mtError,[mbOK],0)
      end;

      Button4.Enabled := True;
      Button5.Enabled := True;

   end;

end;

// Llama la función que Descifra una Archivo
procedure TForm1.Button5Click(Sender: TObject);
var
  openDialog : TOpenDialog;
  MsgUser : String;

begin

   openDialog := TOpenDialog.Create(self);
   openDialog.InitialDir := GetCurrentDir;
   openDialog.Options := [ofFileMustExist];
   openDialog.Filter := 'Files |*.*';

   if openDialog.Execute then
   begin

      Button4.Enabled := False;
      Button5.Enabled := False;

      if DecodeFile(openDialog.FileName, Edit1.Text) then
      begin
         MsgUser := Format('El Archivo %s fue Descifrado',[openDialog.FileName]);
         MessageDlg(MsgUSer,mtInformation,[mbOK],0)
      end
      else
      begin
         MsgUser := Format('Error en el Descifrado del Archivo %s',[openDialog.FileName]);
         MessageDlg(MsgUSer,mtError,[mbOK],0)
      end;

      Button4.Enabled := True;
      Button5.Enabled := True;

   end;

end;

end.
El código anterior en Delphi 7 sobre Windows 7 Professional x32 es la versión 2 del código propuesto en el Msg #20 el cual permite, Cifrar y Descifrar Strings y Archivos por medio de una clave utilizando operaciones matriciales y funciones lógicas, según se muestra en las siguientes imágenes:











El código del ejemplo esta disponible en : NES (Nelson Encryption Standard ).rar

Notas:

1- El algoritmo NES permite, cifrar Strings y Archivos en una secuencia de caracteres hexadecimales.

2- Cuando se cifra un archivo, se crea uno nuevo con el nombre original mas el sufijo '_Enc', ejemplo: File.txt -> Función EncodeFile -> File_Enc.txt

3- Cuando se descifra un archivo, se crea uno nuevo al cual se le cambia el sufijo '_Enc' por '_Dec', ejemplo: File_Enc.txt -> Función DecodeFile -> File_Dec.txt

4- El archivo original nunca es modificado ni borrado, lo cual garantiza las pruebas con el algoritmo y flexibiliza su implementación.

5- El código propuesto es útil como una opción de cifrado/descifrado de Strings y Archivos, sin embargo si los requerimientos de la aplicación lo ameritan, 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.
Responder Con Cita
  #23  
Antiguo 08-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
__________________
Proyectos actuales --> Allegro 5 Pascal ¡y Delphi!|MinGRo Game Engine
Responder Con Cita
Respuesta


Herramientas Buscar en Tema
Buscar en Tema:

Búsqueda Avanzada
Desplegado

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 02:16:21.


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