adxparsr.pas

测试用例

  if wIdx >= 0 then begin
    oEntity := TApdEntityInfo(FEntityInfo.Objects[wIdx]);
    Result := oEntity.EntityClass;
  end;
end;
{--------}
function TApdParser.GetEntityValue(const sEntityName : DOMString;
                                        aPEAllowed  : Boolean)
                                                    : DOMString;
var
  wIdx    : Integer;
  oEntity : TApdEntityInfo;
begin
  Result := '';
  wIdx := GetEntityIndexOf(sEntityName, aPEAllowed);
  if wIdx >= 0 then begin
    oEntity := TApdEntityInfo(FEntityInfo.Objects[wIdx]);
    Result := oEntity.Value;
  end;
end;
{--------}
function TApdParser.GetExternalTextEntityValue(const sName,
                                                    sPublicId : DOMString;
                                                    sSystemId : DOMString)
                                                              : DOMString;
var
  CompletePath : string;
begin
  DataBufferFlush;
  Result := '';

  FHasExternals := True;

  if Assigned(FOnResolveEntity) then
    FOnResolveEntity(self, sName, sPublicId, sSystemId, sSystemId);

  if sSystemId = '' then
    exit;

  PushDocument;
  if (ApxPos('/', sSystemID) = 0) and
     (ApxPos('\', sSystemID) = 0) then
    CompletePath := FCurrentPath + sSystemID
  else
    CompletePath := sSystemID;
  {TODO:: Need to check return value of LoadDataSource? }
  try
    LoadDataSource(CompletePath, FErrors);
  except
    PopDocument;
    raise;
  end;
end;
{--------}
function TApdParser.GetInCharSet : TApdCharEncoding;
begin
  if FFilter <> nil then
    Result := ceUTF8
  else
    { If no current filter then return last known value. }
    Result := FInCharSet;
end;
{--------}
procedure TApdParser.Initialize;
begin
  FDataBuffer := '';

  SetInternalEntity('amp', '&#38;', False);
  SetInternalEntity('lt', '&#60;', False);
  SetInternalEntity('gt', '&#62;', False);
  SetInternalEntity('apos', '&#39;', False);
  SetInternalEntity('quot', '&#34;', False);
end;
{--------}
function TApdParser.IsEndDocument : Boolean;
var
  TheStream : TStream;
  DocCount  : Integer;
begin
  DocCount := FDocStack.Count;
  if (DocCount = 0) then
    Result := FFilter.Eof
  else begin
    Result := False;
    while FFilter.EOF do begin
      if (DocCount > 0) then begin
        TheStream := FFilter.Stream;
        FFilter.Free;
        TheStream.Free;
      end;
      PopDocument;
      DocCount := FDocStack.Count;
    end;
  end;
end;
{--------}
function TApdParser.IsWhitespace(const cVal : DOMChar) : Boolean;
begin
  Result := (cVal = #$20) or (cVal = #$09) or
            (cVal = #$0D) or (cVal = #$0A);
end;
{--------}
function TApdParser.LoadDataSource(sSrcName  : string;
                                  oErrors   : TStringList) : Boolean;
var
  aFileStream : TApdFileStream;
begin
  begin
    { Must be a local or network file. Eliminate file:// prefix. }
    if StrLIComp(PChar(sSrcName), 'file://', 7) = 0 then
      Delete(sSrcName, 1, 7);

    if FileExists(sSrcName) then begin
      FCurrentPath := ExtractFilePath(sSrcName);
      {the stream and filter are destroyed after the document is parsed}
      aFileStream := TApdFileStream.CreateEx(fmOpenRead, sSrcName);
      aFileStream.Position := 0;
      Result := True;
    end else begin
      oErrors.Add(format(sFileNotFound, [sSrcName]));
      raise EAdParserError.CreateError(0,
                                       0,
                                       format(sFileNotFound, [sSrcName]));
    end;
  end;

  if Result then
    try
      aFileStream.Position := 0;
      FFilter := TApdInCharFilter.Create(aFileStream, FBufferSize);
    except
      aFileStream.Free;
      raise;
    end;
end;
{--------}
function TApdParser.ParseAttribute(const sName : DOMString) : DOMString;
var
  sAttrName,
  sValue    : DOMString;
  wType     : Integer;
  HasEntRef : Boolean;
begin
  Result := '';
  HasEntRef := False;
  sAttrName := ReadNameToken(True);
  wType := GetAttributeDefaultValueType(sName, sAttrName);

  ParseEq;

  {we need to validate production 10 - 1st letter in quotes}

  if (wType = ATTRIBUTE_CDATA) or (wType = ATTRIBUTE_UNDECLARED) then
    sValue := ReadLiteral(LIT_CHAR_REF or LIT_ENTITY_REF, HasEntRef)
  else
    sValue := ReadLiteral(LIT_CHAR_REF or
                          LIT_ENTITY_REF or
                          LIT_NORMALIZE,
                          HasEntRef);
  if not HasEntRef then
    ValidateAttribute(sValue, HasEntRef);

  if Assigned(FOnAttribute) then
    FOnAttribute(self, sAttrName, sValue, True);
  FDataBuffer := '';

  FTagAttributes.Add(sAttrName);
  if sAttrName = 'xml:space' then
    Result := sValue;
end;
{--------}
procedure TApdParser.ParseCDSect;
{conditional section}
begin
  ParseUntil(Xpc_ConditionalEnd);
end;
{--------}
function TApdParser.ParseCharRef : DOMChar;
var
  TempChar  : DOMChar;
  Ucs4Chr   : TApdUcs4Char;
begin
  Ucs4Chr := 0;
  if TryRead(Xpc_CharacterRefHex) then begin
   Ucs4Chr := 0;
    while True do begin
      TempChar := ReadChar(True);
      if (TempChar = '0') or (TempChar = '1') or (TempChar = '2') or
         (TempChar = '3') or (TempChar = '4') or (TempChar = '5') or
         (TempChar = '6') or (TempChar = '7') or (TempChar = '8') or
         (TempChar = '9') or (TempChar = 'A') or (TempChar = 'B') or
         (TempChar = 'C') or (TempChar = 'D') or (TempChar = 'E') or
         (TempChar = 'F') or (TempChar = 'a') or (TempChar = 'b') or
         (TempChar = 'c') or (TempChar = 'd') or (TempChar = 'e') or
         (TempChar = 'f') then begin
        Ucs4Chr := Ucs4Chr shl 4;
        Ucs4Chr := Ucs4Chr + StrToIntDef(TempChar, 0);
      end else if (TempChar = ';') then
        Break
      else
        raise EAdParserError.CreateError(FFilter.Line,
                                         FFilter.LinePos,
                                         sIllCharInRef +
                                         QuotedStr(TempChar));
    end;
  end else begin
    while True do begin
      TempChar := ReadChar(True);
      if (TempChar = '0') or (TempChar = '1') or (TempChar = '2') or
         (TempChar = '3') or (TempChar = '4') or (TempChar = '5') or
         (TempChar = '6') or (TempChar = '7') or (TempChar = '8') or
         (TempChar = '9') then begin
        Ucs4Chr := Ucs4Chr * 10;
        Ucs4Chr := Ucs4Chr + StrToIntDef(TempChar, 0);
      end else if (TempChar = ';') then
        Break
      else
        raise EAdParserError.CreateError(FFilter.Line,
                                         FFilter.LinePos,
                                         sIllCharInRef +
                                         QuotedStr(TempChar));
    end;
  end;
  ApxUcs4ToWideChar(Ucs4Chr, Result);
  DataBufferAppend(Result);
end;
{--------}
procedure TApdParser.ParseComment;
var
  TempComment : DOMString;
begin
  ParseUntil(Xpc_CommentEnd);
  TempComment := DataBufferToString;
  { Did we find '--' within the comment? }
  if (TempComment <> '') and
     ((ApxPos('--', TempComment) <> 0) or
      (TempComment[Length(TempComment)] = '-')) then
    { Yes. Raise an error. }
    raise EAdParserError.CreateError(FFilter.Line,
                                     FFilter.LinePos,
                                     sInvalidCommentText);
  if Assigned(FOnComment) then
    FOnComment(self, TempComment);
end;
{--------}
procedure TApdParser.ParseContent;
var
  TempChar    : DOMChar;
  TempStr     : DOMString;
  EntRefs     : TStringList;
  OldLine     : Integer;
  OldPos      : Integer;
  TempInt     : Integer;
  StackLevel  : Integer;
  LastCharAmp : Boolean;
begin
  LastCharAmp := False;
  StackLevel := 0;
  TempChar := #0;
  EntRefs := nil;
  while True do begin
    OldLine := FFilter.Line;
    OldPos := FFilter.LinePos;
    case FCurrentElementContent of
      CONTENT_ANY, CONTENT_MIXED :
        begin
          if Assigned(EntRefs) then begin
            if (FDataBuffer <> '&') or
               (LastCharAmp) then begin
              ParsePCData(True);
              LastCharAmp := False;
            end;
            { Reset the last ent ref if we parsed something.}
            if (FFilter.Line <> OldLine) and
               (FFilter.LinePos <> OldPos) then begin
              EntRefs.Free;
              EntRefs := nil;
            end;
          end else
            ParsePCData(TempChar <> '');
        end;
      CONTENT_ELEMENTS           : ParseWhitespace;
    end;
    TempChar := ReadChar(False);
    if IsEndDocument then
      raise EAdParserError.CreateError(FFilter.Line,
                                       FFilter.LinePos,
                                       sUnexpectedEof);
    if (TempChar = '&') then begin
      SkipChar;
      TempChar := ReadChar(False);
      if TempChar = '#' then begin
        SkipChar;
        TempChar := ParseCharRef;
        if TempChar = '&' then
          LastCharAmp := True;
        if (FCurrentElementContent <> CONTENT_ANY) and
           (FCurrentElementContent <> CONTENT_MIXED) then
          PushString(TempChar);
      end else begin
        if (not Assigned(EntRefs)) then begin
          StackLevel := Succ(FDocStack.Count);
          EntRefs := TStringList.Create;
          TempStr := ParseEntityRef(False);
        end else begin
          {Check for circular references}
          TempStr := ParseEntityRef(False);
          StackLevel := FDocStack.Count;
          TempInt := EntRefs.IndexOf(TempStr);
          if TempInt <> -1 then
            raise EAdParserError.CreateError(FFilter.Line,
                                             FFilter.LinePos,
                                             sCircularEntRef +
                                             TempStr);
        end;
        EntRefs.Add(TempStr);
      end;
      if (FCurrentElementContent <> CONTENT_ANY) and
         (FCurrentElementContent <> CONTENT_MIXED) and
         (TempChar = '<') then begin
        DataBufferFlush;
        ParseElement;
      end else
        TempChar := ReadChar(False);
    end else if (TempChar = '<') then begin
      EntRefs.Free;
      EntRefs := nil;
      SkipChar;
      TempChar := ReadChar(False);
      if (TempChar = '!') then begin
        SkipChar;
        DataBufferFlush;
        TempChar := ReadChar(True);
        if (TempChar = '-') then begin
          Require(Xpc_Dash);
          ParseComment;
        end else if (TempChar = '[') then begin
          Require(Xpc_CDATAStart);
          FCDATA := True;
          ParseCDSect;
          ValidateCData(FDataBuffer);
          DataBufferFlush;
          FCDATA := False;
        end else
          raise EAdParserError.CreateError(FFilter.Line,
                                           FFilter.LinePos,
                                           sExpCommentOrCDATA +
                                           '(' + TempChar + ')');
      end else if (TempChar = '?') then begin
        EntRefs.Free;
        EntRefs := nil;
        SkipChar;
        DataBufferFlush;
        ParsePI;
      end else if (TempChar = '/') then begin
        SkipChar;
        DataBufferFlush;
        ParseEndTag;
        Exit;
      end else begin
        EntRefs.Free;
        EntRefs := nil;
        DataBufferFlush;
        ParseElement;
      end;
    end; {if..else}
    if (Assigned(EntRefs)) and
       (FDocStack.Count < StackLevel) then begin
      EntRefs.Clear;
      StackLevel := FDocStack.Count;
    end;
  end;
  EntRefs.Free;
end;
{--------}
function TApdParser.ParseDataSource(const sSource : string) : Boolean;
begin
  FErrors.Clear;
  FIsStandAlone := False;
  FHasExternals := False;
  FUrl := sSource;
  Result := LoadDataSource(sSource, FErrors);
  if Result then begin
    FFilter.FreeStream := True;
    ParsePrim;
  end
  else
    FErrors.Add(sSrcLoadFailed + sSource);
  FUrl := '';
  Result := FErrors.Count = 0;
end;
{--------}
procedure TApdParser.ParseDocTypeDecl;
var
  sDocTypeName : DOMString;
  sIds         : StringIds;
begin
  RequireWhitespace;
  sDocTypeName := ReadNameToken(True);
  SkipWhitespace(True);
  ReadExternalIds(False, sIds);
  SkipWhitespace(True);

  // Parse external DTD
  if sIds[1] <> '' then begin
  end;

  if sIds[1] <> '' then begin
    while True do begin
      FContext := CONTEXT_DTD;
      SkipWhitespace(True);
      FContext := CONTEXT_NONE;
      if TryRead(Xpc_BracketAngleRight) then
        Break
      else begin
        FContext := CONTEXT_DTD;
        FContext := CONTEXT_NONE;
      end;
    end;
  end else begin