Der Lightweight Encryption Algorithm (auch bekannt als LEA ) ist ein 128-Bit- Blockchiffre , der 2013 in Südkorea entwickelt wurde, um Vertraulichkeit in Hochgeschwindigkeitsumgebungen wie Big Data und Cloud Computing sowie in leichtgewichtigen Umgebungen wie IoT-Geräten und mobilen Geräten zu gewährleisten . LEA hat drei verschiedene Schlüssellängen: 128, 192 und 256 Bit. LEA verschlüsselt Daten etwa 1,5 bis 2 Mal schneller als AES , der in verschiedenen Softwareumgebungen am weitesten verbreitete Blockchiffre.
Es wird benötigt : 2xEditBox, 2xRadioButton, 4xButton und 1x Progressbar
Unit LEA_Hash.pas :unit LEA_Hash;
interface
{Unit LEA_Hash.pas}
uses Windows, SysUtils, Dialogs;
const
HashTable: array [$0..$3] of Longword = ($CF306227, $4FCE8AC8, $ACE059ED, $4E3079A6);
type
THash = record
A, B, C, D: Longword;
end;
TLEACallback = procedure (BlockIndex: Longword; BlockCount: Longword); stdcall;
function Hash (const Buffer; const Size: Longword; Callback: TLEACallback = nil): THash;
function HashStr (const Str : AnsiString ): THash;
function HashInt (const Int : Integer ): THash;
function HashFile (const FilePath: String; Callback: TLEACallback = nil): THash;
function HashToString (const Hash : THash ): AnsiString;
function StringToHash (const Str : AnsiString ): THash;
function SameHash (const A, B : THash ): Boolean;
function Same (A, B: Pointer; SzA, SzB: Longword): Boolean;
function HashCrypt (const Hash : AnsiString; Key: Longword): AnsiString;
function HashUncrypt (const Hash : AnsiString; Key: Longword): AnsiString;
function IsHash (const Hash : AnsiString ): Boolean;
implementation
const Power2: array [$1..$20] of Longword =($00000001, $00000002, $00000004, $00000008,
$00000010, $00000020, $00000040, $00000080,
$00000100, $00000200, $00000400, $00000800,
$00001000, $00002000, $00004000, $00008000,
$00010000, $00020000, $00040000, $00080000,
$00100000, $00200000, $00400000, $00800000,
$01000000, $02000000, $04000000, $08000000,
$10000000, $20000000, $40000000, $80000000);
function RShl(A, B: Longword): Longword;
begin
Result := (A shl B) or (B shl $20);
end;
type
PLEABuf = ^TLEABuf;
TLEABuf = array [$0..$F] of Longword;
procedure LEAInternal(var A, B, C, D: Longword; Buf: TLEABuf);
Var
I: Integer;
begin
for I := $1 to $F do { Pour chaque double mot du buffer }
begin
Inc(A, Buf[I] + (B or (C xor (not D))));
A := ((A shl $6) xor (A shr $D)) + Buf[Pred(I)];
Inc(B, Buf[I] + (C or (D xor (not A))));
B := ((B shl $A) xor (B shr $5)) + Buf[Pred(I)];
Inc(C, Buf[I] + (D or (A xor (not B))));
C := ((C shl $3) xor (C shr $C)) + Buf[Pred(I)];
Inc(D, Buf[I] + (A or (B xor (not C))));
D := ((D shl $E) xor (D shr $9)) + Buf[Pred(I)];
end;
end;
function Hash(const Buffer; const Size: Longword; Callback: TLEACallback = nil): THash;
Var
V: PLEABuf;
Sz, Cnt: Longword;
Buf: TLEABuf;
E: Pointer;
BlockCount: Longword;
begin
Move(HashTable, Result, $10);
if Size = $0 then Exit;
Cnt := $0;
Sz := Size;
repeat Inc(Sz) until Sz mod $40 = $0;
BlockCount := Sz div $40;
V := @Buffer;
E := Ptr(Longword(@Buffer) + Sz);
with Result do
repeat
begin
ZeroMemory(@Buf, $40);
if Size - Cnt > $3F then Move(V^, Buf, $40) else
begin
Move(V^, Buf, Size - Cnt);
FillMemory(Ptr(Longword(@Buf) + Succ(Size - Cnt)), 1, $80);
end;
LEAInternal(A, B, C, D, Buf);
if Assigned(Callback) then Callback(Cnt div $40, BlockCount);
Inc(V);
Inc(Cnt, $40);
end
until V = E;
end;
function HashStr(const Str: AnsiString): THash;
begin
Result := Hash(PAnsiChar(Str)^, Length(Str));
end;
function HashInt(const Int: Integer): THash;
begin
Result := Hash(Int, SizeOf(Integer));
end;
function HashFile(const FilePath: String; Callback: TLEACallback = nil): THash;
Var
H, M: Longword;
P: Pointer;
begin
ZeroMemory(@Result, 16);
H := CreateFile(PChar(FilePath), GENERIC_READ, FILE_SHARE_READ or FILE_SHARE_WRITE,
nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL or FILE_FLAG_SEQUENTIAL_SCAN, 0);
if H = INVALID_HANDLE_VALUE then Exit;
if GetFileSize(H, nil) = 0 then
begin
Result := Hash('', 0);
CloseHandle(H);
Exit;
end;
try
M := CreateFileMapping(H, nil, PAGE_READONLY, 0, 0, nil);
try
if M = 0 then Exit;
P := MapViewOfFile(M, FILE_MAP_READ, 0, 0, 0);
try
if P = nil then Exit;
Result := Hash(P^, GetFileSize(H, nil), Callback);
finally
UnmapViewOfFile(P);
end;
finally
CloseHandle(M);
end;
finally
CloseHandle(H);
end;
end;
function HashToString(const Hash: THash): AnsiString;
begin
Result := AnsiString(Format('%.8x%.8x%.8x%.8x', [Hash.A, Hash.B, Hash.C, Hash.D]));
end;
function StringToHash(const Str: AnsiString): THash;
begin
if IsHash(Str) then
with Result do
begin
A := StrToInt(Format('$%s', [Copy(Str, 1, 8)]));
B := StrToInt(Format('$%s', [Copy(Str, 9, 8)]));
C := StrToInt(Format('$%s', [Copy(Str, 17, 8)]));
D := StrToInt(Format('$%s', [Copy(Str, 25, 8)]));
end
else ZeroMemory(@Result, 16);
end;
function SameHash(const A, B: THash): Boolean;
begin
Result := CompareMem(@A, @B, 16);
end;
function Same(A, B: Pointer; SzA, SzB: Longword): Boolean;
begin
Result := SameHash(Hash(A, SzA), Hash(B, SzB));
end;
const
Z = #0;
function hxinc(X: AnsiChar): AnsiChar;
const
XInc: array [48..70] of AnsiChar = ('1', '2', '3', '4', '5', '6', '7', '8', '9', 'A',
Z, Z, Z, Z, Z, Z, Z, 'B', 'C', 'D', 'E', 'F', '0');
begin
if ord(X) in [48..57, 65..70] then Result := XInc[ord(X)] else Result := Z;
end;
function hxdec(X: AnsiChar): AnsiChar;
const
XDec: array [48..70] of AnsiChar = ('F', '0', '1', '2', '3', '4', '5', '6', '7', '8',
Z, Z, Z, Z, Z, Z, Z, '9', 'A', 'B', 'C', 'D', 'E');
begin
if ord(X) in [48..57, 65..70] then Result := XDec[ord(X)] else Result := Z;
end;
function HashCrypt(const Hash: AnsiString; Key: Longword): AnsiString;
Var
I: Integer;
begin
Result := Hash;
if not IsHash(Hash) then Exit;
for I := 32 downto 1 do
if Key and Power2[I] <> 0 then Result[I] := hxinc(Result[I]) else Result[I] := hxdec(Result[I]);
end;
function HashUncrypt(const Hash: AnsiString; Key: Longword): AnsiString;
Var
I: Integer;
begin
Result := Hash;
if not IsHash(Hash) then Exit;
for I := 32 downto 1 do
if Key and Power2[I] <> 0 then Result[I] := hxdec(Result[I]) else Result[I] := hxinc(Result[I]);
end;
function IsHash(const Hash: AnsiString): Boolean;
Var
I: Integer;
begin
Result := False;
if Length(Hash) <> 32 then Exit;
{$ifndef unicode}
for I := 1 to 32 do if not (Hash[I] in ['0'..'9', 'A'..'F', 'a'..'f']) then Exit;
{$else}
for I := 1 to 32 do if not CharInSet(Hash[I], ['0'..'9', 'A'..'F', 'a'..'f']) then Exit;
{$endif}
Result := True;
end;
end.
unit SEA;
interface
{Unit SEA.pas}
uses Windows, LEA_Hash;
type
TSEACallback = procedure (Position, Count: Longword);
TSEAKey = THash;
const
OPERATION_ENCRYPT = $1;
OPERATION_DECRYPT = $2;
OPERATION_FAST = $4;
OPERATION_SECURE = $8;
function ObtainKey(Str: String): TSEAKey;
function Encrypt(var Buffer; const Size: Longword; Key: TSEAKey; const Operation: Longword; Callback: TSEACallback = nil): Boolean;
function EncryptFile(const FilePath: String; const Key: TSEAKey; const Operation: Longword; Callback: TSEACallback = nil): Boolean;
implementation
function RShlLong(A, B: Longword): Longword;
begin
Result := (A shl B) or (A shr ($08 - B));
end;
function RShl(A, B: Byte): Byte;
begin
Result := (A shl B) or (A shr ($08 - B));
end;
function RShr(A, B: Byte): Byte;
begin
Result := (A shr B) or (A shl ($08 - B));
end;
function ObtainKey(Str: String): TSEAKey;
begin
Result := HashStr(Str);
end;
function Encrypt(var Buffer; const Size: Longword; Key: TSEAKey; const Operation: Longword; Callback: TSEACallback = nil): Boolean;
Var
P, E: PByte;
I: Longword;
H: THash;
begin
Result := False;
if (OPERATION_ENCRYPT and Operation <> 0) and (OPERATION_DECRYPT and Operation <> 0) then Exit;
if (OPERATION_ENCRYPT and Operation = 0) and (OPERATION_DECRYPT and Operation = 0) then Exit;
if (OPERATION_FAST and Operation <> 0) and (OPERATION_SECURE and Operation <> 0) then Exit;
if (OPERATION_FAST and Operation = 0) and (OPERATION_SECURE and Operation = 0) then Exit;
if Size = 0 then Exit;
P := @Buffer;
E := Ptr(Longword(@Buffer) + Size);
I := 0;
H := Hash(I, 4, nil);
repeat
if (OPERATION_DECRYPT and Operation <> 0) then P^ := RShr(P^, (Key.B mod $08) xor (I mod $08));
if (Operation and OPERATION_SECURE <> 0) then H := Hash(I, 4, nil);
if (Operation and OPERATION_FAST <> 0) then if Succ(I) mod $FF = 0 then H := Hash(I, 4, nil);
with H do
begin
P^ := (Key.B mod $FF) xor (P^ xor (C mod $FF));
P^ := (Key.A mod $FF) xor (P^ xor (B mod $FF));
P^ := (Key.D mod $FF) xor (P^ xor (A mod $FF));
P^ := (Key.C mod $FF) xor (P^ xor (D mod $FF));
end;
if (OPERATION_ENCRYPT and Operation <> 0) then P^ := RShl(P^, (Key.B mod $08) xor (I mod $08));
if Assigned(Callback) then Callback(Succ(I), Size);
Inc(P);
Inc(I);
until P = E;
Result := True;
end;
function EncryptFile(const FilePath: String; const Key: TSEAKey; const Operation: Longword; Callback: TSEACallback = nil): Boolean;
Var
H, M: Longword;
P: Pointer;
begin
Result := False;
H := CreateFile(PChar(FilePath), GENERIC_READ or GENERIC_WRITE, 0,
nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL or FILE_FLAG_SEQUENTIAL_SCAN, 0);
if H = INVALID_HANDLE_VALUE then Exit;
if GetFileSize(H, nil) = 0 then
begin
CloseHandle(H);
Exit;
end;
try
M := CreateFileMapping(H, nil, PAGE_READWRITE, 0, 0, nil);
try
if M = 0 then Exit;
P := MapViewOfFile(M, FILE_MAP_READ or FILE_MAP_WRITE, 0, 0, 0);
try
if P = nil then Exit;
Result := Encrypt(P^, GetFileSize(H, nil), Key, Operation, Callback);
finally
UnmapViewOfFile(P);
end;
finally
CloseHandle(M);
end;
finally
CloseHandle(H);
end;
end;
end.
uses SEA
var
Running: Boolean;
//
procedure Callback(Position, Count: Longword);
begin
if (Position mod 32768 <> 0) and (Position <> Count) then Exit;
Form1.Bar.Max := Count;
Form1.Bar.Position := Position;
Application.ProcessMessages;
end;
procedure TForm1.FileEditEnter(Sender: TObject);
begin
if OpenDlg.Execute then
begin
FileEdit.Text := ExtractFileName(OpenDlg.FileName);
EncryptBtn.Enabled := FileExists(OpenDlg.FileName);
DecryptBtn.Enabled := FileExists(OpenDlg.FileName);
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
randomize;
end;
procedure TForm1.RandomBtnClick(Sender: TObject);
begin
KeyEdit.Text := Format('%x%x%x%x%x', [random(256),
random(256),
random(256),
random(256),
random(256)]);
end;
procedure TForm1.EncryptBtnClick(Sender: TObject);
const
CryptType: array [Boolean] of Longword = (OPERATION_FAST, OPERATION_SECURE);
begin
if Sender is TButton then with TButton(Sender) do
try
EncryptBtn.Enabled := False;
DecryptBtn.Enabled := False;
Running := True;
if not EncryptFile(OpenDlg.FileName, ObtainKey(KeyEdit.Text), Tag or CryptType[SecureOption.Checked], Callback) then
raise Exception.Create('Error Encrypting/Decrypting the file.');
finally
Bar.Position := 0;
EncryptBtn.Enabled := True;
DecryptBtn.Enabled := True;
Running := False;
end;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if Running then
begin
Action := caNone;
MessageDlg('Impossible to stop during encryption/decryption, the file would then be half encrypted and half decrypted, which would make its reconstruction almost impossible.', mtWarning, [mbOK], 0);
end;
end;
Keine Kommentare:
Kommentar veröffentlichen