blowunit.pas

来自「本系统在一些大中型企业(跨多达24个区域)一直都在很好的服务过」· PAS 代码 · 共 836 行 · 第 1/2 页

  $0a476341, $992eff74, $3a6f6eab, $f4f8fd37,
  $a812dc60, $a1ebddf8, $991be14c, $db6e6b0d,
  $c67b5510, $6d672c37, $2765d43b, $dcd0e804,
  $f1290dc7, $cc00ffa3, $b5390f92, $690fed0b,

  $667b9ffb, $cedb7d9c, $a091cf0b, $d9155ea3,
  $bb132f88, $515bad24, $7b9479bf, $763bd6eb,
  $37392eb3, $cc115979, $8026e297, $f42e312d,
  $6842ada7, $c66a2b3b, $12754ccc, $782ef11c,

  $6a124237, $b79251e7, $06a1bbe6, $4bfb6350,
  $1a6b1018, $11caedfa, $3d25bdd8, $e2e1c3c9,
  $44421659, $0a121386, $d90cec6e, $d5abea2a,
  $64af674e, $da86a85f, $bebfe988, $64e4c3fe,

  $9dbc8057, $f0f7c086, $60787bf8, $6003604d,
  $d1fd8346, $f6381fb0, $7745ae04, $d736fccc,
  $83426b33, $f01eab71, $b0804187, $3c005e5f,
  $77a057be, $bde8ae24, $55464299, $bf582e61,

  $4e58f48f, $f2ddfda2, $f474ef38, $8789bdc2,
  $5366f9c3, $c8b38e74, $b475f255, $46fcd9b9,
  $7aeb2661, $8b1ddf84, $846a0e79, $915f95e2,
  $466e598e, $20b45770, $8cd55591, $c902de4c,

  $b90bace1, $bb8205d0, $11a86248, $7574a99e,
  $b77f19b6, $e0a9dc09, $662d09a1, $c4324633,
  $e85a1f02, $09f0be8c, $4a99a025, $1d6efe10,
  $1ab93d1d, $0ba5a4df, $a186f20f, $2868f169,

  $dcb7da83, $573906fe, $a1e2ce9b, $4fcd7f52,
  $50115e01, $a70683fa, $a002b5c4, $0de6d027,
  $9af88c27, $773f8641, $c3604c06, $61a806b5,
  $f0177a28, $c0f586e0, $006058aa, $30dc7d62,

  $11e69ed7, $2338ea63, $53c2dd94, $c2c21634,
  $bbcbee56, $90bcb6de, $ebfc7da1, $ce591d76,
  $6f05e409, $4b7c0188, $39720a3d, $7c927c24,
  $86e3725f, $724d9db9, $1ac15bb4, $d39eb8fc,

  $ed545578, $08fca5b5, $d83d7cd3, $4dad0fc4,
  $1e50ef5e, $b161e6f8, $a28514d9, $6c51133c,
  $6fd5c7e7, $56e14ec4, $362abfce, $ddc6c837,
  $d79a3234, $92638212, $670efa8e, $406000e0),
  {Fourth 256}
 ($3a39ce37, $d3faf5cf, $abc27737, $5ac52d1b,
  $5cb0679e, $4fa33742, $d3822740, $99bc9bbe,
  $d5118e9d, $bf0f7315, $d62d1c7e, $c700c47b,
  $b78c1b6b, $21a19045, $b26eb1be, $6a366eb4,

  $5748ab2f, $bc946e79, $c6a376d2, $6549c2c8,
  $530ff8ee, $468dde7d, $d5730a1d, $4cd04dc6,
  $2939bbdb, $a9ba4650, $ac9526e8, $be5ee304,
  $a1fad5f0, $6a2d519a, $63ef8ce2, $9a86ee22,

  $c089c2b8, $43242ef6, $a51e03aa, $9cf2d0a4,
  $83c061ba, $9be96a4d, $8fe51550, $ba645bd6,
  $2826a2f9, $a73a3ae1, $4ba99586, $ef5562e9,
  $c72fefd3, $f752f7da, $3f046f69, $77fa0a59,

  $80e4a915, $87b08601, $9b09e6ad, $3b3ee593,
  $e990fd5a, $9e34d797, $2cf0b7d9, $022b8b51,
  $96d5ac3a, $017da67d, $d1cf3ed6, $7c7d2d28,
  $1f9f25cf, $adf2b89b, $5ad6b472, $5a88f54c,

  $e029ac71, $e019a5e6, $47b0acfd, $ed93fa9b,
  $e8d3c48d, $283b57cc, $f8d56629, $79132e28,
  $785f0191, $ed756055, $f7960e44, $e3d35e8c,
  $15056dd4, $88f46dba, $03a16125, $0564f0bd,

  $c3eb9e15, $3c9057a2, $97271aec, $a93a072a,
  $1b3f6d9b, $1e6321f5, $f59c66fb, $26dcf319,
  $7533d928, $b155fdf5, $03563482, $8aba3cbb,
  $28517711, $c20ad9f8, $abcc5167, $ccad925f,

  $4de81751, $3830dc8e, $379d5862, $9320f991,
  $ea7a90c2, $fb3e7bce, $5121ce64, $774fbe32,
  $a8b6e37e, $c3293d46, $48de5369, $6413e680,
  $a2ae0810, $dd6db224, $69852dfd, $09072166,

  $b39a460a, $6445c0dd, $586cdecf, $1c20c8ae,
  $5bbef7dd, $1b588d40, $ccd2017f, $6bb4e3bb,
  $dda26a7e, $3a59ff45, $3e350a44, $bcb4cdd5,
  $72eacea8, $fa6484bb, $8d6612ae, $bf3c6f47,

  $d29be463, $542f5d9e, $aec2771b, $f64e6370,
  $740e0d8d, $e75b1357, $f8721671, $af537d5d,
  $4040cb08, $4eb4e2cc, $34d2466a, $0115af84,
  $e1b00428, $95983a1d, $06b89fb4, $ce6ea048,

  $6f3f3b82, $3520ab82, $011a1d4b, $277227f8,
  $611560b1, $e7933fdc, $bb3a792b, $344525bd,
  $a08839e1, $51ce794b, $2f32c9b7, $a01fbac9,
  $e01cc87e, $bcc7d1f6, $cf0111c3, $a1e8aac7,

  $1a908749, $d44fbd9a, $d0dadecb, $d50ada38,
  $0339c32a, $c6913667, $8df9317c, $e0b12b4f,
  $f79e59b7, $43f5bb3a, $f2d519ff, $27d9459c,
  $bf97222c, $15e6fc2a, $0f91fc71, $9b941525,

  $fae59361, $ceb69ceb, $c2a86459, $12baa8d1,
  $b6c1075e, $e3056a0c, $10d25065, $cb03a442,
  $e0ec6e0e, $1698db3b, $4c98a0be, $3278e964,
  $9f1f9532, $e0d392df, $d3a0342b, $8971f21e,

  $1b0a7441, $4ba3348c, $c5be7120, $c37632d8,
  $df359f8d, $9b992f2e, $e60b6f47, $0fe3f11d,
  $e54cda54, $1edad891, $ce6279cf, $cd3e7e6f,
  $1618b166, $fd2c1d05, $848fd2c5, $f6fb2299,

  $f523f357, $a6327623, $93a83531, $56cccd02,
  $acf08162, $5a75ebb5, $6e163697, $88d273cc,
  $de966292, $81b949d0, $4c50901b, $71c65614,
  $e6c6c7bd, $327a140a, $45e1d006, $c3f27b9a,

  $c9aa53fd, $62a80f00, $bb25bfe2, $35bdd2f6,
  $71126905, $b2040222, $b6cbcf7c, $cd769c2b,
  $53113ec0, $1640e3d3, $38abbd60, $2547adf0,
  $ba38209c, $f746ce76, $77afa1c5, $20756060,

  $85cbfe4e, $8ae88dd8, $7aaaf9b0, $4cf9aa7e,
  $1948c25c, $02fb8a8c, $01c36ae4, $d6ebe1f9,
  $90d4f869, $a65cdea0, $3f09252d, $c208e69f,
  $b74e6132, $ce77e25b, $578fdfe3, $3ac372e6){,}
);{bf_S}

implementation

{$IFDEF DELPHI}
procedure Register;
  {Registers the Component to the toobar, on the tab named 'Crypto'}
  {Now all a Delphi programmer needs to do is drag n drop to have
   Blowfish encryption}
begin
  RegisterComponents('Crypto', [TBlowfish]);
end;
{$ENDIF}

{$IFDEF DELPHI}
constructor TBlowFish.Create(Owner: TComponent);
{$ENDIF}
{$IFDEF BP7}
constructor TBlowFish.Init;
{$ENDIF}
 begin
  FBLOCKSIZE := SizeOf(aword) * 2;
  New(Fpbf_P);  {Pointer to bf_P array}
  New(Fpbf_S);  {Pointer to bf_S array}
  FIVTemp := nil;
{  GetMem(FIVTemp, FBLOCKSIZE);}
 {$IFDEF DELPHI}
  inherited Create(Owner);
 {$ENDIF}

end;{TBlowFish.Create}

{$IFDEF DELPHI}
destructor TBlowFish.Destroy;
{$ENDIF}
{$IFDEF BP7}
destructor TBlowFish.Done;
{$ENDIF}
 begin
  If Fpbf_P <> nil then Dispose(Fpbf_P);
  If Fpbf_S <> nil then Dispose(Fpbf_S);
 { FreeMem(FIVTemp, FBLOCKSIZE);}
  {$IFDEF DELPHI}
  inherited Destroy;
  {$ENDIF}
end;{TBlowFish.Destroy;}


Procedure TBlowFish.InitArray;
{ PURPOSE:  Since the bf_S and bf_P Arrays are modified during the execution
            of the BlowFish algorithm, it is necessary to copy them to dynamic
            variables. This is only done once per encryption/decryption, or
            when the Key is changed}

var i, j: integer;
begin
  {FIXME: Just use a 'Move' function????? for array initialization}
  For i:= 0 to (bf_N + 1) do begin
   Fpbf_P^[i] := bf_P[i];
  end;

  For i:= 0 to 3 do begin
   for j:= 0 to 255 do begin
    Fpbf_S^[i, j] := bf_S[i, j];
   end;{j while}
  end;{i for}

end;{TBlowFish.InitArray}

Procedure TBlowFish.SetKeys;
var
 kLength: integer;
begin
 kLength := Length(FKey);
 If (kLength < BF_MINKEYLENGTH) or (kLength > BF_MAXKEYLENGTH) then
{FIXME: Should signal an error of some kind, for Delphi use Exceptions}
    FKey := '';
 InitArray;    {Set Sub Key Box arrays back to initial values}
 BF_Initialize;{Generate SBoxs with new Key}
end;{TBlowFish.SetKey}

function TBlowFish.bf_F(x: Paword): aword;
 {FIXME! Put in 'ROUND' to speed up.}
 {FIXED}
 begin
   bf_F.Lword := ((Fpbf_S^[0, x^.w.byte0] + Fpbf_S^[1, x^.w.byte1])
   Xor Fpbf_S^[2, x^.w.byte2]) + Fpbf_S^[3, x^.w.byte3];
end;{TBlowFish.bf_F}

Procedure TBlowFish.ROUND(a, b: Paword; n: BYTE);
var
 bF : aword;
 begin
   bF.Lword := ((Fpbf_S^[0, b^.w.byte0] + Fpbf_S^[1, b^.w.byte1])
   Xor Fpbf_S^[2, b^.w.byte2]) + Fpbf_S^[3, b^.w.byte3];
   a^.Lword := a^.Lword Xor (bF.Lword Xor Fpbf_P^[n]);
end;{TBlowFish.ROUND}

Procedure TBlowFish.BF_Initialize;
 var
  i, j: integer;
  data, datal, datar: UWORD_32bits;
  temp: aword;
  Key: PChar;

 begin
 If Length(FKey) = 0 then exit;{divide by zero, ohh}

 {$IFDEF DELPHI}
   Key := StrAlloc(Length(FKey) + 1);
   try {protect dyanmic memory allocation}
   StrPCopy(Key, FKey);
 {$ENDIF}
 {$IFDEF BP7}
   GetMem(Key,Length(FKEY));
   Move(FKey[1], Key^, Length(FKEY));
 {$ENDIF}

  j := 0;

  For i:= 0 to (bf_N + 1) do begin
    temp.Lword := 0;
    temp.w.byte0 := BYTE(Key[j]);
    temp.w.byte1 := BYTE(Key[(j+1) MOD Length(FKey)]);
    temp.w.byte2 := BYTE(Key[(j+2) MOD Length(FKey)]);
    temp.w.byte3 := BYTE(Key[(j+3) MOD Length(FKey)]);
    data := temp.Lword;
    Fpbf_P^[i] := Fpbf_P^[i] Xor data;
    j := (j + 4) MOD Length(FKey);
  end;{For}

  {zeroize copy of Key for security}
  FillChar(Key^, Length(FKey), #0);

  datal := 0; FpXl := @datal;
  datar := 0; FpXr := @datar;

  i:= 0;
  while (i < (bf_N + 2)) do begin
   BF_Encipher;
   Fpbf_P^[i] := datal;
   Fpbf_P^[i + 1] := datar;
   Inc(i, 2);
  end;

  j:=0;
  For i:= 0 to 3 do begin
   while (j < 256) do begin
    BF_Encipher;
    Fpbf_S^[i, j] := datal;
    Fpbf_S^[i, j + 1] := datar;
    Inc(j, 2);
   end;{j while}
   j:= 0;
  end;{i for}
{$IFDEF DELPHI}
  finally
   StrDispose(Key);
  end;{Finally}
{$ENDIF}
{$IFDEF BP7}
   FreeMem(Key,Length(FKEY));
{$ENDIF}
end;{TBlowFish.BF_Initialize}

Procedure TBlowFish.BF_Encipher;
{We can't flip(intel) the bytes here, because BF_Encipher is used to generate the
 SubKeys, Key generation does not require byte flipping, since it intrepreted
 as an ascii string}

 var
  Xr: aword;
 begin

  FpXl^.Lword := FpXl^.Lword Xor Fpbf_P^[0];
  ROUND (FpXr, FpXl, 1);  ROUND (FpXl, FpXr, 2);
  ROUND (FpXr, FpXl, 3);  ROUND (FpXl, FpXr, 4);
  ROUND (FpXr, FpXl, 5);  ROUND (FpXl, FpXr, 6);
  ROUND (FpXr, FpXl, 7);  ROUND (FpXl, FpXr, 8);
  ROUND (FpXr, FpXl, 9);  ROUND (FpXl, FpXr, 10);
  ROUND (FpXr, FpXl, 11); ROUND (FpXl, FpXr, 12);
  ROUND (FpXr, FpXl, 13); ROUND (FpXl, FpXr, 14);
  ROUND (FpXr, FpXl, 15); ROUND (FpXl, FpXr, 16);
  FpXr^.Lword := FpXr^.Lword Xor Fpbf_P^[17];

  Xr := FpXr^;
  FpXr^ := FpXl^;
  FpXl^ := Xr;
end;{TBlowFish.BF_Encipher}

Procedure TBlowFish.BF_Decipher;
 var
  Xr: aword;
 begin
 {Flip the bytes around}
 {Despite what you might think, this does NOT
  slow the implementation down, it adds about
  200ms per MegaByte of data encrypted.}
 {we either do this, or read in one byte at a
  time and shift left}
{Intelx86}
{$IFDEF ORDER_DCBA}
    Xr := FpXl^;
    FpXl^.w.byte3 := Xr.w.byte0;
    FpXl^.w.byte2 := Xr.w.byte1;
    FpXl^.w.byte1 := Xr.w.byte2;
    FpXl^.w.byte0 := Xr.w.byte3;
    Xr := FpXr^;
    FpXr^.w.byte3 := Xr.w.byte0;
    FpXr^.w.byte2 := Xr.w.byte1;
    FpXr^.w.byte1 := Xr.w.byte2;
    FpXr^.w.byte0 := Xr.w.byte3;
{$ENDIF}

  FpXl^.Lword := FpXl^.Lword Xor Fpbf_P^[17];
  ROUND (FpXr, FpXl, 16);  ROUND (FpXl, FpXr, 15);
  ROUND (FpXr, FpXl, 14);  ROUND (FpXl, FpXr, 13);
  ROUND (FpXr, FpXl, 12);  ROUND (FpXl, FpXr, 11);
  ROUND (FpXr, FpXl, 10);  ROUND (FpXl, FpXr, 9);
  ROUND (FpXr, FpXl, 8);   ROUND (FpXl, FpXr, 7);
  ROUND (FpXr, FpXl, 6);   ROUND (FpXl, FpXr, 5);
  ROUND (FpXr, FpXl, 4);   ROUND (FpXl, FpXr, 3);
  ROUND (FpXr, FpXl, 2);   ROUND (FpXl, FpXr, 1);
  FpXr^.Lword := FpXr^.Lword Xor Fpbf_P^[0];

  Xr := FpXr^;
  FpXr^ := FpXl^;
  FpXl^ := Xr;
{Intelx86}
{$IFDEF ORDER_DCBA}
    Xr := FpXl^;
    FpXl^.w.byte3 := Xr.w.byte0;
    FpXl^.w.byte2 := Xr.w.byte1;
    FpXl^.w.byte1 := Xr.w.byte2;
    FpXl^.w.byte0 := Xr.w.byte3;
    Xr := FpXr^;
    FpXr^.w.byte3 := Xr.w.byte0;
    FpXr^.w.byte2 := Xr.w.byte1;
    FpXr^.w.byte1 := Xr.w.byte2;
    FpXr^.w.byte0 := Xr.w.byte3;
{$ENDIF}
end;{TBlowFish.BF_Decipher}

Procedure TBlowFish.EncipherBLOCK;
{FSmallBuffer holds the clear text, on exit it holds the Cipher text}
 var
  pLong64: PtwoAword;
  leLong64: twoAword;
 begin
  pLong64 := @FSmallBuffer;
  FpXl := @pLong64^.Xl;
  FpXr := @pLong64^.Xr;

{Intelx86}
{$IFDEF ORDER_DCBA}
    leLong64 := pLong64^;
    pLong64^.Xl.w.byte3 := leLong64.Xl.w.byte0;
    pLong64^.Xl.w.byte2 := leLong64.Xl.w.byte1;
    pLong64^.Xl.w.byte1 := leLong64.Xl.w.byte2;
    pLong64^.Xl.w.byte0 := leLong64.Xl.w.byte3;

    pLong64^.Xr.w.byte3 := leLong64.Xr.w.byte0;
    pLong64^.Xr.w.byte2 := leLong64.Xr.w.byte1;
    pLong64^.Xr.w.byte1 := leLong64.Xr.w.byte2;
    pLong64^.Xr.w.byte0 := leLong64.Xr.w.byte3;
{$ENDIF}
    BF_Encipher;
{Flip Bytes Here!!!}
{$IFDEF ORDER_DCBA}
    leLong64 := pLong64^;
    pLong64^.Xl.w.byte3 := leLong64.Xl.w.byte0;
    pLong64^.Xl.w.byte2 := leLong64.Xl.w.byte1;
    pLong64^.Xl.w.byte1 := leLong64.Xl.w.byte2;
    pLong64^.Xl.w.byte0 := leLong64.Xl.w.byte3;

    pLong64^.Xr.w.byte3 := leLong64.Xr.w.byte0;
    pLong64^.Xr.w.byte2 := leLong64.Xr.w.byte1;
    pLong64^.Xr.w.byte1 := leLong64.Xr.w.byte2;
    pLong64^.Xr.w.byte0 := leLong64.Xr.w.byte3;
{$ENDIF}
end;{TBlowFish.EncipheBLOCK}

Procedure TBlowFish.DecipherBLOCK;
var
  pLong64: PtwoAword;
 begin
  pLong64 := @FSmallBuffer;
  FpXl := @pLong64^.Xl;
  FpXr := @pLong64^.Xr;
  BF_Decipher;
end;{TBlowFish.DecipherBLOCK}
end.