www.pudn.com > ALGO.rar > ALG_Iderto.pas


Unit ALG_Iderto; 
 
interface 
 
uses 
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
  Dialogs, StdCtrls; 
type 
     TPlainKey = array[0..7] of Byte; 
     THexKey = array[0..9] of Byte; 
     PHexKey = ^THexKey; 
     Procedure Decrypt_IDERTO (worddata_I,MK_PK_I,date_Iderto : string); 
     procedure RotateKey(Key: PByteArray); 
     function  SigCalc(plainmasterkey, plainkey : array of byte) : THexKey; 
     function  VerifySignature( ins_idert , MK_PK_I ,sig_idert,date_Iderto : string ) : Boolean; 
     procedure CryptKey(N: Word; Key1, Key2: PByteArray); 
     procedure RotateKey2(N: Word; Key: PByteArray); 
     function  VerifySignatureEMM( ins_idert ,MK_PK_I ,sig_idert  : string ) : Boolean; 
var 
  CW_I : array[0..7] of Byte; 
  Date_I : array[0..1] of Byte; 
  BK_I : array[0..9] of Byte; 
  PK_I : array[0..7] of Byte; 
  key :  array[0..7] of Byte; 
  Tmp_EK_I : array[0..7] of Byte; 
  EK_I : array[0..7] of Byte; 
  Test_III : Byte ; 
  Buffer: array[0..256] of Byte; 
  SigKey: TPlainKey; 
implementation 
 
const 
  RotTable1: array[0..15] of Byte = (0, 1, 2, 3, 4, 5, 6, 7, 0, 3, 6, 1, 4, 7, 2, 5); 
  AsciTable: array[0..7]  of Byte = ($61, $62, $63, $64, $65, $66, $67, $FE); 
  Table1: array[0..255]   of Byte = ( 
    $DA,$26,$E8,$72,$11,$52,$3E,$46,$32,$FF,$8C,$1E,$A7,$BE,$2C,$29, 
    $5F,$86,$7E,$75,$0A,$08,$A5,$21,$61,$FB,$7A,$58,$60,$F7,$81,$4F, 
    $E4,$FC,$DF,$B1,$BB,$6A,$02,$B3,$0B,$6E,$5D,$5C,$D5,$CF,$CA,$2A, 
    $14,$B7,$90,$F3,$D9,$37,$3A,$59,$44,$69,$C9,$78,$30,$16,$39,$9A, 
    $0D,$05,$1F,$8B,$5E,$EE,$1B,$C4,$76,$43,$BD,$EB,$42,$EF,$F9,$D0, 
    $4D,$E3,$F4,$57,$56,$A3,$0F,$A6,$50,$FD,$DE,$D2,$80,$4C,$D3,$CB, 
    $F8,$49,$8F,$22,$71,$84,$33,$E0,$47,$C2,$93,$BC,$7C,$3B,$9C,$7D, 
    $EC,$C3,$F1,$89,$CE,$98,$A2,$E1,$C1,$F2,$27,$12,$01,$EA,$E5,$9B, 
    $25,$87,$96,$7B,$34,$45,$AD,$D1,$B5,$DB,$83,$55,$B0,$9E,$19,$D7, 
    $17,$C6,$35,$D8,$F0,$AE,$D4,$2B,$1D,$A0,$99,$8A,$15,$00,$AF,$2D, 
    $09,$A8,$F5,$6C,$A1,$63,$67,$51,$3C,$B2,$C0,$ED,$94,$03,$6F,$BA, 
    $3F,$4E,$62,$92,$85,$DD,$AB,$FE,$10,$2E,$68,$65,$E7,$04,$F6,$0C, 
    $20,$1C,$A9,$53,$40,$77,$2F,$A4,$FA,$6D,$73,$28,$E2,$CD,$79,$C8, 
    $97,$66,$8E,$82,$74,$06,$C7,$88,$1A,$4A,$6B,$CC,$41,$E9,$9D,$B8, 
    $23,$9F,$3D,$BF,$8D,$95,$C5,$13,$B9,$24,$5A,$DC,$64,$18,$38,$91, 
    $7F,$5B,$70,$54,$07,$B6,$4B,$0E,$36,$AC,$31,$E6,$D6,$48,$AA,$B4); 
  Table2 : Array[0..255]   of Byte = ( 
    $8E,$D5,$32,$53,$4B,$18,$7F,$95,$BE,$30,$F3,$E0,$22,$E1,$68,$90, 
    $82,$C8,$A8,$57,$21,$C5,$38,$73,$61,$5D,$5A,$D6,$60,$B7,$48,$70, 
    $2B,$7A,$1D,$D1,$B1,$EC,$7C,$AA,$2F,$1F,$37,$58,$72,$88,$FF,$87, 
    $1C,$CB,$00,$E6,$4E,$AB,$EB,$B3,$F7,$59,$71,$6A,$64,$2A,$55,$4D, 
    $FC,$C0,$51,$01,$2D,$C4,$54,$E2,$9F,$26,$16,$27,$F2,$9C,$86,$11, 
    $05,$29,$A2,$78,$49,$B2,$A6,$CA,$96,$E5,$33,$3F,$46,$BA,$D0,$BB, 
    $5F,$84,$98,$E4,$F9,$0A,$62,$EE,$F6,$CF,$94,$F0,$EA,$1E,$BF,$07, 
    $9B,$D9,$E9,$74,$C6,$A4,$B9,$56,$3E,$DB,$C7,$15,$E3,$80,$D7,$ED, 
    $EF,$13,$AC,$A1,$91,$C2,$89,$5B,$08,$0B,$4C,$02,$3A,$5C,$A9,$3B, 
    $CE,$6B,$A7,$E7,$CD,$7B,$A0,$47,$09,$6D,$F8,$F1,$8B,$B0,$12,$42, 
    $4A,$9A,$17,$B4,$7E,$AD,$FE,$FD,$2C,$D3,$F4,$B6,$A3,$FA,$DF,$B8, 
    $D4,$DA,$0F,$50,$93,$66,$6C,$20,$D8,$8A,$DD,$31,$1A,$8C,$06,$D2, 
    $44,$E8,$23,$43,$6E,$10,$69,$36,$BC,$19,$8D,$24,$81,$14,$40,$C9, 
    $6F,$2E,$45,$52,$41,$92,$34,$FB,$5E,$0D,$F5,$76,$25,$77,$63,$65, 
    $AF,$4F,$CC,$03,$9D,$0C,$28,$39,$85,$DE,$B5,$7D,$67,$83,$BD,$C3, 
    $DC,$3C,$AE,$99,$04,$75,$8F,$97,$C1,$A5,$9E,$35,$0E,$3D,$1B,$79); 
 
function VerifySignature( ins_idert ,MK_PK_I ,sig_idert , date_Iderto : string ) : Boolean; 
var 
  I,J:Integer; 
  TmpMKey:THexKey; 
  B0,B1,B2,B3:SmallInt; 
  tmp_I:string; 
begin 
  // 
  for i:=0 to ((Length(ins_idert)DIV 2)-1) do Buffer[i]:=strtoint('$'+copy(ins_idert,i*2+1,2)); 
  for i:= 0 to 7 do tmpMKey[i]:=strtoint('$'+copy(MK_PK_I,i*2+1,2)); 
  for i:= 0 to 1 do tmpMKey[i+8]:=strtoint('$'+copy(MK_PK_I,i*2+1,2)) Xor strtoint('$'+copy(date_Iderto,i*2+1,2)); 
  tmp_I:='';B0:=0;B2:=0;B3:=0; 
  for i := 0 to 9 do if tmpMKey[i]>$F then tmp_I:=tmp_I+Format('%2x',[tmpMKey[i]]) 
                                      else tmp_I:=tmp_I+Format('0%1x',[tmpMKey[i]]); 
  // 
  FillChar(SigKey[0],SizeOf(SigKey),0);I:=Length(ins_idert)DIV 2 ; 
  while I > 0 do 
    begin 
      B1:=0;J:=0; 
      if I < 8 then B1 := (8 - I); 
      while (8 - B1) > J do 
        begin 
         SigKey[J] := SigKey[J] xor Buffer[(B3 shl 3) + B0 + J];Inc(J); 
        end; 
      J:=8;J:=J-B1; 
      while (J < 8) do 
        begin 
          SigKey[J] := SigKey[J] xor ascitable[B2];Inc(B2);Inc(J); 
        end; 
      if B1 = 0 then CryptKey($28, @TmpMKey, @SigKey) 
                else CryptKey($68, @TmpMKey, @SigKey); 
      Inc(B3);I:=I-8; 
    end; 
  tmp_I:=''; 
  for i:= 0 to 4 do if SigKey[I]>$F then tmp_I:=tmp_I+format('%2x',[SigKey[I]]) 
                         else tmp_I:=tmp_I+format('0%1x',[SigKey[I]]); 
  if tmp_I=sig_idert then Result:=True else Result:=False; 
end; 
function VerifySignatureEMM( ins_idert ,MK_PK_I ,sig_idert : string ) : Boolean; 
var 
  I,J:Integer; 
  TmpMKey:THexKey; 
  B0,B1,B2,B3:SmallInt; 
  tmp_I:string; 
begin 
 
  for i:=0 to ((Length(ins_idert)DIV 2)-1) do Buffer[i]:=strtoint('$'+copy(ins_idert,i*2+1,2)); 
  for i:= 0 to 7 do tmpMKey[i]:=00; 
  for i:= 0 to 1 do tmpMKey[i+8]:=00; 
  tmp_I:='';B0:=0;B2:=0;B3:=0; 
  for i := 0 to 9 do if tmpMKey[i]>$F then tmp_I:=tmp_I+Format('%2x',[tmpMKey[i]])    //  9 
                                      else tmp_I:=tmp_I+Format('0%1x',[tmpMKey[i]]); 
  // 
  FillChar(SigKey[0],SizeOf(SigKey),0);I:=Length(ins_idert)DIV 2 ; 
  while I > 0 do 
    begin 
      B1:=0;J:=0; 
      if I < 8 then B1 := (8 - I); 
      while (8 - B1) > J do 
        begin 
         SigKey[J] := SigKey[J] xor Buffer[(B3 shl 3) + B0 + J];Inc(J); 
        end; 
      J:=8;J:=J-B1; 
      while (J < 8) do 
        begin 
          SigKey[J] := SigKey[J] xor ascitable[B2];Inc(B2);Inc(J); 
        end; 
      if B1 = 0 then CryptKey($28, @TmpMKey, @SigKey) 
                else CryptKey($68, @TmpMKey, @SigKey); 
      Inc(B3);I:=I-8; 
    end; 
  tmp_I:=''; 
  for i:= 0 to 4 do if SigKey[I]>$F then tmp_I:=tmp_I+format('%2x',[SigKey[I]]) 
                         else tmp_I:=tmp_I+format('0%1x',[SigKey[I]]); 
  if tmp_I=sig_idert then Result:=True else Result:=False; 
end; 
procedure CryptKey(N: Word; Key1, Key2: PByteArray); 
var 
  I, J, K, L: Integer; 
begin 
  I := 0; 
  while I < N do 
    begin 
      J:=I mod 10; 
      K:=I mod 8; 
      L:=(I+1) mod 8; 
      if J=0 then RotateKey2(10, Key1); 
      if (Key1[J] and 1) <> 0 then Key2[L] := Key2[L] xor Table1[Key2[K] xor Key1[J]] 
                              else Key2[L] := Key2[L] xor Table2[Key2[K] xor Key1[J]]; 
      Inc(I) 
    end; 
  RotateKey2(10, Key1); 
end; 
 
Procedure Decrypt_IDERTO (worddata_I,MK_PK_I,date_Iderto : string); 
 Var 
  i:integer; 
  tmp_I:string; 
begin 
  // 
  for i:= 0 to 7 do CW_I[i]:=strtoint('$'+copy(worddata_I,i*2+1,2)); 
  for i:= 0 to 7 do PK_I[i]:=strtoint('$'+copy(MK_PK_I,i*2+1,2)); 
  for i:= 0 to 1 do date_I[i]:=strtoint('$'+copy(date_Iderto,i*2+1,2)); 
  // 
  for I := 0 to 9 do BK_I[I] := PK_I[I mod 8]; 
  for I := 0 to 1 do BK_I[8 + I] := BK_I[8 + I] xor date_I[I]; 
  // 
  SigCalc(PK_I, CW_I ); 
  // 
  tmp_I:=''; 
  for i:= 0 to 7 do if Tmp_EK_I[i]>$F then tmp_I:=tmp_I+format('%2x',[Tmp_EK_I[i]]) else tmp_I:=tmp_I+format('0%1x',[Tmp_EK_I[i]]); 
end; 
 
function SigCalc(plainmasterkey, plainkey : array of byte ) : THexKey; 
var 
  I, J, K, L: Integer; 
begin 
  I := 0; 
  while (I < 128) do 
    begin 
      J := I mod 10; 
      K := RotTable1[I mod 16]; 
      L := RotTable1[(I + 1) mod 16]; 
      if J = 0 then RotateKey(@BK_I[0]); 
      if ((BK_I[J] and 1) = 1) Then plainkey[L] := plainkey[L] xor Table1[plainkey[K] xor BK_I[J]] 
                               else plainkey[L] := plainkey[L] xor Table2[plainkey[K] xor BK_I[J]]; 
      Inc(I); 
    end; 
  for i:=0 to 9 do Tmp_EK_I[i]:=plainkey[i]; 
end; 
 
procedure RotateKey(Key: PByteArray); 
var 
  i: Integer; 
  OKey: Byte; 
begin 
  OKey := Key[9]; 
  for i := 9 downto 1 do Key[i] := (Key[i] shr 1) or (Key[i - 1] shl 7); 
  Key[0] := (Key[0] shr 1) or (OKey shl 7); 
end; 
 
procedure RotateKey2(N: Word; Key: PByteArray); 
var 
  OKey: Byte; 
begin 
  N:=N-1; 
  OKey:=Key[N]; 
  while N > 0 do 
    begin 
      Key[N] := (Key[N] shr 1) or (Key[N - 1] shl 7); 
      Dec(N); 
    end; 
  Key[0]:=(Key[0] shr 1)or(OKey shl 7) 
end; 
 
 
end.