adxchrflt.pas

Async Professional 4.04

  {get the first byte character from the buffer}
  Utf8Char[1] := FBuffer[FBufPos];
  FBufPos := FBufPos + 1;
  {determine the length of the Utf8 character from this}
  Len := ApxGetLengthUtf8(Utf8Char[1]);
  if (Len < 1) then
    raise EAdFilterError.CreateError(FStream.Position,
                                     Line,
                                     LinePos,
                                     sBadUTF8Char);
  Move(Len, Utf8Char[0], 1);
  {get the remaining characters from the stream}
  for i := 2 to Len do begin
    {if the buffer is empty, fill it}
    if (FBufPos >= FBufEnd - FBufDMZ) and
       (not FInTryRead) then begin
      {if we exhaust the stream now, it's a badly formed UTF8
       character--true--but we'll just pretend that the last character
       does not exist}
      if not csGetNextBuffer then begin
        Result := TApdUCS4Char(ApxEndOfStream);
        Exit;
      end;
    end;
    {get the next byte character from the buffer}
    Utf8Char[i] := FBuffer[FBufPos];
    FBufPos := FBufPos + 1;
  end;
  {convert the UTF8 character into a UCS4 character}
  if (not ApxUtf8ToUcs4(Utf8Char, Len, Result)) then
    raise EAdFilterError.CreateError(FStream.Position,
                                     Line,
                                     LinePos,
                                     sBadUTF8Char);
end;
{--------}
procedure TApdInCharFilter.csIdentifyFormat;
begin
  {Note: a stream in either of the UTF16 formats will start with a
         byte-order-mark (BOM). This is the unicode value $FEFF. Hence
         if the first two bytes of the stream are read as ($FE, $FF),
         we have a UTF16BE stream. If they are read as ($FF, $FE), we
         have a UTF16LE stream. Otherwise we assume a UTF8 stream (at
         least for now, it can be changed later).}
  csGetNextBuffer;
  if FBufSize > 2 then
    if (FBuffer[0] = #$FE) and (FBuffer[1] = #$FF) then begin
      FFormat := sfUTF16BE;
      FBufPos := 2;
    end else if (FBuffer[0] = #$FF) and (FBuffer[1] = #$FE) then begin
      FFormat := sfUTF16LE;
      FBufPos := 2;
    end else if (FBuffer[0] = #$EF) and
                (FBuffer[1] = #$BB) and
                (FBuffer[2] = #$BF) then begin
      FFormat := sfUTF8;
      FBufPos := 3;
    end else
      FFormat := sfUTF8
  else
    FFormat := sfUTF8;
end;
{--------}
procedure TApdInCharFilter.csPushCharPrim(aCh : TApdUcs4Char);
begin
  Assert(FUCS4Char = TApdUCS4Char(ApxNullChar));
  {put the char into the buffer}
  FUCS4Char := aCh;
end;
{--------}
procedure TApdInCharFilter.csSetFormat(const aValue : TApdStreamFormat);
begin
  {we do not allow the UTF16 formats to be changed since they were
   well defined by the BOM at the start of the stream but all other
   changes are allowed (caveat user); this means that an input stream
   that defaulted to UTF8 can be changed at a later stage to
   ISO-8859-1 or whatever if required}
  if (Format <> sfUTF16LE) and (Format <> sfUTF16BE) then
    FFormat := aValue;
end;
{--------}
procedure TApdInCharFilter.csGetChar(var aCh        : TApdUcs4Char;
                                    var aIsLiteral : Boolean);
begin
  {get the next character; for an EOF raise an exception}
  csGetCharPrim(aCh, aIsLiteral);
  if (aCh = TApdUCS4Char(ApxEndOfStream)) then
    FEOF := True
  else
    {maintain the line/character counts}
    if (aCh = LF) then
      csAdvanceLine
    else
      csAdvanceLinePos;
end;
{--------}
function TApdInCharFilter.TryRead(const S : array of Longint) : Boolean;
var
  Idx         : Longint;
  Ch          : TApdUcs4Char;
  IL          : Boolean;
  OldBufPos   : Longint;
  OldChar     : DOMChar;
  OldUCS4Char : TApdUcs4Char;
  OldLinePos  : Longint;
  OldLine     : Longint;
begin
  OldBufPos := FBufPos;
  OldChar := FLastChar;
  OldUCS4Char := FUCS4Char;
  OldLinePos := LinePos;
  OldLine := Line;
  Result := True;
  FInTryRead := True;
  try
    for Idx := Low(s) to High(S) do begin
      csGetChar(Ch, IL);
      if Ch <> TApdUcs4Char(S[Idx]) then begin
        Result := False;
        Break;
      end;
    end;
  finally
    if not Result then begin
      FBufPos := OldBufPos;
      FLastChar := OldChar;
      FUCS4Char := OldUCS4Char;
      FLinePos := OldLinePos;
      FLine := OldLine;
    end else begin
      FLastChar := #0;
      FUCS4Char := TApdUCS4Char(ApxNullChar);
      if (FStreamSize = FStreamPos) and
         (FBufPos = FBufEnd) then
        FEOF := True;
    end;
    FInTryRead := False;
  end;
end;
{--------}
procedure TApdInCharFilter.SkipChar;
begin
  FLastChar := #0;
  FUCS4Char := TApdUCS4Char(ApxNullChar);
  Inc(FLinePos);
end;
{--------}
function TApdInCharFilter.ReadandSkipChar : DOMChar;
var
  Ch     : TApdUCS4Char;
  IL     : Boolean;
begin
  if FLastChar = '' then begin
    csGetChar(Ch, IL);
    ApxUcs4ToWideChar(Ch, Result);
  end else begin
    Result := FLastChar;
    Inc(FLinePos);
  end;
  FLastChar := #0;
  FUCS4Char := TApdUCS4Char(ApxNullChar);
  if (FStreamSize = FStreamPos) and
     (FBufPos = FBufEnd) then
    FEOF := True;
end;
{--------}
function TApdInCharFilter.ReadChar : DOMChar;
var
  Ch     : TApdUCS4Char;
  IL     : Boolean;
begin
  if FLastChar = '' then begin
    csGetChar(Ch, IL);
    ApxUcs4ToWideChar(Ch, Result);
    Dec(FLinePos);
    FLastChar := Result;
    if (FUCS4Char <> TApdUCS4Char(ApxNullChar)) then
      if (Format = sfUTF16LE) or
         (Format = sfUTF16BE) then
        Dec(FBufPos, 2)
      else if FBufPos > 0 then
        Dec(FBufPos, 1);
    FUCS4Char := Ch;
  end else
    Result := FLastChar;
end;

{===TApdOutCharFilter=================================================}
constructor TApdOutCharFilter.Create(aStream : TStream; const aBufSize : Longint);
begin
  inherited Create(aStream, aBufSize);
  FSetUTF8Sig := True;
end;
{--------}
destructor TApdOutCharFilter.Destroy;
begin
  if Assigned(FBuffer) then
    if (FBufPos > 0) then
      csWriteBuffer;

  inherited Destroy;
end;
{--------}
function TApdOutCharFilter.csGetSize : LongInt;
begin
  Result := FStream.Size + FBufPos;
end;
{--------}
procedure TApdOutCharFilter.csPutUtf8Char(const aCh : TApdUcs4Char);
var
  UTF8 : TApdUtf8Char;
  i    : integer;
begin
  if not ApxUcs4ToUtf8(aCh, UTF8) then
    raise EAdStreamError.CreateError(FStream.Position, sUCS_U8ConverErr);
  for i := 1 to length(UTF8) do begin
    if (FBufPos = FBufSize) then
      csWriteBuffer;
    FBuffer[FBufPos] := UTF8[i];
    inc(FBufPos);
  end;
end;
{--------}
procedure TApdOutCharFilter.csSetFormat(const aValue : TApdStreamFormat);
var
  TooLate : Boolean;
begin
    case Format of
      sfUTF8     : TooLate := (FSetUTF8Sig and (Position > 3)) or
                              ((not FSetUTF8Sig) and (Position > 0));
      sfUTF16LE  : TooLate := (Position > 2);
      sfUTF16BE  : TooLate := (Position > 2);
      sfISO88591 : TooLate := (Position > 0);
    else
      TooLate := true;
    end;
    if not TooLate then begin
      FBufPos := 0;
      FFormat := aValue;
      case Format of
        sfUTF8:
          if FSetUTF8Sig then begin
            FBuffer[0] := #$EF;
            FBuffer[1] := #$BB;
            FBuffer[2] := #$BF;
            FBufPos := 3;
          end;
        sfUTF16LE : begin
                      FBuffer[0] := #$FF;
                      FBuffer[1] := #$FE;
                      FBufPos := 2;
                    end;
        sfUTF16BE : begin
                      FBuffer[0] := #$FE;
                      FBuffer[1] := #$FF;
                      FBufPos := 2;
                    end;
      else
        FBufPos := 0;
      end;
    end;
end;
{--------}
procedure TApdOutCharFilter.csWriteBuffer;
begin
  FStream.WriteBuffer(FBuffer^, FBufPos);
  FBufPos := 0;
end;
{--------}
procedure TApdOutCharFilter.PutUCS4Char(aCh : TApdUcs4Char);
begin
  case Format of
    sfUTF8     : csPutUTF8Char(aCh);
  end;
end;
{--------}
function TApdOutCharFilter.PutChar(aCh1, aCh2 : DOMChar;
                              var aBothUsed  : Boolean) : Boolean;
var
  OutCh : TApdUCS4Char;
begin
  Result := ApxUTF16toUCS4(aCh1, aCh2, OutCh, aBothUsed);
  if Result then
    PutUCS4Char(OutCh);
end;
{--------}
function TApdOutCharFilter.PutString(const aText : DOMString) : Boolean;
var
  aBothUsed : Boolean;
  aLen, aPos : Integer;
begin
  aLen := Length(aText);
  aPos := 1;
  Result := True;
  while Result and (aPos <= aLen) do begin
    if aPos = aLen then
      Result := PutChar(aText[aPos], aText[aPos], aBothUsed)
    else
      Result := PutChar(aText[aPos], aText[aPos + 1], aBothUsed);
    if Result then
      if aBothUsed then
        inc(aPos, 2)
      else
        inc(aPos, 1);
  end;
end;
{--------}
function TApdOutCharFilter.Position : integer;
begin
  Result := FStreamPos + FBufPos;
end;

end.