Delphi加密算法des源码

unit dmdes;

{ ********************************************************* }
{ * DELPHI、PHP、C#通用DES编码解码单元 * }
{ * 由TurboPower LockBox部分代码改写 * }
{ * 滕州市东鸣软件工作室制作 ZWF 2011-12-27 *
  * update by wh 2012-12-13 仅限英文及数字,中文不匹配 for delphi xe2 * }
{ * EncryDes为编码函数,DecryDes为解码函数,keystr为密码,ivstr为偏移量,
  一般设置keystr,ivstr相同,内容为八位字节长度的字符串,编码结果为十六进制字串 * }
{ ********************************************************* }
// 附:测试代码如下
// uses dmdes, Soap.EncdDecd;
//
// procedure TForm1.Button1Click(Sender: TObject);
// var
// str1, str2: AnsiString;
// keyAnsiStr, ivAnsiStr: AnsiString;
// begin
// keyAnsiStr := '11111111';
// ivAnsiStr := AnsiChar($12) + AnsiChar($34) + AnsiChar($56) + AnsiChar($78) +
// AnsiChar($90) + AnsiChar($AB) + AnsiChar($CD) + AnsiChar($EF);
// str1 := AnsiString(Edit1.Text);
// str2 := EncryDes(str1, keyAnsiStr, ivAnsiStr);
// Edit2.Text := EncodeString(string(str2));
// end;

interface

uses

  Windows, SysUtils, System.Math;

type

  PKey64 = ^TKey64;
  TKey64 = array [0 .. 7] of Byte;

type

  TDESBlock = array [0 .. 7] of Byte;

  TDESContext = packed record
    TransformedKey: array [0 .. 31] of LongInt;
    Encrypt: Boolean;
  end;

function EncryDes(const str: AnsiString; const keystr: AnsiString;
  const ivstr: AnsiString): AnsiString;

function DecryDes(const str: AnsiString; const keystr: AnsiString;
  const ivstr: AnsiString): AnsiString;

function DecryDessec(const str: AnsiString; const keystr: AnsiString;
  const ivstr: AnsiString): AnsiString;

implementation

uses System.AnsiStrings;

procedure XorMemPrim(var Mem1; const Mem2; Count: Cardinal); register;
asm
  push esi
  push edi
  mov esi, eax // esi = Mem1
  mov edi, edx // edi = Mem2
  push ecx // save byte count
  shr ecx, 2 // convert to dwords
  jz @Continue
  cld
@Loop1: // xor dwords at a time
  mov eax, [edi]
  xor [esi], eax
  add esi, 4
  add edi, 4
  dec ecx
  jnz @Loop1
@Continue: // handle remaining bytes (3 or less)
  pop ecx
  and ecx, 3
  jz @Done
@Loop2: // xor remaining bytes
  mov al, [edi]
  xor [esi], al
  inc esi
  inc edi
  dec ecx
  jnz @Loop2
@Done:
  pop edi
  pop esi
end;

{ -------------------------------------------------------------------------- }

procedure XorMem(var Mem1; const Mem2; Count: Cardinal);
begin
  XorMemPrim(Mem1, Mem2, Count);
end;

{ -------------------------------------------------------------------------- }

procedure EncryptDES(const Context: TDESContext; var Block: TDESBlock);
const
  SPBox: array [0 .. 7, 0 .. 63] of DWord = (($01010400, $00000000, $00010000,
    $01010404, $01010004, $00010404, $00000004, $00010000, $00000400, $01010400,
    $01010404, $00000400, $01000404, $01010004, $01000000, $00000004, $00000404,
    $01000400, $01000400, $00010400, $00010400, $01010000, $01010000, $01000404,
    $00010004, $01000004, $01000004, $00010004, $00000000, $00000404, $00010404,
    $01000000, $00010000, $01010404, $00000004, $01010000, $01010400, $01000000,
    $01000000, $00000400, $01010004, $00010000, $00010400, $01000004, $00000400,
    $00000004, $01000404, $00010404, $01010404, $00010004, $01010000, $01000404,
    $01000004, $00000404, $00010404, $01010400, $00000404, $01000400, $01000400,
    $00000000, $00010004, $00010400, $00000000, $01010004),

    ($80108020, $80008000, $00008000, $00108020, $00100000, $00000020,
    $80100020, $80008020, $80000020, $80108020, $80108000, $80000000, $80008000,
    $00100000, $00000020, $80100020, $00108000, $00100020, $80008020, $00000000,
    $80000000, $00008000, $00108020, $80100000, $00100020, $80000020, $00000000,
    $00108000, $00008020, $80108000, $80100000, $00008020, $00000000, $00108020,
    $80100020, $00100000, $80008020, $80100000, $80108000, $00008000, $80100000,
    $80008000, $00000020, $80108020, $00108020, $00000020, $00008000, $80000000,
    $00008020, $80108000, $00100000, $80000020, $00100020, $80008020, $80000020,
    $00100020, $00108000, $00000000, $80008000, $00008020, $80000000, $80100020,
    $80108020, $00108000),

    ($00000208, $08020200, $00000000, $08020008, $08000200, $00000000,
    $00020208, $08000200, $00020008, $08000008, $08000008, $00020000, $08020208,
    $00020008, $08020000, $00000208, $08000000, $00000008, $08020200, $00000200,
    $00020200, $08020000, $08020008, $00020208, $08000208, $00020200, $00020000,
    $08000208, $00000008, $08020208, $00000200, $08000000, $08020200, $08000000,
    $00020008, $00000208, $00020000, $08020200, $08000200, $00000000, $00000200,
    $00020008, $08020208, $08000200, $08000008, $00000200, $00000000, $08020008,
    $08000208, $00020000, $08000000, $08020208, $00000008, $00020208, $00020200,
    $08000008, $08020000, $08000208, $00000208, $08020000, $00020208, $00000008,
    $08020008, $00020200),

    ($00802001, $00002081, $00002081, $00000080, $00802080, $00800081,
    $00800001, $00002001, $00000000, $00802000, $00802000, $00802081, $00000081,
    $00000000, $00800080, $00800001, $00000001, $00002000, $00800000, $00802001,
    $00000080, $00800000, $00002001, $00002080, $00800081, $00000001, $00002080,
    $00800080, $00002000, $00802080, $00802081, $00000081, $00800080, $00800001,
    $00802000, $00802081, $00000081, $00000000, $00000000, $00802000, $00002080,
    $00800080, $00800081, $00000001, $00802001, $00002081, $00002081, $00000080,
    $00802081, $00000081, $00000001, $00002000, $00800001, $00002001, $00802080,
    $00800081, $00002001, $00002080, $00800000, $00802001, $00000080, $00800000,
    $00002000, $00802080),

    ($00000100, $02080100, $02080000, $42000100, $00080000, $00000100,
    $40000000, $02080000, $40080100, $00080000, $02000100, $40080100, $42000100,
    $42080000, $00080100, $40000000, $02000000, $40080000, $40080000, $00000000,
    $40000100, $42080100, $42080100, $02000100, $42080000, $40000100, $00000000,
    $42000000, $02080100, $02000000, $42000000, $00080100, $00080000, $42000100,
    $00000100, $02000000, $40000000, $02080000, $42000100, $40080100, $02000100,
    $40000000, $42080000, $02080100, $40080100, $00000100, $02000000, $42080000,
    $42080100, $00080100, $42000000, $42080100, $02080000, $00000000, $40080000,
    $42000000, $00080100, $02000100, $40000100, $00080000, $00000000, $40080000,
    $02080100, $40000100),

    ($20000010, $20400000, $00004000, $20404010, $20400000, $00000010,
    $20404010, $00400000, $20004000, $00404010, $00400000, $20000010, $00400010,
    $20004000, $20000000, $00004010, $00000000, $00400010, $20004010, $00004000,
    $00404000, $20004010, $00000010, $20400010, $20400010, $00000000, $00404010,
    $20404000, $00004010, $00404000, $20404000, $20000000, $20004000, $00000010,
    $20400010, $00404000, $20404010, $00400000, $00004010, $20000010, $00400000,
    $20004000, $20000000, $00004010, $20000010, $20404010, $00404000, $20400000,
    $00404010, $20404000, $00000000, $20400010, $00000010, $00004000, $20400000,
    $00404010, $00004000, $00400010, $20004010, $00000000, $20404000, $20000000,
    $00400010, $20004010),

    ($00200000, $04200002, $04000802, $00000000, $00000800, $04000802,
    $00200802, $04200800, $04200802, $00200000, $00000000, $04000002, $00000002,
    $04000000, $04200002, $00000802, $04000800, $00200802, $00200002, $04000800,
    $04000002, $04200000, $04200800, $00200002, $04200000, $00000800, $00000802,
    $04200802, $00200800, $00000002, $04000000, $00200800, $04000000, $00200800,
    $00200000, $04000802, $04000802, $04200002, $04200002, $00000002, $00200002,
    $04000000, $04000800, $00200000, $04200800, $00000802, $00200802, $04200800,
    $00000802, $04000002, $04200802, $04200000, $00200800, $00000000, $00000002,
    $04200802, $00000000, $00200802, $04200000, $00000800, $04000002, $04000800,
    $00000800, $00200002),

    ($10001040, $00001000, $00040000, $10041040, $10000000, $10001040,
    $00000040, $10000000, $00040040, $10040000, $10041040, $00041000, $10041000,
    $00041040, $00001000, $00000040, $10040000, $10000040, $10001000, $00001040,
    $00041000, $00040040, $10040040, $10041000, $00001040, $00000000, $00000000,
    $10040040, $10000040, $10001000, $00041040, $00040000, $00041040, $00040000,
    $10041000, $00001000, $00000040, $10040040, $00001000, $00041040, $10001000,
    $00000040, $10000040, $10040000, $10040040, $10000000, $00040000, $10001040,
    $00000000, $10041040, $00040040, $10000040, $10040000, $10001000, $10001040,
    $00000000, $10041040, $00041000, $00041000, $00001040, $00001040, $00040040,
    $10000000, $10041000));

var
  I, L, R, Work: DWord;
  CPtr: PDWord;
  procedure SplitBlock(const Block: TDESBlock; var L, R: DWord); register;
  asm
    push ebx
    push eax
    mov eax, [eax]
    mov bh, al
    mov bl, ah
    rol ebx, 16
    shr eax, 16
    mov bh, al
    mov bl, ah
    mov [edx], ebx
    pop eax
    mov eax, [eax+4]
    mov bh, al
    mov bl, ah
    rol ebx, 16
    shr eax, 16
    mov bh, al
    mov bl, ah
    mov [ecx], ebx
    pop ebx
  end;

  procedure JoinBlock(const L, R: LongInt; var Block: TDESBlock); register;
  asm
    push ebx
    mov bh, al
    mov bl, ah
    rol ebx, 16
    shr eax, 16
    mov bh, al
    mov bl, ah
    mov [ecx+4], ebx
    mov bh, dl
    mov bl, dh
    rol ebx, 16
    shr edx, 16
    mov bh, dl
    mov bl, dh
    mov [ecx], ebx
    pop ebx
  end;

  procedure IPerm(var L, R: DWord);
  var
    Work: DWord;
  begin
    Work := ((L shr 4) xor R) and $0F0F0F0F;
    R := R xor Work;
    L := L xor Work shl 4;
    Work := ((L shr 16) xor R) and $0000FFFF;
    R := R xor Work;
    L := L xor Work shl 16;
    Work := ((R shr 2) xor L) and $33333333;
    L := L xor Work;
    R := R xor Work shl 2;
    Work := ((R shr 8) xor L) and $00FF00FF;
    L := L xor Work;
    R := R xor Work shl 8;
    R := (R shl 1) or (R shr 31);
    Work := (L xor R) and $AAAAAAAA;
    L := L xor Work;
    R := R xor Work;
    L := (L shl 1) or (L shr 31);
  end;

  procedure FPerm(var L, R: DWord);
  var
    Work: DWord;
  begin
    L := L;
    R := (R shl 31) or (R shr 1);
    Work := (L xor R) and $AAAAAAAA;
    L := L xor Work;
    R := R xor Work;
    L := (L shr 1) or (L shl 31);
    Work := ((L shr 8) xor R) and $00FF00FF;
    R := R xor Work;
    L := L xor Work shl 8;
    Work := ((L shr 2) xor R) and $33333333;
    R := R xor Work;
    L := L xor Work shl 2;
    Work := ((R shr 16) xor L) and $0000FFFF;
    L := L xor Work;
    R := R xor Work shl 16;
    Work := ((R shr 4) xor L) and $0F0F0F0F;
    L := L xor Work;
    R := R xor Work shl 4;
  end;

begin
  SplitBlock(Block, L, R);
  IPerm(L, R);
  CPtr := @Context;
  for I := 0 to 7 do
  begin
    Work := (((R shr 4) or (R shl 28)) xor CPtr^);
    inc(CPtr);
    L := L xor SPBox[6, Work and $3F];
    L := L xor SPBox[4, Work shr 8 and $3F];
    L := L xor SPBox[2, Work shr 16 and $3F];
    L := L xor SPBox[0, Work shr 24 and $3F];
    Work := (R xor CPtr^);
    inc(CPtr);
    L := L xor SPBox[7, Work and $3F];
    L := L xor SPBox[5, Work shr 8 and $3F];
    L := L xor SPBox[3, Work shr 16 and $3F];
    L := L xor SPBox[1, Work shr 24 and $3F];
    Work := (((L shr 4) or (L shl 28)) xor CPtr^);
    inc(CPtr);
    R := R xor SPBox[6, Work and $3F];
    R := R xor SPBox[4, Work shr 8 and $3F];
    R := R xor SPBox[2, Work shr 16 and $3F];
    R := R xor SPBox[0, Work shr 24 and $3F];
    Work := (L xor CPtr^);
    inc(CPtr);
    R := R xor SPBox[7, Work and $3F];
    R := R xor SPBox[5, Work shr 8 and $3F];
    R := R xor SPBox[3, Work shr 16 and $3F];
    R := R xor SPBox[1, Work shr 24 and $3F];
  end;
  FPerm(L, R);
  JoinBlock(L, R, Block);

end;

procedure InitEncryptDES(const Key: TKey64; var Context: TDESContext;
  Encrypt: Boolean);
const
  PC1: array [0 .. 55] of Byte = (56, 48, 40, 32, 24, 16, 8, 0, 57, 49, 41, 33,
    25, 17, 9, 1, 58, 50, 42, 34, 26, 18, 10, 2, 59, 51, 43, 35, 62, 54, 46, 38,
    30, 22, 14, 6, 61, 53, 45, 37, 29, 21, 13, 5, 60, 52, 44, 36, 28, 20, 12, 4,
    27, 19, 11, 3);

  PC2: array [0 .. 47] of Byte = (13, 16, 10, 23, 0, 4, 2, 27, 14, 5, 20, 9, 22,
    18, 11, 3, 25, 7, 15, 6, 26, 19, 12, 1, 40, 51, 30, 36, 46, 54, 29, 39, 50,
    44, 32, 47, 43, 48, 38, 55, 33, 52, 45, 41, 49, 35, 28, 31);

  CTotRot: array [0 .. 15] of Byte = (1, 2, 4, 6, 8, 10, 12, 14, 15, 17, 19, 21,
    23, 25, 27, 28);

  CBitMask: array [0 .. 7] of Byte = (128, 64, 32, 16, 8, 4, 2, 1);

var
  PC1M: array [0 .. 55] of Byte;
  PC1R: array [0 .. 55] of Byte;
  KS: array [0 .. 7] of Byte;
  I, J, L, M: LongInt;
begin

  { convert PC1 to bits of key }
  for J := 0 to 55 do
  begin
    L := PC1[J];
    M := L mod 8;
    PC1M[J] := Ord((Key[L div 8] and CBitMask[M]) <> 0);
  end;

  { key chunk for each iteration }
  for I := 0 to 15 do
  begin
    { rotate PC1 the right amount }
    for J := 0 to 27 do
    begin
      L := J + CTotRot[I];
      if (L < 28) then
      begin
        PC1R[J] := PC1M[L];
        PC1R[J + 28] := PC1M[L + 28];
      end
      else
      begin
        PC1R[J] := PC1M[L - 28];
        PC1R[J + 28] := PC1M[L];
      end;

    end;

    { select bits individually }

    FillChar(KS, SizeOf(KS), 0);
    for J := 0 to 47 do
      if Boolean(PC1R[PC2[J]]) then
      begin
        L := J div 6;
        KS[L] := KS[L] or CBitMask[J mod 6] shr 2;
      end;

    { now convert to odd/even interleaved form for use in F }

    if Encrypt then
    begin
      Context.TransformedKey[I * 2] := (LongInt(KS[0]) shl 24) or
        (LongInt(KS[2]) shl 16) or (LongInt(KS[4]) shl 8) or (LongInt(KS[6]));

      Context.TransformedKey[I * 2 + 1] := (LongInt(KS[1]) shl 24) or
        (LongInt(KS[3]) shl 16) or (LongInt(KS[5]) shl 8) or (LongInt(KS[7]));

    end
    else
    begin
      Context.TransformedKey[31 - (I * 2 + 1)] := (LongInt(KS[0]) shl 24) or
        (LongInt(KS[2]) shl 16) or (LongInt(KS[4]) shl 8) or (LongInt(KS[6]));

      Context.TransformedKey[31 - (I * 2)] := (LongInt(KS[1]) shl 24) or
        (LongInt(KS[3]) shl 16) or (LongInt(KS[5]) shl 8) or (LongInt(KS[7]));

    end;

  end;
  Context.Encrypt := Encrypt;

end;

procedure EncryptDESCBC(const Context: TDESContext; const Prev: TDESBlock;
  var Block: TDESBlock);

begin
  if Context.Encrypt then
  begin
    XorMem(Block, Prev, SizeOf(Block));
    EncryptDES(Context, Block);
  end
  else
  begin
    EncryptDES(Context, Block);
    XorMem(Block, Prev, SizeOf(Block));
  end;

end;

function EncryDes(const str: AnsiString; const keystr: AnsiString;
  const ivstr: AnsiString): AnsiString;
var
  Key: TKey64;
  Context: TDESContext;
  Block, iv: TDESBlock;
  I, J, len, posnum: smallint;
  poschar, xx: AnsiChar;
begin
  for I := 0 to 7 do
  begin
    if I > (length(keystr) - 1) then
      Key[I] := 0
    else
      Key[I] := Byte(keystr[I + 1]);
  end;
  for I := 0 to 7 do
  begin
    if I > (length(ivstr) - 1) then
      iv[I] := 0
    else
      iv[I] := Byte(ivstr[I + 1]);
  end;
  InitEncryptDES(Key, Context, true);
  len := length(AnsiString(str));
  xx := AnsiChar(8 - (len mod 8));

  { DELPHI下要实现相应的加密和解密,需要自己写DES代码,并加上CBC方式的异或
    这里要说明一点,我发现C#下DES明文在加密前,有补足8的倍数的情况,即如果
    如果是“11111”就会补成“11111#3#3#3”,如果是“11111111”就会“11111111#8#8#8#8#8#8#8#8”,
    然后在进行异或,最后加密! }
  for I := 0 to (len div 8) do
  begin
    for J := 0 to 7 do
    begin
      if ((I * 8 + J + 1) <= len) then // <=
      begin
        poschar := str[I * 8 + J + 1];
        Block[J] := Byte(poschar);
      end
      else
        Block[J] := Byte(xx);
    end;
    EncryptDESCBC(Context, iv, Block);
    for J := 0 to 7 do
    begin
      posnum := Block[J];
      result := result + AnsiChar(posnum); // inttohex(posnum,2);
    end;
    iv := Block;
  end;
end;

function DecryDessec(const str: AnsiString; const keystr: AnsiString;
  const ivstr: AnsiString): AnsiString;
var
  Key: TKey64;
  Context: TDESContext;
  bak, Block, iv: TDESBlock;
  I, J, { len, } posnum: smallint;
  { poschar,xx:char; }
  res, { lss, } temp: AnsiString;
begin
  temp := keystr;
  res := '';
  for I := 0 to 7 do
  begin
    if I > (length(temp) - 1) then
      Key[I] := 0
    else
      Key[I] := Byte(temp[I + 1]);
  end;
  temp := ivstr;
  for I := 0 to 7 do
  begin
    if I > (length(temp) - 1) then
      iv[I] := 0
    else
      iv[I] := Byte(temp[I + 1]);
  end;
  InitEncryptDES(Key, Context, False);
  temp := str;
  posnum := 0;
  for I := 0 to length(temp) - 1 do
  begin
    Block[posnum] := Byte(temp[I + 1]);
    posnum := posnum + 1;
    if posnum = 8 then
    begin
      bak := Block;
      EncryptDESCBC(Context, iv, Block);
      for J := 0 to 7 do
      begin
        // temp := temp+inttostr(byte(block[i]))+' ';
        res := res + AnsiChar(Block[J]);
      end;
      iv := bak;
      posnum := 0;
    end;

  end;
  if posnum <> 0 then
  begin
    //
  end
  else
  begin
    temp := '';
    for I := 1 to length(res) do
    begin
      temp := temp + AnsiChar(res[I]);
    end;
    result := Trim(temp);
  end;

end;

function DecryDes(const str: AnsiString; const keystr: AnsiString;
  const ivstr: AnsiString): AnsiString;
var
  Key: TKey64;
  Context: TDESContext;
  bak, Block, iv: TDESBlock;
  I, J, len { ,posnum } : smallint;
  poschar, xx: AnsiChar;
  res, lss: AnsiString;
begin
  for I := 0 to 7 do
  begin
    if I > (length(keystr) - 1) then
      Key[I] := 0
    else
      Key[I] := Byte(keystr[I + 1]);
  end;
  for I := 0 to 15 do
  begin
    if I > (length(ivstr) - 1) then
      iv[I] := 0
    else
      iv[I] := Byte(ivstr[I + 1]);
  end;
  InitEncryptDES(Key, Context, False);
  res := '';
  for J := 0 to (length(str) div 2) - 1 do
  begin
    lss := copy(str, J * 2 + 1, 2);
    res := res + AnsiChar(StrToInt('$' + lss));
  end;
  len := length(AnsiString(res));
  for I := 0 to round(len / 8) - 1 do
  begin
    for J := 0 to 7 do
    begin
      if ((I * 7 + J + 1) <= len) then
      begin
        poschar := res[I * 8 + J + 1];
        Block[J] := Byte(poschar);
      end
      else
      begin
        Block[J] := Byte(xx);
      end;
    end;
    bak := Block;
    EncryptDESCBC(Context, iv, Block);
    for J := 0 to 7 do
    begin
      result := result + AnsiChar(Block[J]);
    end;
    iv := bak;
  end;

end;

end.

© 版权声明
THE END
喜欢就支持一下吧
点赞0 分享