{$define UNLIMITED}          // WASSENAAR_LIMITED, UNLIMITED

unit Blowfish;

interface

uses
     Classes, SysUtils;

const
     {general constants}
     BLOCKSIZE = 8;          // Blowfish has an 8 byte block
     BUFFERSIZE = 4096;      // the buffer for file encryption

type SingleBytes = Record
     byte3: Byte; {LSB}
     byte2: BYTE;
     byte1: BYTE;
     byte0: BYTE; {MSB}
end;{SingleBytes}

type EKeyError = class(Exception);

type EFileError = class(Exception);

type EInputError = class(Exception);

type DoublWord = record
  case Integer Of
   0: (LWord: Longint);
   1: (w: singleBytes);
   2: (fByte: Array[0..3] of Byte);
 end;{DoublWord}

type PDoublWord = ^DoublWord;
type TBlock = array[0..(BLOCKSIZE - 1)] of Byte;
type PBlock  = ^TBlock;
PArray = array[0..17] of Longint;
SArray = array[0..255] of Longint;

type TCipherMode = (ECB, CBC, CFB, OFB);
type TStringMode = (smEncode, smNormal);
type Tblf_Core_ctx = record
     P :            PArray;   //P數組
     S1:            SArray;   //第1個S盒
     S2:            SArray;   //第2個S盒
     S3:            SArray;   //第3個S盒
     S4:            SArray;   //第4個S盒
     case Integer of          // Encryption/decryption block buffer
          0: (ByteBuffer: TBlock);
          1: (LongBuffer: array[0..1] of LongInt);
end; {Tblf_ctx}

type Tblf_ctx = record
     KeyInit:       Boolean;  // Shows if the password has been initialised
     IVInit:        Boolean;  // Shows if the IV has been initialised
     IV:            TBlock;   // The Initialisation Vector
     ct:            TBlock;   // temporary buffer used in CBC, CFB and OFB modes
     end; {Tblf_ctx}

type TBlowCore = class(TObject)
     ctx:          Tblf_Core_ctx;
     FPtrL:        PDoublWord;   //指向低32位數據
     FPtrR:        PDoublWord;   //指向高32位數據
public
     procedure     Blowfish_Core_Block_Encrypt;
     procedure     Blowfish_Core_Block_Decrypt;
end; {TBLowCore}

type TBlowfish = class(TObject)
  private
     FBlowCore:    TBlowCore;
     ctx:          Tblf_ctx;
     FBuffer:      array[0..BUFFERSIZE+BLOCKSIZE] of BYTE; {Local Copy of Data}
     PtrBuffer:    PBlock;
     FCipherMode:  TCipherMode;
     FStringMode:  TStringMode;
     procedure     Blowfish_Core_Key_Setup(KeyArray: array of Byte; const KeyLength: integer);
     procedure     EncryptBlockMode;
     procedure     DecryptBlockMode;
     procedure     InitArray;
     procedure     EndianEncBlock;
     procedure     EndianDecBlock;
     function      EncodeString(InputString: string): string;
     function      DecodeString(InputString: string): string;
     procedure     CheckKeys;
  public
     constructor   Create;
     destructor    Destroy; override;
     procedure     InitialiseString(const Key: string);
     procedure     LoadIVString(const IVString: string);
     procedure     EncBlock (const Input: TBlock; var Output: TBlock);
     procedure     DecBlock (const Input: TBlock; var Output: TBlock);
     procedure     EncBuffer(const Len: integer);
     procedure     DecBuffer(const Len: integer);
     procedure     EncString(const Input: string; var Output: string);
     procedure     DecString(const Input: string; var Output: string);
     procedure     Burn;
     function      GetVersion: string;
     procedure     SetCipherMode(const Value: TCipherMode);
     function      GetCipherMode: TCipherMode;
     procedure     SetStringMode(const Value: TStringMode);
     function      GetStringMode: TStringMode;
end;

implementation

uses Windows, Dialogs;

{$I BFConst.inc}

const
     MAXBYTES = 56;          // max number of bytes in the key
     N = 16;                 // Blowfish rounds (default 16)
     RELVER = '1.15';        // Version number
     LIT_COMPNAME            = 'Blowfish';
     LIT_KEY_NOT_SET         = LIT_COMPNAME + ': Key not set';
     LIT_IV_NOT_SET          = LIT_COMPNAME + ': IV not set';
     LIT_KEY_LENGTH          = LIT_COMPNAME + ': Key must be between 1 and 56 bytes';
     LIT_INFILE_NOT_FOUND    = LIT_COMPNAME + ': Input file not found';
     LIT_CBC_NOT_SET         = LIT_COMPNAME + ': Mode must be CBC for CBCMAC';
     LIT_OUTFILE_OPEN_ERROR  = LIT_COMPNAME + ': Could not open output file';
     LIT_OUTFILE_WRITE_ERROR = LIT_COMPNAME + ': Error writing output file';
     LIT_INPUT_LENGTH        = LIT_COMPNAME + ': Input not valid - too short';
     LIT_BASE64CNV           = LIT_COMPNAME + ': Error converting from Base64 - invalid character';

function TBlowfish.EncodeString(InputString: string): string;
var
  Counter:integer;
  ReturnString:string;
  b:Byte;
  i:integer;
  last:byte;
  Flush:Boolean;
  LengthInput:integer;
begin
  Counter := 0;
  ReturnString := '';
  Flush := False;
  last := 0;
  if (Length(InputString) mod 3) <> 0 then
    begin
      InputString := InputString + Chr(0);
      Flush := True;
    end;
  LengthInput := Length(InputString);
  i := 1;
  while (i <= LengthInput) do
    begin
      if i <= LengthInput then
        b := Ord(InputString[i])
      else
        b := 0;
      case Counter of
        0:
          begin
            ReturnString := ReturnString + BinToAsc[(b shr 2)];
            last := b;
          end;
        1:
          begin
            ReturnString := ReturnString + BinToAsc[((last and $3) shl 4) or ((b and $F0) shr 4) ];
            last := b;
          end;
        2:
          begin
            ReturnString := ReturnString + BinToAsc[((last and $F) shl 2) or ((b and $C0) shr 6)];
            if not (Flush and (i = LengthInput)) then
              ReturnString := ReturnString + BinToAsc[(b and $3F)];
            last := 0;
          end;
      end; {case}

      Inc(Counter);
      if Counter = 3 then
        Counter := 0;
      Inc(i);
  end; {while}
  Result := ReturnString;
end; {EncodeString}

function TBlowfish.DecodeString(InputString: string): string;
     function  DecodeBase64(b: byte): byte;
     begin
          if (b >= Ord('0')) and (b <= Ord('9')) then
          begin
               Result := b - Ord('0') + 2;
               Exit;
          end;
          if (b >= Ord('A')) and (b <= Ord('Z')) then
          begin
               Result := b - Ord('A') + 12;
               Exit;
          end;
          if (b >= Ord('a')) and (b <= Ord('z')) then
          begin
               Result := b - Ord('a') + 38;
               Exit;
          end;
          if b = Ord('+') then
          begin
               Result := 0;
               Exit;
          end;
          if b = Ord('-') then
          begin
               Result := 1;
               Exit;
          end;
          raise EConvertError.Create(LIT_BASE64CNV);
     end; {DecodeBase64}
var
     Counter:      integer;
     ReturnString: string;
     c:            Char;
     last:         byte;
     this:         byte;
     i:            integer;
begin
     Counter := 0;
     ReturnString := '';
     last := 0;

     for i := 1 to Length(InputString) do
     begin
          c := InputString[i];
          case Counter of
          0:
               begin
                    last := DecodeBase64(Ord(c)) shl 2;
               end;
          1:
               begin
                    this := DecodeBase64(Ord(c));
                    ReturnString := ReturnString + Chr((last or (this shr 4)) and $ff);
                    last := this shl 4;
               end;
          2:
               begin
                    this := DecodeBase64(Ord(c));
                    ReturnString := ReturnString + Chr((last or (this shr 2)) and $ff);
                    last := this shl 6;
               end;
          3:
               begin
                    this := DecodeBase64(Ord(c));
                    ReturnString := ReturnString + Chr((last or this) and $ff);
                    last := 0;
               end;
          end; {case}

          Inc(Counter);
          if Counter = 4 then
          begin
               Counter := 0;
          end; {if}
     end; {for}

     Result := ReturnString;
end; {DecodeString}

function TBlowfish.GetVersion;
begin
     // return the version string
     Result := LIT_COMPNAME + ' ' + RELVER;
end; {GetVersion}

procedure TBlowfish.InitialiseString(const Key: string);
var
  KeyArray: array[0..255] of Byte;
  i: integer;
begin
  if (Length(Key) < 1) or (Length(Key) > MAXBYTES) then
    begin
      raise EKeyError.Create(LIT_KEY_LENGTH);
      Exit;
    end;

  FillChar(ctx.ct, Sizeof(ctx.ct), #0);
  FillChar(FBlowCore.ctx.ByteBuffer, Sizeof(FBlowCore.ctx.ByteBuffer), #0);
  FillChar(FBlowCore.ctx.S1, Sizeof(FBlowCore.ctx.S1), #0);
  FillChar(FBlowCore.ctx.S2, Sizeof(FBlowCore.ctx.S2), #0);
  FillChar(FBlowCore.ctx.S3, Sizeof(FBlowCore.ctx.S3), #0);
  FillChar(FBlowCore.ctx.S3, Sizeof(FBlowCore.ctx.S4), #0);
  FillChar(FBlowCore.ctx.P, Sizeof(FBlowCore.ctx.P), #0);
  FillChar(KeyArray, Sizeof(KeyArray), #0);

  {$ifdef WASSENAAR_LIMITED}
  for i := 1 to Length(Key) do
    KeyArray[(i-1) mod 8] := Ord(Key[i]);
  {$else}
  for i := 1 to Length(Key) do
    KeyArray[i-1] := Ord(Key[i]);
  {$endif}
  Blowfish_Core_Key_Setup(KeyArray, Length(Key));
     ctx.KeyInit := True;
end; {InitialiseString}

procedure TBlowfish.LoadIVString(Const IVString: string);
var
  i:integer;
begin
  FillChar(ctx.IV, BLOCKSIZE, #0);
  for i := 1 to Length(IVString) do
    ctx.IV[(i-1) and (BLOCKSIZE - 1)] := ctx.IV[(i-1) and (BLOCKSIZE - 1)] xor Ord(IVString[i]);
  ctx.IVInit := True;
end;

procedure TBlowfish.EncBlock(const Input: TBlock; var Output: TBlock);
begin
  CheckKeys;
  FBlowCore.ctx.ByteBuffer := Input;
  EncryptBlockMode;
  Output := FBlowCore.ctx.ByteBuffer;
end;

procedure TBlowfish.DecBlock(const Input: TBlock; var Output: TBlock);
begin
  CheckKeys;
  FBlowCore.ctx.ByteBuffer := Input;
  DecryptBlockMode;
  Output := FBlowCore.ctx.ByteBuffer;
end;

procedure TBlowfish.EncBuffer(const Len: integer);
var
     Index: integer;
begin
     // check that we have a keys and IV
     CheckKeys;

     // index is the pointer to the current position in the buffer
     Index := 0;

     // PtrBuffer points to the address of the buffer
     PtrBuffer := @FBuffer;

     // for every block in the buffer
     repeat
          // move one block from the buffer contents into the context
          Move(FBuffer[Index], FBlowCore.ctx.ByteBuffer, BLOCKSIZE);

          // encrypt the context
          EncryptBlockMode;

          // move the block back
          Move(FBlowCore.ctx.ByteBuffer, PtrBuffer^[Index], BLOCKSIZE);

          // increment the pointer
          Inc(Index,BLOCKSIZE);
     until Index = Len;
end; {EncBuffer}

procedure TBlowfish.DecBuffer(const Len: integer);
var
     Index: integer;
begin
     CheckKeys;
     Index := 0;
     PtrBuffer := @FBuffer;
     repeat
          Move(FBuffer[Index], FBlowCore.ctx.ByteBuffer, BLOCKSIZE);
          DecryptBlockMode;
          Move(FBlowCore.ctx.ByteBuffer, PtrBuffer^[Index], BLOCKSIZE);
          Inc(Index,BLOCKSIZE);
     until Index = Len;
end;

procedure TBlowfish.EncString(const Input: string; var Output: string);
var
  i:longint;
  j:longint;
  s:string;
begin
  CheckKeys;
  Output := '';
  if Length(Input) = 0 then
    Exit;

     // load the input into the buffer
     s := Input;

     // Pad the input string to a multiple of BLOCKSIZE bytes.
     j := Length(s) + 1;
     i := BLOCKSIZE - (Length(s) mod BLOCKSIZE);
     SetLength(s, Length(s)+i);
     SetLength(Output, Length(s));

     // add the pad bytes to the end of the string
     while j <= Length(s) do
     begin
          s[j] := chr(i);
          inc(j);
     end; {while j}

     // initialise the counters
     j := 1;
     i := 1;

     // and step through the string
     while i < length(s) do
     begin
          // copy the next bytes into the context block buffer
          Move(s[i], FBlowCore.ctx.ByteBuffer, BLOCKSIZE);
          Inc(i, BLOCKSIZE);

          // perform the encryption of the context
          EncryptBlockMode;

          // copy the block into the output string
          Move(FBlowCore.ctx.ByteBuffer, Output[j], BLOCKSIZE);
          Inc(j, BLOCKSIZE);
     end; {while j}

     // encode the string if required
     if FStringMode = smEncode then
     begin
          Output := EncodeString(Output);
     end;
end; {EncString}

procedure TBlowfish.DecString(const Input: string; var Output: string);