Simple code to encrypt an .INI file string using a password
Asked Answered
A

5

10

I am looking for something more sophisticated than ROT13, but which does not require a library (preferablly not even a unit, just a drop in function).

I want to symetrically encrypt/decrypt a given string with a password provided by the user. However, the result has to be a string, in the sense that it I have to be able to store it in an .INI file.

Does anyone have a simple function to do this (delphi XE2)? Google is not my friend today.

Thanks in advance


[Update] / [Bounty] Just to make it clear (aplogies if it was not so originally), I don't want a hash. I have a list box where users can add/modiy/delete entries. I want to store those in an .INI file when the program closes and reload when it starts again. Anyone looking at the .INI file (for instance, opening it in Notepad) should not be able to read those strings.

I suppose that I could just stream the compnent as binary, but for eace of mind I would rather encrypt the strings using a user provided password. For the purpose of this applciation it does not matter if .INI file section names or keyte values are human readable, I just want to encrypt the data, giving me something list this when stored on disk:

[config]
numEntries=3

[listbox]
0=ywevdyuvewfcyuw
1=edw
2=hr4uifareiuf
Absorbing answered 19/1, 2013 at 7:3 Comment(11)
Why you no try MD5 or SHA ? What is your Delphi version ?Santanasantayana
Using RC4.pas you would by able to de/encrypt Streams as shown in this excerpt. Procedure LoadMemIniFileCrypted(INI: TMemInifile; const fn: String; Key: String); var s: String; sl: TStringList; st: TStringStream; RC4Reader: TRC4StreamReader; begin if not FileExists(fn) then Exit; sl := TStringList.Create; st := TStringStream.Create; try RC4Reader := TRC4StreamReader.Create(TFileStream.Create(fn, fmOpenRead or fmShareDenyWrite), Key);Cancan
I think password should be Hash not encrypt/decrypt. Do you have special work or usual ?Santanasantayana
1) Ini can store streams directly 2) what is your problem with units 3) whats your problem with librariesNoah
@SirRufo +1 1) can you tell me more? INI file is plain text, but I don't want it human readable 2) no problem, but I think in this case I am asking for a 10 line function 3) no problem if easy to install, but they can contain too much (e.g Jedi) and may not be easy to install. Points 2) and 3) were only made because I think this needs only a few lines of codeAbsorbing
@MahdiParsa What about storing a password for a external connection e.g. a database? You can't use a hashed passwordNoah
Ini and Stream -> docwiki.embarcadero.com/Libraries/XE2/en/… ;o)Noah
WriteBinaryStream write a value as hexa text - you can use it but you need to cypher it before writing, and after reading.Mix
+1 but it's hardly secure; nor is base 64Absorbing
As for the requirement that it should be strings: you can use any encryption you like and then just Base64-encode them. This is how many encryption libraries work already so that the output can remain a string.Clypeus
"you can use any encryption you like" - and what encryption do I like? That's the point. +1 though for base 64 after encruption so that I don't end up with an EOF char in thereAbsorbing
C
11

This is a replacement for Tinifile.
ReadString and WriteString are overridden, these are internal used to for Read/WriteFloat, Read/WriteInteger etc.

Strings are encrypted and stored as HEX-Strings.

Demo usage:

uses CryptingIni;
{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
 ini:TCryptingIni;
begin
    ini:=TCryptingIni.Create('C:\temp\test.ini');
    ini.UseInternalVersion(1234);
    ini.WriteFloat('Sect','Float',123.456);
    ini.WriteString('Sect2','String','How to encode');
    ini.Free;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
 ini:TCryptingIni;
begin
    ini:=TCryptingIni.Create('C:\temp\test.ini');
    ini.UseInternalVersion(1234);
    Showmessage(FloatToStr(ini.ReadFloat('Sect','Float',0)));
    Showmessage(ini.ReadString('Sect2','String',''));
    Showmessage(ini.ReadString('SectUnkknow','Showdefault','DEFAULT'));
    ini.Free;
end;

You may use internal encryption method by UseInternalVersion, or provide own procedures with
Procedure SetCryptingData(aEncryptProc, aDecryptProc: CryptingProc; aKey: Word);

unit CryptingIni;

// 2013 by Thomas Wassermann
interface

uses
  Windows, SysUtils, Variants, Classes, inifiles;

type

  CryptingProc = Function(const InString: String; Key: Word): String;

  TCryptingIni = Class(TInifile)
    function ReadString(const Section, Ident, Default: string): string; override;
    procedure WriteString(const Section, Ident, Value: String); override;
  private
    FEncryptProc: CryptingProc;
    FDecryptProc: CryptingProc;
    FKey: Word;
  public
    Procedure SetCryptingData(aEncryptProc, aDecryptProc: CryptingProc; aKey: Word);
    Procedure UseInternalVersion(aKey: Word);
  End;

implementation

const
  c1 = 52845;
  c2 = 22719;

Type
  TByteArray = Array [0 .. 0] of byte;

Function AsHexString(p: Pointer; cnt: Integer): String;
var
  i: Integer;
begin
  Result := '';
  for i := 0 to cnt do
    Result := Result + '$' + IntToHex(TByteArray(p^)[i], 2);
end;

Procedure MoveHexString2Dest(Dest: Pointer; Const HS: String);
var
  i: Integer;
begin
  i := 1;
  while i < Length(HS) do
  begin
    TByteArray(Dest^)[i div 3] := StrToInt(Copy(HS, i, 3));
    i := i + 3;
  end;
end;

function EncryptV1(const s: string; Key: Word): string;
var
  i: smallint;
  ResultStr: string;
  UCS: WIDEString;
begin
  Result := s;
  if Length(s) > 0 then
  begin
    for i := 1 to (Length(s)) do
    begin
      Result[i] := Char(byte(s[i]) xor (Key shr 8));
      Key := (smallint(Result[i]) + Key) * c1 + c2
    end;
    UCS := Result;
    Result := AsHexString(@UCS[1], Length(UCS) * 2 - 1)
  end;
end;

function DecryptV1(const s: string; Key: Word): string;
var
  i: smallint;
  sb: String;
  UCS: WIDEString;
begin
  if Length(s) > 0 then
  begin
    SetLength(UCS, Length(s) div 3 div 2);
    MoveHexString2Dest(@UCS[1], s);
    sb := UCS;
    SetLength(Result, Length(sb));
    for i := 1 to (Length(sb)) do
    begin
      Result[i] := Char(byte(sb[i]) xor (Key shr 8));
      Key := (smallint(sb[i]) + Key) * c1 + c2
    end;
  end
  else
    Result := s;
end;

{ TCryptingIni }

function TCryptingIni.ReadString(const Section, Ident, Default: string): string;
begin
  if Assigned(FEncryptProc) then
    Result := inherited ReadString(Section, Ident, FEncryptProc(Default, FKey))
  else
    Result := inherited ReadString(Section, Ident, Default);
  if Assigned(FDecryptProc) then
    Result := FDecryptProc(Result, FKey);
end;

procedure TCryptingIni.SetCryptingData(aEncryptProc, aDecryptProc: CryptingProc; aKey: Word);
begin
  FEncryptProc := aEncryptProc;
  FDecryptProc := aDecryptProc;
  FKey := aKey;
end;

procedure TCryptingIni.UseInternalVersion(aKey: Word);
begin
  FKey := aKey;
  FEncryptProc := EncryptV1;
  FDecryptProc := DecryptV1;
end;

procedure TCryptingIni.WriteString(const Section, Ident, Value: String);
var
  s: String;
begin
  if Assigned(FEncryptProc) then
    s := FEncryptProc(Value, FKey)
  else
    s := Value;
  inherited WriteString(Section, Ident, s);
end;

end.
Cancan answered 22/1, 2013 at 10:21 Comment(3)
+1 Another very good piece of code (with a weak algorithm, but I guess I can live with that). You showed some good techniques here which should be helpful to others reading this. ThanksAbsorbing
Widestring was not suported in android and I have used String and the Decryption was not providing the proper result. Which one we need to useErythrism
Significant security weakness if bad actor can get to the .ini Need only swap Username= & Password= fields in the ini to show the password in the username box. So write your own encrypt & decrypt where Section & Ident are parameters and are factored into those procedures. Thanks for the great start here though :)Sicyon
V
11

Disclaimer

The encryption algorithm used in this answer is very basic and can be easily broken by any individual with medium to high skills in cryptography. It is used in the solution because the OP is asking for a simple symmetric solution without requiring any library.

Principle

The solution is based on the XOR cipher. From the Wikipedia:

In cryptography, the simple XOR cipher is a type of additive cipher, an encryption algorithm that operates according to the principles:

A X 0 = A,

A X A = 0,

(A X B) X C = A X (B X C),

(B X A) X A = B X 0 = B,

where X denotes the XOR operation.

Pieces of the puzzle

My proposed solution is based in this basic routine:

function XorCipher(const Key, Source: TBytes): TBytes;
var
  I: Integer;
begin
  if Length(Key) = 0 then
    Exit(Source);
  SetLength(Result, Length(Source));
  for I := Low(Source) to High(Source) do
    Result[I] := Key[I mod Length(Key)] xor Source[I];
end;

The routine accepts a key and the source data as an array of bytes, and returns the resulting XORed array of bytes. The same routine functions to encrypt and to decrypt information, given the same key is used in both operations. To encrypt, the source is the plain data, and to decrypt, the source is the encrypted data.

I made two auxiliary routines to allow storing the result as a string. One to convert an array of bytes to a textual sequence of hexadecimal numbers, and the other to perform the reverse conversion:

function BytesToStr(const Bytes: TBytes): string;
var
  I: Integer;
begin
  Result := '';
  for I := Low(Bytes) to High(Bytes) do
    Result := Result + LowerCase(IntToHex(Bytes[I], 2));
end;

function StrToBytes(const value: string): TBytes;
var
  I: Integer;
begin
  SetLength(Result, Length(value) div 2);
  for I := Low(Result) to High(Result) do
    Result[I] := StrToIntDef('$' + Copy(value, (I * 2) + 1, 2), 0);
end;

With this foundations, you can build all of what you need. For convenience and test my code, I created some other routines, for example:

  • this one to store the key inside the exe and get it as a TBytes value

    function GetKey: TBytes;
    begin
      Result := TArray<Byte>.Create(
         $07, $14, $47, $A0, $F4, $F7, $FF, $48, $21, $32
       , $AF, $87, $09, $8E, $B3, $C0, $7D, $54, $45, $87
       , $8A, $A8, $23, $32, $00, $56, $11, $1D, $98, $FA
      );
    end;
    

    you can provide a key of any length, since it rolls to encrypt the data inside XorCipher routine.

  • this one to properly encode a given string using that key:

    function XorEncodeStr(const Source: string): string; overload;
    var
      BSource: TBytes;
    begin
      SetLength(BSource, Length(Source) * SizeOf(Char));
      Move(Source[1], BSource[0], Length(Source) * SizeOf(Char));
      Result := XorEncodeToStr(GetKey, BSource);
    end;
    
  • this other to properly decode a encoded string to a string

    function XorDecodeStr(const Source: string): string; overload;
    var
      BResult: TBytes;
    begin
      BResult := XorDecodeFromStr(GetKey, source);
      Result := TEncoding.Unicode.GetString( BResult );
    end;
    

Writing the INI file

With this routines accessible to the place where you write and read your INI file, you can easily write and read it, for example:

procedure TForm1.SaveIni;
var
  Ini: TIniFile;
  I: Integer;
begin
  Ini := TIniFile.Create('.\config.ini');
  try
    Ini.WriteInteger('config', 'NumEntries', ListBox1.Items.Count);
    for I := 0 to ListBox1.Items.Count - 1 do
      Ini.WriteString('listbox', IntToStr(I), XorEncodeStr(listbox1.Items[I]));
  finally
    Ini.Free;
  end;
end;

procedure TForm1.LoadIni;
var
  Ini: TIniFile;
  Max, I: Integer;
begin
  ListBox1.Items.Clear;
  Ini := TIniFile.Create('.\config.ini');
  try
    Max := Ini.ReadInteger('config', 'NumEntries', 0);
    for I := 0 to Max - 1 do
      ListBox1.Items.Add(
        XorDecodeStr(Ini.ReadString('listbox', IntToStr(I), ''))
      );
  finally
    Ini.Free;
  end;
end;

This is not production ready-code, since it's written only to test the solution, but it is also a starting point for you to make it rock-solid.

A word of caution

This is not strong cryptography, so, don't rely on this to store really sensitive information. One weak point is the key is contained inside your exe in plain form. You can work on this, but the main weakens is the algorithm itself.

Take as an example of this issue the following: since you're encoding Unicode Delphi strings in UTF-16 format, the second byte of each character is usually zero (unless you're in the east or a country with a non-latin alphabet), and you will find the exact bytes of the key repeats in your encoded stored strings. You can make this less apparent by not using a plain hexadecimal representation of the encoded data (for example encoding it using base64 as already suggested here).

You can resort to AnsiStrings to avoid revealing this parts of your key, or you can code your key with explicit zero bytes (or other constant byte) in the even positions.

Anything of this will work if the users of your software are not cryptographically educated, but the fact is that anyone with a medium level of knowledge and good skills can get the key by analyzing your data. If the user knows a un-encoded value, it gets easier.

Vive answered 22/1, 2013 at 9:36 Comment(4)
@achguate +1 Thanks for taking so much trouble. Yes, XOR is pretty weak, so I would be relying on security through obscurity :-( DOn't worry about the password being in the .EXE - it won't be; the user is prompted and enters it at run -time. Thanks again for contributing to this discussionAbsorbing
Since your requirement was something more sophisticated than ROT13, XOR looked like a good candidate, because it is WAY more sophisticated than that. IMHO XOR is not security trough obscurity, just a weak method, but it qualifies as real cryptography IMHO.Vive
Is it just me, or is the implementation of XorDecodeFromStr() missing?Hammel
@Steve, XorDecodeFromStr is not needed, since the way XOR works. If you pass the plain text, and the key, to the XorEncodeStr, you get the "encoded" string. If you pass the encoded string and the key, you get the plain text again.Vive
C
11

This is a replacement for Tinifile.
ReadString and WriteString are overridden, these are internal used to for Read/WriteFloat, Read/WriteInteger etc.

Strings are encrypted and stored as HEX-Strings.

Demo usage:

uses CryptingIni;
{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
 ini:TCryptingIni;
begin
    ini:=TCryptingIni.Create('C:\temp\test.ini');
    ini.UseInternalVersion(1234);
    ini.WriteFloat('Sect','Float',123.456);
    ini.WriteString('Sect2','String','How to encode');
    ini.Free;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
 ini:TCryptingIni;
begin
    ini:=TCryptingIni.Create('C:\temp\test.ini');
    ini.UseInternalVersion(1234);
    Showmessage(FloatToStr(ini.ReadFloat('Sect','Float',0)));
    Showmessage(ini.ReadString('Sect2','String',''));
    Showmessage(ini.ReadString('SectUnkknow','Showdefault','DEFAULT'));
    ini.Free;
end;

You may use internal encryption method by UseInternalVersion, or provide own procedures with
Procedure SetCryptingData(aEncryptProc, aDecryptProc: CryptingProc; aKey: Word);

unit CryptingIni;

// 2013 by Thomas Wassermann
interface

uses
  Windows, SysUtils, Variants, Classes, inifiles;

type

  CryptingProc = Function(const InString: String; Key: Word): String;

  TCryptingIni = Class(TInifile)
    function ReadString(const Section, Ident, Default: string): string; override;
    procedure WriteString(const Section, Ident, Value: String); override;
  private
    FEncryptProc: CryptingProc;
    FDecryptProc: CryptingProc;
    FKey: Word;
  public
    Procedure SetCryptingData(aEncryptProc, aDecryptProc: CryptingProc; aKey: Word);
    Procedure UseInternalVersion(aKey: Word);
  End;

implementation

const
  c1 = 52845;
  c2 = 22719;

Type
  TByteArray = Array [0 .. 0] of byte;

Function AsHexString(p: Pointer; cnt: Integer): String;
var
  i: Integer;
begin
  Result := '';
  for i := 0 to cnt do
    Result := Result + '$' + IntToHex(TByteArray(p^)[i], 2);
end;

Procedure MoveHexString2Dest(Dest: Pointer; Const HS: String);
var
  i: Integer;
begin
  i := 1;
  while i < Length(HS) do
  begin
    TByteArray(Dest^)[i div 3] := StrToInt(Copy(HS, i, 3));
    i := i + 3;
  end;
end;

function EncryptV1(const s: string; Key: Word): string;
var
  i: smallint;
  ResultStr: string;
  UCS: WIDEString;
begin
  Result := s;
  if Length(s) > 0 then
  begin
    for i := 1 to (Length(s)) do
    begin
      Result[i] := Char(byte(s[i]) xor (Key shr 8));
      Key := (smallint(Result[i]) + Key) * c1 + c2
    end;
    UCS := Result;
    Result := AsHexString(@UCS[1], Length(UCS) * 2 - 1)
  end;
end;

function DecryptV1(const s: string; Key: Word): string;
var
  i: smallint;
  sb: String;
  UCS: WIDEString;
begin
  if Length(s) > 0 then
  begin
    SetLength(UCS, Length(s) div 3 div 2);
    MoveHexString2Dest(@UCS[1], s);
    sb := UCS;
    SetLength(Result, Length(sb));
    for i := 1 to (Length(sb)) do
    begin
      Result[i] := Char(byte(sb[i]) xor (Key shr 8));
      Key := (smallint(sb[i]) + Key) * c1 + c2
    end;
  end
  else
    Result := s;
end;

{ TCryptingIni }

function TCryptingIni.ReadString(const Section, Ident, Default: string): string;
begin
  if Assigned(FEncryptProc) then
    Result := inherited ReadString(Section, Ident, FEncryptProc(Default, FKey))
  else
    Result := inherited ReadString(Section, Ident, Default);
  if Assigned(FDecryptProc) then
    Result := FDecryptProc(Result, FKey);
end;

procedure TCryptingIni.SetCryptingData(aEncryptProc, aDecryptProc: CryptingProc; aKey: Word);
begin
  FEncryptProc := aEncryptProc;
  FDecryptProc := aDecryptProc;
  FKey := aKey;
end;

procedure TCryptingIni.UseInternalVersion(aKey: Word);
begin
  FKey := aKey;
  FEncryptProc := EncryptV1;
  FDecryptProc := DecryptV1;
end;

procedure TCryptingIni.WriteString(const Section, Ident, Value: String);
var
  s: String;
begin
  if Assigned(FEncryptProc) then
    s := FEncryptProc(Value, FKey)
  else
    s := Value;
  inherited WriteString(Section, Ident, s);
end;

end.
Cancan answered 22/1, 2013 at 10:21 Comment(3)
+1 Another very good piece of code (with a weak algorithm, but I guess I can live with that). You showed some good techniques here which should be helpful to others reading this. ThanksAbsorbing
Widestring was not suported in android and I have used String and the Decryption was not providing the proper result. Which one we need to useErythrism
Significant security weakness if bad actor can get to the .ini Need only swap Username= & Password= fields in the ini to show the password in the username box. So write your own encrypt & decrypt where Section & Ident are parameters and are factored into those procedures. Thanks for the great start here though :)Sicyon
R
7

I use Delphi Encryption Compendium which has wonderful functions for both hash and symmetric encryption/decryption. It is divided into units, but doesn't require any external libraries, and is pretty fast.

Here's how I use it in my code:

function Encrypt(const AStr: string): string;
begin
  Result := AStr;
  with TCipher_Gost.Create do
    try
      Init(THash_SHA1.KDFx('Encryption Key', '', Context.KeySize));
      Result := EncodeBinary(Result, TFormat_HEX);
    finally
      Free;
    end;
end;

function Decrypt(const AStr: string): string;
begin
  Result := AStr;
  with TCipher_Gost.Create do
    try
      Init(THash_SHA1.KDFx('Encryption Key', '', Context.KeySize));
      Result := DecodeBinary(Result, TFormat_HEX);
    finally
      Free;
    end;
end;

You can use any of the TCipher_* classes instead of GOST.

Rawley answered 19/1, 2013 at 7:20 Comment(6)
+1 this looks good, but won't compile. What is "binary" type? ThanksAbsorbing
Which version of Delphi are you using? Binary is WideString without character encoding in Delphi 2009 I believe.Rawley
DECCipher, DECHash, DECFmtRawley
@Absorbing you could also use a loop to perform more than one encryption on your data, if you want to give anyone trying to decipher your stored passwords a headache ;-)Rawley
The BlowFish encryption/decryption routines in Delphi Encryption Compendium allows for encryption/decryption of strings, including a password string. These should fit the OP's requirements out of the box.Pollinosis
@LURD, I would also go with blowfish->base64 since it's simple, fast, patent free, and does not have any known weaknesses.Sinkage
B
5

First off, see this link for the wincrypt unit I'm using since I used it here.

What this does for encryption is take the string that's put into it (you are using INI so it's all single strings anyway, right?), and then runs it through the WinCrypt 3DES based on a password entered in, and then since that produces binary, I run that through Base64. For decryption, I reverse the process. An incorrect password produces garbage on decryption, but for the amount that I tested it, it seems to work right as long as the password is right for both steps. Of course, I may have forgotten to do some cleanup, but if that is the case it can readily be fixed.

function DecryptStringW(instr, pwd: WideString): WideString;
// password based decryption of a string using WinCrypt API, WideString version
  var
    Key: TCryptKey;
    Hash: TCryptHash;
    Prov: TCryptProv;
    DataLen, skip, Flags: DWord;
    DataBuf: Pointer;
    outstr: WideString;
  begin
    CryptAcquireContext(Prov, nil, nil, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT);
    CryptCreateHash(Prov, CALG_SHA, nil, 0, hash);
    CryptHashData(hash, @pwd[1], Length(Pwd), 0);
    CryptDeriveKey(Prov, CALG_3DES, hash, 0, key);
    CryptDestroyHash(hash);

    CryptStringToBinaryW(pointer(instr), Length(instr), CRYPT_STRING_BASE64, nil, DataLen, skip, Flags);
    GetMem(databuf, DataLen);
    try
      CryptStringToBinaryW(pointer(instr), Length(instr), CRYPT_STRING_BASE64, DataBuf,
           DataLen, skip, Flags);
      CryptDecrypt(Key, nil, True, 0, DataBuf, Datalen);
      SetLength(outstr, datalen);
      Move(DataBuf^, outstr[1], DataLen);
      CryptReleaseContext(Prov, 0);
      Result := outstr;
    finally
      FreeMem(databuf);
    end;
 end;

 function EncryptStringW(instr, pwd: WideString): WideString;
 // password based encryption of a string, WideString version
   var
    Key: TCryptKey;
    Hash: TCryptHash;
    Prov: TCryptProv;
    DataLen, bufsize: DWord;
    databuf: PByte;
    outstr: WideString;
  begin
    CryptAcquireContext(Prov, nil, nil, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT);
    CryptCreateHash(Prov, CALG_SHA, nil, 0, hash);
    CryptHashData(hash, @pwd[1], Length(Pwd), 0);
    CryptDeriveKey(Prov, CALG_3DES, hash, 0, key);
    CryptDestroyHash(hash);
    bufsize := 0;
    DataLen := 0;
    CryptEncrypt(Key, nil, True, 0, nil, bufsize, Length(instr));
    GetMem(databuf, bufsize);
    try
      Move(instr[1], databuf^, Length(instr));
      DataLen := Length(instr);
      CryptEncrypt(Key, nil, True, 0, databuf, DataLen, bufsize);
      CryptReleaseContext(Prov, 0);
      CryptBinaryToStringW(databuf, DataLen, CRYPT_STRING_BASE64 or
              CRYPT_STRING_NOCRLF, nil, bufsize);
      SetLength(outstr, bufsize);
      CryptBinaryToStringW(databuf, DataLen, CRYPT_STRING_BASE64 or
              CRYPT_STRING_NOCRLF, @outstr[1], bufsize);
     // result, kill the three characters after the final one the base64 returns    ($D$A$0)
     // CRYPT_STRING_NOCRLF seems to mean nothing on XP, it might on other systems
     // you will need to change to the commented line if you are on Vista, 7, or 8
      Result := Copy(outstr, 1, Length(outstr) - 3);
     // Result := Outstr;
    finally
      FreeMem(databuf);
    end;
  end;

  function DecryptStringA(instr, pwd: AnsiString): AnsiString;
  // password based decryption of a string using WinCrypt API, ANSI VERSION.
    var
      Key: TCryptKey;
      Hash: TCryptHash;
      Prov: TCryptProv;
      DataLen, skip, Flags: DWord;
      DataBuf: Pointer;
      outstr: AnsiString;
    begin
      CryptAcquireContext(Prov, nil, nil, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT);
      CryptCreateHash(Prov, CALG_SHA, nil, 0, hash);
      CryptHashData(hash, @pwd[1], Length(Pwd), 0);
      CryptDeriveKey(Prov, CALG_3DES, hash, 0, key);
      CryptDestroyHash(hash);

      CryptStringToBinaryA(pointer(instr), Length(instr), CRYPT_STRING_BASE64, nil, DataLen, skip, Flags);
      GetMem(databuf, DataLen);
      try
        CryptStringToBinaryA(pointer(instr), Length(instr), CRYPT_STRING_BASE64, DataBuf, DataLen, skip, Flags);
        CryptDecrypt(Key, nil, True, 0, DataBuf, Datalen);
        SetLength(outstr, datalen);
        Move(DataBuf^, outstr[1], DataLen);
        CryptReleaseContext(Prov, 0);
        Result := outstr;
      finally
        FreeMem(databuf);
      end;
   end;

  function EncryptStringA(instr, pwd: AnsiString): AnsiString;
   // password based encryption of a string, ANSI version
    var
      Key: TCryptKey;
      Hash: TCryptHash;
      Prov: TCryptProv;
      DataLen, bufsize: DWord;
      databuf: PByte;
      outstr: AnsiString;
   begin
     CryptAcquireContext(Prov, nil, nil, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT);
     CryptCreateHash(Prov, CALG_SHA, nil, 0, hash);
     CryptHashData(hash, @pwd[1], Length(Pwd), 0);
     CryptDeriveKey(Prov, CALG_3DES, hash, 0, key);
     CryptDestroyHash(hash);
     DataLen := 0;
     bufsize := 0;
     CryptEncrypt(Key, nil, True, 0, nil, bufsize, Length(instr));
     GetMem(databuf, bufsize);
     try
       Move(instr[1], databuf^, Length(instr));
       DataLen := Length(instr);
       CryptEncrypt(Key, nil, True, 0, databuf, DataLen, bufsize);
       CryptReleaseContext(Prov, 0);
       CryptBinaryToStringA(databuf, DataLen, CRYPT_STRING_BASE64 or
              CRYPT_STRING_NOCRLF, nil, bufsize);
       SetLength(outstr, bufsize);
       CryptBinaryToStringA(databuf, DataLen, CRYPT_STRING_BASE64 or
              CRYPT_STRING_NOCRLF, @outstr[1], bufsize);
     // result, kill the three characters after the final one the base64 returns    ($D$A$0)
     // CRYPT_STRING_NOCRLF seems to mean nothing on XP, it might on other systems
     // you will need to change to the commented line if you are on Vista, 7, or 8
      Result := Copy(outstr, 1, Length(outstr) - 3);
     // Result := Outstr;
    finally
       FreeMem(databuf);
    end;
  end;

Quick usage example:

 procedure TForm1.Button1Click(Sender: TObject);
   var
     password1: AnsiString;
   begin
     password1 := 'Test1';
     Edit2.Text := EncryptStringA(Edit1.Text, password1);
   end;

 procedure TForm1.Button2Click(Sender: TObject);
   var
     password1: AnsiString;
   begin
     password1 := 'Test1';
     Label1.Caption := DecryptStringA(Edit2.Text, password1);
   end;

 procedure TForm1.Button3Click(Sender: TObject);
   var
     password1: WideString;
   begin
     password1 := 'Test1';
     Edit2.Text := EncryptStringW(Edit1.Text, password1);
   end;

 procedure TForm1.Button4Click(Sender: TObject);
   var
     password1: WideString;
   begin
     password1 := 'Test1';
     Label1.Caption := DecryptStringW(Edit2.Text, password1);
   end;

Hope it helps out someone.

Using "Edit1" as input. Correct output for encryption ANSI: 3+Pp7o8aErc= Correct output for encryption WideString: HijzDYgRr/Y=

Edit: I posted WideString versions as well. I downloaded the XE3 demo to look at and play with. This code works there as well as Turbo Delphi 2006 and Delphi 3, so if you have difficulty check the line(s) that I put comments on about the Windows XP Base64 implementation not honoring CRYPT_STRING_NOCRLF, because if you are on a Windows that does, the line needs to be changed for this to work right. Regardless, for the OP's stated intention we DO NOT want $13$10 to appear in the encoded text

Bold answered 22/1, 2013 at 15:47 Comment(8)
I assume this is an Ansi version? I have tested this in D7/Win7. it did not compile until I changed DataLen, skip, Flags to DWORD. encrypting Edit1 results 3+Pp7o8aEr but then the decrypted string showed garbage. When I do not "kill the three characters after the final one" it works fine.Sinkage
1. Yes it's an ANSI version. I presume all that would be necessary to clarify is explicitly define AnsiStrings instead of generic strings. The WideString version should be easy enough from there to come up with. 2. In looking at the CryptBinaryToString function, the CRYPT_STRING_NOCRLF constant has no meaning in Windows XP (where I tested it). So I had to remove the CR/LF pair (per the comment) to get what I was looking for - the line seems to not be necessary on Windows 7.Bold
@Bold +1 Thanks. Others have given more than I requested, but used weaker encryption. Yours looks stronger, but I can't tell as you neglected the USES clause & Delphi help ... doesn't. Ah! I googled and found delphi.cjcsoft.net/viewthread.php?tid=46162 but when I add that unit to my project I get errors "E2033 Types of actual and formal var parameters must be identical" on DataLen and Flags. Like Kobik, I hcanged them to Dword and both Edit2 and Label contained grabage. Can you help? ThanksAbsorbing
@Absorbing I linked to the proper version of the unit I was using in the first sentence of the post. Other than that, you might have to explicitly define the strings to be ANSIStrings. As well, changing the types you indicated to DWord would be good, as well as checking the last line as indicated on the comment. I use older versions of Delphi and am on Windows XP as well so it might require a little work. All I can say though is that it's working right here, save removing the $D and $A that the CryptoAPI keeps insisting on putting in the base64 strings.Bold
@Bold +1 Ooops, I miss the URL. Ok, I D/Led that and changed LongInt to DWord and the parameters to EncryptString` and DecryptString are now AnsiString, as are all variables (and I stopped using VCL controls because their Text/Caption are String, not AnsiString. Still garbage :-( I really want to give you the bonus ... how about D/Ling a 30 day trial of a more recent Delphi? You might like it ;-) The starter edition is about US $199, but no 64 bit executables and NO DATABSEAbsorbing
@Absorbing all I can suggest is that if you're not on XP to change the Result := Copy( line to Result := outstr; since CRYPT_STRING_NOCRLF works right on Windows Vista, 7, and 8. If it works on TD 2006, I don't see any reason it shouldn't work on newer stuff. To say more, I'd have to see what you're trying.Bold
@Bold +1 Thanks for all the effort you are putting into this. On Windows 7, using XE 2 Starter edition (32 bit EXE only), using AnsiString, EncryptStringA('Edit1', 'Testt1') is giving only 3+Pp7o8aEr where you expect 3+Pp7o8aErc=, so I am losing a few chars at the end. I got rid of the copy and replaced it with Result := Outstr; and now it works!! Excellent!! Thank you so much for your help. Answer awarded!Absorbing
++ for widestring international support need 2 all length(str) add *SizeOf(WideChar)Noriega
S
1

The base64 is very good encoder and have string result and standard :

{**************************************************************}
{                  Base 64 - by David Barton                   }
{--------------------------------------------------------------}

 const
  B64: array[0..63] of byte= (65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,
    81,82,83,84,85,86,87,88,89,90,97,98,99,100,101,102,103,104,105,106,107,108,
    109,110,111,112,113,114,115,116,117,118,119,120,121,122,48,49,50,51,52,53,
    54,55,56,57,43,47);

function B64Encode(pInput: pointer; pOutput: pointer; Size: longint): longint;
var
  i, iptr, optr: integer;
  Input, Output: PByteArray;
begin
  Input:= PByteArray(pInput); Output:= PByteArray(pOutput);
  iptr:= 0; optr:= 0;
  for i:= 1 to (Size div 3) do
  begin
    Output^[optr+0]:= B64[Input^[iptr] shr 2];
    Output^[optr+1]:= B64[((Input^[iptr] and 3) shl 4) + (Input^[iptr+1] shr 4)];
    Output^[optr+2]:= B64[((Input^[iptr+1] and 15) shl 2) + (Input^[iptr+2] shr 6)];
    Output^[optr+3]:= B64[Input^[iptr+2] and 63];
    Inc(optr,4); Inc(iptr,3);
  end;
  case (Size mod 3) of
    1: begin
         Output^[optr+0]:= B64[Input^[iptr] shr 2];
         Output^[optr+1]:= B64[(Input^[iptr] and 3) shl 4];
         Output^[optr+2]:= byte('=');
         Output^[optr+3]:= byte('=');
       end;
    2: begin
         Output^[optr+0]:= B64[Input^[iptr] shr 2];
         Output^[optr+1]:= B64[((Input^[iptr] and 3) shl 4) + (Input^[iptr+1] shr 4)];
         Output^[optr+2]:= B64[(Input^[iptr+1] and 15) shl 2];
         Output^[optr+3]:= byte('=');
       end;
  end;
  Result:= ((Size+2) div 3) * 4;
end;


function Base64Encode(const Value: AnsiString): AnsiString;
begin
  SetLength(Result,((Length(Value)+2) div 3) * 4);
  B64Encode(@Value[1],@Result[1],Length(Value));
end;


function B64Decode(pInput: pointer; pOutput: pointer; Size: longint): longint;
var
  i, j, iptr, optr: integer;
  Temp: array[0..3] of byte;
  Input, Output: PByteArray;
begin
  Input:= PByteArray(pInput); Output:= PByteArray(pOutput);
  iptr:= 0; optr:= 0;
  Result:= 0;
  for i:= 1 to (Size div 4) do
  begin
    for j:= 0 to 3 do
    begin
      case Input^[iptr] of
        65..90 : Temp[j]:= Input^[iptr] - Ord('A');
        97..122: Temp[j]:= Input^[iptr] - Ord('a') + 26;
        48..57 : Temp[j]:= Input^[iptr] - Ord('0') + 52;
        43     : Temp[j]:= 62;
        47     : Temp[j]:= 63;
        61     : Temp[j]:= $FF;
      end;
      Inc(iptr);
    end;
    Output^[optr]:= (Temp[0] shl 2) or (Temp[1] shr 4);
    Result:= optr+1;
    if (Temp[2]<> $FF) and (Temp[3]= $FF) then
    begin
      Output^[optr+1]:= (Temp[1] shl 4) or (Temp[2] shr 2);
      Result:= optr+2;
      Inc(optr)
    end
    else if (Temp[2]<> $FF) then
    begin
      Output^[optr+1]:= (Temp[1] shl 4) or (Temp[2] shr 2);
      Output^[optr+2]:= (Temp[2] shl 6) or  Temp[3];
      Result:= optr+3;
      Inc(optr,2);
    end;
    Inc(optr);
  end;
end;

function Base64Decode(const Value: AnsiString): AnsiString;
begin
  SetLength(Result,(Length(Value) div 4) * 3);
  SetLength(Result,B64Decode(@Value[1],@Result[1],Length(Value)));
end;

You can use with this sample :

encode :

procedure TForm1.btn1Click(Sender: TObject);
begin
  edt1.Text := Base64Encode(edt1.Text)  ;
end;

decode:

procedure TForm1.btn1Click(Sender: TObject);
begin
  edt1.Text := Base64Decode(edt1.Text)  ;
end;
Santanasantayana answered 19/1, 2013 at 7:58 Comment(6)
TCustomIniFile.WriteBinaryStream will do that job ;o)Noah
This doesn't encrypt the data, but rather converts it to base64 charactersRawley
@iManBiglari: I know it , but is that is standard way and password should be Hash not encrypt or encode.Santanasantayana
OP is asking for encrypt/decrypt not hashing - to me he needs to store a password for e.g. database connection and hashed keys are not helpful in this caseNoah
Delphi comes with a number of base64 implementations. No need to add yet another one.Interdenominational
Just only answer one part of the question: getting the file content as string. It does not use a password, and features encoding, not encryption. So not a valid answer.Mix

© 2022 - 2024 — McMap. All rights reserved.