我正在寻找比 ROT13 更复杂的东西，但它不需要库（最好甚至不需要一个单元，只是一个功能的下降）。
我想用用户提供的密码对称地加密/解密给定的字符串。但是，结果必须是一个字符串，因为我必须能够将它存储在一个 .INI 文件中。
有没有人有一个简单的功能来做到这一点（delphi XE2）？谷歌今天不是我的朋友。
提前致谢
[更新] / [赏金] 只是为了说清楚（如果最初不是这样道歉），我不想要哈希。我有一个列表框，用户可以在其中添加/修改/删除条目。我想在程序关闭时将它们存储在 .INI 文件中，并在程序再次启动时重新加载。任何查看 .INI 文件的人（例如，在记事本中打开它）都应该无法读取这些字符串。
我想我可以将组件作为二进制流式传输，但为了方便起见，我宁愿使用用户提供的密码来加密字符串。出于此应用的目的，.INI 文件部分名称或密钥值是否是人类可读的并不重要，我只想加密数据，当存储在磁盘上时给我一些列表：
[config]
numEntries=3
[listbox]
0=ywevdyuvewfcyuw
1=edw
2=hr4uifareiuf
此答案中使用的加密算法非常基本，任何具有中高级密码学技能的人都可以轻松破解。在解决方案中使用它是因为 OP 要求一个简单的对称解决方案而不需要任何库。
该解决方案基于XOR 密码。来自维基百科：
在密码学中，简单 XOR 密码是一种加法密码，一种根据以下原则运行的加密算法：
AX 0 = A，
安盛 = 0,
(AXB) XC = AX (BXC),
(BXA) XA = BX 0 = B,
其中 X 表示 XOR 操作。
我提出的解决方案基于这个基本例程：
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;
该例程接受键和源数据作为字节数组，并返回结果异或字节数组。假设在两种操作中使用相同的密钥，相同的例程功能来加密和解密信息。加密时，源是明文数据，解密时，源是加密数据。
我做了两个辅助例程来允许将结果存储为字符串。一个用于将字节数组转换为十六进制数字的文本序列，另一个用于执行反向转换：
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;
有了这个基础，您就可以构建所有您需要的东西。为了方便和测试我的代码，我创建了一些其他例程，例如：
这个用于将密钥存储在 exe 中并将其作为 TBytes 值获取
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;
您可以提供任意长度的密钥，因为它会滚动加密 XorCipher 例程中的数据。
这个使用该键正确编码给定的字符串：
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;
这另一个正确地将编码字符串解码为字符串
function XorDecodeStr(const Source: string): string; overload;
var
BResult: TBytes;
begin
BResult := XorDecodeFromStr(GetKey, source);
Result := TEncoding.Unicode.GetString( BResult );
end;
通过在您编写和读取 INI 文件的地方可以访问此例程，您可以轻松地编写和读取它，例如：
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;
这不是生产就绪代码，因为它只是为了测试解决方案而编写的，但它也是您使它坚如磐石的起点。
这不是强密码学，因此，不要依赖它来存储真正敏感的信息。一个弱点是密钥以纯格式包含在您的 exe 中。你可以解决这个问题，但主要的弱点是算法本身。
以以下问题为例：由于您正在以 UTF-16 格式编码 Unicode Delphi 字符串，因此每个字符的第二个字节通常为零（除非您在东部或使用非拉丁字母的国家/地区)，您将在编码的存储字符串中找到键重复的确切字节。您可以通过不使用编码数据的普通十六进制表示来使这一点变得不那么明显（例如，使用这里已经建议的 base64 对其进行编码）。
您可以使用 AnsiStrings 来避免泄露密钥的这一部分，或者您可以在偶数位置使用显式零字节（或其他常量字节）对密钥进行编码。
如果您的软件的用户没有受过密码学教育，这一切都会奏效，但事实是，任何具有中等知识水平和良好技能的人都可以通过分析您的数据来获得密钥。如果用户知道一个未编码的值，它会变得更容易。
这是 Tinifile 的替代品。
ReadString 和 WriteString 被覆盖，这些是内部用于 Read/WriteFloat、Read/WriteInteger 等的。
字符串被加密并存储为 HEX 字符串。
演示用法：
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;
您可以通过 UseInternalVersion 使用内部加密方法，或通过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.
我使用Delphi Encryption Compendium，它具有出色的哈希和对称加密/解密功能。它分为多个单元，但不需要任何外部库，而且速度非常快。
这是我在代码中使用它的方式：
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;
您可以使用任何TCipher_*类来代替 GOST。
首先，请参阅我在这里使用的 wincrypt 单元的 链接。
这对加密的作用是获取放入其中的字符串（您使用的是 INI，所以无论如何它都是单个字符串，对吗？），然后根据输入的密码通过 WinCrypt 3DES 运行它，然后生成二进制，我通过 Base64 运行它。对于解密，我颠倒了这个过程。不正确的密码会在解密时产生垃圾，但是对于我测试的数量，只要密码对两个步骤都正确，它似乎就可以正常工作。当然，我可能忘了做一些清理工作，但如果是这样的话，它可以很容易地修复。
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;
快速使用示例：
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;
希望它可以帮助某人。
使用“Edit1”作为输入。加密 ANSI 的正确输出：3+Pp7o8aErc= 加密 WideString 的正确输出：HijzDYgRr/Y=
编辑：我也发布了 WideString 版本。我下载了 XE3 演示来查看和使用。这段代码和 Turbo Delphi 2006 和 Delphi 3 一样有效，所以如果你有困难，请检查我评论的关于 Windows XP Base64 实现不尊重 CRYPT_STRING_NOCRLF 的行，因为如果你在 Windows 上，需要更改该行才能使其正常工作。无论如何，对于 OP 的声明意图，我们不希望 $13$10 出现在编码文本中
base64 是非常好的编码器，具有字符串结果和标准：
{**************************************************************}
{ 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;
您可以使用此示例：
编码：
procedure TForm1.btn1Click(Sender: TObject);
begin
edt1.Text := Base64Encode(edt1.Text) ;
end;
解码：
procedure TForm1.btn1Click(Sender: TObject);
begin
edt1.Text := Base64Decode(edt1.Text) ;
end;