System.NetEncoding: Delphi-compatible Base64 and Base64String encodings

packages/fcl-base/src/base64.pp

@@ -37,11 +37,23 @@ uses classes, sysutils;
 type
 
   TBase64EncodingStream = class(TOwnerStream)
+  private type
+    TWriteBuffer = array[0..3] of AnsiChar;
+    TWriteBufferLength = 1..4;
   protected
+    CharsPerLine: Integer;
+    LineSeparator: string;
+    PadEnd: Boolean;
+
     TotalBytesProcessed, BytesWritten: LongWord;
+    LineLength: Integer;
     Buf: array[0..2] of Byte;
     BufSize: Integer;    // # of bytes used in Buf
+
+    procedure DoWriteBuf(var Buffer: TWriteBuffer; BufferLength: TWriteBufferLength);
   public
+    constructor Create(ASource: TStream); overload;
+    constructor Create(ASource: TStream; ACharsPerLine: Integer; ALineSeparator: string; APadEnd: Boolean); overload;
     destructor Destroy; override;
     Function Flush : Boolean;
     function Write(const Buffer; Count: Longint): Longint; override;
@@ -84,11 +96,11 @@ type
 
     function Read(var Buffer; Count: Longint): Longint; override;
     function Seek(Offset: Longint; Origin: Word): Longint; override;
-    
+
     property EOF: Boolean read fEOF;
     property Mode: TBase64DecodingMode read FMode write SetMode;
   end;
-  
+
   EBase64DecodingException = class(Exception)
   end;
 
@@ -147,9 +159,7 @@ begin
     1: begin
         WriteBuf[0] := EncodingTable[Buf[0] shr 2];
         WriteBuf[1] := EncodingTable[(Buf[0] and 3) shl 4];
-        WriteBuf[2] := '=';
-        WriteBuf[3] := '=';
-        Source.Write(WriteBuf, 4);
+        DoWriteBuf(WriteBuf, 2);
         Result:=True;
         Inc(TotalBytesProcessed,2);
       end;
@@ -157,8 +167,7 @@ begin
         WriteBuf[0] := EncodingTable[Buf[0] shr 2];
         WriteBuf[1] := EncodingTable[(Buf[0] and 3) shl 4 or (Buf[1] shr 4)];
         WriteBuf[2] := EncodingTable[(Buf[1] and 15) shl 2];
-        WriteBuf[3] := '=';
-        Source.Write(WriteBuf, 4);
+        DoWriteBuf(WriteBuf, 3);
         Result:=True;
         Inc(TotalBytesProcessed,1);
       end;
@@ -167,12 +176,66 @@ begin
   end;
 end;
 
+constructor TBase64EncodingStream.Create(ASource: TStream);
+begin
+  Create(ASource, 0, '', True);
+end;
+
+constructor TBase64EncodingStream.Create(ASource: TStream; ACharsPerLine: Integer; ALineSeparator: string; APadEnd: Boolean);
+begin
+  inherited Create(ASource);
+
+  CharsPerLine := ACharsPerLine;
+  LineSeparator := ALineSeparator;
+  PadEnd := APadEnd;
+end;
+
 destructor TBase64EncodingStream.Destroy;
 begin
   Flush;
   inherited Destroy;
 end;
 
+procedure TBase64EncodingStream.DoWriteBuf(var Buffer: TWriteBuffer; BufferLength: TWriteBufferLength);
+const
+  Pad: AnsiChar = '=';
+var
+  CharsBeforeLineEnd: Integer;
+  I: TWriteBufferLength;
+begin
+  if PadEnd and (BufferLength<4) then
+  begin
+    for I := BufferLength to 3 do
+      Buffer[I] := Pad;
+    BufferLength := 4;
+  end;
+
+  if (CharsPerLine<=0) or (LineSeparator='') then
+    Source.Write(Buffer[0], BufferLength)
+  else
+  begin // split output into lines
+    CharsBeforeLineEnd := CharsPerLine-LineLength;
+    if CharsBeforeLineEnd<0 then
+      CharsBeforeLineEnd := 0;
+
+    if CharsBeforeLineEnd<BufferLength then
+    begin // buffer does not fit in the line
+      if CharsBeforeLineEnd>0 then
+        Source.Write(Buffer[0], CharsBeforeLineEnd);
+      Source.Write(LineSeparator[1], Length(LineSeparator));
+      Source.Write(Buffer[CharsBeforeLineEnd], BufferLength-CharsBeforeLineEnd);
+      Inc(BytesWritten, Length(LineSeparator));
+      LineLength := BufferLength-CharsBeforeLineEnd;
+    end else
+    begin
+      Source.Write(Buffer[0], BufferLength);
+      Inc(LineLength, BufferLength);
+    end;
+  end;
+  Inc(BytesWritten, BufferLength);
+  BufSize := 0;
+end;
+
 function TBase64EncodingStream.Write(const Buffer; Count: Longint): Longint;
 var
   ReadNow: LongInt;
@@ -196,19 +259,35 @@ begin
     WriteBuf[1] := EncodingTable[(Buf[0] and 3) shl 4 or (Buf[1] shr 4)];
     WriteBuf[2] := EncodingTable[(Buf[1] and 15) shl 2 or (Buf[2] shr 6)];
     WriteBuf[3] := EncodingTable[Buf[2] and 63];
-    Source.Write(WriteBuf, 4);
-    Inc(BytesWritten, 4);
-    BufSize := 0;
+    DoWriteBuf(WriteBuf, 4);
   end;
   Move(p^, Buf[BufSize], count);
   Inc(BufSize, count);
 end;
 
 function TBase64EncodingStream.Seek(Offset: Longint; Origin: Word): Longint;
+var
+  NewChars: Integer;
 begin
   Result := BytesWritten;
   if BufSize > 0 then
-    Inc(Result, 4);
+  begin
+    if PadEnd then
+      NewChars := 4
+    else
+    case (TotalBytesProcessed mod 3) of
+      1: NewChars := 2;
+      2: NewChars := 3;
+    else
+      NewChars := 0;
+    end;
+    if NewChars>0 then
+    begin
+      Inc(Result, NewChars);
+      if (CharsPerLine>0) and (LineLength+NewChars>CharsPerLine) then
+        Inc(Result, Length(LineSeparator));
+    end;
+  end;
 
   // This stream only supports the Seek modes needed for determining its size
   if not ((((Origin = soFromCurrent) or (Origin = soFromEnd)) and (Offset = 0))
@@ -312,7 +391,7 @@ var
   b: byte;
   ReadBuf: array[0..3] of Byte; // buffer to store last read 4 input bytes
   ToRead, OrgToRead, HaveRead, ReadOK, i: Integer;
-  
+
   procedure DetectedEnd(ASize:Int64);
   begin
     DecodedSize := ASize;
@@ -320,7 +399,7 @@ var
     if CurPos + Count > DecodedSize then
       Count := DecodedSize - CurPos;
   end;
-  
+
 begin
   if Count <= 0 then exit(0); // nothing to read, quit
   if DecodedSize <> -1 then begin // try using calculated size info if possible
@@ -354,7 +433,7 @@ begin
             end;
           end;
         end;
-        
+
         if HaveRead <> OrgToRead then begin // less than 4 base64 bytes could be read; end of input stream
           //WriteLn('End: ReadOK=', ReadOK, ', count=', Count);
           for i := ReadOK to 3 do
@@ -366,7 +445,7 @@ begin
       end;
 
       Inc(ReadBase64ByteCount, ReadOK);
-      
+
       // Check for pad characters
       case Mode of
         bdmStrict:begin
@@ -396,13 +475,13 @@ begin
           end;
         end;
       end;
-      
+
       // Decode the 4 bytes in the buffer to 3 undecoded bytes
       Buf[0] :=  ReadBuf[0]         shl 2 or ReadBuf[1] shr 4;
       Buf[1] := (ReadBuf[1] and 15) shl 4 or ReadBuf[2] shr 2;
       Buf[2] := (ReadBuf[2] and  3) shl 6 or ReadBuf[3];
     end;
-    
+
     if Count <= 0 then begin
       Break;
     end;
@@ -415,7 +494,7 @@ begin
     Dec(Count);
     Inc(Result);
   end;
-  
+
   // check for EOF
   if (DecodedSize <> -1) and (CurPos >= DecodedSize) then begin
     FEOF := true;
@@ -430,21 +509,21 @@ end;
 
 function DecodeStringBase64(const s: AnsiString;strict:boolean=false): AnsiString;
 
-var 
+var
   SD : Ansistring;
-  Instream, 
+  Instream,
   Outstream : TStringStream;
   Decoder   : TBase64DecodingStream;
 begin
   if Length(s)=0 then
     Exit('');
   SD:=S;
-  while Length(Sd) mod 4 > 0 do 
+  while Length(Sd) mod 4 > 0 do
     SD := SD + '=';
   Instream:=TStringStream.Create(SD);
   try
     Outstream:=TStringStream.Create('');
-    try 
+    try
       if strict then
         Decoder:=TBase64DecodingStream.Create(Instream,bdmStrict)
       else
@@ -455,10 +534,10 @@ begin
       finally
         Decoder.Free;
         end;
-    finally 
+    finally
      Outstream.Free;
      end;
-  finally 
+  finally
     Instream.Free;
     end;
 end;
@@ -469,14 +548,14 @@ var
   Outstream : TStringStream;
   Encoder   : TBase64EncodingStream;
 begin
-  if Length(s)=0 then 
+  if Length(s)=0 then
     Exit('');
   Outstream:=TStringStream.Create('');
   try
     Encoder:=TBase64EncodingStream.create(outstream);
-    try 
+    try
       Encoder.Write(s[1],Length(s));
-    finally 
+    finally
       Encoder.Free;
       end;
     Result:=Outstream.DataString;

packages/vcl-compat/src/system.netencoding.pp

@@ -39,11 +39,15 @@ type
 
   TNetEncoding = class
   private
-    Const
-      StdCount = 3;
+    type
+      TStandardEncoding = (
+        seBase64,
+        seBase64String,
+        seHTML,
+        seURL);
     Class var
-      FStdEncodings : Array[1..StdCount] of TNetEncoding;
-    Class Function GetStdEncoding(aIndex : Integer) : TNetEncoding; Static;
+      FStdEncodings : Array[TStandardEncoding] of TNetEncoding;
+    Class Function GetStdEncoding(aIndex : TStandardEncoding) : TNetEncoding; Static;
     Class Destructor Destroy;
     class function GetURLEncoding: TURLEncoding; static;
   protected
@@ -85,14 +89,22 @@ type
     Function EncodeBytesToString(const aInput: array of Byte): UnicodeString; overload;
     Function EncodeBytesToString(const aInput: Pointer; Size: Integer): UnicodeString; overload;
     // Default instances
-    class property Base64: TNetEncoding Index 1 read GetStdEncoding;
-    class property HTML: TNetEncoding Index 2 read GetStdEncoding;
+    class property Base64: TNetEncoding Index seBase64 read GetStdEncoding;
+    class property Base64String: TNetEncoding Index seBase64String read GetStdEncoding;
+    class property HTML: TNetEncoding Index seHTML read GetStdEncoding;
     class property URL: TURLEncoding read GetURLEncoding;
   end;
 
-  { TBase64Encoding }
+  { TCustomBase64Encoding }
 
-  TBase64Encoding = class(TNetEncoding)
+  TCustomBase64Encoding = class(TNetEncoding)
+  protected const
+    kCharsPerLine = 76;
+    kLineSeparator = #13#10;
+  protected
+    FCharsPerline: Integer;
+    FLineSeparator: string;
+    FPadEnd: Boolean;
   protected
     Function DoDecode(const aInput, aOutput: TStream): Integer; overload; override;
     Function DoEncode(const aInput, aOutput: TStream): Integer; overload; override;
@@ -101,6 +113,22 @@ type
     Function DoEncode(const aInput: RawByteString): RawByteString; overload; override;
   end;
 
+  { TBase64Encoding }
+
+  TBase64Encoding = class(TCustomBase64Encoding)
+  public
+    constructor Create; overload; virtual;
+    constructor Create(CharsPerLine: Integer); overload; virtual;
+    constructor Create(CharsPerLine: Integer; LineSeparator: string); overload; virtual;
+  end;
+
+  { TBase64StringEncoding }
+
+  TBase64StringEncoding = class(TCustomBase64Encoding)
+  public
+    constructor Create; overload; virtual;
+  end;
+
   { TURLEncoding }
 
   TURLEncoding = class(TNetEncoding)
@@ -141,9 +169,9 @@ uses base64, httpprotocol, HTMLDefs, xmlread;
 Resourcestring
   sInvalidHTMLEntity = 'Invalid HTML encoded character: %s';
 
-{ TBase64Encoding }
+{ TCustomBase64Encoding }
 
-function TBase64Encoding.DoDecode(const aInput, aOutput: TStream): Integer;
+function TCustomBase64Encoding.DoDecode(const aInput, aOutput: TStream): Integer;
 
 Var
   S : TBase64DecodingStream;
@@ -158,12 +186,12 @@ begin
   end;
 end;
 
-function TBase64Encoding.DoEncode(const aInput, aOutput: TStream): Integer;
+function TCustomBase64Encoding.DoEncode(const aInput, aOutput: TStream): Integer;
 Var
   S : TBase64EncodingStream;
 
 begin
-  S:=TBase64EncodingStream.Create(aInput);
+  S:=TBase64EncodingStream.Create(aInput,FCharsPerline,FLineSeparator,FPadEnd);
   try
     Result:=S.Size;
     aOutput.CopyFrom(S,Result);
@@ -172,14 +200,60 @@ begin
   end;
 end;
 
-function TBase64Encoding.DoDecode(const aInput: RawByteString): RawByteString;
+function TCustomBase64Encoding.DoDecode(const aInput: RawByteString): RawByteString;
 begin
   Result:=DecodeStringBase64(aInput,False);
 end;
 
-function TBase64Encoding.DoEncode(const aInput: RawByteString): RawByteString;
+function TCustomBase64Encoding.DoEncode(const aInput: RawByteString): RawByteString;
+var
+  Outstream : TStringStream;
+  Encoder   : TBase64EncodingStream;
 begin
-  Result:=EncodeStringBase64(aInput);
+  if Length(aInput)=0 then
+    Exit('');
+  Outstream:=TStringStream.Create('');
+  try
+    Encoder:=TBase64EncodingStream.create(outstream,FCharsPerline,FLineSeparator,FPadEnd);
+    try
+      Encoder.Write(aInput[1],Length(aInput));
+    finally
+      Encoder.Free;
+    end;
+    Result:=Outstream.DataString;
+  finally
+    Outstream.free;
+  end;
+end;
+
+{ TBase64Encoding }
+
+constructor TBase64Encoding.Create(CharsPerLine: Integer);
+begin
+  Create(CharsPerLine, kLineSeparator);
+end;
+
+constructor TBase64Encoding.Create(CharsPerLine: Integer; LineSeparator: string);
+begin
+  inherited Create;
+  FCharsPerline:=CharsPerLine;
+  FLineSeparator:=LineSeparator;
+  FPadEnd:=True;
+end;
+
+constructor TBase64Encoding.Create;
+begin
+  Create(kCharsPerLine, kLineSeparator);
+end;
+
+{ TBase64StringEncoding }
+
+constructor TBase64StringEncoding.Create;
+begin
+  inherited Create;
+  FCharsPerline:=0;
+  FLineSeparator:='';
+  FPadEnd:=True;
 end;
 
 { ---------------------------------------------------------------------
@@ -189,10 +263,10 @@ end;
 class procedure TNetEncoding.FreeStdEncodings;
 
 Var
-  I : Integer;
+  I : TStandardEncoding;
 
 begin
-  For I:=1 to StdCount do
+  For I in TStandardEncoding do
     FreeAndNil(FStdEncodings[i]);
 end;
 
@@ -201,20 +275,39 @@ begin
   FreeStdEncodings;
 end;
 
-class function TNetEncoding.GetURLEncoding: TURLEncoding; static;
+class function TNetEncoding.GetURLEncoding: TURLEncoding;
 begin
-  Result:=TURLEncoding(GetStdEncoding(3));
+  Result:=TURLEncoding(GetStdEncoding(seURL));
 end;
 
-class function TNetEncoding.GetStdEncoding(aIndex: Integer): TNetEncoding;
+class function TNetEncoding.GetStdEncoding(aIndex: TStandardEncoding): TNetEncoding;
 begin
-  if FStdEncodings[aIndex]=Nil then
-    case aIndex of
-      1 : FStdEncodings[1]:=TBase64Encoding.Create;
-      2 : FStdEncodings[2]:=THTMLEncoding.Create;
-      3 : FStdEncodings[3]:=TURLEncoding.Create;
-    end;
   Result:=FStdEncodings[aIndex];
+  if Assigned(Result) then
+  begin
+{$ifdef FPC_HAS_FEATURE_THREADING}
+    ReadDependencyBarrier; // Read Result contents (by caller) after Result pointer.
+{$endif}
+    Exit;
+  end;
+
+  case aIndex of
+    seBase64: Result:=TBase64Encoding.Create;
+    seBase64String: Result:=TBase64StringEncoding.Create;
+    seHTML: Result:=THTMLEncoding.Create;
+    seURL: Result:=TURLEncoding.Create;
+  end;
+
+{$ifdef FPC_HAS_FEATURE_THREADING}
+  WriteBarrier; // Write FStdEncodings[aIndex] after Result contents.
+  if InterlockedCompareExchange(Pointer(FStdEncodings[aIndex]), Pointer(Result), nil) <> nil then
+  begin
+    Result.Free;
+    Result := FStdEncodings[aIndex];
+  end;
+{$else}
+  FStdEncodings[aIndex] := Result;
+{$endif}
 end;
 
 // Public API