{ $HDR$}
{**********************************************************************}
{ Unit archived using Team Coherence                                   }
{ Team Coherence is Copyright 2002 by Quality Software Components      }
{                                                                      }
{ For further information / comments, visit our WEB site at            }
{ http://www.TeamCoherence.com                                         }
{**********************************************************************}
{}
{ $Log:  13754: IdCoder3to4.pas
{
{   Rev 1.17    11/10/2003 7:54:14 PM  BGooijen
{ Did all todo's ( TStream to TIdStream mainly )
}
{
{   Rev 1.16    2003.10.24 10:43:02 AM  czhower
{ TIdSTream to dos
}
{
{   Rev 1.15    22/10/2003 12:25:36  HHariri
{ Stephanes changes
}
{
    Rev 1.14    10/16/2003 11:10:18 PM  DSiders
  Added localization comments, whitespace.
}
{
{   Rev 1.13    2003.10.11 10:00:12 PM  czhower
{ Compiles again
}
{
{   Rev 1.12    10/5/2003 4:31:02 PM  GGrieve
{ use ToBytes for Cardinal to Bytes conversion
}
{
{   Rev 1.11    10/4/2003 9:12:18 PM  GGrieve
{ DotNet
}
{
{   Rev 1.10    2003.06.24 12:02:10 AM  czhower
{ Coders now decode properly again.
}
{
{   Rev 1.9    2003.06.23 10:53:16 PM  czhower
{ Removed unused overriden methods.
}
{
{   Rev 1.8    2003.06.13 6:57:10 PM  czhower
{ Speed improvement
}
{
{   Rev 1.7    2003.06.13 3:41:18 PM  czhower
{ Optimizaitions.
}
{
{   Rev 1.6    2003.06.13 2:24:08 PM  czhower
{ Speed improvement
}
{
{   Rev 1.5    10/6/2003 5:37:02 PM  SGrobety
{ Bug fix in decoders.
}
{
{   Rev 1.4    6/6/2003 4:50:30 PM  SGrobety
{ Reworked the 3to4decoder for performance and stability.
{ Note that encoders haven't been touched. Will come later. Another problem:
{ input is ALWAYS a string. Should be a TStream.
{
{ 1/ Fix: added filtering for #13,#10 and #32 to the decoding mechanism.
{ 2/ Optimization: Speed the decoding by a factor 7-10 AND added filtering ;)
{ Could still do better by using a pointer and a stiding window by a factor 2-3.
{ 3/ Improvement: instead of writing everything to the output stream, there is
{ an internal buffer of 4k. It should speed things up when working on large
{ data (no large chunk of memory pre-allocated while keeping a decent perf by
{ not requiring every byte to be written separately).
}
{
{   Rev 1.3    28/05/2003 10:06:56  CCostelloe
{ StripCRLFs changes stripped out at the request of Chad
}
{
{   Rev 1.2    20/05/2003 02:01:00  CCostelloe
}
{
{   Rev 1.1    20/05/2003 01:44:12  CCostelloe
{ Bug fix: decoder code altered to ensure that any CRLFs inserted by an MTA are
{ removed
}
{
{   Rev 1.0    11/14/2002 02:14:36 PM  JPMugaas
}
unit IdCoder3to4;

interface

uses
  Classes,
  IdCoder,
  IdCoreGlobal;

type
  TIdDecodeTable = array[1..127] of Byte;

  TIdEncoder3to4 = class(TIdEncoder)
  protected
    FCodingTable: string;
    FFillChar: Char;
  public
    function Encode(ASrcStream: TStream;
     const ABytes: Integer = MaxInt): string; override;
    procedure EncodeUnit(const AIn1, AIn2, AIn3: Byte; var VOut: TIdBytes);
  published
    property CodingTable: string read FCodingTable;
    property FillChar: Char read FFillChar write FFillChar;
  end;

  TIdEncoder3to4Class = class of TIdEncoder3to4;

  TIdDecoder4to3 = class(TIdDecoder)
  protected
    FCodingTable: string;
    FDecodeTable: TIdDecodeTable;
    FFillChar: Char;
  public
    class procedure ConstructDecodeTable(const ACodingTable: string;
     var ADecodeArray: TIdDecodeTable);
    procedure Decode(const AIn: string; const AStartPos: Integer = 1;
     const ABytes: Integer = -1); override;
  published
    property FillChar: Char read FFillChar write FFillChar;
  end;

implementation

uses
  IdException, IdGlobal, IdResourceStrings, IdStream,
  SysUtils;

{ TIdDecoder4to3 }

class procedure TIdDecoder4to3.ConstructDecodeTable(const ACodingTable: string;
 var ADecodeArray: TIdDecodeTable);
var
  i: integer;
begin
                                                                                         
  //decode char is valid, that is it returns a 255 from the DecodeTable, or at maybe
  //check its presence in the encode table.
  for i := Low(ADecodeArray) to High(ADecodeArray) do begin
    ADecodeArray[i] := 255;
  end;
  for i := 1 to Length(ACodingTable) do begin
    ADecodeArray[Ord(ACodingTable[i])] := i - 1;
  end;
end;

procedure TIdDecoder4to3.Decode(const AIn: string; const AStartPos: Integer = 1; const ABytes: Integer = -1);
var
  LEmptyBytes: Integer;
  LIn : TIdBytes;
  LInBytes: TIdBytes;
  LOut: TIdBytes; //Cache
  LOutPos: Integer;
  LOutSize: Integer;
  LInLimit: Integer;
  LInPos: Integer;
  LWorkBytes: TIdBytes;
  LWhole : Cardinal;
begin
  SetLength(LInBytes, 4);
  SetLength(LWorkBytes, 4);
  LIn := ToBytes(AIn); // if in dotnet, convert to serialisable format

                                          
  if AIn <> '' then begin
    LEmptyBytes := 0;
    // Presize output buffer
    LOutPos := 1;
    if ABytes = -1 then begin
      LOutSize := (Length(AIn) div 4) * 3;
    end else begin
      // Need to make sure we have space as we always write out 3 and then trim
      // because it requires less checking in the loop
      if ABytes mod 3 > 0 then begin
        LOutSize := (ABytes div 3) * 3 + 3;
      end else begin
        LOutSize := ABytes;
      end;
    end;
    SetLength(LOut, LOutSize);
    //
    LInPos := AStartPos;
    // +1 because LInPos is 1 based
    LInLimit := Length(LIn) - SizeOf(LInBytes) + 1;
    while LInPos <= LInLimit do begin
      // Read 4 bytes in for processing
      CopyTIdBytes(LIn, LInPos, LInBytes, 0, Length(LInBytes));
      // Inc pointer
      Inc(LInPos, Length(LInBytes));
      // Reduce to 3 bytes
      LWhole :=
       (FDecodeTable[LInBytes[0]] shl 18)
       or (FDecodeTable[LInBytes[1]] shl 12)
       or (FDecodeTable[LInBytes[2]] shl 6)
       or FDecodeTable[LInBytes[3]];
      LWorkBytes := ToBytes(LWhole);


                                                                             
      // Then we can call a move on all 3 bytes
      LOut[LOutPos] := LWorkBytes[2];
      LOut[LOutPos + 1] := LWorkBytes[1];
      LOut[LOutPos + 2] := LWorkBytes[0];
      Inc(LOutPos, 3);
      // If we dont know how many bytes we need to watch for fill chars. MIME
      // is this way.
      //
      // In best case, the end is not before the end of the input, but the input
      // may be right padded with spaces, or even contain the EOL chars.
      //
      // Because of this we watch for early ends beyond what we originally
      // estimated.
      if ABytes = -1 then begin
        // Must check 3 before 4, if 3 is FillChar, 4 will also be FillChar
        if LInBytes[2] = ord(FillChar) then begin
          LEmptyBytes := 2;
          Break;
        end else if LInBytes[3] = ord(FillChar) then begin
          LEmptyBytes := 1;
          Break;
        end;
      // But with 00E's, we have a length signal for each line so we know
      end else if LOutPos > ABytes then begin
        LEmptyBytes := LOutPos - ABytes - 1;
        Break;
      end;
    end;
    // Write out data to stream
    FDestIdStream.Write(Copy(LOut,1,Length(LOut) - LEmptyBytes));
  end;
end;

{ TIdEncoder3to4 }

function TIdEncoder3to4.Encode(ASrcStream: TStream; const ABytes: Integer = MaxInt): string;
                                                                           
// calls to ReadBuffer then pull from memory
var
  LBuffer : TIdBytes;
  LSize : Integer;
  LLen : integer;
  LBufSize : Integer;
  LBufDataLen: Integer;
  LOutSize: Integer;
  LPos : Integer;
  LIn1, LIn2, LIn3: Byte;
  LUnit: TIdBytes;
  LOutgoing : TIdBytes;
begin
  LIn3 := 0;
  if (ABytes <> MaxInt) and ((ABytes mod 3) > 0) then begin
    raise EIdException.Create(RSUnevenSizeInEncodeStream);
  end;
  // No no - this will read the whole thing into memory and what if its MBs?
  // need to load it in smaller buffered chunks MaxInt is WAY too big....
  LBufSize := ASrcStream.Size - ASrcStream.Position;
  if LBufSize > ABytes then begin
    LBufSize := ABytes;
  end;
  if LBufSize = 0 then begin
    Exit;
  end;
  LOutSize := ((LBufSize+2) div 3) * 4;
  SetLength(LOutgoing, LOutSize); // we know that the string will grow by 4/3 adjusted to 3 boundary
  LLen := 0;
  SetLength(LBuffer, LBufSize);
  with TIdStream.Create(ASrcStream,False) do try
    ReadBytes(LBuffer,LBufSize);
  finally
    Free;
  end;
  LPos := 0;

  // S.G. 21/10/2003: Copy the relevant bytes into the temporary buffer.
  // S.G. 21/10/2003: Record the data length and force exit loop when necessary
  while (LPos <= LBufSize) do
  begin
    LBufDataLen := LBufSize - LPos;
    if LBufDataLen > 3 then
    begin
      LIn1 := LBuffer[LPos];
      LIn2 := LBuffer[LPos+1];
      LIn3 := LBuffer[LPos+2];
      LSize := 3;
      inc(LPos, 3);
    end
    else
    begin
      if LBufDataLen > 2 then
      begin
        LIn1 := LBuffer[LPos];
        LIn2 := LBuffer[LPos+1];
        LIn3 := LBuffer[LPos+2];
        LSize := 3;
        LPos := LBufSize+1; // Make sure we break at end of loop
      end
      else
      begin
        if LBufDataLen > 1 then
        begin
          LIn1 := LBuffer[LPos];
          LIn2 := LBuffer[LPos+1];
          LIn3 := 0;
          LSize := 2;
          LPos := LBufSize+1; // Make sure we break at end of loop
        end
        else
        begin
          LIn1 := LBuffer[LPos];
          LIn2 := 0;
          LIn3 := 0;
          LSize := 1;
          LPos := LBufSize+1; // Make sure we break at end of loop
        end;
      end;
    end;

    EncodeUnit(LIn1, LIn2, LIn3, LUnit);

    assert(LLen + 4 <= length(LOutgoing),
      'TIdEncoder3to4.Encode: Calculated length exceeded (expected '+ {do not localize}
      inttostr(4 * trunc((LBufSize + 2)/3)) +
      ', about to go '+                                               {do not localize}
      inttostr(LLen + 4) +
      ' at offset ' +                                                 {do not localize}
      inttostr(LPos) +
      ' of '+                                                         {do not localize}
      inttostr(LBufSize));

    CopyTIdBytes(LUnit, 0, LOutgoing, LLen, 4);
    inc(LLen, 4);

    if LSize < 3 then begin
      LOutgoing[LLen-1] := ord(FillChar);
      if LSize = 1 then begin
         LOutgoing[LLen-2] := ord(FillChar);
      end;
    end;
  end;

  assert(LLen = (4 * trunc((LBufSize + 2)/3)),
    'TIdEncoder3to4.Encode: Calculated length not met (expected ' +  {do not localize}
    inttostr(4 * trunc((LBufSize + 2)/3)) +
    ', finished at ' +                                               {do not localize}
    inttostr(LLen + 4) +
    ', Bufsize = ' +                                                 {do not localize}
    inttostr(LBufSize));

  result := BytesToString(LOutgoing);
end;

procedure TIdEncoder3to4.EncodeUnit(const AIn1, AIn2, AIn3: Byte; var VOut: TIdBytes);
begin
  SetLength(VOut, 4);
  VOut[0] := Ord(FCodingTable[((AIn1 SHR 2) and 63) + 1]);
  VOut[1] := Ord(FCodingTable[(((AIn1 SHL 4) or (AIn2 SHR 4)) and 63) + 1]);
  VOut[2] := Ord(FCodingTable[(((AIn2 SHL 2) or (AIn3 SHR 6)) and 63) + 1]);
  VOut[3] := Ord(FCodingTable[(Ord(AIn3) and 63) + 1]);
end;

end.

