{*****************************************************************************
 *
 *  BASE64Sup.pas - BASE 64 support  (19-July-1998)
 *
 *  Copyright (c) 1998-99 Michael Haller
 *
 *  Author:     Michael Haller
 *  E-mail:     michael@discountdrive.com
 *  Homepage:   http://www.discountdrive.com/sunrise/
 *
 *  This program is free software; you can redistribute it and/or
 *  modify it under the terms of the GNU General Public License
 *  as published by the Free Software Foundation;
 *
 *  This program is distributed in the hope that it will be useful,
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 *  GNU General Public License for more details.
 *
 *  You should have received a copy of the GNU General Public License
 *  along with this program; if not, write to the Free Software
 *  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA
 *
 *----------------------------------------------------------------------------
 *
 *  Revision history:
 *
 *     DATE     REV                 DESCRIPTION
 *  ----------- --- ----------------------------------------------------------
 *
 *****************************************************************************}

unit BASE64Sup;

interface

procedure PrepareBase64Support;
function StringToBase64(S: string): string;
function Base64ToString(S: string): string;
function _Base64ToString(S : string) : string;

implementation

var
  Bit6ToBase64: array[0..63] of Byte;
  Base64ToBit6: array[0..255] of SmallInt;
  iEncodeInput: SmallInt;
  EncodeShifter: LongInt;
  iDecodeInput: SmallInt;
  DecodeShifter: LongInt;

procedure Init;
begin
  iEncodeInput := 0;
  EncodeShifter := 0;
  iDecodeInput := 0;
  DecodeShifter := 0;
end;

function AddByteToEncode(B: Byte): Boolean;
begin
  Result := True;
  if iEncodeInput = 3 then
    Exit;
  EncodeShifter := EncodeShifter shl 8;
  EncodeShifter := EncodeShifter or B;
  Inc(iEncodeInput);
  Result := (iEncodeInput = 3);
end;

function GetBase64String: string;
var
  S: string;
  I: SmallInt;
begin
  Result := '';
  if iEncodeInput = 0 then
    Exit;
  EncodeShifter := EncodeShifter shl ((3 - iEncodeInput) * 8);
  S := '';
  for I := 1 to 4 do begin
    S := Chr(Bit6ToBase64[EncodeShifter and $3F]) + S;
    EncodeShifter := EncodeShifter shr 6;
  end;

  for I := iEncodeInput + 2 to Length(S) do
    S[I] := '=';
  Result := S;
  EncodeShifter := 0;
  iEncodeInput := 0;
end;

function AddBase64ToDecode(B: Byte): Boolean;
begin
  Result := True;
  if iDecodeInput = 4 then
    Exit;
  B := Base64ToBit6[B];
  if B > $40 then begin
    Result := False;
    Exit;
  end;
  if B = $40 then begin
    B := 0; {Exit;}
  end;
  DecodeShifter := DecodeShifter shl 6;
  DecodeShifter := DecodeShifter or B;
  Inc(iDecodeInput);
  Result := (iDecodeInput = 4);
end;

function GetByteString: string;
var
  S: string;
  I, iDecodeOutput: SmallInt;
begin
  Result := '';
  if iDecodeInput = 0 then
    Exit;
  DecodeShifter := DecodeShifter shl ((4 - iDecodeInput) * 6);
  S := '';
  for I := 1 to 3 do begin
    S := Chr(DecodeShifter and $FF) + S;
    DecodeShifter := DecodeShifter shr 8;
  end;
  iDecodeOutput := iDecodeInput;
  if iDecodeOutput = 4 then
    iDecodeOutput := 3;
  Result := '';
  for I := 1 to iDecodeOutput do
    Result := Result + S[I];
  DecodeShifter := 0;
  iDecodeInput := 0;
end;

procedure PrepareBase64Support;
var
  I: SmallInt;
begin
  for I := 0 to 25 do
    Bit6ToBase64[I] := Ord('A') + I;
  for I := 0 to 25 do
    Bit6ToBase64[26 + I] := Ord('a') + I;
  for I := 0 to 9 do
    Bit6ToBase64[52 + I] := Ord('0') + I;
  Bit6ToBase64[62] := Ord('+');
  Bit6ToBase64[63] := Ord('/');
  for I := 0 to 255 do
    Base64ToBit6[I] := 255;
  for I := 0 to 63 do
    Base64ToBit6[Bit6ToBase64[I]] := I;
  Base64ToBit6[Ord('=')] := $40;
  Init;
end;

function StringToBase64(S: string): string;
var
  I: SmallInt;
  sOut: string;
begin
  Init;
  sOut := '';
  for I := 1 to Length(S) do
    if AddByteToEncode(Ord(S[I])) then
      sOut := sOut + GetBase64String;
  sOut := sOut + GetBase64String;
  Result := sOut;
end;

function Base64ToString(S: string): string;
var
  I: SmallInt;
  sOut: string;
begin
  Init;
  sOut := '';
  for I := 1 to Length(S) do begin
    if AddBase64ToDecode(Ord(S[I])) then begin
      sOut := sOut + GetByteString;
    end;
  end;
  sOut := sOut + GetByteString;
  Result := sOut;
end;
// AHRK22 shortcut... replacement
function _Base64ToString(S : string) : string;
const
  Table =
    #$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$3E +#$40
    +#$40 +#$40 +#$3F +#$34 +#$35 +#$36 +#$37 +#$38 +#$39 +#$3A +#$3B +#$3C
    +#$3D +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$00 +#$01 +#$02 +#$03
    +#$04 +#$05 +#$06 +#$07 +#$08 +#$09 +#$0A +#$0B +#$0C +#$0D +#$0E +#$0F
    +#$10 +#$11 +#$12 +#$13 +#$14 +#$15 +#$16 +#$17 +#$18 +#$19 +#$40 +#$40
    +#$40 +#$40 +#$40 +#$40 +#$1A +#$1B +#$1C +#$1D +#$1E +#$1F +#$20 +#$21
    +#$22 +#$23 +#$24 +#$25 +#$26 +#$27 +#$28 +#$29 +#$2A +#$2B +#$2C +#$2D
    +#$2E +#$2F +#$30 +#$31 +#$32 +#$33 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40;

var
  x, y, n, l: Integer;
  d: array[0..3] of Byte;
begin
  SetLength(Result, Length(S));
  x := 1;
  l := 1;
  while x < Length(S) do
  begin
    for n := 0 to 3 do
    begin
      if x > Length(S) then
        d[n] := 64
      else
      begin
        y := Ord(S[x]);
        if (y < 33) or (y > 127) then
          d[n] := 64
        else
          d[n] := Ord(Table[y - 32]);
      end;
      Inc(x);
    end;
    Result[l] := Char((D[0] and $3F) shl 2 + (D[1] and $30) shr 4);
    Inc(l);
    if d[2] <> 64 then
    begin
      Result[l] := Char((D[1] and $0F) shl 4 + (D[2] and $3C) shr 2);
      Inc(l);
      if d[3] <> 64 then
      begin
        Result[l] := Char((D[2] and $03) shl 6 + (D[3] and $3F));
        Inc(l);
      end;
    end;
  end;
  Dec(l);
  SetLength(Result, l);
end;
end.

