adxparsr.pas

测试用例

    SkipWhitespace(True);
    Require(Xpc_BracketAngleRight);
  end;

  if Assigned(FOnDocTypeDecl) then
    FOnDocTypeDecl(self, sDocTypeName, sIds[0], sIds[1]);
end;
{--------}
procedure TApdParser.ParseDocument;
begin
  FXMLDecParsed := False;
  ParseProlog;
  Require(Xpc_BracketAngleLeft);
  ParseElement;
  try
    ParseMisc;
  except
  end;
  SkipWhiteSpace(True);
  if (not IsEndDocument) then
    raise EAdParserError.CreateError(FFilter.Line,
                                     FFilter.LinePos,
                                     sDataAfterValDoc);

  if Assigned(FOnEndDocument) then
    FOnEndDocument(self);
end;
{--------}
procedure TApdParser.ParseElement;
var
  wOldElementContent,
  i                  : Integer;
  sOldElement        : DOMString;
  sGi, sTmp, sTmp2   : DOMString;
  oTmpAttrs          : TStringList;
  bOldPreserve       : Boolean;
  TempChar           : DOMChar;
  aList              : TStringList;
  ElemIdx            : Integer;
begin
  wOldElementContent := FCurrentElementContent;
  sOldElement := FCurrentElement;
  bOldPreserve := FPreserve;

  FTagAttributes.Clear;
  sGi := ReadNameToken(True);

  ValidateElementName(sGi);

  if Assigned(FOnBeginElement) then
    FOnBeginElement(self, sGi);

  FCurrentElement := sGi;
  ElemIdx := GetElementIndexOf(sGi);
  FCurrentElementContent := GetElementContentType(sGi, ElemIdx);
  if FCurrentElementContent = CONTENT_UNDECLARED then
    FCurrentElementContent := CONTENT_ANY;

  SkipWhitespace(True);
  sTmp := '';
  TempChar := ReadChar(False);
  while (TempChar <> '/') and
        (TempChar <> '>') do begin
    sTmp2 := ParseAttribute(sGi);
    if sTmp2 <> '' then
      sTmp := sTmp2;
    SkipWhitespace(True);          
    TempChar := ReadChar(False);
    { check for duplicate attributes }
    if FTagAttributes.Count > 1 then begin
      aList := TStringList.Create;
      try
        aList.Sorted := True;
        aList.Duplicates := dupIgnore;
        aList.Assign(FTagAttributes);
        if (aList.Count <> FTagAttributes.Count) then
          raise EAdParserError.CreateError(FFilter.Line,
                                           FFilter.LinePos,
                                           sRedefinedAttr);
      finally
        aList.Free;
      end;
    end;
  end;

  oTmpAttrs := DeclaredAttributes(sGi, ElemIdx);
  if oTmpAttrs <> nil then begin
    for i := 0 to oTmpAttrs.Count - 1 do begin
      if FTagAttributes.IndexOf(oTmpAttrs[i]) <> - 1 then
        Continue;

      if Assigned(FOnAttribute) then begin
        sTmp2 := GetAttributeExpandedValue(sGi, oTmpAttrs[i], ElemIdx);
        if sTmp2 <> '' then
          FOnAttribute(self, oTmpAttrs[i], sTmp2, False);
      end;
    end;
  end;

  if sTmp = '' then
    sTmp := GetAttributeExpandedValue(sGi, 'xml:space', ElemIdx);
  if sTmp = 'preserve' then
    FPreserve := True
  else if sTmp = 'default' then
    FPreserve := not FNormalizeData;

  if Assigned(FOnPreserveSpace) then
    FOnPreserveSpace(self, sGi, FPreserve);

  TempChar := ReadChar(True);
  if (TempChar = '>') then begin
    if Assigned(FOnStartElement) then
      FOnStartElement(self, sGi);
    ParseContent;
  end else if (TempChar = '/') then begin
    Require(Xpc_BracketAngleRight);
    if Assigned(FOnStartElement) then
      FOnStartElement(self, sGi);
    if Assigned(FOnEndElement) then
      FOnEndElement(self, sGi);
  end;

  FPreserve := bOldPreserve;
  FCurrentElement := sOldElement;
  FCurrentElementContent := wOldElementContent;
end;
{--------}
procedure TApdParser.ParseEndTag;
var
  sName : DOMString;
begin
  sName := ReadNameToken(True);
  if sName <> FCurrentElement then
    raise EAdParserError.CreateError(FFilter.Line,
                                     FFilter.LinePos,
                                     sMismatchEndTag +
                                     'Start tag = "' + FCurrentElement +
                                     '" End tag = "' + sName + '"');
  SkipWhitespace(True);
  Require(Xpc_BracketAngleRight);
  if Assigned(FOnEndElement) then
    FOnEndElement(self, FCurrentElement);
end;
{--------}
function TApdParser.ParseEntityRef(bPEAllowed : Boolean) : DOMString;
begin
  Result := ReadNameToken(True);
  Require(Xpc_GenParsedEntityEnd);
  case GetEntityType(Result, bPEAllowed) of
    ENTITY_UNDECLARED :
      begin
        raise EAdParserError.CreateError(FFilter.Line,
                                         FFilter.LinePos,
                                         sUndeclaredEntity +
                                         QuotedStr(Result));
      end;
    ENTITY_INTERNAL :
      PushString(GetEntityValue(Result, False));
    ENTITY_TEXT :
      begin
        (GetExternalTextEntityValue(Result,
                                    GetEntityPublicId(Result),
                                    GetEntitySystemId(Result)));
      end;
    ENTITY_NDATA :
      begin
        FHasExternals := True;
        if Assigned(FOnNonXMLEntity) then
          FOnNonXMLEntity(self,
                          Result,
                          GetEntityPublicId(Result),
                          GetEntitySystemId(Result),
                          GetEntityNotationName(Result));
      end;
  end;
end;
{--------}
procedure TApdParser.ParseEq;
begin
  SkipWhitespace(True);
  Require(Xpc_Equation);
  SkipWhitespace(True);
end;
{--------}
function TApdParser.ParseMemory(var aBuffer; aSize : Longint) : Boolean;
var
  MemStream  : TApdMemoryStream;
begin
  Assert(not Assigned(FFilter));

  FErrors.Clear;
  FPreserve := False;
  FIsStandAlone := False;
  FHasExternals := False;

  MemStream := TApdMemoryStream.Create;
  try
    Memstream.SetPointer(@aBuffer, aSize);
    FFilter := TApdInCharFilter.Create(MemStream, BufferSize);
    ParsePrim;
  finally
    MemStream.Free;
  end;

  Result := FErrors.Count = 0;
end;
{--------}
procedure TApdParser.ParseMisc;
var
  ParsedComment : Boolean;
begin
  ParsedComment := False;
  while True do begin
    SkipWhitespace(True);
    if TryRead(Xpc_ProcessInstrStart) then begin
      if ParsePIEx and ParsedComment then
        raise EAdParserError.CreateError(FFilter.Line,
                                         FFilter.LinePos,
                                         sCommentBeforeXMLDecl)
      else
        FXMLDecParsed := True;
    end else if TryRead(Xpc_CommentStart) then begin
      FXMLDecParsed := True;
      ParsedComment := True;
      ParseComment;
    end else
      Exit;
  end;
end;
{--------}
function TApdParser.ParseParameterEntityRef(aPEAllowed : Boolean;
                                           bSkip      : Boolean)
                                                      : DOMString;
var
  sName,
  sValue : DOMString;
begin
  sName := ReadNameToken(True);
  Require(Xpc_GenParsedEntityEnd);
  case GetEntityType(sName, aPEAllowed) of
    ENTITY_UNDECLARED :
      raise EAdParserError.CreateError(FFilter.Line,
                                       FFilter.LinePos - 3,
                                       sUndeclaredEntity + sName);
    ENTITY_INTERNAL :
      begin
        sValue := GetEntityValue(sName, aPEAllowed);
        if bSkip then
          DataBufferAppend(sValue)
        else
          PushString(sValue);
        Result := sValue;
      end;
    ENTITY_TEXT :
      begin
        sValue := GetExternalTextEntityValue(sName,
                                             GetEntityPublicId(sName),
                                             GetEntitySystemId(sName));
        if bSkip then
          DataBufferAppend(sValue);
        Result := sValue;
      end;
    ENTITY_NDATA :
      begin
        FHasExternals := True;
        if Assigned(FOnNonXMLEntity) then
          FOnNonXMLEntity(self,
                          sName,
                          GetEntityPublicId(sName),
                          GetEntitySystemId(sName),
                          GetEntityNotationName(sName));
      end;
  end;
end;
{--------}
procedure TApdParser.ParsePCData(aInEntityRef : Boolean);
var
  TempBuff   : DOMString;
  TempChar   : DOMChar;
  CurrLength : Longint;
  BuffLength : Longint;
  Added      : Boolean;
begin
  Added := False;
  CurrLength := 0;
  BuffLength := 50;
  SetLength(TempBuff, BuffLength);
  while True do begin
    TempChar := ReadChar(False);
    if (TempChar = '<') or
       (TempChar = '&') or
       (FFilter.EOF) then
      Break
    else begin
      if ((CurrLength + 2) > BuffLength) then begin
        BuffLength := BuffLength * 2;
        SetLength(TempBuff, BuffLength);
      end;
      Move(TempChar,
           PByteArray(Pointer(TempBuff))[CurrLength],
           2);
      Inc(CurrLength, 2);
      SkipChar;
      Added := True;
    end;
  end;
  if Added then begin
    SetLength(TempBuff, CurrLength div 2);
    ValidatePCData(TempBuff, aInEntityRef);
    DataBufferAppend(TempBuff);
  end;
end;
{--------}
procedure TApdParser.ParsePI;
begin
  ParsePIEx;
end;
{--------}
function TApdParser.ParsePIEx : Boolean;
var
  sName : DOMString;
begin
  Result := False;
  sName := ReadNameToken(True);
  if sName <> 'xml' then begin
    FXMLDecParsed := True;
    if not TryRead(Xpc_ProcessInstrEnd) then begin
      RequireWhitespace;
      ParseUntil(Xpc_ProcessInstrEnd);
    end;
  end else begin
    Result := True;
    ParseXMLDeclaration;
  end;
  if Assigned(FOnProcessingInstruction) then
    FOnProcessingInstruction(self, sName, DataBufferToString)
  else
    DataBufferToString;
end;
{--------}
procedure TApdParser.ParsePrim;
begin
  try
    Initialize;

    if Assigned(FOnStartDocument) then
      FOnStartDocument(self);

    try
      ParseDocument;
    except
      on E: EAdFilterError do begin
        FErrors.Add(Format(sFmtErrorMsg,
                           [E.Line, E.LinePos, E.Message]));
        if FRaiseErrors then begin
          if Assigned(FOnEndDocument) then
            FOnEndDocument(self);
          Cleanup;
          raise;
        end;
      end;
    end;

    if Assigned(FOnEndDocument) then
      FOnEndDocument(self);

    Cleanup;
  finally
    FInCharSet := ceUTF8;
    FFilter.Free;
    FFilter := nil;
  end;
end;
{--------}
procedure TApdParser.ParseProlog;
begin
  ParseMisc;
  if TryRead(Xpc_DTDDocType) then begin
    FXMLDecParsed := True;
    ParseDocTypeDecl;
    ParseMisc;
  end;
end;
{--------}
function TApdParser.ParseStream(oStream : TStream) : Boolean;
begin
  Assert(not Assigned(FFilter));

  FErrors.Clear;
  FPreserve := False;
  FIsStandAlone := False;
  FHasExternals := False;

  oStream.Position := 0;
  FFilter := TApdInCharFilter.Create(oStream, oStream.Size);
  ParsePrim;
  Result := FErrors.Count = 0;
end;
{--------}
procedure TApdParser.ParseUntil(const S : array of Longint);
var
  TempStr  : AnsiString;
  TempChar : AnsiChar;
  i        : Integer;
  Found    : Boolean;
begin
  Found := TryRead(s);
  while (not Found) and
        (not FFilter.EOF) do begin
    DataBufferAppend(ReadChar(True));
    Found := TryRead(s);
  end;
  if (not Found) then begin
    {$IFDEF DCC4OrLater}
    SetLength(TempStr, Length(S));
    {$ENDIF}
    for i := 0 to High(S) do begin
      ApxUcs4ToIso88591(s[i], TempChar);
      TempStr[Succ(i)] := TempChar;
    end;