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