{ $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:  13760: IdCoderQuotedPrintable.pas 
{
{   Rev 1.9    11/10/2003 7:41:30 PM  BGooijen
{ Did all todo's ( TStream to TIdStream mainly )
}
{
{   Rev 1.8    2003.10.17 6:14:44 PM  czhower
{ Fix to match new IdStream
}
{
{   Rev 1.7    2003.10.12 3:38:26 PM  czhower
{ Added path to .inc
}
{
{   Rev 1.6    10/12/2003 1:33:42 PM  BGooijen
{ Compiles on D7 now too
}
{
{   Rev 1.5    10/12/2003 12:02:50 PM  BGooijen
{ DotNet
}
{
{   Rev 1.4    6/13/2003 12:07:44 PM  JPMugaas
{ QP was broken again.
}
{
{   Rev 1.3    6/13/2003 07:58:50 AM  JPMugaas
{ Should now compile with new decoder design.
}
{
{   Rev 1.2    6/13/2003 06:17:06 AM  JPMugaas
{ Should now compil,e.
}
{
{   Rev 1.1    12.6.2003 ã. 12:00:28  DBondzhev
{ Fix for . at the begining of new line
}
{
{   Rev 1.0    11/14/2002 02:15:00 PM  JPMugaas
}
unit IdCoderQuotedPrintable;

{
 2002-08-13/14 - Johannes Berg
   completely rewrote the Encoder. May do the Decoder later.
   The encoder will add an EOL to the end of the file if it had no EOL
   at start. I can't avoid this due to the design of IdStream.ReadLn,
   but its also no problem, because in transmission this would happen
   anyway.
 9-17-2001 - J. Peter Mugaas
  made the interpretation of =20 + EOL to mean a hard line break
  soft line breaks are now ignored.  It does not make much sense
  in plain text.  Soft breaks do not indicate the end of paragraphs unlike
  hard line breaks that do end paragraphs.
 3-24-2001 - J. Peter Mugaas
  Rewrote the Decoder according to a new design.
 3-25-2001 - J. Peter Mugaas
  Rewrote the Encoder according to the new design}

interface

{$I Core\IdCompilerDefines.inc}

uses
  Classes,
  IdCoder;

type
  TIdDecoderQuotedPrintable = class(TIdDecoder)
  public
    procedure Decode(const AIn: string;
      const AStartPos: Integer = 1; const ABytes: Integer = -1); override;
  end;

  TIdEncoderQuotedPrintable = class(TIdEncoder)
  public
    function Encode(ASrcStream: TStream; const ABytes: integer = MaxInt): string; override;
  end;

implementation

uses
  IdCoreGlobal,
  IdGlobal,
  IdStream,
  SysUtils;


// BGO: TODO: Move somewhere else
procedure Move(const ASource:ShortString;ASourceStart:integer;var ADest:ShortString;ADestStart, ALen:integer);
{$ifdef DotNet}
var a:integer;
{$endif}
begin
  {$ifdef DotNet}
  for a:=1 to ALen do begin
    ADest[ADestStart]:= ASource[ASourceStart];
    inc(ADestStart);
    inc(ASourceStart);
  end;
  {$else}
    System.Move(ASource[ASourceStart], ADest[ADestStart], ALen);
  {$endif}
end;

{ TIdDecoderQuotedPrintable }

procedure TIdDecoderQuotedPrintable.Decode(const AIn: string;
      const AStartPos: Integer = 1; const ABytes: Integer = -1); 

var
  Buffer, Line, Hex : String;
  i : Integer;
  b : Byte;
const
  Numbers = '01234567890ABCDEF';  {Do not Localize}

  procedure StripEOLChars;
  var j : Integer;
  begin
    for j := 1 to length(sLineBreak) do
    begin
      if (Length(Buffer) > 0) and
         (IndyPos(Buffer[1],EOL) > 0) then
      begin
        Delete(Buffer,1,1);
      end
      else
      begin
        break;
      end;
    end;
  end;
  function TrimRightWhiteSpace(const Str : String) : String;
  var
    i : integer;
    LSaveStr : String;
  begin
    SetLength(LSaveStr,0);
    i := Length(Str);
    while (i > 0) and (Str[i] in [#9,#32]+[#10,#13]) do
    begin
      if Str[i] in [#10,#13] then
      begin
      //BGO: TODO: Change this
      {$ifdef DotNet}Borland.Delphi.{$endif}System.Insert(Str[i],LSaveStr,1);
      end;
      dec(i);
    end;
    result := Copy(Str,1,i) + LSaveStr;
  end;

begin
  Line := '';     {Do not Localize}
  { when decoding a Quoted-Printable body, any trailing
  white space on a line must be deleted, - RFC 1521}
  Buffer := TrimRightWhiteSpace(AIn);
  while Length(Buffer) > 0 do
  begin
    Line :=  Line + Fetch(Buffer,'=');  {Do not Localize}
    // process any following hexidecimal represntation
    if Length(Buffer) > 0 then
    begin
      Hex := '';     {Do not Localize}
      for i := 0 to 1 do
      begin
        If IndyPos(UpperCase(Buffer[1]),Numbers) <> 0 then
        begin
          Hex := Hex + Copy(Buffer,1,1);
          Delete(Buffer,1,1);
        end
        else
        begin
          break;
        end;
      end;
      if (Length(Hex) > 0) then
      begin
        b := StrToInt('$'+Hex);  {Do not Localize}
        //if =20 + EOL, this is a hard line break after a space
        if (b = 32) and
          (Length(Buffer) > 0) and
          (Pos(Buffer[1],EOL) > 0) then
        begin
          Line := Line + Char(b) + EOL;
          StripEOLChars;
        end
        else
        begin
          Line := Line + Char(b);
        end;
      end
      else
      begin
        //ignore soft line breaks -
        StripEOLChars;
      end;
    end;
  end;
  if Length(Line) > 0 then
  begin
    FDestIdStream.Write(Line);
  end;
end;

{ TIdEncoderQuotedPrintable }
function TIdEncoderQuotedPrintable.Encode(ASrcStream: TStream; const ABytes: integer): string;
const
  SafeChars = [#33..#60, #62..#126];
  HalfSafeChars = [#32, TAB];
  // Rule #2, #3

var
  st: TStringList;
  CurrentLine: shortstring;
  // this is a shortstring for performance reasons.
  // the lines may never get longer than 76, so even if I go a bit
  // further, they won't go longer than 80 or so
  SourceLine: AnsiString;
  CurrentPos: integer;

    procedure WriteToString(const s: shortstring);
    var
      SLen: integer;
    begin
      SLen := Length(s);
      Move(s,1, CurrentLine,CurrentPos, SLen);
      Inc(CurrentPos, SLen);
    end;

    Procedure NewLine(const AtPos: integer);
    begin
      if AtPos = CurrentPos then begin
        WriteToString('=');  {Do not Localize}
        st.Add(Copy(CurrentLine, 1, CurrentPos-1));
        CurrentPos := 1;
      end else begin
        st.Add(Copy(CurrentLine, 1, AtPos-1)+'='); { Do not Localize }
        CurrentPos := CurrentPos-AtPos+1;
        Move(CurrentLine, AtPos, CurrentLine, 1, CurrentPos-1);
      end;
    end;

    Procedure FinishLine;
    begin
      st.Add(Copy(CurrentLine, 1, CurrentPos - 1));
      CurrentPos := 1;
    end;

    Function QPHex(const c : AnsiChar) : shortstring;
    begin
      SetLength(Result,3);
      Result[1] := '='; {Do not Localize}
      Result[2] := IdHexDigits[byte(c) shr 4];
      Result[3] := IdHexDigits[byte(c) AND $0F];
    end;

var
  i: integer;
  PossibleBreakPos: integer;
  SourceLen: integer;
  LStream: TIdStream;
begin
  LStream := TIdStream.Create(ASrcStream);
  st := TStringList.Create;
  SetLength(CurrentLine, 255);
  try
    while not LStream.EOF do begin
      SourceLine := TIdStream.ReadLn(ASrcStream,-1, False);
      PossibleBreakPos := 1;
      CurrentPos := 1;
      SourceLen := length(SourceLine);
      for i := 1 to SourceLen do begin
        if CurrentPos < 72 then begin
          PossibleBreakPos := CurrentPos;
        end;
        if not (SourceLine[i] in SafeChars) then begin
          if (SourceLine[i] in HalfSafeChars) then begin
            if i = SourceLen then begin
              WriteToString(QPHex(SourceLine[i]));
            end else begin
              WriteToString(SourceLine[i]);
            end;
          end else begin
            WriteToString(QPHex(SourceLine[i]));
          end;
        end else begin
          if (CurrentPos = 1) and (SourceLine[i] = '.') then begin
            WriteToString(QPHex(SourceLine[i]));
          end else begin
            WriteToString(SourceLine[i]);
          end;
        end;
        if CurrentPos > 74 then begin
          NewLine(PossibleBreakPos);
          PossibleBreakPos := 1;
        end;
      end;
      FinishLine;
    end;
    Result := st.Text;
  finally
    FreeAndNil(st);
  end;
end;

end.
