des3desprg.pas

des 3des加密delphi例子；标准的des,3des算法

{*******************************************************}
{                                                       }
{       Des 3Des加密解密                                }
{                                                       }
{       工程名 Project1                                 }
{       版权所有 (C) 2008 艾尔普科技                    }
{       作者 顾体强                                     }
{                                                       }
{*******************************************************}

unit Des3DesPrg;


interface
uses Windows, SysUtils, Math, CommTablePrg;
type
  TDes3DesCls = class
  private

    sPlaintext:string;//待加密明文 
    sKey,sKey1:string;//密钥1，密钥2

    SubKeys:TSubKey; //array[0..15,0..47]of Char;//储存16组48位密钥
    SubKeys2:TSubKey;//array[0..15,0..47]of Char;//储存16组48位密钥

    szCiphertext:array[0..15]of Char;//储存16位密文(十六进制字符串)
    szPlaintext:array[0..7]of Char;//储存8位明文字符串
    szFCiphertextAnyLength:array[0..8191]of Char;//任意长度密文(十六进制字符串)
    szFPlaintextAnyLength:array[0..4095]of Char;//任意长度明文字符串

    //--------------------------------------------------------------
    //功能:将int类型的0或1转换为char类型的0或1
    //参数:0或1
    //返回:'0'或'1'
    //--------------------------------------------------------------
    function SingleBinaryToChar(iTmp:Integer):Char;

    //--------------------------------------------------------------
    //功能:当明文不足8位,使用'$'进行填充,
    //参数:原始字符串,
    //结果:返回8位字符串
    //--------------------------------------------------------------
      function FillToEightBits(var sz:string):Boolean;

    //--------------------------------------------------------------
    //功能:IP变换
    //参数:待处理字符串,处理后结果存放指针,加密/解密(true加密,false解密)
    //结果:函数改变第二个参数的内容
    //--------------------------------------------------------------
      function InitialPermuteData(s:string;var sz:array of Char;szBool:Boolean):Boolean;
    //--------------------------------------------------------------
    //功能:DES中的F函数,
    //参数:左32位,右32位,key序号(0-15)
    //结果:均在变换左右32位
    //--------------------------------------------------------------
     procedure FunctionF(var sz_Li1, sz_Ri1:array of Char;bIsUseSecondKey:Boolean;iKey:Integer);

    //--------------------------------------------------------------
    //功能:二进制串到字符串的转换,
    //参数:源二进制字符串,二进制字符串长度,类型(true为二进制到hex,false为二进制到ANSCII char),
    //结果:返回处理后结果
    //--------------------------------------------------------------
      function BinaryToString(szSource:array of Char; len:Integer;bType:Boolean):string;

    //--------------------------------------------------------------
    //功能:单个char '0'或'1' 到int 0或1的变换
    //参数: '0'或'1'
    //结果:0或1
    //--------------------------------------------------------------
    function SingleCharToBinary(ch:Char):Integer;

    //--------------------------------------------------------------
    //功能:将右32位进行扩展位48位,
    //参数:原32位字符串,扩展后结果存放指针
    //结果:函数改变第二个参数的内容
    //--------------------------------------------------------------
     procedure ExpansionR(var rsData,deData:array of Char);

    //--------------------------------------------------------------
    //功能:异或函数,
    //参数:待异或的操作字符串1,字符串2,操作数长度,处理后结果存放指针
    //结果: 函数改变第四个参数的内容
    //--------------------------------------------------------------
    procedure ExecXOR(sz_P1,sz_P2:array of Char;len:Integer; var Return_value:array of Char);
    //--------------------------------------------------------------
    //功能:S-BOX , 数据压缩,
    //参数:48位二进制字符串,
    //结果:返回结果:32位字符串
    //--------------------------------------------------------------
    function CompressFuncS(sz_48:array of Char):string;

    //--------------------------------------------------------------
    //功能:16进制整数(0-15)到2进制字符串的转换
    //参数:十六进制整数(0-15)
    //结果:返回二进制字符串("0000"-"1111")
    //--------------------------------------------------------------
    function HexIntToBinary(i:Integer ):string;
    function  HexCharToBinary(ch:Char):string;



  protected

  public
  //--------------------------------------------------------------

  //功能:产生16个28位的key
  //参数:源8位的字符串(key)
  //结果:函数将调用private CreateSubKey将结果存于SubKeys[16][48];SubKeys1[16][48]
  //--------------------------------------------------------------
   function InitializeKey(sKey:string;isScndKey:Boolean):Boolean;

  //--------------------------------------------------------------
  //功能:生成子密钥
  //参数:经过PC1变换的56位二进制字符串
  //结果:将保存于char SubKeys[16][48]
  //--------------------------------------------------------------
  function CreateSubKey(sz:array of Char;var reSubKey:TSubKey):Boolean;

  //--------------------------------------------------------------
  //功能:加密任意长度字符串
  //参数:任意长度字符串
  //结果:函数将加密后结果存放于private szFCiphertextAnyLength[8192]
  //      用户通过属性CiphertextAnyLength得到
  //--------------------------------------------------------------
  function EncryptAnyLength(szSource:string;bIsUseSecondKey:Boolean):Boolean;

  //--------------------------------------------------------------
  //功能:加密8位字符串
  //参数:8位字符串
  //结果:函数将加密后结果存放于private szCiphertext[16]
  //      用户通过属性Ciphertext得到
  //--------------------------------------------------------------
    function EncryptData(s:string;bIsUseSecondKey,bShowResultInHex:Boolean):Boolean;

    //--------------------------------------------------------------
    //功能:IP逆变换,
    //参数:待变换字符串,处理后结果存放指针
    //结果:函数改变第二个参数的内容
    //--------------------------------------------------------------
    procedure PermutationP(s:string;var Return_value:array of Char);

    function MyPower(base,Exponent:Integer):Integer;

    function GetCiphertextAnyLength:string;



  published
    constructor CreateDESCls();
    destructor  Destroy();
    function EncryptDES(skey,szSource:string):string;  //DES加密
    function DecryptDES(skey,szSource:string):string;  //DES解密

    function Encrypt3DES(sKey,sKey1,szSource:string):string;  //3DES加密
    function Decrypt3DES(sKey,sKey1,szSource:string):string;  //3DES解密


end;



implementation

{ TDes3DesCls }

function TDes3DesCls.BinaryToString(szSource: array of Char; len: Integer;
  bType: Boolean): string;
var
  ilen,i,j,iCh:Integer;
  s_return,tmpS:string;
  szTmp8:array[0..7]of Char;
  buffer:array[0..15]of Char;
  cTmp,ch:Char;
begin
        //bType == true is Binary to Hex
        //else is Binary to Char
  FillChar(szTmp8,SizeOf(szTmp8),$0);
  FillChar(buffer,SizeOf(buffer),$0);

  ilen := 0;
  if (len mod 8)<>0 then
  begin
    Result := Char($0);
  end
  else
    ilen := Trunc(len/8);
  s_return := '';
  for i:=0 to ilen-1 do
  begin
    iCh :=0;
    CopyMemory(@szTmp8,@szSource[8*i],8);
    for j:=0 to 7 do
    begin

      iCh := iCh+SingleCharToBinary(szTmp8[j]) * MyPower(2,7-j);
    end;
    if bType then
    begin
      if iCh>$F then
        tmpS := LowerCase(IntToHex(iCh,2))
      else
        tmpS := LowerCase(IntToHex(iCh,1));
      CopyMemory(@buffer,PChar(tmpS),Length(tmpS));
//      itoa(iCh,buffer,16);
      if iCh <16 then
      begin
        cTmp := buffer[0];
        buffer[0] := Char('0');
        buffer[1] := cTmp;
      end;
      s_return := s_return+buffer[0];
      s_return := s_return+buffer[1];
      buffer[0]:= Char($0);
      buffer[1]:= Char($0);
    end
    else
    begin
      ch := Char(iCh);
      s_return := s_return+ch;
    end;
  end;
  Result := s_return;

end;

function TDes3DesCls.CompressFuncS(sz_48: array of Char): string;
var
  sTmp:array[0..7,0..5]of Char;
  sz_32:string;
  i,j:Integer;
  iX,iY:Integer;
begin
  FillChar(sTmp,SizeOf(sTmp),$0);

  for i:=0 to 7 do
  begin
    CopyMemory(@sTmp[i],@sz_48[6*i],6);
    iX := SingleCharToBinary(sTmp[i][0])*2+SingleCharToBinary(sTmp[i][5]);
    iY := 0;
    for j:=1 to 4 do
      iY := iY+ SingleCharToBinary(sTmp[i][j]) * MyPower(2,4-j);
    sz_32 := sz_32+HexIntToBinary(S_Box[i][iX][iY]);
  end;
  Result := sz_32;

end;

constructor TDes3DesCls.CreateDESCls;
begin
  inherited Create;
  //初始 数组
  FillChar(SubKeys,SizeOf(SubKeys),$0);
  FillChar(SubKeys2,SizeOf(SubKeys2),$0);
  FillChar(szCiphertext,SizeOf(szCiphertext),$0);
  FillChar(szPlaintext,SizeOf(szPlaintext),$0);
  FillChar(szFCiphertextAnyLength,SizeOf(szFCiphertextAnyLength),$0);
  FillChar(szFPlaintextAnyLength,SizeOf(szFPlaintextAnyLength),$0); 
end;

function TDes3DesCls.CreateSubKey(sz: array of Char;
  var reSubKey: TSubKey): Boolean;
var
  szCi,szDi,szTmpR,szTmpL:array[0..27] of Char;
  szTmp56:array[0..55] of Char;
  i,j:Integer;
begin
  FillChar(szTmpL,SizeOf(szTmpL),$0);
  FillChar(szTmpR,SizeOf(szTmpR),$0);
  FillChar(szCi,SizeOf(szCi),$0);
  FillChar(szDi,SizeOf(szDi),$0);
  //把56位密钥分解为两部分
  CopyMemory(@szTmpL[0],@sz[0],28);
  CopyMemory(@szTmpR[0],@sz[28],28);
  {生成16个子密钥，初始I=1。 
 1-2-3-1、同时将C[I]、D[I]左移1位或2位，根据I值决定左移的位数。见下表 
 I： 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 
 左移位数： 1 1 2 2 2 2 2 2 1 2 2 2 2 2 2 1}
  for i:=0 to 15 do
  begin
    //shift to left
    //Left 28 bits
    CopyMemory(@szCi,@szTmpL[Shift_Table[i]],28-Shift_Table[i]);
    CopyMemory(@szCi[28-Shift_Table[i]],@szTmpL,Shift_Table[i]);
    //Right 28 bits
    CopyMemory(@szDi,@szTmpR[Shift_Table[i]],28 - Shift_Table[i]);
    CopyMemory(@szDi[28 - Shift_Table[i]],@szTmpR,Shift_Table[i]);
    //permuted choice 48 bits key
    CopyMemory(@szTmp56,@szCi,28);
    CopyMemory(@szTmp56[28],@szDi,28);
    for j:=0 to 47 do
    begin
      reSubKey[i][j] := szTmp56[PC2_Table[j]-1]
    end;
    CopyMemory(@szTmpL,@szCi,28);
    CopyMemory(@szTmpR,@szDi,28);
  end;
  Result := True;
end;

function TDes3DesCls.Decrypt3DES(sKey, sKey1, szSource: string): string;
begin
//adsf
end;

function TDes3DesCls.DecryptDes(skey, szSource: string): string;
begin
//asdf
end;

destructor TDes3DesCls.Destroy;
begin
  //asdf
end;

function TDes3DesCls.Encrypt3DES(sKey, sKey1, szSource: string): string;
begin
//af
end;

function TDes3DesCls.EncryptAnyLength(szSource: string;
  bIsUseSecondKey: Boolean): Boolean;
var
  iLength,iParts,iResidue,i:Integer;
  szLast8Bits,szTmp:string;
begin
  iLength := Length(szSource);
  if iLength = 8 then
  begin
    EncryptData(szSource,bIsUseSecondKey,true);
    CopyMemory(@szFCiphertextAnyLength,@szCiphertext,16);
    //set the last char to '\0'
    szFCiphertextAnyLength[16] := Char($0);
  end
  else
  if iLength<8 then
  begin
    FillToEightBits(szSource);
    EncryptData(szSource,bIsUseSecondKey,true);
    CopyMemory(@szFCiphertextAnyLength,@szCiphertext,16);
    //set the last char to '\0'
    szFCiphertextAnyLength[16] := Char($0);

  end
  else
  if iLength>8 then
  begin

    iParts := ceil(iLength/8.0);   //使用ceil函数。ceil(x)返回的是大于x的最小整数
    iResidue := iLength mod 8;
    //encrypt the data 8 by 8 except the last part
    for i:=0 to (iParts-2) do
    begin
      szTmp := Copy(szSource,(i*8)+1,8);
      EncryptData(szTmp,bIsUseSecondKey,true);
      //after call EncryptData
      //cpoy the temp result to szFCiphertextAnyLength