I'm in the process of implementing XML digital signatures. I'm starting with little steps, so right now I want to solve the problem of SHA-1 hashing.
There are lots of questions about this in SO:
Digitially Sign Key with Lockbox
Encryption library for Delphi
Convert this php digital signing to Delphi
Delphi: is there a version of LockBox for Delphi-XE
Delphi 2010 Cryptography libraries
...and probably more. However, I'm using Delphi XE. So far, I've tried LockBox 2 (both the Songbeamer and Sourceforge versions), Lock Box 3, DCPCrypto2 and some others (Hashes is an easy to use unit which uses Windows crypto functions)
I prepared a small test rig that gives me the following:
LockBox2
FAILED: 1 ('abc')
Got: '9f04f41a848514162050e3d68c1a7abb441dc2b5'
Expected: 'a9993e364706816aba3e25717850c26c9cd0d89d'
FAILED: 2 ('abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq')
Got: '51d7d8769ac72c409c5b0e3f69c60adc9a039014'
Expected: '84983e441c3bd26ebaae4aa1f95129e5e54670f1'
LockBox3
FAILED: 1 ('abc')
Got: '9f04f41a848514162050e3d68c1a7abb441dc2b5'
Expected: 'a9993e364706816aba3e25717850c26c9cd0d89d'
FAILED: 2 ('abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq')
Got: '51d7d8769ac72c409c5b0e3f69c60adc9a039014'
Expected: '84983e441c3bd26ebaae4aa1f95129e5e54670f1'
DCPCrypto2
FAILED: 1 ('abc')
Got: '9f04f41a848514162050e3d68c1a7abb441dc2b5'
Expected: 'a9993e364706816aba3e25717850c26c9cd0d89d'
FAILED: 2 ('abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq')
Got: '51d7d8769ac72c409c5b0e3f69c60adc9a039014'
Expected: '84983e441c3bd26ebaae4aa1f95129e5e54670f1'
Hashes
Test 1 passes
Test 2 passes
Have you succeeded in compile the mentioned libraries under Delphi XE and make them give the appropriate values? I'm particularly interested in DCPCrypt2 SelfTest procedure.
Edit: I've added this answer with the fixed source code. Thank you all for your help, it is most appreciated.
Leonardo, i think which your problem is the UNICODE when you uses a function to hash a string you are passing a array (buffer) of bytes. so when you pass the abc string in Delphi XE, your are hashing a buffer like this 61 00 62 00 63 00 (Hex representation)
check this sample application which uses the Windows crypto functions from the Jwscl library (JEDI Windows Security Code Lib)
program Jwscl_TestHash;
{$APPTYPE CONSOLE}
uses
JwsclTypes,
JwsclCryptProvider,
Classes,
SysUtils;
function GetHashString(Algorithm: TJwHashAlgorithm; Buffer : Pointer;Size:Integer) : AnsiString;
var
Hash: TJwHash;
HashSize: Cardinal;
HashData: Pointer;
i : Integer;
begin
Hash := TJwHash.Create(Algorithm);
try
Hash.HashData(Buffer,Size);
HashData := Hash.RetrieveHash(HashSize);
try
SetLength(Result,HashSize*2);
BinToHex(PAnsiChar(HashData),PAnsiChar(Result),HashSize);
finally
TJwHash.FreeBuffer(HashData);
end;
finally
Hash.Free;
end;
end;
function GetHashSHA(FBuffer : AnsiString): AnsiString;
begin
Result:=GetHashString(haSHA,#FBuffer[1],Length(FBuffer));
end;
function GetHashSHA_Unicode(FBuffer : String): String;
begin
Result:=GetHashString(haSHA,#FBuffer[1],Length(FBuffer)*SizeOf(Char));
end;
begin
try
Writeln(GetHashSHA('abc'));
Writeln(GetHashSHA('abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq'));
Writeln(GetHashSHA_Unicode('abc'));
Writeln(GetHashSHA_Unicode('abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq'));
Readln;
except
on E:Exception do
begin
Writeln(E.Classname, ':', E.Message);
Readln;
end;
end;
end.
this return
abc AnsiString
A9993E364706816ABA3E25717850C26C9CD0D89D
abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq AnsiString
84983E441C3BD26EBAAE4AA1F95129E5E54670F1 for
abc unicode
9F04F41A848514162050E3D68C1A7ABB441DC2B5
abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq Unicode
51D7D8769AC72C409C5B0E3F69C60ADC9A039014
My Cygwin command-prompt tells me it is indeed Unicode that's confusing you:
~$ printf 'a\0b\0c\0' | sha1sum
9f04f41a848514162050e3d68c1a7abb441dc2b5 *-
~$ printf 'abc' | sha1sum
a9993e364706816aba3e25717850c26c9cd0d89d *-
Could the expected value be for an ANSI string and the hash you are getting is for a unicode string?
Okay, so it was Unicode issues. Just in case you want to know, this is my Unit1.pas source. You need a form with a memo and a button. Requires DCPCrypt2, LockBox2, LockBox3 and the Hashes unit.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, LbCipher, LbClass, StdCtrls, DCPcrypt2, DCPsha1, Hashes,
uTPLb_CryptographicLibrary, uTPLb_BaseNonVisualComponent, uTPLb_Hash;
type
THashProc = reference to procedure(src: AnsiString; var output: AnsiString);
TForm1 = class(TForm)
Memo1: TMemo;
btnTest: TButton;
function Display(Buf: TBytes): String;
procedure LockBox2Test;
procedure LockBox3Test;
procedure DCPCrypto2Test;
procedure HashesTest;
procedure btnTestClick(Sender: TObject);
private
{ Private declarations }
procedure RunTests(Name: String; HashFunc: THashProc);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses uTPLb_StreamUtils;
{$R *.dfm}
procedure TForm1.btnTestClick(Sender: TObject);
begin
LockBox2Test;
LockBox3Test;
DCPCrypto2Test;
HashesTest;
end;
procedure TForm1.DCPCrypto2Test;
begin
RunTests('DCPCrypto2', procedure(src: AnsiString; var output: AnsiString)
var
Digest: TSHA1Digest;
Bytes : TBytes;
SHA1 : TDCP_sha1;
begin
SHA1 := TDCP_sha1.Create(nil);
SHA1.Init;
SHA1.UpdateStr(src);
SHA1.Final(Digest);
SHA1.Destroy;
SetLength(Bytes, 20);
Move(Digest, Bytes[0], 20);
output := Form1.Display(Bytes);
end);
end;
function TForm1.Display(Buf: TBytes): String;
var
i: Integer;
begin
Result := '';
for i := 0 to 19 do
Result := Result + Format('%0.2x', [Buf[i]]);
Result := LowerCase(Trim(Result));
end;
procedure TForm1.HashesTest;
begin
RunTests('Hashes', procedure(src: AnsiString; var output: AnsiString)
begin
output := CalcHash2(src, haSHA1)
end)
end;
procedure TForm1.LockBox2Test;
begin
RunTests('LockBox2', procedure(src: AnsiString; var output: AnsiString)
var
Digest: TSHA1Digest;
Bytes : TBytes;
SHA1 : TLbSHA1;
begin
SHA1 := TLbSHA1.Create(nil);
SHA1.HashStringA(src);
SHA1.GetDigest(Digest);
SHA1.Destroy;
SetLength(Bytes, 20);
Move(Digest, Bytes[0], 20);
output := Form1.Display(Bytes);
end);
end;
procedure TForm1.LockBox3Test;
begin
RunTests('LockBox3', procedure(src: AnsiString; var output: AnsiString)
var
Digest: TSHA1Digest;
bytes : TBytes;
P, Sz: integer;
aByte: byte;
s: string;
SHA1 : THash;
Lib : TCryptographicLibrary;
begin
Lib := TCryptographicLibrary.Create(nil);
SHA1 := THash.Create(nil);
SHA1.CryptoLibrary := Lib;
SHA1.HashId := 'native.hash.SHA-1';
SHA1.Begin_Hash;
SHA1.HashAnsiString(src);
if not assigned(SHA1.HashOutputValue) then
output := 'nil'
else
begin
SetLength(Bytes, 20);
Sz := SHA1.HashOutputValue.Size;
if Sz <> 20 then
output := Format('wrong size: %d', [Sz])
else
begin
P := 0;
SHA1.HashOutputValue.Position := 0;
while SHA1.HashOutputValue.Read(aByte, 1) = 1 do
begin
bytes[P] := aByte;
Inc(P);
end;
output := Form1.Display(Bytes);
end;
end;
SHA1.Destroy;
Lib.Destroy;
end)
end;
procedure TForm1.RunTests(Name: String; HashFunc: THashProc);
var
i: Integer;
Tests: array [1 .. 2, 1 .. 2] of AnsiString;
src, res: AnsiString;
expected: String;
begin
// http://www.nsrl.nist.gov/testdata/
Tests[1][1] := 'abc';
Tests[1][2] := 'a9993e364706816aba3e25717850c26c9cd0d89d';
Tests[2][1] := 'abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq';
Tests[2][2] := '84983e441c3bd26ebaae4aa1f95129e5e54670f1';
Memo1.Lines.Add('');
Memo1.Lines.Add('**' + Name + '**');
Memo1.Lines.Add('');
for i := 1 to 2 do
begin
src := Tests[i][1];
expected := Tests[i][2];
HashFunc(src, res);
res := Trim(LowerCase(res));
if res = expected then
begin
Memo1.Lines.Add(Format(' Test %d passes', [i]))
end
else
begin
Memo1.Lines.Add(Format(' FAILED: %d (''%s'') ', [i, src]));
Memo1.Lines.Add(Format(' Got: ''%s''', [res]));
Memo1.Lines.Add(Format(' Expected: ''%s''', [expected]));
end;
end;
end;
end.
Related
Using DEC (Delphi Encryption Compendium Version 5.2) in Delphi XE2, I encrypt a string with the following code below.
However, AFTER EACH PROGRAM START the same sequence of encryption results are generated. I have tried to use Randomize in FormCreate, but it does not help.
uses
DECUtil, DECCipher, DECHash, DECFmt;
const
MyPW = 'MyPassword';
var
AKDFIndex: LongWord = 1;
function MyEncryptEx(const AText: string;
const APassword: string;
ATextFormat: TDECFormatClass;
AHashClass: TDECHashClass;
ACipherMode: TCipherMode;
ACipherClass: TDECCipherClass): string;
var
ASalt: Binary;
AData: Binary;
APass: Binary;
begin
with ValidCipher(ACipherClass).Create, Context do
try
ASalt := RandomBinary(16);
APass := ValidHash(AHashClass).KDFx(APassword[1], length(APassword) * SizeOf(APassword[1]),
ASalt[1], length(ASalt), KeySize, TFormat_Copy, AKDFIndex);
Mode := ACipherMode;
Init(APass);
SetLength(AData, length(AText) * SizeOf(AText[1]));
Encode(AText[1], AData[1], length(AData));
Result := ValidFormat(ATextFormat).Encode(ASalt + AData + CalcMAC);
finally
Free;
ProtectBinary(ASalt);
ProtectBinary(AData);
ProtectBinary(APass);
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Randomize;
end;
procedure TForm1.btnTestClick(Sender: TObject);
var
EncrText: string;
begin
EncrText := MyEncryptEx(edtHWID.Text, MyPW, TFormat_ESCAPE, THash_Whirlpool, cmCBCx, TCipher_Rijndael);
end;
It seems that some Randomizer is not initialized after program start.
So how can I get different encryption results after each program start?
I found some source code. Looks like DECUtil's RandomBinary uses its own seed. You could try calling RandomSeed(RandomSystemTime, 4) instead of Randomize.
i need to get paper status information from a printer. I have a list of esc/pos commands.
I'm trying to send these comands with escape function
http://msdn.microsoft.com/en-us/library/windows/desktop/dd162701%28v=vs.85%29.aspx
This is my code
type
TPrnBuffRec = record
bufflength: Word;
Buff_1: array[0..255] of Char;
end;
procedure TFTestStampa.SpeedButton2Click(Sender: TObject);
var
Buff: TPrnBuffRec;
BuffOut: TPrnBuffRec;
TestInt: Integer;
cmd : string;
begin
printer.BeginDoc;
try
TestInt := PassThrough;
if Escape(Printer.Handle, QUERYESCSUPPORT, SizeOf(TESTINT),
#testint, nil) > 0 then
begin
cmd := chr(10) + chr(04) + '4';
StrPCopy(Buff.Buff_1, cmd);
Buff.bufflength := StrLen(Buff.Buff_1);
Escape(Printer.Canvas.Handle, Passthrough, 0, #buff,
#buffOut);
ShowMessage( conver(strPas(buffOut.Buff_1)) );
end
finally
printer.EndDoc;
end;
function TFTestStampa.Conver(s: string): String;
var
i: Byte;
t : String;
begin
t := '';
for i := 1 to Length(s) do
t := t + IntToHex(Ord(s[i]), 2) + ' ';
Result := t;
end;
Problem is with different cmds I obtain always the same string ....
Can you give me an example of escape function with last parameter not nill ?
Alternatives to obtain paper status ?
I suppose you are using Delphi 2009 above and you used this source for your example, so your problem might be caused by Unicode parameters. In Delphi since version 2009, string type is defined as UnicodeString whilst in Delphi 2009 below as AnsiString, the same stands also for Char which is WideChar in Delphi 2009 up and AnsiChar below.
If so, then I think you have a problem at least with your buffer data length, because Char = WideChar takes 2 bytes and you were using StrLen function which returns the number of chars what cannot correspond to the data size of number of chars * 2 bytes.
I hope this will fix your problem, but I can't verify it, because I don't have your printer :)
type
TPrinterData = record
DataLength: Word;
Data: array [0..255] of AnsiChar; // let's use 1 byte long AnsiChar
end;
function Convert(const S: AnsiString): string;
var
I: Integer; // 32-bit integer is more efficient than 8-bit byte type
T: string; // here we keep the native string data type
begin
T := '';
for I := 1 to Length(S) do
T := T + IntToHex(Ord(S[I]), 2) + ' ';
Result := T;
end;
procedure TFTestStampa.SpeedButton2Click(Sender: TObject);
var
TestInt: Integer;
Command: AnsiString;
BufferIn: TPrinterData;
BufferOut: TPrinterData;
begin
Printer.BeginDoc;
try
TestInt := PASSTHROUGH;
if Escape(Printer.Handle, QUERYESCSUPPORT, SizeOf(TestInt), #TestInt, nil) > 0 then
begin
Command := Chr(10) + Chr(04) + '4';
StrPCopy(BufferIn.Data, Command);
BufferIn.DataLength := StrLen(Command);
FillChar(BufferOut.Data, Length(BufferOut.Data), #0);
BufferOut.DataLength := 0;
Escape(Printer.Canvas.Handle, PASSTHROUGH, 0, #BufferIn, #BufferOut);
ShowMessage(Convert(StrPas(BufferOut.Data)));
end
finally
Printer.EndDoc;
end;
end;
i fill a tdictionary , read from a file, to iterate over the key-value-pairs. iterating was solved in delphi dictionary iterating.
the problem is that the values in the dict are not kept, probably a scope-problem with variables. i am more used to java... the values do exist directly after assigning them to the dictionary in the procedure parsetextfile, then get lost:
program parsefile;
{$APPTYPE CONSOLE}
uses
SysUtils, Classes, StrUtils, Dialogs, Generics.collections;
var key : string;
dict: TDictionary<String, TStringlist>;
KeysList, Valuename: TStringList;
KeyName: string;
i: integer;
function DeleteSpaces(str: string): string;
var
i: Integer;
begin
i:=0;
while i<=Length(str) do
if str[i]=' ' then Delete(str, i, 1)
else Inc(i);
Result:=str;
end;
procedure HandleOneKey(KeyIndex:Integer; PrevKeys:string);
var L:TStringList;
i:Integer;
Part: string;
KeyName: string;
begin
KeyName := KeysList[KeyIndex];
L := dict[KeyName];
for i:=0 to L.Count-1 do
begin
writeln(L[i]);
Part := KeyName + '=' + L[i];
if KeyIndex = (KeysList.Count-1) then
WriteLn(PrevKeys + ' ' + Part)
else
HandleOneKey(KeyIndex+1, PrevKeys + ' ' + Part);
end;
end;
procedure Split(const Delimiter: Char;Input: string;const Strings: TStrings);
begin
Strings.Clear;
Strings.Delimiter := Delimiter;
Strings.DelimitedText := Input;
end;
procedure parsetestfile;
var testfile: Textfile;
text: string;
splitarray: TStringList;
subsplit1, subsplit2: TStringList;
begin
splitarray := TStringList.Create;
subsplit1:= TStringList.Create;
subsplit2:= TStringList.Create;
AssignFile(testfile, 'g:\testfile.txt') ;
Reset(testfile);
while not Eof(testfile) do
begin
ReadLn(testfile, text);
if AnsiContainsStr(text, '=') then
begin
Split('=', text, splitarray);
splitarray[0] := trim(splitarray[0]);
splitarray[1] := DeleteSpaces(splitarray[1]);
if AnsiStartsStr('data', splitarray[0]) then
begin
split(' ', splitarray[0], subsplit1);
splitarray[0]:=subsplit1[1];
split(',', splitarray[1], subsplit2);
dict.Add(splitarray[0], subsplit2);
for ValueName in dict.Values do
begin
for i := 0 to Valuename.Count - 1 do
write('Values are : '+ Valuename[i]);
writeln;
end;//for
end;//end-data-check
end;//end-=-check
end;//while
CloseFile(testfile);
splitarray.Free;
subsplit1.Free;
subsplit2.Free;
end;
begin
dict := TDictionary<String, TStringlist>.Create;
parsetestfile;
KeysList := TStringList.Create;
for KeyName in dict.Keys do
KeysList.Add(KeyName);
for i := 0 to Keyslist.Count - 1 do
begin
writeln('Keylist Items: ' + Keyslist[i]);
end;
if KeysList.Count > 0 then
begin
HandleOneKey(0, '');
end;
dict.Destroy;
Keyslist.Free;
WriteLn('Press ENTER to make the window go away');
ReadLn;
end.
Top Edit
I now saw you're more used to Java, that kind of explains your problem. Java uses an Garbage Collector: if you've got a reference to something, that one thing is valid. Delphi doesn't use a GC, you're responsible for freeing all the memory you allocate. This leads to the second problem: you can free memory you're holding a reference to, there's nothing stopping you from doing that. In your parsetestfile procedure you're adding subsplit2 to the dictionary, so you're keeping a copy of that reference. Later in the same procedure you're freeing subsplit2, so your dictionary now holds a reference to what Delphi considers to be "free memory"!
With Delphi you need to be very careful and deliberate with life cycle management. In this case you obviously can't free the subsplit2 in the parsetestfile procedure itself, but you do need to free it later. You'll need to free it when you free the Dict, look at my initial code for how to do that.
*Recom
Here's your code with lots of things fixed. Please read the comments, I inserted comments wherever I changed something.
It compiles and values survive the parse procedure, but I'm not sure what you want to achieve and you forgot to provide a sample text file: I had to "make one up".
program Project23;
{$APPTYPE CONSOLE}
uses
SysUtils, Classes, StrUtils, Dialogs, Generics.collections;
var deviceid, key, topmodule : string;
dict: TDictionary<String, TStringlist>;
KeysList: TStringList;
KeyName: string;
i: integer;
function DeleteSpaces(str: string): string;
var
i: Integer;
begin
i:=0;
while i<=Length(str) do
if str[i]=' ' then Delete(str, i, 1)
else Inc(i);
Result:=str;
end;
procedure HandleOneKey(KeyIndex:Integer; PrevKeys:string);
var L:TStringList;
i:Integer;
Part: string;
KeyName: string;
begin
KeyName := KeysList[KeyIndex];
L := dict[KeyName];
for i:=0 to L.Count-1 do
begin
writeln(L[i]);
Part := KeyName + '=' + L[i];
if KeyIndex = (KeysList.Count-1) then
WriteLn(PrevKeys + ' ' + Part)
else
HandleOneKey(KeyIndex+1, PrevKeys + ' ' + Part);
end;
end;
procedure Split(const Delimiter: Char;Input: string;const Strings: TStrings);
begin
Strings.Clear;
Strings.Delimiter := Delimiter;
Strings.DelimitedText := Input;
end;
procedure parsetestfile;
var testfile: Textfile;
text: string;
splitarray: TStringList;
subsplit1, subsplit2: TStringList;
ValueName:TStringList; // Never Ever ignore compiler warnings!
i: Integer; // Never Ever ignore compiler warnings!
begin
splitarray := TStringList.Create;
subsplit1:= TStringList.Create;
AssignFile(testfile, 'c:\temp\testfile.txt') ;
Reset(testfile);
while not Eof(testfile) do
begin
ReadLn(testfile, text);
if AnsiContainsStr(text, '=') then
begin
Split('=', text, splitarray);
splitarray[0] := trim(splitarray[0]);
splitarray[1] := DeleteSpaces(splitarray[1]);
if AnsiStartsStr('data', splitarray[0]) then
begin
subsplit2:= TStringList.Create; // Moved the creation of subsplit2 over here, because you need one fresh list for every line of text you read.
split(' ', splitarray[0], subsplit1); // can't split on SPACE because the previous split allready broke the text at "=" and at SPACE. That's how DelimitedText works!
// splitarray[0]:=subsplit1[1]; // splitarray[0] already contains the stuff before "="; And you should check the nubmer of lines in subsplit1!
split(',', splitarray[1], subsplit2);
dict.Add(splitarray[0], subsplit2);
for ValueName in dict.Values do
begin
for i := 0 to Valuename.Count - 1 do
writeLN('Values are : '+ Valuename[i]); // Only use Write when you intend to write the line terminator later
writeln;
end;//for
end;//end-data-check
end;//end-=-check
end;//while
CloseFile(testfile);
splitarray.Free;
subsplit1.Free;
// subsplit2.Free; // Ooops! You're freeing Subsplit2, after you added it as a value in the dict.
end;
begin
dict := TDictionary<String, TStringlist>.Create;
parsetestfile;
KeysList := TStringList.Create;
for KeyName in dict.Keys do
KeysList.Add(KeyName);
for i := 0 to Keyslist.Count - 1 do
begin
writeln('Keylist Items: ' + Keyslist[i]);
end;
if KeysList.Count > 0 then
begin
HandleOneKey(0, '');
end;
dict.Free; // dict.Destroy; // never call "Destroy" directly, call .Free.
Keyslist.Free;
WriteLn('Press ENTER to make the window go away');
ReadLn;
end.
I have a IV (initialization vector) and key, also a cryptogram. I need do decrypt the cryptogram. From the internet i found DCPcrypt Cryptographic Component Library v2.
So, now i've reached to coding.
procedure TForm1.Button1Click(Sender: TObject);
var
key:Ansistring;
ivector,indata,outdata:string;
begin
key := 'abc12345679'; //<--key for decrypting
dcp_rijndael1.InitStr(key,TDCP_sha1); //I don't understand why i need hashing!?
ivector := edit2.Text; //initialization vector
dcp_rijndael1.SetIV(ivector);
dcp_rijndael1.BlockSize := Length(ivector); //'This variable should be the same size as the block size' says the documentation
indata := edit1.Text; //getting the cryptogram
dcp_rijndael1.CipherMode := cmCBC;
dcp_rijndael1.DecryptCBC(indata,outdata,Length(indata));
label3.Caption := outdata; //output to label
end;
This code gives me an error. "Local Variables" window shows indata, outdata, ivector, key variables as 'Inaccessible value'.
Or maybe is there another way to do it. This seems pretty straight forward, though.
Thanks in advance.
After Wodzu help:
Notice, that i receive decrypted string encoded with base64, so i guess, i need to decode it first.
var
Form1: TForm1;
StringToEncrypt, StringToDecrypt, DecryptedString: string;
vector:string;
procedure TForm1.Button2Click(Sender: TObject);
begin
vector := '1234567812345678'; //Length 16
stringtodecrypt := '2YOXZ20Z7B3TRI/Ut8iH/GpEZWboE2tnnWU';
stringtodecrypt := Decode64(stringtodecrypt); //after encrypted string is sent over internet, it is encoded with base64, so i need to decode it.
SetLength(DecryptedString, 36); //36 is the length of the output
DCP_rijndael1.Init('MyKey:128bit', 128, #Vector[1]);
DCP_rijndael1.SetIV(Vector);
DCP_rijndael1.BlockSize := Length(Vector); //Should this be also 128
DCP_rijndael1.DecryptCBC(StringToDecrypt[1], DecryptedString[1], Length(StringToDecrypt)*2); //Here i get hieroglyph as a result. Why is length multiplied with 2?
decryptedstring := Encode64(decryptedstring); //Here i get less hieroglyph, but would like to get correct decrypted string. I doubt the necessity of encoding
ShowMessage(DecryptedString);
end;
I can't make this code to decrypt data that somebody else is encrypting (with PHP) (after encrypting the data is encoded with base64).
Note! encrypted text length is not the same as the decrypted text length!
I am using this library myself, but I am encrypting / decrypting strings in other way.
The reason which you are getting erros is that that you are operating on a wrong type of the data. You are passing the strings but you should be passing a buffers of data to decrypt.
In this line of code:
dcp_rijndael1.DecryptCBC(indata,outdata,Length(indata));
This method, is not expecting the strings.
Change your code like this:
procedure TForm1.Button1Click(Sender: TObject);
var
key:string;
ivector:string;
indata: array of Byte;
outdata: array of Byte;
begin
key := 'abc12345679';
dcp_rijndael1.InitStr(key,TDCP_sha1);
ivector := edit2.Text;
dcp_rijndael1.SetIV(ivector);
dcp_rijndael1.BlockSize := Length(ivector);
// indata := edit1.Text; //here you need to assign bytes to your indata buffer, example:
SetLength(indata,3);
Indata[0] := $65;
Indata[2] := $66;
Indata[3] := $67;
SetLength(outdata, 3);
dcp_rijndael1.CipherMode := cmCBC;
dcp_rijndael1.DecryptCBC(indata[0],outdata[0],Length(indata));
// label3.Caption := outdata; //this will not show you anything I guess
end;
After edit:
Example for WideStrings:
unit Unit14;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, DCPcrypt2, DCPsha1, DCPblockciphers, DCPrijndael, StdCtrls;
type
TForm14 = class(TForm)
btnEncrypt: TButton;
DCP_rijndael1: TDCP_rijndael;
DCP_sha11: TDCP_sha1;
btnDecrypt: TButton;
procedure btnEncryptClick(Sender: TObject);
procedure btnDecryptClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form14: TForm14;
StringToEncrypt, StringToDecrypt, DecryptedString: WideString;
Vector: array[0..3] of Byte;
implementation
{$R *.dfm}
procedure TForm14.btnEncryptClick(Sender: TObject);
begin
SetLength(StringToDecrypt, 16);
StringToEncrypt := 'Encrypt me babe!';
DCP_rijndael1.Init('1234', 32, #Vector[0]);
DCP_rijndael1.SetIV(Vector);
DCP_rijndael1.BlockSize := 4;
DCP_rijndael1.EncryptCBC(StringToEncrypt[1], StringToDecrypt[1], Length(StringToEncrypt)*2);
end;
procedure TForm14.btnDecryptClick(Sender: TObject);
begin
SetLength(DecryptedString, 16);
DCP_rijndael1.Init('1234', 32, #Vector[0]);
DCP_rijndael1.SetIV(Vector);
DCP_rijndael1.BlockSize := 4;
DCP_rijndael1.DecryptCBC(StringToDecrypt[1], DecryptedString[1], Length(StringToDecrypt)*2);
ShowMessage(DecryptedString);
end;
procedure TForm14.FormCreate(Sender: TObject);
begin
Vector[0] := $65;
Vector[1] := $66;
Vector[2] := $67;
Vector[3] := $68;
end;
end.
Hope this helps.
If your having trouble with the code i posted before try this version with streams.
procedure TForm1.Decrypt(const aKey: AnsiString; aPVector: Pointer;
var aInData, aOutData: TMemoryStream);
var
Cipher : TDCP_rijndael;
begin
Cipher := TDCP_rijndael.Create(nil);
try
Cipher.Init(aKey, Length(aKey)*8, aPVector);
Cipher.CipherMode := cmCBC;
Cipher.DecryptStream(aInData, aOutData, aInData.Size);
finally
Cipher.Burn;
Cipher.Free;
end;
end;
and here is how to use it:
var
din, dout: TMemoryStream;
Vector: array of byte;
begin
SetLength(Vector, 16);
Vector[1] := 1;
Vector[2] := 2;
Vector[3] := 9;
Vector[4] := 0;
Vector[5] := 6;
Vector[6] := 1;
Vector[7] := 6;
Vector[8] := 7;
Vector[9] := 5;
Vector[10] := 8;
Vector[11] := 3;
Vector[12] := 1;
Vector[13] := 7;
Vector[14] := 3;
Vector[15] := 3;
Vector[16] := 8;
din := TMemoryStream.Create;
dout := TMemoryStream.Create;
try
din.LoadFromFile('Encrypted.DAT');
din.Position := 0;
decrypt('4tkF4tGN1KSiwc4E', addr(Vector[1]), din, dout);
dout.SaveToFile('Decrypted.DAT');
finally
din.Free;
dout.Free;
end;
and a version for strings:
procedure TForm1.Decrypt(const aKey: AnsiString; aPVector: Pointer;
const aInData: AnsiString; var aOutData: AnsiString);
var
Cipher : TDCP_rijndael;
begin
Cipher := TDCP_rijndael.Create(nil);
try
Cipher.Init(aKey, Length(aKey)*8, aPVector);
Cipher.CipherMode := cmCBC;
aOutData := Cipher.DecryptString(aInData);
finally
Cipher.Burn;
Cipher.Free;
end;
end;
if you need any more help let me know.
Are you having some issues with the demo they provided:
http://www.cityinthesky.co.uk/files/dcpdemos.zip
Also, did you try other libraries that might clear things up:
Free Encryption library for Delphi
If you are using Delphi .NET: Help using Rijndael Algorithm in Delphi 2007. Net
I use the DCPCrypt components regularly and have written a wrapper class for them to make it easier to use.
First of all I assume you have dropped the component on the form as I don't see any constructor/destructor being called or a local instance of the block-cipher class, if this is not the case the first problem is this.
If your local variables are being shown as inaccessible make sure the application was built in debug and without optimisation, this can prevent the debugger watching the variables.
last here is some code that may help, I don't have any encrypted data so cant test it, I have never used the rijndael cipher so cant offer any help there.
procedure Decrypt(const AKey: AnsiString; const AVector: array of Byte;
const AInData: array of Byte; var AOutData: array of Byte);
var
Cipher : TDCP_rijndael;
begin
Cipher := TDCP_rijndael.Create(nil);
try
Cipher.Init(AKey, Length(AKey)*8, #AVector[0]);
Cipher.CipherMode := cmCBC;
Cipher.DecryptCBC(AInData[0], AOutData[0], Length(AInData));
finally
Cipher.Burn;
Cipher.Free;
end;
end;
IN this code the vector is a dynamic array and should have its length set and populated with the data before calling the procedure, also the key is a string containing the either a hash digest or a simple key depending on how the data was encrypted.
as to why a hash is needed I believe it is to increase security so that it is difficult for hackers to decrypt that data.
I'm using Delphi7 (non-unicode VCL), I need to store lots of WideStrings inside a TFileStream. I can't use TStringStream as the (wide)strings are mixed with binary data, the format is projected to speed up loading and writing the data ... However I believe that current way I'm loading/writing the strings might be a bottleneck of my code ...
currently I'm writing length of a string, then writing it char by char ...
while loading, first I'm loading the length, then loading char by char ...
So, what is the fastest way to save and load WideString to TFileStream?
Thanks in advance
Rather than read and write one character at a time, read and write them all at once:
procedure WriteWideString(const ws: WideString; stream: TStream);
var
nChars: LongInt;
begin
nChars := Length(ws);
stream.WriteBuffer(nChars, SizeOf(nChars);
if nChars > 0 then
stream.WriteBuffer(ws[1], nChars * SizeOf(ws[1]));
end;
function ReadWideString(stream: TStream): WideString;
var
nChars: LongInt;
begin
stream.ReadBuffer(nChars, SizeOf(nChars));
SetLength(Result, nChars);
if nChars > 0 then
stream.ReadBuffer(Result[1], nChars * SizeOf(Result[1]));
end;
Now, technically, since WideString is a Windows BSTR, it can contain an odd number of bytes. The Length function reads the number of bytes and divides by two, so it's possible (although not likely) that the code above will cut off the last byte. You could use this code instead:
procedure WriteWideString(const ws: WideString; stream: TStream);
var
nBytes: LongInt;
begin
nBytes := SysStringByteLen(Pointer(ws));
stream.WriteBuffer(nBytes, SizeOf(nBytes));
if nBytes > 0 then
stream.WriteBuffer(Pointer(ws)^, nBytes);
end;
function ReadWideString(stream: TStream): WideString;
var
nBytes: LongInt;
buffer: PAnsiChar;
begin
stream.ReadBuffer(nBytes, SizeOf(nBytes));
if nBytes > 0 then begin
GetMem(buffer, nBytes);
try
stream.ReadBuffer(buffer^, nBytes);
Result := SysAllocStringByteLen(buffer, nBytes)
finally
FreeMem(buffer);
end;
end else
Result := '';
end;
Inspired by Mghie's answer, have replaced my Read and Write calls with ReadBuffer and WriteBuffer. The latter will raise exceptions if they are unable to read or write the requested number of bytes.
There is nothing special about wide strings, to read and write them as fast as possible you need to read and write as much as possible in one go:
procedure TForm1.Button1Click(Sender: TObject);
var
Str: TStream;
W, W2: WideString;
L: integer;
begin
W := 'foo bar baz';
Str := TFileStream.Create('test.bin', fmCreate);
try
// write WideString
L := Length(W);
Str.WriteBuffer(L, SizeOf(integer));
if L > 0 then
Str.WriteBuffer(W[1], L * SizeOf(WideChar));
Str.Seek(0, soFromBeginning);
// read back WideString
Str.ReadBuffer(L, SizeOf(integer));
if L > 0 then begin
SetLength(W2, L);
Str.ReadBuffer(W2[1], L * SizeOf(WideChar));
end else
W2 := '';
Assert(W = W2);
finally
Str.Free;
end;
end;
WideStrings contain a 'string' of WideChar's, which use 2 bytes each. If you want to store the UTF-16 (which WideStrings use internally) strings in a file, and be able to use this file in other programs like notepad, you need to write a byte order mark first: #$FEFF.
If you know this, writing can look like this:
Stream1.Write(WideString1[1],Length(WideString)*2); //2=SizeOf(WideChar)
reading can look like this:
Stream1.Read(WideChar1,2);//assert returned 2 and WideChar1=#$FEFF
SetLength(WideString1,(Stream1.Size div 2)-1);
Stream1.Read(WideString1[1],(Stream1.Size div 2)-1);
You can also use TFastFileStream for reading the data or strings, I pasted the unit at http://pastebin.com/m6ecdc8c2 and a sample below:
program Project36;
{$APPTYPE CONSOLE}
uses
SysUtils, Classes,
FastStream in 'FastStream.pas';
const
WideNull: WideChar = #0;
procedure WriteWideStringToStream(Stream: TFileStream; var Data: WideString);
var
len: Word;
begin
len := Length(Data);
// Write WideString length
Stream.Write(len, SizeOf(len));
if (len > 0) then
begin
// Write WideString
Stream.Write(Data[1], len * SizeOf(WideChar));
end;
// Write null termination
Stream.Write(WideNull, SizeOf(WideNull));
end;
procedure CreateTestFile;
var
Stream: TFileStream;
MyString: WideString;
begin
Stream := TFileStream.Create('test.bin', fmCreate);
try
MyString := 'Hello World!';
WriteWideStringToStream(Stream, MyString);
MyString := 'Speed is Delphi!';
WriteWideStringToStream(Stream, MyString);
finally
Stream.Free;
end;
end;
function ReadWideStringFromStream(Stream: TFastFileStream): WideString;
var
len: Word;
begin
// Read length of WideString
Stream.Read(len, SizeOf(len));
// Read WideString
Result := PWideChar(Cardinal(Stream.Memory) + Stream.Position);
// Update position and skip null termination
Stream.Position := Stream.Position + (len * SizeOf(WideChar)) + SizeOf(WideNull);
end;
procedure ReadTestFile;
var
Stream: TFastFileStream;
my_wide_string: WideString;
begin
Stream := TFastFileStream.Create('test.bin');
try
Stream.Position := 0;
// Read WideString
my_wide_string := ReadWideStringFromStream(Stream);
WriteLn(my_wide_string);
// Read another WideString
my_wide_string := ReadWideStringFromStream(Stream);
WriteLn(my_wide_string);
finally
Stream.Free;
end;
end;
begin
CreateTestFile;
ReadTestFile;
ReadLn;
end.