How to hash using DCPcrypt? - delphi

I have scowered the net trying to find an example of a function, how to hash text with Sha1 and DCPcrypt.
I have the below example. Seems to pop up the whole time.
But it returns chinese characters every time. Please assist in corecting the function.
function TForm1.EncryptThis(aString : string) : string;
var
Cipher: TDCP_cast256;
KeyStr: string;
begin
KeyStr:= '';
Cipher:= TDCP_cast256.Create(Self);
Cipher.InitStr(KeyStr,TDCP_sha1);
result := Cipher.EncryptString(aString);
Cipher.Burn;
Cipher.Free;
end;
UPDATE:
Using the links and info belowe, I built these functions. But as I said, This does not make alot of sense to me. So please excuse the ignorance.
THe code however does not work. Its output is: 3F3F3F3F3F3F3F3F3F3F00000000000000000000 whereas it should be 40bd001563085fc35165329ea1ff5c5ecbdbbeef since i told the program to has 123.
Please help.
function CalcDigest(text: string): string;
var
x: TDCP_hash;
begin
x := TDCP_sha1.Create(nil);
try
x.Init;
x.UpdateStr(text);
SetLength(Result, x.GetHashSize div 8);
x.Final(Result[1]);
finally
x.Free;
end;
end;
function String2Hex(const Buffer: Ansistring): string;
begin
SetLength(result, 2*Length(Buffer));
BinToHex(#Buffer[1], PWideChar(#result[1]), Length(Buffer));
end;
procedure TForm1.Button1Click(Sender: TObject);
var
I: Integer;
begin
memo2.Lines.Add(String2Hex(CalcDigest(memo1.Lines.Strings[0])));
end;

Judging by this, you can do it this way:
function CalcDigest(text: string): string;
var
x: TDCP_hash;
begin
x := TDCP_sha1.Create(nil);
try
x.Init;
x.UpdateStr(text);
SetLength(Result, x.GetHashSize div 8);
x.Final(Result[1]);
finally
x.Free;
end;
end;
You may want to encode the hash before printing, because the output is binary. See for example this question.

I am not very familiar with DCPCrypt. You can also use other libraries.
1) Indy - usually included in Delphi
function SHA1Text(const s: string): string;
begin
with TIdHashSHA1.Create do
try
Result:=LowerCase(HashStringAsHex(s));
finally
Free;
end;
end;
2) Wolfgang Ehrhardt's libraries (fastest as far as I know) from
http://www.wolfgang-ehrhardt.de/crchash_en.html
function SHA1Text(const s: string): string;
var
Context: THashContext;
SHA1Digest: TSHA1Digest;
begin
SHA1Init(Context);
SHA1Update(Context, pChar(s), length(s));
SHA1Final(Context, SHA1Digest);
Result:=HexStr(#SHA1Digest, SizeOf(SHA1Digest));
end;
NOTE: it is from Delphi 7. You will need to update it if you use unicode Delphi.

Related

TClientDataSet Custom compare field function

I am using an in-memory TClientDataSet with a TStringField column which contains folders path (Delphi 7).
When I create an index on this column the order is not what I am looking for.
As an example I get :
c:\foo
c:\fôo\a
c:\foo\b
when I would like this order :
c:\foo
c:\foo\b
c:\fôo\a
So I searched a way to use my own compare field function.
Based on this RRUZ answer How to change the implementation (detour) of an externally declared function I tried the following :
type
TClientDataSetHelper = class(DBClient.TClientDataSet);
...
MyCDS : TClientDataSet;
...
// My custom compare field function
function FldCmpHack
(
iFldType : LongWord;
pFld1 : Pointer;
pFld2 : Pointer;
iUnits1 : LongWord;
iUnits2 : LongWord
): Integer; stdcall;
begin
// Just to test
Result := -1;
end;
...
---RRUZ code here---
...
procedure HookDataCompare;
begin
HookProc
(
(MyCDs as TClientDataSetHelper).DSBase.FldCmp, <== do not compile !!!
#FldCmpHack,
FldCmpBackup
);
end;
When I try to compile I get an error (MyCDs as TClientDataSetHelper).DSBase.FldCmp : not enough actual parameters
I do not understand why this does not compile. Could you please help me ?
Is it even possible to "detour" IDSBase.FldCmp in DSIntf.pas ? Am i totally wrong ?
Thank you
EDIT
Finally, thanks to Dsm answer, I transformed the TStringFieldcolumn into a TVarBytesField in order to avoid doubling the buffer. Plus, when a TVarBytesField is indexed the order is based on the bytes value so I get the order I want. For having all child folders after a parent folder and before the next parent folder (c:\foo.new after c:\foo\b), I patched TVarBytesFieldlike this :
TVarBytesField = class(DB.TVarBytesField)
protected
function GetAsString: string; override;
procedure GetText(var Text: string; DisplayText: Boolean); override;
procedure SetAsString(const Value: string); override;
end;
function TVarBytesField.GetAsString: string;
var
vBuffer : PAnsiChar;
vTaille : WORD;
vTexte : PAnsiChar;
vI : WORD;
begin
Result := '';
GetMem(vBuffer, DataSize);
try
if GetData(vBuffer) then
begin
vTaille := PWORD(vBuffer)^;
vTexte := vBuffer + 2;
SetLength(Result, vTaille);
for vI := 1 to vTaille do
begin
if vTexte^ = #2 then
begin
Result[vI] := '\';
end
else
begin
Result[vI] := vTexte^;
end;
Inc(vTexte);
end;
end;
finally
FreeMem(vBuffer);
end;
end;
procedure TVarBytesField.GetText(var Text: string; DisplayText: Boolean);
begin
Text := GetAsString;
end;
procedure TVarBytesField.SetAsString(const Value: string);
var
vBuffer : PAnsiChar;
vTaille : WORD;
vTexte : PAnsiChar;
vI : WORD;
begin
vBuffer := AllocMem(DataSize);
try
vTaille := WORD(Length(Value));
PWORD(vBuffer)^ := vTaille;
vTexte := vBuffer + 2;
for vI := 1 to vTaille do
begin
if Value[vI] = '\' then
begin
vTexte^ := #2
end
else
begin
vTexte^ := Value[vI];
end;
Inc(vTexte);
end;
SetData(vBuffer);
finally
FreeMem(vBuffer);
end;
end;
The message is telling you that FldCmp is a function, and it is expecting you to execute it, but it has not got enough parameters. I am sure that you already realised that and probably already tried to get the address of the function with the # (like you do for FldCmpHack) and found that that does not work.
The reason for that is, I am afraid, that FldCmp is not a normal function. DSBase is actually an interface, which will have been assigned (looking at the source code) by a class factory. What you actually need is the real function itself and for that you need the real object that the class factory creates. And I am sorry, but I can't see any realistic way of doing that.
However, the DSBase field is only created if it has not been assigned, so you could, in theory, create your own IDSBase interface object, which is the way this type of problem is meant to be handled. That is a lot of work, though, unless you know class that the class factory produces and can descend from that.
A sneakier alternative is to override the Translate property and create some sort of hash (perhaps by translating the ASCII codes to their HEX values) so that the database keeps them in the right order
TClientDataSetHelper = class(TClientDataSet)
public
function Translate(Src, Dest: PAnsiChar; ToOem: Boolean): Integer; override;
end;

sha1 checksum in delphi

I have the following code written in delphi.
with TIdHashMessageDigest5.Create do begin
st2.Position := 0;
Digest := HashValue( st2 );
SetLength( Hash, 16 );
Move( Digest, Hash[1], 16);
Free;
end;
I need to convert that to use SHA1 hash. I couldn't find SHA1 type in the library. Can anyone help? I have looked for help on the internet but couldn't find any.
See here:
https://sergworks.wordpress.com/2014/10/25/high-performance-hash-library/
SHA1 hashing in Delphi XE
https://sourceforge.net/projects/sha1implementat/
http://www.colorfultyping.com/generating-a-sha-1-checksum-for-a-given-class-type/
BTW, you didn't mention your Delphi version. If you are using a modern version (XE onwards), I suppose that its standard libraries should support SHA-1, MD5, etc.
You could do it like this:
uses IdHashSHA;
function SHA1FromString(const AString: string): string;
var
SHA1: TIdHashSHA1;
begin
SHA1 := TIdHashSHA1.Create;
try
Result := SHA1.HashStringAsHex(AString);
finally
SHA1.Free;
end;
end;
Just in case, in latest Delphi versions You can try:
uses
System.Hash;
...
function getHashCode(const s : string) : string;
begin
Result := THashSHA1.GetHashString(s);
end;
You appear to be using Indy 9, which does not support SHA1. SHA1 (and a few other hashes, including several other SHAs) was added in Indy 10. The interface for TIdHash was also re-written in Indy 10. Amongst other changes, the HashValue() method was replaced with new Hash...() and Hash...AsHex() methods (HashString(AsHex), HashStream(AsHex), HashBytes(AsHex)), eg:
uses
..., IdHash, IdHashMessageDigest;
var
Hash: TIdBytes;
begin
with TIdHashMessageDigest5.Create do
try
st2.Position := 0;
Hash := HashStream( st2 );
finally
Free;
end;
// use Hash as needed...
end;
uses
..., IdHash, IdHashSHA;
var
Hash: TIdBytes;
begin
with TIdHashSHA1.Create do
try
st2.Position := 0;
Hash := HashStream( st2 );
finally
Free;
end;
// use Hash as needed...
end;
Two more options:
http://www.spring4d.org
unit Spring.Cryptography.SHA;
TSHA1 = class(THashAlgorithmBase, ISHA1)
http://lockbox.seanbdurkin.id.au/HomePage
unit LbProc;
procedure StreamHashSHA1(var Digest : TSHA1Digest; AStream : TStream);
procedure FileHashSHA1(var Digest : TSHA1Digest; const AFileName : string);
In older versions also (tested in maXbox4):
function SHA1FromFile(const filename: string): string;
var SHA1: TIdHashSHA1;
fs: TFileStream;
begin
SHA1:= TIdHashSHA1.Create;
fs:= TFileStream.Create(fileName, fmOpenRead or fmShareDenyWrite);
try
result:= SHA1.AsHex(SHA1.hashvalue1((fs),0,fs.size));
finally
SHA1.Free;
fs.Free;
end;
end;

Delphi, How to use BEncode to get info_hash?

I want to get info_hash of *.torrent file using Delphi.
Tried this BEncode decorder.
But it gives crazy characters when decode.
Any other working BEncode decoder in Delphi? Or anything I'm doing wrong?
This is my code:
procedure TForm.Button1Click(Sender: TObject);
var
be: TBEncoded;
fs: tfilestream;
op: string;
begin
fs := tfilestream.Create('xx.torrent', fmOpenReadWrite);
be := TBEncoded.Create(fs);
be.Encode(be.ListData.Items[0].Data, op);
showmessage(op);
be.Encode(be.ListData.FindElement('info'), op);
showmessage(op);
end;
I've just tried this decoder, it's working normally. You didn't need to use Encode procedure, its purpose (as seen from name) is to encode elements back to BEncode. That's test program that shows torrent information in TMemo:
procedure ShowDecoded(be: TBEncoded; indent: string='');
var i: Integer;
begin
with form1.Memo1.Lines do
case be.Format of
befstring: Add(indent+be.StringData);
befInteger: Add(indent+IntToStr(be.IntegerData));
befList: begin
Add(indent+'list');
for i:=0 to be.ListData.Count-1 do
ShowDecoded(be.ListData.Items[i].Data as TBEncoded,indent+' ');
Add(indent+'end of list');
end;
befDictionary: begin
Add(indent+'dict');
for i:=0 to be.ListData.Count-1 do begin
Add(indent+' '+be.ListData.Items[i].Header+'=');
ShowDecoded(be.listData.Items[i].Data as TBEncoded,indent+' ');
end;
Add(indent+'end of dict');
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var fs: TFileStream;
be: TBEncoded;
i: Integer;
begin
if OpenDialog1.Execute then begin
fs:=TFileStream.Create(OpenDialog1.FileName,fmOpenRead);
try
be:=TBEncoded.Create(fs);
ShowDecoded(be);
be.Free;
finally
fs.Free;
end;
end;
end;
That's test result:
dict
created by=
uTorrent/3.4.3
creation date=
1439626950
encoding=
UTF-8
info=
dict
length=
1345178
name=
Алябьев А., Лист Ф. - Соловей - 1987.pdf
piece length=
16384
pieces=
)Lo.Î ’üXí»IÙçsáôt£ˆb›hŒˆ*Ð誺š¤/N7’`0âÓ†nË5&T€:V•Ìפ¯9¤Ý:¦J©Ï|Œ•A¥,¼R¯þ:H:X&…¢<¸º"2îV-vÀÖˆD†¨¬ß‰ƒ,ümjà?éÛoe¬r£{¨¾]•4òØžhô†›­¼AØBeJÕÌ4³·Œ‹¶ËAG— f„\pa
end of dict
end of dict
I'd make some changes to BEncode unit, there is mess in there: raising empty exceptions, unsafe cast: TBEncoded(object) instead of "object as TBEncoded",
checking for nil object before object.free, which is tautology, but in general it works.
Update 1
Simple code to take one of the fields, 'pieces' and show in hex.
procedure FindAndShowHash(be: TBEncoded);
var i: Integer;
s: string;
infoChunk, piecesChunk: TBencoded;
begin
s:='';
infoChunk:=be.ListData.FindElement('info') as TBencoded;
piecesChunk:=infoChunk.ListData.FindElement('pieces') as TBencoded;
for i:=1 to Length(piecesChunk.StringData) do
s:=s+IntToHex(Byte(piecesChunk.StringData[i]),2);
form1.Memo1.Lines.Add('Hash function:');
form1.Memo1.Lines.Add(s);
end;
As you see, we access StringData char by char and cast it as Byte. I just showed it in hex, of course you can use these bytes for further processing.
Beware: you'll get LOADS of hex values, this is not MD5 hash or any other hash of WHOLE torrent, it's sequence of hash functions for each piece of data, usually blocks of 1 or 2 MB.
UPDATE 2
This unit can be used in newer versions of Delphi, all you need to do is to replace ALL string variables in it from 'string' to 'ANSIstring', just with Ctrl+R - ':string' replace to ':ANSIstring'.
UPDATE 3
OK, finally I get it. Here is procedure which computes info_hash and shows it in hex, this requires newer version of Delphi. Also, add IdGlobal and IdHashSHA to 'uses' section.
procedure makeInfoHash(be: TBEncoded);
var SHA1: TIdHashSHA1;
s: string;
infoChunk: TBencoded;
infoEncoded: ANSIString;
bytes: TIdBytes;
begin
infoChunk:=be.ListData.FindElement('info') as TBencoded;
TBencoded.Encode(infoChunk,infoEncoded);
bytes:=RawToBytes(infoEncoded[1],Length(infoEncoded));
SHA1:=TIdHashSHA1.Create;
try
s:=SHA1.HashBytesAsHex(bytes);
finally
SHA1.Free;
end;
Form1.Memo1.Lines.Add(s);
end;
It gives correct info_hash, the same which is displayed in uTorrent, like this:
7D0487D3D99D9C27A7C09CDCBB2F2A8034D4F9BF
You must replace all string to ANSIstring in BENcode.pas, as said in update 2. Enjoy!

DEC encryption creates same results after each program start

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.

Writing a string to a TFileStream in Delphi 2010

I have Delphi 2007 code that looks like this:
procedure WriteString(Stream: TFileStream; var SourceBuffer: PChar; s: string);
begin
StrPCopy(SourceBuffer,s);
Stream.Write(SourceBuffer[0], StrLen(SourceBuffer));
end;
I call it like this:
var
SourceBuffer : PChar;
MyFile: TFileStream;
....
SourceBuffer := StrAlloc(1024);
MyFile := TFileStream.Create('MyFile.txt',fmCreate);
WriteString(MyFile,SourceBuffer,'Some Text');
....
This worked in Delphi 2007, but it gives me a lot of junk characters in Delphi 2010. I know this is due to unicode compliance issues, but I am not sure how to address the issue.
Here is what I've tried so far:
Change the data type of
SourceBuffer(and also the parameter
expected by WideString) to PWideChar
Every one of the suggestions listed
here
What am I doing wrong?
You don't need a separate buffer to write a string to a stream. Probably the simplest way to do it is to encode the string to UTF8, like so:
procedure TStreamEx.writeString(const data: string);
var
len: cardinal;
oString: UTF8String;
begin
oString := UTF8String(data);
len := length(oString);
self.WriteBuffer(len, 4);
if len > 0 then
self.WriteBuffer(oString[1], len);
end;
function TStreamEx.readString: string;
var
len: integer;
iString: UTF8String;
begin
self.readBuffer(len, 4);
if len > 0 then
begin
setLength(iString, len);
self.ReadBuffer(iString[1], len);
result := string(iString);
end;
end;
I've declared TStreamEx as a class helper for TStream, but it shouldn't be too difficult to rewrite these as a solo procedure and function like your example.
Delphi 2010 has a nice solution for this, documented here:
http://docwiki.embarcadero.com/CodeExamples/en/StreamStrRdWr_%28Delphi%29
var
Writer: TStreamWriter;
...
{ Create a new stream writer directly. }
Writer := TStreamWriter.Create('MyFile.txt', false, TEncoding.UTF8);
Writer.Write('Some Text');
{ Close and free the writer. }
Writer.Free();

Resources