uses
TSC, Hash, Whirl512, fcaes256, AES_EAX, mem_util;
procedure GetSalt(
var salt: TFCA256Salt);
{ -generate salt for key derivation }
// http://www.wolfgang-ehrhardt.de/crypt_en.html
var
Ctr : TCtrRec;
TS : TTimeStamp;
sctx : THashContext;
sdig : TWhirlDigest;
qword: int64;
begin
{ Hash Date, Time, Randseed, size and free space (in byte) on active disk and (normally) TSC }
_ReadCounter(Ctr);
Whirl_Init(sctx);
TS := datetimetotimestamp(now);
{ get date and time with millisecond precision }
Whirl_Update(sctx, @TS.date, SizeOf(TS.date));
Whirl_Update(sctx, @TS.time, SizeOf(TS.time));
qword := disksize(0);
Whirl_Update(sctx, @qword, SizeOf(qword));
{ size of active disk }
qword := diskfree(0);
Whirl_Update(sctx, @qword, SizeOf(qword));
{ free space on active disk }
Whirl_Update(sctx, @Ctr, SizeOf(Ctr));
Whirl_Update(sctx, @randseed, SizeOf(randseed));
Whirl_Final(sctx, sdig);
move(sdig, salt, SizeOf(salt));
end;
function Encrypt1(
const AText:
string;
const APassword:
string):
string;
{ -Encrypt file InName to OutName using password }
// http://www.wolfgang-ehrhardt.de/crypt_en.html
const
bufSize = $C000;
var
N : word;
len : int64;
hdr : TFCA256Hdr;
cxe : TAES_EAXContext;
auth : TFCA256_AuthBlock;
TextOut, TextIn: TStringStream;
buf :
array [0 .. bufSize - 1]
of Byte;
begin
randomize;
TextIn := TStringStream.Create(AText);
TextOut := TStringStream.Create;
try
len := TextIn.Size;
GetSalt(hdr.salt);
if FCA_EAX256_initS(cxe, APassword, hdr) <> 0
then
raise Exception.Create('
Fehler');
// Abort('Internal error (FCA_EAX256_init)');
TextOut.WriteBuffer(hdr, SizeOf(hdr));
while len > 0
do
begin
if len > SizeOf(buf)
then
N := SizeOf(buf)
else
N := len;
TextIn.ReadBuffer(buf, N);
dec(len, N);
if FCA_EAX256_encrypt(cxe, buf, N) <> 0
then
raise Exception.Create('
Fehler');
// Abort('Internal error (FCA_EAX256_encrypt)');
TextOut.WriteBuffer(buf, N);
end;
FCA_EAX256_final(cxe, auth);
TextOut.WriteBuffer(auth, SizeOf(auth));
Result := Base64EncStr(TextOut.DataString);
finally
TextOut.Free;
TextIn.Free;
end;
end;
function Decrypt1(
const AText:
string;
const APassword:
string):
string;
{ -Decrypt file InName to OutName using password sPW }
// http://www.wolfgang-ehrhardt.de/crypt_en.html
const
bufSize = $C000;
var
N : word;
I, len : longint;
hdrk : TFCA256Hdr;
hdrf : TFCA256Hdr;
cxe : TAES_EAXContext;
cxh : TFCA_HMAC256_Context;
authf : TFCA256_AuthBlock;
authc : TFCA256_AuthBlock;
UseEAX : boolean;
TextOut, TextIn: TStringStream;
buf :
array [0 .. bufSize - 1]
of Byte;
begin
if AText = '
'
then
Exit('
');
TextIn := TStringStream.Create(Base64DecStr(AText));
TextOut := TStringStream.Create;
try
len := TextIn.Size - SizeOf(hdrf) - SizeOf(authf);
TextIn.ReadBuffer(hdrf, SizeOf(hdrf));
if (hdrf.FCASig <> C_FCA_Sig)
or (hdrf.Flags
and $F0 <> $A0)
then
raise Exception.Create('
Fehler');
// Abort('Invalid file header');
if hdrf.Flags
and $02 <> 0
then
begin
writeln(#7'
*** Warning: Found zlib compression flag, use t_zlibex to inflate <outfile>');
end;
if not(hdrf.Flags
and $04 <> 0)
then
begin
raise Exception.Create('
Fehler');
// writeln('Found: 256 bit key size');
end;
hdrk := hdrf;
UseEAX := odd(hdrf.Flags);
if UseEAX
then
begin
if FCA_EAX256_initS(cxe, APassword, hdrk) <> 0
then
raise Exception.Create('
Fehler');
// Abort('Internal error (FCA_EAX256_init)');
end
else
begin
if FCA_HMAC256_initS(cxh, APassword, hdrk) <> 0
then
raise Exception.Create('
Fehler');
// Abort('Internal error (FCA_HMAC256_init)');
end;
if hdrf.PW_ver <> hdrk.PW_ver
then
raise Exception.Create('
Fehler');
// Abort('Wrong password');
while len > 0
do
begin
if len > SizeOf(buf)
then
N := SizeOf(buf)
else
N := len;
TextIn.ReadBuffer(buf, N);
dec(len, N);
if UseEAX
then
begin
if FCA_EAX256_decrypt(cxe, buf, N) <> 0
then
raise Exception.Create('
Fehler');
// Abort('Internal error (FCA_EAX256_decrypt)');
end
else
begin
if FCA_HMAC256_decrypt(cxh, buf, N) <> 0
then
raise Exception.Create('
Fehler');
// Abort('Internal error (FCA_HMAC256_decrypt)');
end;
TextOut.WriteBuffer(buf, N);
end;
if UseEAX
then
begin
FCA_EAX256_final(cxe, authc);
end
else
begin
FCA_HMAC256_final(cxh, authc);
end;
TextIn.ReadBuffer(authf, SizeOf(authf));
for I := 0
to 15
do
begin
if authf[I] <> authc[I]
then
begin
raise Exception.Create('
Fehler');
// writeln(' Authentication failure!');
end;
end;
Result := TextOut.DataString;
finally
TextOut.Free;
TextIn.Free;
end;
end;