encryption.pas

供水营销打印程序源码

unit Encryption;

interface

uses
  SysUtils;

type
  Key256 = array[0..7] of Longword;

  Prng_CTX = record
    r: array[1..97] of real;
    x1,x2,x3: Longword;
  end;
  TPrng_CTX = ^Prng_CTX;

  Haval_CTX = record
    lenhi,lenlo: Longword;
    Index:Longword;
    hash:array[0..7]of Longword;
    hashbuffer:array[0..127]of byte;
  end;
  THaval_CTX = ^Haval_CTX;

  KeyStatistics = record
    KeyLength: Longword;
    KeySize: Longword;
    CharCount: Byte;
    CharBits: Byte;
    Patterns: Longword;
    Differential: Longword;
    BruteLength: Longword;
    Rating: Longword;
  end;
  TKeyStatistics = ^KeyStatistics;

  procedure MutateKey(var key: Key256);
  function  PasswordToKey(Pass: string): key256;
  function  AnalyzePassword(Pass:string): KeyStatistics;
  function  SimpleEnDecrypt(const Password, Key: string): string;

implementation

const
  BIT_MASK: array[0..7] of byte = (1,2,4,8,16,32,64,128);
  HASH_SIZE = 256;
  PrngM1: Longword = 259200;
  PrngI1: Longword = 7141;
  PrngC1: Longword = 54773;
  PrngM2: Longword = 134456;
  PrngI2: Longword = 8121;
  PrngC2: Longword = 28411;
  PrngM3: Longword = 243000;
  PrngI3: Longword = 4561;
  PrngC3: Longword = 51349;

procedure HavalCompress(ctx: THaval_CTX);

  function rr32(x: Longword; c: longint): Longword; register; assembler;
  asm
    mov ecx,edx
    ror eax,cl
  end;

  procedure r1(var x7,x6,x5,x4,x3,x2,x1,x0: Longword; const w: Longword);
  var
    t:Longword;
  begin
    t := ((x2) and ((x6) xor (x1)) xor (x5) and (x4) xor (x0) and (x3) xor (x6));
    x7 := rr32(t,7) + rr32(x7,11) + w;
  end;

  procedure r2(var x7,x6,x5,x4,x3,x2,x1,x0: Longword; const w,c: Longword);
  var
    t: Longword;
  begin
    t:=(x3 and(x4 and (not x0) xor x1 and x2 xor x6 xor x5) xor x1 and (x4 xor x2)
       xor x0 and x2 xor x5);
    x7 := rr32(t,7) + rr32(x7,11) + w + c;
  end;

  procedure r3(var x7,x6,x5,x4,x3,x2,x1,x0: Longword; const w,c: Longword);
  var
    t: Longword;
  begin
    t := ((x4) and ((x1) and (x3) xor (x2) xor (x5)) xor (x1) and (x0) xor (x3) and (x6)
         xor (x5));
    x7 := rr32(t,7) + rr32(x7,11) + w + c;
  end;

  procedure r4(var x7,x6,x5,x4,x3,x2,x1,x0: Longword; const w,c: Longword);
  var
    t: Longword;
  begin
    t := (x3 and (x5 and (not x0) xor x2 and (not x1) xor x4 xor x1 xor x6) xor x2
         and (x4 and x0 xor x5 xor x1)xor x0 and x1 xor x6);
    x7 := rr32(t,7) + rr32(x7,11) + w + c;
  end;

  procedure r5(var x7,x6,x5,x4,x3,x2,x1,x0: Longword; const w,c: Longword);
  var t:Longword;
  begin
    t := (x1 and (x3 and x4 and x6 xor(not x5))xor x3 and x0 xor x4 and x5
         xor x6 and x2);
    x7 := rr32(t,7) + rr32(x7,11) + w + c;
   end;

var
  t7,t6,t5,t4,t3,t2,t1,t0: Longword;
  w: array[0..31] of Longword;
begin
  t0 := ctx.hash[0];
  t1 := ctx.hash[1];
  t2 := ctx.hash[2];
  t3 := ctx.hash[3];
  t4 := ctx.hash[4];
  t5 := ctx.hash[5];
  t6 := ctx.hash[6];
  t7 := ctx.hash[7];
  move(ctx.hashbuffer,w,sizeof(w));
  r1(t7,t6,t5,t4,t3,t2,t1,t0,w[ 0]);
  r1(t6,t5,t4,t3,t2,t1,t0,t7,w[ 1]);
  r1(t5,t4,t3,t2,t1,t0,t7,t6,w[ 2]);
  r1(t4,t3,t2,t1,t0,t7,t6,t5,w[ 3]);
  r1(t3,t2,t1,t0,t7,t6,t5,t4,w[ 4]);
  r1(t2,t1,t0,t7,t6,t5,t4,t3,w[ 5]);
  r1(t1,t0,t7,t6,t5,t4,t3,t2,w[ 6]);
  r1(t0,t7,t6,t5,t4,t3,t2,t1,w[ 7]);
  r1(t7,t6,t5,t4,t3,t2,t1,t0,w[ 8]);
  r1(t6,t5,t4,t3,t2,t1,t0,t7,w[ 9]);
  r1(t5,t4,t3,t2,t1,t0,t7,t6,w[10]);
  r1(t4,t3,t2,t1,t0,t7,t6,t5,w[11]);
  r1(t3,t2,t1,t0,t7,t6,t5,t4,w[12]);
  r1(t2,t1,t0,t7,t6,t5,t4,t3,w[13]);
  r1(t1,t0,t7,t6,t5,t4,t3,t2,w[14]);
  r1(t0,t7,t6,t5,t4,t3,t2,t1,w[15]);
  r1(t7,t6,t5,t4,t3,t2,t1,t0,w[16]);
  r1(t6,t5,t4,t3,t2,t1,t0,t7,w[17]);
  r1(t5,t4,t3,t2,t1,t0,t7,t6,w[18]);
  r1(t4,t3,t2,t1,t0,t7,t6,t5,w[19]);
  r1(t3,t2,t1,t0,t7,t6,t5,t4,w[20]);
  r1(t2,t1,t0,t7,t6,t5,t4,t3,w[21]);
  r1(t1,t0,t7,t6,t5,t4,t3,t2,w[22]);
  r1(t0,t7,t6,t5,t4,t3,t2,t1,w[23]);
  r1(t7,t6,t5,t4,t3,t2,t1,t0,w[24]);
  r1(t6,t5,t4,t3,t2,t1,t0,t7,w[25]);
  r1(t5,t4,t3,t2,t1,t0,t7,t6,w[26]);
  r1(t4,t3,t2,t1,t0,t7,t6,t5,w[27]);
  r1(t3,t2,t1,t0,t7,t6,t5,t4,w[28]);
  r1(t2,t1,t0,t7,t6,t5,t4,t3,w[29]);
  r1(t1,t0,t7,t6,t5,t4,t3,t2,w[30]);
  r1(t0,t7,t6,t5,t4,t3,t2,t1,w[31]);
  r2(t7,t6,t5,t4,t3,t2,t1,t0,w[ 5],$452821E6);
  r2(t6,t5,t4,t3,t2,t1,t0,t7,w[14],$38D01377);
  r2(t5,t4,t3,t2,t1,t0,t7,t6,w[26],$BE5466CF);
  r2(t4,t3,t2,t1,t0,t7,t6,t5,w[18],$34E90C6C);
  r2(t3,t2,t1,t0,t7,t6,t5,t4,w[11],$C0AC29B7);
  r2(t2,t1,t0,t7,t6,t5,t4,t3,w[28],$C97C50DD);
  r2(t1,t0,t7,t6,t5,t4,t3,t2,w[ 7],$3F84D5B5);
  r2(t0,t7,t6,t5,t4,t3,t2,t1,w[16],$B5470917);
  r2(t7,t6,t5,t4,t3,t2,t1,t0,w[ 0],$9216D5D9);
  r2(t6,t5,t4,t3,t2,t1,t0,t7,w[23],$8979FB1B);
  r2(t5,t4,t3,t2,t1,t0,t7,t6,w[20],$D1310BA6);
  r2(t4,t3,t2,t1,t0,t7,t6,t5,w[22],$98DFB5AC);
  r2(t3,t2,t1,t0,t7,t6,t5,t4,w[ 1],$2FFD72DB);
  r2(t2,t1,t0,t7,t6,t5,t4,t3,w[10],$D01ADFB7);
  r2(t1,t0,t7,t6,t5,t4,t3,t2,w[ 4],$B8E1AFED);
  r2(t0,t7,t6,t5,t4,t3,t2,t1,w[ 8],$6A267E96);
  r2(t7,t6,t5,t4,t3,t2,t1,t0,w[30],$BA7C9045);
  r2(t6,t5,t4,t3,t2,t1,t0,t7,w[ 3],$F12C7F99);
  r2(t5,t4,t3,t2,t1,t0,t7,t6,w[21],$24A19947);
  r2(t4,t3,t2,t1,t0,t7,t6,t5,w[ 9],$B3916CF7);
  r2(t3,t2,t1,t0,t7,t6,t5,t4,w[17],$0801F2E2);
  r2(t2,t1,t0,t7,t6,t5,t4,t3,w[24],$858EFC16);
  r2(t1,t0,t7,t6,t5,t4,t3,t2,w[29],$636920D8);
  r2(t0,t7,t6,t5,t4,t3,t2,t1,w[ 6],$71574E69);
  r2(t7,t6,t5,t4,t3,t2,t1,t0,w[19],$A458FEA3);
  r2(t6,t5,t4,t3,t2,t1,t0,t7,w[12],$F4933D7E);
  r2(t5,t4,t3,t2,t1,t0,t7,t6,w[15],$0D95748F);
  r2(t4,t3,t2,t1,t0,t7,t6,t5,w[13],$728EB658);
  r2(t3,t2,t1,t0,t7,t6,t5,t4,w[ 2],$718BCD58);
  r2(t2,t1,t0,t7,t6,t5,t4,t3,w[25],$82154AEE);
  r2(t1,t0,t7,t6,t5,t4,t3,t2,w[31],$7B54A41D);
  r2(t0,t7,t6,t5,t4,t3,t2,t1,w[27],$C25A59B5);
  r3(t7,t6,t5,t4,t3,t2,t1,t0,w[19],$9C30D539);
  r3(t6,t5,t4,t3,t2,t1,t0,t7,w[ 9],$2AF26013);
  r3(t5,t4,t3,t2,t1,t0,t7,t6,w[ 4],$C5D1B023);
  r3(t4,t3,t2,t1,t0,t7,t6,t5,w[20],$286085F0);
  r3(t3,t2,t1,t0,t7,t6,t5,t4,w[28],$CA417918);
  r3(t2,t1,t0,t7,t6,t5,t4,t3,w[17],$B8DB38EF);
  r3(t1,t0,t7,t6,t5,t4,t3,t2,w[ 8],$8E79DCB0);
  r3(t0,t7,t6,t5,t4,t3,t2,t1,w[22],$603A180E);
  r3(t7,t6,t5,t4,t3,t2,t1,t0,w[29],$6C9E0E8B);
  r3(t6,t5,t4,t3,t2,t1,t0,t7,w[14],$B01E8A3E);
  r3(t5,t4,t3,t2,t1,t0,t7,t6,w[25],$D71577C1);
  r3(t4,t3,t2,t1,t0,t7,t6,t5,w[12],$BD314B27);
  r3(t3,t2,t1,t0,t7,t6,t5,t4,w[24],$78AF2FDA);
  r3(t2,t1,t0,t7,t6,t5,t4,t3,w[30],$55605C60);
  r3(t1,t0,t7,t6,t5,t4,t3,t2,w[16],$E65525F3);
  r3(t0,t7,t6,t5,t4,t3,t2,t1,w[26],$AA55AB94);
  r3(t7,t6,t5,t4,t3,t2,t1,t0,w[31],$57489862);
  r3(t6,t5,t4,t3,t2,t1,t0,t7,w[15],$63E81440);
  r3(t5,t4,t3,t2,t1,t0,t7,t6,w[ 7],$55CA396A);
  r3(t4,t3,t2,t1,t0,t7,t6,t5,w[ 3],$2AAB10B6);
  r3(t3,t2,t1,t0,t7,t6,t5,t4,w[ 1],$B4CC5C34);
  r3(t2,t1,t0,t7,t6,t5,t4,t3,w[ 0],$1141E8CE);
  r3(t1,t0,t7,t6,t5,t4,t3,t2,w[18],$A15486AF);
  r3(t0,t7,t6,t5,t4,t3,t2,t1,w[27],$7C72E993);
  r3(t7,t6,t5,t4,t3,t2,t1,t0,w[13],$B3EE1411);
  r3(t6,t5,t4,t3,t2,t1,t0,t7,w[ 6],$636FBC2A);
  r3(t5,t4,t3,t2,t1,t0,t7,t6,w[21],$2BA9C55D);
  r3(t4,t3,t2,t1,t0,t7,t6,t5,w[10],$741831F6);
  r3(t3,t2,t1,t0,t7,t6,t5,t4,w[23],$CE5C3E16);
  r3(t2,t1,t0,t7,t6,t5,t4,t3,w[11],$9B87931E);
  r3(t1,t0,t7,t6,t5,t4,t3,t2,w[ 5],$AFD6BA33);
  r3(t0,t7,t6,t5,t4,t3,t2,t1,w[ 2],$6C24CF5C);
  r4(t7,t6,t5,t4,t3,t2,t1,t0,w[24],$7A325381);
  r4(t6,t5,t4,t3,t2,t1,t0,t7,w[ 4],$28958677);
  r4(t5,t4,t3,t2,t1,t0,t7,t6,w[ 0],$3B8F4898);
  r4(t4,t3,t2,t1,t0,t7,t6,t5,w[14],$6B4BB9AF);
  r4(t3,t2,t1,t0,t7,t6,t5,t4,w[ 2],$C4BFE81B);
  r4(t2,t1,t0,t7,t6,t5,t4,t3,w[ 7],$66282193);
  r4(t1,t0,t7,t6,t5,t4,t3,t2,w[28],$61D809CC);
  r4(t0,t7,t6,t5,t4,t3,t2,t1,w[23],$FB21A991);
  r4(t7,t6,t5,t4,t3,t2,t1,t0,w[26],$487CAC60);
  r4(t6,t5,t4,t3,t2,t1,t0,t7,w[ 6],$5DEC8032);
  r4(t5,t4,t3,t2,t1,t0,t7,t6,w[30],$EF845D5D);
  r4(t4,t3,t2,t1,t0,t7,t6,t5,w[20],$E98575B1);
  r4(t3,t2,t1,t0,t7,t6,t5,t4,w[18],$DC262302);
  r4(t2,t1,t0,t7,t6,t5,t4,t3,w[25],$EB651B88);
  r4(t1,t0,t7,t6,t5,t4,t3,t2,w[19],$23893E81);
  r4(t0,t7,t6,t5,t4,t3,t2,t1,w[ 3],$D396ACC5);
  r4(t7,t6,t5,t4,t3,t2,t1,t0,w[22],$0F6D6FF3);
  r4(t6,t5,t4,t3,t2,t1,t0,t7,w[11],$83F44239);
  r4(t5,t4,t3,t2,t1,t0,t7,t6,w[31],$2E0B4482);
  r4(t4,t3,t2,t1,t0,t7,t6,t5,w[21],$A4842004);
  r4(t3,t2,t1,t0,t7,t6,t5,t4,w[ 8],$69C8F04A);
  r4(t2,t1,t0,t7,t6,t5,t4,t3,w[27],$9E1F9B5E);
  r4(t1,t0,t7,t6,t5,t4,t3,t2,w[12],$21C66842);
  r4(t0,t7,t6,t5,t4,t3,t2,t1,w[ 9],$F6E96C9A);
  r4(t7,t6,t5,t4,t3,t2,t1,t0,w[ 1],$670C9C61);
  r4(t6,t5,t4,t3,t2,t1,t0,t7,w[29],$ABD388F0);
  r4(t5,t4,t3,t2,t1,t0,t7,t6,w[ 5],$6A51A0D2);
  r4(t4,t3,t2,t1,t0,t7,t6,t5,w[15],$D8542F68);
  r4(t3,t2,t1,t0,t7,t6,t5,t4,w[17],$960FA728);
  r4(t2,t1,t0,t7,t6,t5,t4,t3,w[10],$AB5133A3);
  r4(t1,t0,t7,t6,t5,t4,t3,t2,w[16],$6EEF0B6C);
  r4(t0,t7,t6,t5,t4,t3,t2,t1,w[13],$137A3BE4);
  r5(t7,t6,t5,t4,t3,t2,t1,t0,w[27],$BA3BF050);
  r5(t6,t5,t4,t3,t2,t1,t0,t7,w[ 3],$7EFB2A98);
  r5(t5,t4,t3,t2,t1,t0,t7,t6,w[21],$A1F1651D);
  r5(t4,t3,t2,t1,t0,t7,t6,t5,w[26],$39AF0176);
  r5(t3,t2,t1,t0,t7,t6,t5,t4,w[17],$66CA593E);
  r5(t2,t1,t0,t7,t6,t5,t4,t3,w[11],$82430E88);
  r5(t1,t0,t7,t6,t5,t4,t3,t2,w[20],$8CEE8619);
  r5(t0,t7,t6,t5,t4,t3,t2,t1,w[29],$456F9FB4);
  r5(t7,t6,t5,t4,t3,t2,t1,t0,w[19],$7D84A5C3);
  r5(t6,t5,t4,t3,t2,t1,t0,t7,w[ 0],$3B8B5EBE);
  r5(t5,t4,t3,t2,t1,t0,t7,t6,w[12],$E06F75D8);
  r5(t4,t3,t2,t1,t0,t7,t6,t5,w[ 7],$85C12073);
  r5(t3,t2,t1,t0,t7,t6,t5,t4,w[13],$401A449F);
  r5(t2,t1,t0,t7,t6,t5,t4,t3,w[ 8],$56C16AA6);
  r5(t1,t0,t7,t6,t5,t4,t3,t2,w[31],$4ED3AA62);
  r5(t0,t7,t6,t5,t4,t3,t2,t1,w[10],$363F7706);
  r5(t7,t6,t5,t4,t3,t2,t1,t0,w[ 5],$1BFEDF72);
  r5(t6,t5,t4,t3,t2,t1,t0,t7,w[ 9],$429B023D);
  r5(t5,t4,t3,t2,t1,t0,t7,t6,w[14],$37D0D724);
  r5(t4,t3,t2,t1,t0,t7,t6,t5,w[30],$D00A1248);
  r5(t3,t2,t1,t0,t7,t6,t5,t4,w[18],$DB0FEAD3);
  r5(t2,t1,t0,t7,t6,t5,t4,t3,w[ 6],$49F1C09B);
  r5(t1,t0,t7,t6,t5,t4,t3,t2,w[28],$075372C9);
  r5(t0,t7,t6,t5,t4,t3,t2,t1,w[24],$80991B7B);
  r5(t7,t6,t5,t4,t3,t2,t1,t0,w[ 2],$25D479D8);
  r5(t6,t5,t4,t3,t2,t1,t0,t7,w[23],$F6E8DEF7);
  r5(t5,t4,t3,t2,t1,t0,t7,t6,w[16],$E3FE501A);
  r5(t4,t3,t2,t1,t0,t7,t6,t5,w[22],$B6794C3B);
  r5(t3,t2,t1,t0,t7,t6,t5,t4,w[ 4],$976CE0BD);
  r5(t2,t1,t0,t7,t6,t5,t4,t3,w[ 1],$04C006BA);
  r5(t1,t0,t7,t6,t5,t4,t3,t2,w[25],$C1A94FB6);
  r5(t0,t7,t6,t5,t4,t3,t2,t1,w[15],$409F60C4);
  inc(ctx.hash[0], t0);
  inc(ctx.hash[1], t1);
  inc(ctx.hash[2], t2);
  inc(ctx.hash[3], t3);
  inc(ctx.hash[4], t4);
  inc(ctx.hash[5], t5);
  inc(ctx.hash[6], t6);
  inc(ctx.hash[7], t7);
  fillchar(w,sizeof(w),0);
  ctx.index := 0;
  fillchar(ctx.hashbuffer, sizeof(ctx.hashbuffer), 0);
end;

procedure HavalUpdateLen(ctx: THaval_CTX; len: Longword);
begin
  inc(ctx.lenlo, (len shl 3));