我正在寻找比ROT13更复杂的东西，但不需要使用库（最好甚至不需要单元，只需一个即插即用函数）。
我想对给定的字符串使用用户提供的密码进行对称加密/解密。但结果必须是一个字符串，也就是说，我必须能够将其存储在.INI文件中。
有没有人有一个简单的函数可以做到这一点（Delphi XE2）？今天谷歌不是我的朋友。
提前致谢
[更新] / [赏金] 为了明确（如果最初没有这样做，请道歉），我不想要哈希。我有一个列表框，用户可以添加/修改/删除条目。当程序关闭并重新启动时，我想将它们存储在.INI文件中。任何查看.INI文件的人（例如，在记事本中打开它）都不应该能够读取这些字符串。
我想，我可以将组件作为二进制流传输，但出于安全考虑，我宁愿使用用户提供的密码加密字符串。对于此应用程序的目的，.INI文件部分名称或键值是否可读并不重要，我只想加密数据，使其在磁盘上存储时像这样：
[config]
numEntries=3
[listbox]
0=ywevdyuvewfcyuw
1=edw
2=hr4uifareiuf
本答案使用的加密算法非常基础，任何具备中高级密码学技能的个人都可以轻松破解。之所以在解决方案中使用它，是因为原始问题要求提供一个简单的对称解决方案，而不需要使用任何库。
该解决方案基于异或密码。维基百科上的定义如下：
在密码学中，简单的异或密码是一种加法密码类型，一个根据以下原则运作的加密算法：
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,
其中X表示异或操作。
我提出的解决方案基于这个基本例程：
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;
该程序接受一个密钥和一组字节数组作为源数据，并返回结果XOR后的字节数组。使用相同的密钥进行加密和解密，可以使用同一例程函数。要加密，源是明文数据；要解密，则源是加密数据。
我编写了两个辅助例程，以允许将结果存储为字符串。其中一个将字节数组转换为十六进制数字的文本序列，另一个则执行反向转换：
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等操作。
字符串已加密，并以十六进制字符串形式存储。
Demo用法：
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来使用内部加密方法，或者使用SetCryptingData过程来提供自己的加密过程，其中包括aEncryptProc，aDecryptProc和aKey参数。
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.
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。DECCipher, DECHash, DECFmt - iMan BiglariDelphi Encryption Compendium 中的 BlowFish 加密/解密例程允许加密/解密字符串，包括密码字符串。这些应该可以直接满足 OP 的要求。 - LU RDblowfish->base64，因为它简单、快速、无专利，并且没有已知的弱点。 - kobikfunction 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;
{**************************************************************}
{ 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;
- Ini 可以直接存储流
- 你对单位有什么问题？
- 你对库有什么问题？
- Sir Rufo