声明

Question

我正在寻找比ROT13更复杂的东西，但它不需要一个库（甚至不是一个单元，只是功能下降）。

我想用用户提供的密码对称地加密/解密给定的字符串。但是，结果必须是一个字符串，因为我必须能够将它存储在.INI文件中。

有没有人有这么简单的功能（delphi XE2）？谷歌今天不是我的朋友。

提前致谢

[更新] / [赏金]为了说清楚（如果它不是最初的aplogies），我不想要哈希。我有一个列表框，用户可以在其中添加/修改/删除条目。我希望在程序关闭时将它们存储在.INI文件中，并在它再次启动时重新加载。任何查看.INI文件的人（例如，在记事本中打开它）都不应该读取这些字符串。

我想我可以将组件流式传输为二进制文件，但为了减轻思想，我宁愿使用用户提供的密码加密字符串。出于此应用程序的目的，.INI文件节名称或键值是否是人类可读的并不重要，我只想加密数据，在存储在磁盘上时给我一些列表：

[config]
numEntries=3

[listbox]
0=ywevdyuvewfcyuw
1=edw
2=hr4uifareiuf

Answer 1

声明

本答案中使用的加密算法非常基础，任何具有中高级密码学技能的人都可以轻松破解。它在解决方案中使用，因为OP要求一个简单的对称解决方案而不需要任何库。

原理

解决方案基于XOR cipher。来自维基百科：

在密码学中，简单的XOR密码是一种附加密码，一种根据原则运行的加密算法：

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表示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;

例程接受一个键和源数据作为字节数组，并返回生成的XORed字节数组。在两个操作中使用相同的密钥，相同的例程用于加密和解密信息。要加密，源是纯数据，要解密，源是加密数据。

我制作了两个辅助例程，允许将结果存储为字符串。一个用于将字节数组转换为十六进制数字的文本序列，另一个用于执行反向转换：

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文件

在您编写和读取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字符串，因此每个字符的第二个字节通常为零（除非您位于东部或非国家/地区） -latin alphabet），你会在编码的存储字符串中找到密钥重复的确切字节。你可以通过不使用编码数据的普通十六进制表示来使这一点变得不那么明显（例如，如此处已经建议的那样使用base64对其进行编码）。

您可以使用AnsiStrings来避免泄露密钥的这一部分，或者您可以在偶数位置使用显式零字节（或其他常量字节）对密钥进行编码。

如果您的软件用户没有接受过加密教育，那么任何此类工作都会有效，但事实是，任何具有中等知识水平和良好技能的人都可以通过分析您的数据获得密钥。如果用户知道未编码的值，则会更容易。

Answer 2

这是Tinifile的替代品重写了ReadString和WriteString，这些内部用于Read / WriteFloat，Read / WriteInteger等。

字符串被加密并存储为HEX-Strings。

演示用法：

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：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.

Answer 3

我使用 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。

Answer 4

首先，请看this link我正在使用的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一样有效，所以如果你在查看关于不遵守CRYPT_STRING_NOCRLF的Windows XP Base64实现的注释的行上有困难，因为如果你在Windows上，需要更改该行才能使其正常工作。无论如何，对于OP的声明，我们不希望13美元10美元出现在编码文本中

Answer 5

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;

使用密码加密.INI文件字符串的简单代码

5 个答案:

声明

原理

拼图的碎片

编写INI文件

谨慎提及