dmdes.pas

4-26 243

unit dmdes;

{*********************************************************}

{* DELPHI、PHP、C#通用DES编码解码单元 *}

{* 由TurboPower LockBox部分代码改写 *}

{* 滕州市东鸣软件工作室制作 ZWF 2011-12-27 *}

{*********************************************************}

{EncryDes为编码函数,DecryDes为解码函数,keystr为密码,ivstr为偏移量,

一般设置keystr,ivstr相同,内容为八位字节长度的字符串,编码结果为十六进制字串}

interface

uses

Windows,SysUtils;

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:string;const keystr:string;const ivstr:string):string ;

function DecryDes(const str:string;const keystr:string;const ivstr:string):string ;
function DecryDessec(const str:string;const keystr:string;const ivstr:string):string ;
implementation

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:string;const keystr:string;const ivstr:string):string ;

var key:tkey64;

Context:TDESContext;

Block,iv:TDESBlock;

i,j,len,posnum:smallint;

poschar,xx:char;
xuhuan:integer;

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:= char( 8- (len mod 8));
if len<=8 then
xuhuan:=0
else
xuhuan:=round(len/8);

for i:=0 to xuhuan 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 + inttohex(posnum,2);
end;

iv:=block;

end;

end;

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

var key:tkey64;

Context:TDESContext;

bak,Block,iv:TDESBlock;

i,j,len,posnum:smallint;

poschar,xx:char;

res,lss,temp:string;

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 +   char(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+char(res[i]);

    end;

  Result:= trim(temp);

   end;
end;
function DecryDes(const str:string;const keystr:string;const ivstr:string):string ;

var key:tkey64;

Context:TDESContext;

bak,Block,iv:TDESBlock;

i,j,len,posnum:smallint;

poschar,xx:char;

res,lss:string;

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+ char(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 + char(block[j]);

end;

iv:=bak;

end;

end;

end.

 

Delphi import unit per OpenSSL DLL RSA+MD5 signature

A nice contribute by Dim (Russia) Require libeay32.pas, v. >= 0.7 // Equivalent to: // openssl dgst -md5 -sign private.pem -hex -out ...

阅读全文

Hash a file with MD5

This tutorial continues from Encrypt a file. Setup Put another button on the main form and caption it "Hash". Add a THash compon...

阅读全文

Encrypting a file with 3DES

http://lockbox.seanbdurkin.id.au/Encrypt+a+file n this tutorial, we are going to use a component based approach to encrypt some files. Make a...

阅读全文

Comments are closed, but trackbacks and pingbacks are open.