adxparsr.pas

测试用例

    raise EAdParserError.CreateError(FFilter.Line,
                                     FFilter.LinePos,
                                     sUnexpEndOfInput +
                                     QuotedStr(TempStr));
  end;
end;
{--------}
procedure TApdParser.ParseWhitespace;
var
  TempChar : DOMChar;
begin
  TempChar := ReadChar(False);
  while IsWhitespace(TempChar) do begin
    SkipChar;
    DataBufferAppend(TempChar);
    TempChar := ReadChar(False);
  end;
end;
{--------}
procedure TApdParser.ParseXMLDeclaration;
var
  sValue    : DOMString;
  Buffer    : DOMString;
  HasEntRef : Boolean;
begin
  if FXMLDecParsed then
    raise EAdParserError.CreateError(FFilter.Line,
                                     FFilter.LinePos,
                                     sXMLDecNotAtBeg);
  HasEntRef := False;
  SkipWhitespace(True);
  Require(Xpc_Version);
  DatabufferAppend('version');
  ParseEq;
  DatabufferAppend('="');
  Buffer := DatabufferToString;
  sValue := ReadLiteral(0, HasEntRef);
  ValidateVersNum(sValue);
  Buffer := Buffer + sValue + '"';
  if (sValue <> ApdXMLSpecification) then
    raise EAdParserError.CreateError(FFilter.Line,
                                     FFilter.LinePos,
                                     Format(sInvalidXMLVersion,
                                            [ApdXMLSpecification]));
  SkipWhitespace(True);
    if TryRead(Xpc_Encoding) then begin
      DatabufferAppend('encoding');
      ParseEq;
      DataBufferAppend('="');
      Buffer := Buffer + ' ' + DataBufferToString;
      sValue := ReadLiteral(LIT_CHAR_REF or
                            LIT_ENTITY_REF,
                            HasEntRef);
      ValidateEncName(sValue);
      Buffer := Buffer + sValue + '"';
      if CompareText(sValue, 'ISO-8859-1') = 0 then
        FFilter.Format := sfISO88591;
      SkipWhitespace(True);
  end;

    if TryRead(Xpc_Standalone) then begin
      DatabufferAppend('standalone');
      ParseEq;
      DatabufferAppend('="');
      Buffer := Buffer + ' ' + DataBufferToString;
      sValue := ReadLiteral(LIT_CHAR_REF or
                            LIT_ENTITY_REF,
                            HasEntRef);
      if (not ((sValue = 'yes') or
               (sValue = 'no'))) then
        raise EAdParserError.CreateError(FFilter.Line,
                                         FFilter.LinePos,
                                         sInvStandAloneVal);
      Buffer := Buffer + sValue + '"';
      FIsStandalone := sValue = 'yes';
      SkipWhitespace(True)
  end;

  Require(Xpc_ProcessInstrEnd);
  DatabufferToString;
  DatabufferAppend(Buffer);
end;
{--------}
procedure TApdParser.PopDocument;
begin
  Assert(FDocStack.Count > 0);

  if FDocStack.Count > 0 then begin
    FFilter := FDocStack[Pred(FDocStack.Count)];
    FDocStack.Delete(Pred(FDocStack.Count));
  end;
end;
{--------}
procedure TApdParser.PushDocument;
begin
  Assert(Assigned(FFilter));

  FDocStack.Add(Pointer(FFilter));
  FFilter := nil;
end;
{--------}
procedure TApdParser.PushString(const sVal : DOMString);
var
  MemStream  : TApdMemoryStream;
  TempString : string;
begin
  if Length(sVal) > 0 then begin
    PushDocument;
    MemStream := TApdMemoryStream.Create;
    TempString := WideCharLenToString(Pointer(sVal), Length(sVal));
    MemStream.Write(TempString[1], Length(TempString));
    MemStream.Position := 0;
    FFilter := TApdInCharFilter.Create(MemStream, BufferSize);
  end;
end;
{--------}
function TApdParser.ReadChar(const UpdatePos : Boolean) : DOMChar;
begin
  Result := FFilter.ReadChar;
  if ((Result = ApxEndOfStream) and
      (not IsEndDocument)) then
    Result := FFilter.ReadChar;
  if (UpdatePos) then
    FFilter.SkipChar;
end;
{--------}
procedure TApdParser.ReadExternalIds(bInNotation : Boolean;
                                var sIds        : StringIds);
var
  HasEntRef : Boolean;
  TempChar  : DOMChar;
begin
  HasEntRef := False;
  if TryRead(Xpc_ExternalPublic) then begin
    RequireWhitespace;
    sIds[0] := ReadLiteral(LIT_NORMALIZE, HasEntRef);
    ValidatePublicID(sIds[0]);
    if bInNotation then begin
      SkipWhitespace(True);
      TempChar := ReadChar(False);
      if (TempChar = '''') or
         (TempChar = '"') then
        sIds[1] := ReadLiteral(0, HasEntRef);
    end else begin
      RequireWhitespace;
      sIds[1] := ReadLiteral(0, HasEntRef);
    end;
  end else if TryRead(Xpc_ExternalSystem) then begin
    RequireWhitespace;
    sIds[1] := ReadLiteral(0, HasEntRef);
  end;
end;
{--------}
function TApdParser.ReadLiteral(wFlags    : Integer;
                           var HasEntRef : Boolean) : DOMString;
var
  TempStr     : DOMString;
  cDelim,
  TempChar    : DOMChar;
  EntRefs     : TStringList;
  StackLevel  : Integer;
  CurrCharRef : Boolean;
begin
  StackLevel := 0;
  CurrCharRef := False;
  Result := '';
  EntRefs := nil;
  cDelim := ReadChar(True);
  if (cDelim <> '"') and
     (cDelim <> #39) and
     (cDelim <> #126) and
     (cDelim <> #0) then
    raise EAdParserError.CreateError(FFilter.Line,
                                     FFilter.LinePos,
                                     sQuoteExpected);
  TempChar := ReadChar(False);
  while (not IsEndDocument) and
        ((CurrCharRef) or
         (TempChar <> cDelim)) do begin
    if (TempChar = #$0A) then begin
      TempChar := ' ';
    end else if (TempChar = #$0D) then
      TempChar := ' '
    else if (TempChar = '&') then begin
      if wFlags and LIT_CHAR_REF <> 0 then begin
        if wFlags and LIT_ENTITY_REF <> 0 then
          CurrCharRef := True;
        HasEntRef := True;
        SkipChar;
        TempChar := ReadChar(False);
        if TempChar = '#' then begin
          SkipChar;
          ParseCharRef;
          TempChar := ReadChar(False);
          CurrCharRef := False;
          Continue;
        end else if wFlags and LIT_ENTITY_REF <> 0 then begin
          TempStr := ParseEntityRef(False);
          if (TempStr <> 'lt') and
             (TempStr <> 'gt') and
             (TempStr <> 'amp') and
             (TempStr <> 'apos') and
             (TempStr <> 'quot') then begin
            if (not Assigned(EntRefs)) then begin
              EntRefs := TStringList.Create;
              EntRefs.Sorted := True;
              EntRefs.Duplicates := dupError;
              StackLevel := FDocStack.Count;
            end else
              StackLevel := Succ(FDocStack.Count);
            try
              if FDocStack.Count = StackLevel then begin
                EntRefs.Clear;
                StackLevel := FDocStack.Count;
              end;
              EntRefs.Add(TempStr);
            except
              on E:EStringListError do begin
                EntRefs.Free;
                raise EAdParserError.CreateError(FFilter.Line,
                                                 FFilter.LinePos,
                                                 sCircularEntRef +
                                                 TempChar);
              end;
              on E:EAdParserError do
                raise;
            end;
          end else
            HasEntRef := False;
          TempChar := ReadChar(False);
          Continue;
        end else if wFlags and LIT_PE_REF <> 0 then begin
          ParseParameterEntityRef(False, True);
          Continue;
        end else
          DataBufferAppend('&');
          if (not Assigned(EntRefs)) then begin
            StackLevel := FDocStack.Count;
            EntRefs := TStringList.Create;
            EntRefs.Sorted := True;
            EntRefs.Duplicates := dupError;
          end;
          try
            if StackLevel = FDocStack.Count then begin
              EntRefs.Clear;
              StackLevel := FDocStack.Count;
            end;
            EntRefs.Add('&' + DOMString(TempChar));
          except
            on E:EStringListError do begin
              EntRefs.Free;
              raise EAdParserError.CreateError(FFilter.Line,
                                               FFilter.LinePos,
                                               sCircularEntRef +
                                               TempChar);
            end;
            on E:EAdParserError do
              raise;
          end;
      end;
    end;
    DataBufferAppend(TempChar);
    SkipChar;
    TempChar := ReadChar(False);
    CurrCharRef := False;
  end;
  if TempChar <> cDelim then
    raise EAdParserError.CreateError(FFilter.Line,
                                     FFilter.LinePos,
                                     'Expected: ' + cDelim);

  SkipChar;

  if wFlags and LIT_NORMALIZE <> 0 then
    DataBufferNormalize;

  Result := DataBufferToString;

  EntRefs.Free;
end;
{--------}
function TApdParser.ReadNameToken(aValFirst : Boolean) : DOMString;
var
  TempChar : DOMChar;
  First    : Boolean;
  ResultLen : Integer;
  CurrLen   : Integer;
begin
  if TryRead(Xpc_ParamEntity) then begin
    ParseParameterEntityRef(True, False);
    SkipWhiteSpace(True);
  end;
  First := aValFirst;
  Result := '';
  CurrLen := 0;
  ResultLen := 20;
  SetLength(Result, ResultLen);
  while True do begin
    TempChar := ReadChar(False);
    if (TempChar = '%') or (TempChar = '<') or (TempChar = '>') or
       (TempChar = '&') or (TempChar = ',') or (TempChar = '|') or
       (TempChar = '*') or (TempChar = '+') or (TempChar = '?') or
       (TempChar = ')') or (TempChar = '=') or (TempChar = #39) or
       (TempChar = '"') or (TempChar = '[') or (TempChar = ' ') or
       (TempChar = #9) or (TempChar = #$0A) or (TempChar = #$0D) or
       (TempChar = ';') or (TempChar = '/') or (TempChar = '') or
       (TempChar = #1) then
      Break
    else
      if ValidateNameChar(First, TempChar) then begin
        if (CurrLen + 2 > ResultLen) then begin
          ResultLen := ResultLen * 2;
          SetLength(Result, ResultLen);
        end;
        SkipChar;
        Move(TempChar,
             PByteArray(Pointer(Result))^[CurrLen],
             2);
        Inc(CurrLen, 2);
      end else
        raise EAdParserError.CreateError(FFilter.Line,
                                         FFilter.LinePos,
                                         sInvalidName +
                                         QuotedStr(TempChar));
    First := False;
  end;
  SetLength(Result, CurrLen div 2);
end;
{--------}
procedure TApdParser.Require(const S : array of Longint);
var
  TempStr  : AnsiString;
  TempChar : AnsiChar;
  i        : Integer;
begin
  if not TryRead(S) then begin
    SetLength(TempStr, High(S) + 1);
    for i := 0 to High(S) do begin
      ApxUcs4ToIso88591(s[i], TempChar);
      TempStr[i + 1] := TempChar;
    end;
    if ReadChar(False) = '&' then begin
      SkipChar;
      if ReadChar(False) = '#' then begin
        SkipChar;
        if ParseCharRef = TempStr then
          Exit;
      end;
    end;
    raise EAdParserError.CreateError(FFilter.Line,
                                     FFilter.LinePos,
                                     sExpectedString +
                                     QuotedStr(TempStr));
  end;
end;
{--------}
procedure TApdParser.RequireWhitespace;
begin
  if IsWhitespace(ReadChar(False)) then
    SkipWhitespace(True)
  else
    raise EAdParserError.CreateError(FFilter.Line,
                                     FFilter.LinePos,
                                     sSpaceExpectedAt +
                                       'Line: ' + IntToStr(FFilter.Line) +
                                       ' Position: ' + IntToStr(FFilter.LinePos));
end;
{--------}
procedure TApdParser.SetAttribute(const sElemName, sName : DOMString;
                                       wType            : Integer;
                                 const sEnum, sValue    : DOMString;
                                       wValueType       : Integer);
var
  wIdx      : Integer;
  oElemInfo : TApdElementInfo;
  oAttrInfo : TApdAttributeInfo;
begin
  wIdx := GetElementIndexOf(sElemName);
  if wIdx < 0 then begin
    SetElement(sElemName, CONTENT_UNDECLARED, '');
    wIdx := GetElementIndexOf(sElemName);
  end;

  oElemInfo := TApdElementInfo(FElementInfo.Objects[wIdx]);
  oAttrInfo := TApdAttributeInfo.Create;
  oAttrInfo.AttrType := wType;
  oAttrInfo.Value := sValue;
  oAttrInfo.ValueType := wValueType;
  oAttrInfo.Enum := sEnum;
  oElemInfo.SetAttribute(sName, oAttrInfo);
end;
{--------}
procedure TApdParser.SetElement(const sName         : DOMString;
                                     wType         : Integer;
                               const sContentModel : DOMString);
var
  oElem : TApdElementInfo;
  wIdx  : Integer;
begin
  wIdx := GetElementIndexOf(sName);
  if wIdx < 0 then begin
    oElem := TApdElementInfo.Create;
    FElementInfo.AddObject(sName, oElem);
  end else
    oElem := TApdElementInfo(FElementInfo.Objects[wIdx]);

  if wType <> CONTENT_UNDECLARED then
    oElem.ContentType := wType;

  if sContentModel <> '' then
    oElem.ContentModel := sContentModel;
end;
{--------}
procedure TApdParser.SetEntity(const sEntityName   : DOMString;
                                    wClass        : Integer;
                              const sPublicId,
                                    sSystemId,