des3desprg.~pas

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

      //cpoy the temp result to szFCiphertextAnyLength
      CopyMemory(@szFCiphertextAnyLength[16*i],@szCiphertext,16);
      if iResidue<>0 then //can't be divided exactly by 8
      begin
        szLast8Bits := Copy(szSource,(iParts-1)*8+1,iResidue);
        FillToEightBits(szLast8Bits);
      end
      else  //be divided exactly by 8
        szLast8Bits := Copy(szSource,(iParts-1)*8+1,8);

      //encrypt the last part
      EncryptData(szLast8Bits,bIsUseSecondKey,true);
      CopyMemory(@szFCiphertextAnyLength[16*(iParts - 1)],@szCiphertext,16);
      //set the last char to '\0'
      szFCiphertextAnyLength[(iParts)*16] := Char($0);
    end;
  end;
  Result := True;

end;

function TDes3DesCls.EncryptData(s: string; bIsUseSecondKey,
  bShowResultInHex: Boolean): Boolean;
var
  iCnt:Integer;
  sz_Li,sz_Ri:array[0..31] of Char;
  sz_IP,sz_Final64,szCiphertextBinary:array[0..63] of Char;
begin
  FillChar(sz_IP,SizeOf(sz_IP),$0);
  FillChar(sz_Final64,SizeOf(sz_Final64),$0);
  FillChar(szCiphertextBinary,SizeOf(szCiphertextBinary),$0);

  //IP
  InitialPermuteData(s,sz_IP,true);
  //分成两部份
  FillChar(sz_Li,SizeOf(sz_Li),$0);
  FillChar(sz_Ri,SizeOf(sz_Ri),$0);
  CopyMemory(@sz_Li[0],@sz_IP[0],32);
  CopyMemory(@sz_Ri[0],@sz_IP[32],32);

  for iCnt:=0 to 15 do
    FunctionF(sz_Li,sz_Ri,bIsUseSecondKey,iCnt);

  CopyMemory(@sz_Final64,@sz_Ri,32);
  CopyMemory(@sz_Final64[32],@sz_Li,32);
 //~IP

  iCnt := 0;
//  for iCnt := 0 to 63 do
  while iCnt <64 do            //按*P置换
  begin
    szCiphertextBinary[iCnt] := sz_Final64[Ord(IPR_Table[iCnt])-1];
    Inc(iCnt);
  end;
  CopyMemory(@szCiphertext,PChar(BinaryToString(szCiphertextBinary,64,true)),16);
  Result := True;

end;

function TDes3DesCls.EncryptDes(skey, szSource: string): string;
begin
  InitializeKey(skey,False);
  EncryptAnyLength(szSource,False);
  Result :=GetCiphertextAnyLength();
end;

procedure TDes3DesCls.ExecXOR(sz_P1, sz_P2: array of Char; len: Integer;
  var Return_value: array of Char);
var
  sz_Buffer :array[0..255] of Char;
  i:Integer;
begin
  FillChar(sz_Buffer,SizeOf(sz_Buffer),$0);
  for i:=0 to len-1 do
  begin
    sz_Buffer[i] := SingleBinaryToChar(SingleCharToBinary(sz_P1[i]) xor SingleCharToBinary(sz_P2[i]))
  end;
  CopyMemory(@Return_value,@sz_Buffer,len);

end;

procedure TDes3DesCls.ExpansionR(var rsData, deData: array of Char);
var
  sz_48ER :array[0..47]of Char;
  ii:Integer;
begin

  FillChar(sz_48ER,SizeOf(sz_48ER),$0);

  ii := 0;
  while  ii<48 do //for ii:=0 to 47 do
  begin
    sz_48ER[ii]:= rsData[E_Table[ii]-1];
    ii:=ii+1;

  end;
  CopyMemory(@deData,@sz_48ER,48);

end;

function TDes3DesCls.FillToEightBits(var sz: string): Boolean;
var
  Temp:array[0..7] of Char;
  i,j,k:Integer;
  re:Boolean;
begin
     //length less than 8 , add zero(s) to tail
  re:=True;
	FillChar(Temp,SizeOf(Temp),$0);
  for i:=1 to Length(sz)do  //把SZ的内容存储到临时数组中
  begin
    Temp[i-1] := sz[i];
  end;
  j:=Length(sz)+1;
  while j<9 do        //增加SZ长度
  begin
    sz := sz+char('0');
    Inc(j);
  end;
  for k:=1 to 8 do   //把数组中的字符全部给SZ，相当于不足的填0
  begin
    sz[k] := Temp[k-1];
  end;
  Result :=re;

end;

procedure TDes3DesCls.FunctionF(var sz_Li1, sz_Ri1: array of Char;
  bIsUseSecondKey: Boolean; iKey: Integer);
var
  sz_48R,sz_xor48,sz_Key:array[0..47]of Char;
  sz_P32,sz_Rii:array[0..31]of Char;
  s_Compress32:string;
begin
  FillChar(sz_48R,SizeOf(sz_48R),$0);
  FillChar(sz_xor48,SizeOf(sz_xor48),$0);
  FillChar(sz_Key,SizeOf(sz_Key),$0);
  FillChar(sz_P32,SizeOf(sz_P32),$0);
  FillChar(sz_Rii,SizeOf(sz_Rii),$0);
  if bIsUseSecondKey then
    CopyMemory(@sz_Key,@SubKeys2[iKey],48)

  else
    CopyMemory(@sz_Key,@SubKeys[iKey],48);
  ExpansionR(sz_Ri1,sz_48R);     //将右32位扩展为48位
  ExecXOR(sz_48R,sz_Key,48,sz_xor48);  //与16组密钥的一组进行异或

  s_Compress32 := CompressFuncS(sz_xor48); //分解为8个6位长 并按S表置换

  PermutationP(s_Compress32,sz_P32); // 按IP逆置换

  ExecXOR(sz_P32,sz_Li1,32,sz_Rii);  //于左部分异或放在右部分
  CopyMemory(@sz_Li1,@sz_Ri1,32);    //交换左右部分
  CopyMemory(@sz_Ri1,@sz_Rii,32);

end;

function TDes3DesCls.HexCharToBinary(ch: Char): string;
begin
   case ch of

    '0':Result:= '0000';
    '1':Result:= '0001';
    '2':Result:= '0010';
    '3':Result:= '0011';
    '4':Result:= '0100';
    '5':Result:= '0101';
    '6':Result:= '0110';
    '7':Result:= '0111';
    '8':Result:= '1000';
    '9':Result:= '1001';
    'a':Result:= '1010';
    'b':Result:= '1011';
    'c':Result:= '1100';
    'd':Result:= '1101';
    'e':Result:= '1110';
    'f':Result:= '1111';
    else  Result:= '';
   end;

end;

function TDes3DesCls.HexIntToBinary(i: Integer): string;
begin
  case i of
    0:result := '0000';
    1:result := '0001';
    2:result := '0010';
    3:result := '0011';
    4:result := '0100';
    5:result := '0101';
    6:result := '0110';
    7:result := '0111';
    8:result := '1000';
    9:result := '1001';
    10:result := '1010';
    11:result := '1011';
    12:result := '1100';
    13:result := '1101';
    14:result := '1110';
    15: result := '1111';
    else result := '';
  end;

end;

function TDes3DesCls.InitializeKey(sKey: string;
  isScndKey: Boolean): Boolean;
var
  sz_64key:array[0..63]of Char;
  iTmpBit:array[0..63]of Integer;
  sz_56Key:array[0..55]of Char;
  i,j,it:Integer;
begin
  FillChar(iTmpBit,SizeOf(iTmpBit),0);
  FillChar(sz_64key,SizeOf(sz_64key),' ');
  FillChar(sz_56Key,SizeOf(sz_56Key),' ');
  //convert 8 char-bytes key to 64 binary-bits    把8字节的密钥转换为64位的二进制bits
  for i:=0 to 63 do
  begin
    it := i shr 3;
    if it<Length(sKey) then
      iTmpBit[i] := (Ord(sKey[it+1])shr(i and 7))and 1
    else
      iTmpBit[i] := 0;
      //a = 0x61 = 0110,0001
      //after this , a is 1000,0110

  end;
//  let me convert it to right
  for i:=0 to 7 do
  begin
    for j:=0 to 7 do
      sz_64key[8*i+j] := SingleBinaryToChar(iTmpBit[8*(i+1)-(j+1)]);
  end;
  // 舍弃64位密钥中的奇偶校验位，然后按PC1置换

  for i:=0 to 55 do
  begin
    sz_56Key[i] := sz_64key[PC1_Table[i]-1];

  end;
  if isScndKey then
    CreateSubKey(sz_56Key,SubKeys2)
  else
    CreateSubKey(sz_56Key,SubKeys);

end;

function TDes3DesCls.InitialPermuteData(s: string; var sz: array of Char;
  szBool: Boolean): Boolean;
var
  sz_64Data:array[0..63]of  Char;
  iTmpBit:array[0..63]of Integer;
  sz_IPData:array[0..63] of Char;
  iCnt,iPst,_i,ui:Integer;
  DeStr:string;
  ch:Char;
begin
  FillChar(sz_64Data,SizeOf(sz_64Data),$0);
  FillChar(sz_IPData,SizeOf(sz_IPData),$0);
  FillChar(iTmpBit,SizeOf(iTmpBit),0);
  if szBool then    //加密
  begin
		//把8byte（64位）的string转换为2进制的位数组
    for iCnt :=0 to 63 do
      iTmpBit[iCnt] := (Ord(s[1+(iCnt shr 3)])shr(iCnt and 7))and 1;
    for iCnt :=0 to 7 do
    begin
     for iPst :=0 to 7 do
     begin
       sz_64Data[8*iCnt+iPst] := SingleBinaryToChar(iTmpBit[8*(iCnt+1)-(iPst+1)]);
     end;
    end;
    //IP置换
//    for _i := 0 to 63 do
    _i := 0;
    while _i<64 do
    begin
      sz_IPData[_i] := sz_64Data[IP_Table[_i]-1];
//      Inc(i);
      _i := _i+1;
    end;

  end
  else   //解密
  begin
    for ui:=0 to (Length(s)-1) do
    begin
      ch := s[ui+1];
      DeStr := DeStr+HexCharToBinary(LowerCase(ch)[1]);
    end;
    for _i:=0 to 63 do
    begin
      sz_IPData[_i] := DeStr[IP_Table[_i]];
    end;
  end;

  CopyMemory(@sz,@sz_IPData,Length(sz_IPData));
  Result := True;

end;

function TDes3DesCls.MyPower(base, Exponent: Integer): Integer;
begin
 if Exponent = 0 then
    Result := 1               { n**0 = 1 }
  else if (Base = 0) and (Exponent > 0) then
    Result := 0              { 0**n = 0, n > 0 }
  else if (Frac(Exponent) = 0) and (Abs(Exponent) <= MaxInt) then
    Result := StrToInt(FloatToStr(IntPower(Base, Integer(Trunc(Exponent)))))
  else
    Result := StrToInt(FloatToStr(Exp(Exponent * Ln(Base))));

end;

procedure TDes3DesCls.PermutationP(s: string;
  var Return_value: array of Char);
var
  sz_32bits :array[0..31] of Char;
  i:Integer;
begin
  FillChar(sz_32bits,SizeOf(sz_32bits),$0);
//  for i:=0 to 31 do
  i:=0;
  while i<32 do
  begin
    sz_32bits[i]:=s[Ord(P_Table[i])];
    i:=i+1;
  end;
  CopyMemory(@Return_value,@sz_32bits,32);

end;

function TDes3DesCls.SingleBinaryToChar(iTmp: Integer): Char;
begin
  if iTmp=1 then
    Result:= '1'
  else
    Result:='0';
end;

function TDes3DesCls.SingleCharToBinary(ch: Char): Integer;
begin
  if(ch = '1') then
    Result:= 1
  else
    Result:= 0;

end;

end.