Ñuño Martínez,
Cita:
Empezado por Ñuño Martínez
...Me lo apunto...
|
Revisa este código:
Código Delphi
[-]
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
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;
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;
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;
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;
function StringToHex(S: String): String;
var
i: Integer;
begin
for i := 1 to Length(S) do
Result := Result + IntToHex(Ord(S[i]), 2);
end;
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;
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;
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;
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;
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
[-]
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
public
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
Uses NES;
procedure TForm1.Button1Click(Sender: TObject);
begin
Memo2.Text := EncodeString(Memo1.Text, Edit1.Text);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
Memo3.Text := DecodeString(Memo2.Text, Edit1.Text);
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
Edit1.Text := EmptyStr;
Memo1.Clear;
Memo2.Clear;
Memo3.Clear;
end;
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;
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.