adxparsr.pas

测试用例

    property Lookup : DOMString
      read FLookup
      write FLookup;

    property Value : DOMString
      read FValue
      write FValue;

    property ValueType : Integer
      read FValueType
      write FValueType;
  end;
{== TApdElementInfo ===================================================}
  TApdElementInfo = class(TObject)
  private
    FAttributeList : TStringList;
    FContentType   : Integer;
    FContentModel  : DOMString;
  public
    constructor Create;
    destructor Destroy; override;

    procedure SetAttribute(const sName     : DOMString;
                                 oAttrInfo : TApdAttributeInfo);

    property AttributeList : TStringList
      read FAttributeList;

    property ContentModel : DOMString
      read FContentModel
      write FContentModel;

    property ContentType : Integer
      read FContentType
      write FContentType;
  end;
{=== TApdElementInfo ==================================================}
constructor TApdElementInfo.Create;
begin
  inherited Create;
  FAttributeList := nil;
  FContentModel := '';
  FContentType := 0;
end;
{--------}
destructor TApdElementInfo.Destroy;
var
  i : Integer;
begin
  if FAttributeList <> nil then begin
    for i := 0 to FAttributeList.Count - 1 do
      TApdAttributeInfo(FAttributeList.Objects[i]).Free;
    FAttributeList.Free;
  end;
  inherited Destroy;
end;
{--------}
procedure TApdElementInfo.SetAttribute(const sName     : DOMString;
                                            oAttrInfo : TApdAttributeInfo);
var
  wIdx : Integer;
begin
  if FAttributeList = nil then begin
    FAttributeList := TStringList.Create;
    FAttributeList.Sorted := True;
    wIdx := -1
  end else
    wIdx := FAttributeList.IndexOf(sName);

  if wIdx < 0 then
    FAttributeList.AddObject(sName, oAttrInfo)
  else begin
    TApdAttributeInfo(FAttributeList.Objects[wIdx]).Free;
    FAttributeList.Objects[wIdx] := oAttrInfo;
  end;
end;

{=== TApdParser =======================================================}
constructor TApdParser.Create(oOwner : TComponent);
begin
  inherited Create(oOwner);

  FErrors := TStringList.Create;
  FAttributeType := TStringList.Create;
  FAttributeType.AddObject('CDATA', Pointer(ATTRIBUTE_CDATA));
  FAttributeType.AddObject('ID', Pointer(ATTRIBUTE_ID));
  FAttributeType.AddObject('IDREF', Pointer(ATTRIBUTE_IDREF));
  FAttributeType.AddObject('IDREFS', Pointer(ATTRIBUTE_IDREFS));
  FAttributeType.AddObject('ENTITY', Pointer(ATTRIBUTE_ENTITY));
  FAttributeType.AddObject('ENTITIES', Pointer(ATTRIBUTE_ENTITIES));
  FAttributeType.AddObject('NMTOKEN', Pointer(ATTRIBUTE_NMTOKEN));
  FAttributeType.AddObject('NMTOKENS', Pointer(ATTRIBUTE_NMTOKENS));
  FAttributeType.AddObject('NOTATION', Pointer(ATTRIBUTE_NOTATION));
  FElementInfo := TStringList.Create;
  FElementInfo.Sorted := True;
  FEntityInfo := TStringList.Create;
  FInCharSet := ceUnknown;
  FNotationInfo := TStringList.Create;
  FNotationInfo.Sorted := true;
  FNotationInfo.Duplicates := dupIgnore;
  FTagAttributes := TStringList.Create;
  FAttrEnum := TStringList.Create;
  FDocStack := TList.Create;
  FNormalizeData := True;
  FCDATA := False;
  FPreserve := False;
  FUrl := '';
  FRaiseErrors := False;
  FFilter := nil;
  FBufferSize := 8192;
  FCurrentPath := '';
  FTempFiles := TStringList.Create;
  FIsStandAlone := False;
  FHasExternals := False;
  FXMLDecParsed := False;
end;
{--------}
destructor TApdParser.Destroy;
var
  TempFilter : TApdInCharFilter;
  i          : Integer;
begin
  Cleanup;
  FTagAttributes.Free;
  FNotationInfo.Free;
  FEntityInfo.Free;
  FElementInfo.Free;
  FAttributeType.Free;
  FErrors.Free;
  if Assigned(FTempFiles) then begin
    for i := 0 to Pred(FTempFiles.Count) do
      DeleteFile(FTempFiles[i]);
    FTempFiles.Free;
  end;
  FAttrEnum.Free;
  if FDocStack.Count > 0 then begin
    for i := Pred(FDocStack.Count) to 0 do begin
      TempFilter := FDocStack[i];
      TempFilter.Free;
      FDocStack.Delete(i);
    end;
  end;
  FDocStack.Free;
  inherited Destroy;
end;
{--------}
procedure TApdParser.CheckParamEntityNesting(const aString : DOMString);
var
  OpenPos : Integer;
  ClosePos : Integer;
begin
  OpenPos := ApxPos('(', aString);
  ClosePos := ApxPos(')', aString);
  if (((OpenPos <> 0) and
       (ClosePos = 0)) or
      ((ClosePos <> 0) and
       (OpenPos = 0))) then
     raise EAdParserError.CreateError(FFilter.Line,
                                       FFilter.LinePos,
                                       sBadParamEntNesting +
                                       aString);
end;
{--------}
procedure TApdParser.Cleanup;
var
  i : Integer;
begin
  if FElementInfo <> nil then begin
    for i := 0 to FElementInfo.Count - 1 do
      TApdElementInfo(FElementInfo.Objects[i]).Free;
    FElementInfo.Clear;
  end;

  if FEntityInfo <> nil then begin
    for i := 0 to FEntityInfo.Count - 1 do
      TApdEntityInfo(FEntityInfo.Objects[i]).Free;
    FEntityInfo.Clear;
  end;

  if FNotationInfo <> nil then begin
    for i := 0 to FNotationInfo.Count - 1 do
      TApdNotationInfo(FNotationInfo.Objects[i]).Free;
    FNotationInfo.Clear;
  end;
end;
{--------}
procedure TApdParser.DataBufferAppend(const sVal : DOMString);
begin
  FDataBuffer := FDataBuffer + sVal;
end;
{--------}
procedure TApdParser.DataBufferFlush;
begin
  if FNormalizeData and
     not FCDATA and
     not FPreserve then
    DataBufferNormalize;
  if FDataBuffer <> '' then begin
    case FCurrentElementContent of
      CONTENT_MIXED, CONTENT_ANY :
        if FCDATA then begin
          ValidateCData(FDataBuffer);
          if Assigned(FOnCDATASection) then
            FOnCDATASection(self, FDataBuffer);
        end else begin
          if Assigned(FOnCharData) then
            FOnCharData(self, FDataBuffer);
        end;
      CONTENT_ELEMENTS :
        if Assigned(FOnIgnorableWhitespace) then
          FOnIgnorableWhitespace(self, FDataBuffer);
    end;
    FDataBuffer := '';
  end;
end;
{--------}
procedure TApdParser.DataBufferNormalize;
var
  BuffLen     : Integer;
  j           : Integer;
  CharDeleted : Boolean;
begin
  while (Length(FDataBuffer) > 0) and
        IsWhiteSpace(FDataBuffer[1]) do
    Delete(FDataBuffer, 1, 1);
  while (Length(FDataBuffer) > 0) and
        IsWhiteSpace(FDataBuffer[Length(FDataBuffer)]) do
    Delete(FDataBuffer, Length(FDataBuffer), 1);

  j := 1;
  BuffLen := Length(FDataBuffer);
  CharDeleted := False;
  while j < BuffLen do begin
    if IsWhiteSpace(FDataBuffer[j]) then begin
      { Force whitespace to a single space }
      FDataBuffer[j] := ' ';

      { Remove additional whitespace }
      j := j + 1;
      while (j <= Length(FDataBuffer)) and
            IsWhiteSpace(FDataBuffer[j]) do begin
        Delete(FDataBuffer, j, 1);
        CharDeleted := True;
      end;
      if (CharDeleted) then begin
        BuffLen := Length(FDataBuffer);
        CharDeleted := False;
      end;
    end;
    j := j + 1;
  end;
end;
{--------}
function TApdParser.DataBufferToString : DOMString;
begin
  Result := FDataBuffer;
  FDataBuffer := '';
end;
{--------}
function TApdParser.GetErrorCount : Integer;
begin
  Result := FErrors.Count;
end;
{--------}
function TApdParser.GetErrorMsg(wIdx : Integer) : DOMString;
begin
  Result := sIndexOutOfBounds;
  if (wIdx >= 0) and
     (wIdx < FErrors.Count) then
    Result := FErrors[wIdx];
end;
{--------}
function TApdParser.DeclaredAttributes(const sName : DOMString;
                                            aIdx  : Integer)
                                                  : TStringList;
begin
  if aIdx < 0 then
    Result := nil
  else
    Result := TApdElementInfo(FElementInfo.Objects[aIdx]).AttributeList;
end;
{--------}
function TApdParser.GetAttributeDefaultValueType(const sElemName,
                                                      sAttrName : DOMString)
                                                                : Integer;
var
  wIdx      : Integer;
  oAttrList : TStringList;
  oAttr     : TApdAttributeInfo;
begin
  Result := ATTRIBUTE_DEFAULT_UNDECLARED;
  wIdx := GetElementIndexOf(sElemName);
  if wIdx >= 0 then begin
    oAttrList := TApdElementInfo(FElementInfo.Objects[wIdx]).AttributeList;
    if oAttrList <> nil then begin
      wIdx := oAttrList.IndexOf(sAttrName);
      if wIdx >= 0 then begin
        oAttr := TApdAttributeInfo(oAttrList.Objects[wIdx]);
        Result := oAttr.AttrType;
      end;
    end;
  end;
end;
{--------}
function TApdParser.GetAttributeExpandedValue(const sElemName,
                                                   sAttrName : DOMString;
                                                   aIdx      : Integer)
                                                             : DOMString;
var
  wIdx      : Integer;
  oAttrList : TStringList;
  oAttr     : TApdAttributeInfo;
  HasEntRef : Boolean;
begin
  SetLength(Result, 0);
  HasEntRef := False;
  {wIdx := GetElementIndexOf(sElemName);}
  if aIdx >= 0 then begin
    oAttrList := TApdElementInfo(FElementInfo.Objects[aIdx]).AttributeList;
    if oAttrList <> nil then begin
      wIdx := oAttrList.IndexOf(sAttrName);
      if wIdx >= 0 then begin
        oAttr := TApdAttributeInfo(oAttrList.Objects[wIdx]);
        if (oAttr.Lookup = '') and
           (oAttr.Value <> '') then begin
          PushString('"' + oAttr.Value + '"');
          oAttr.Lookup := ReadLiteral(LIT_NORMALIZE or
                                      LIT_CHAR_REF or
                                      LIT_ENTITY_REF,
                                      HasEntRef);
          SkipWhitespace(True);
        end;
        Result := oAttr.Lookup;
      end;
    end;
  end;
end;
{--------}
function TApdParser.GetElementContentType(const sName : DOMString;
                                               aIdx  : Integer)
                                                     : Integer;
begin
  if aIdx < 0 then
    Result := CONTENT_UNDECLARED
  else
    Result := TApdElementInfo(FElementInfo.Objects[aIdx]).ContentType;
end;
{--------}
function TApdParser.GetElementIndexOf(const sElemName : DOMString)
                                                     : Integer;
begin
  Result := FElementInfo.IndexOf(sElemName);
end;
{--------}
function TApdParser.GetEntityIndexOf(const sEntityName : DOMString;
                                          aPEAllowed  : Boolean)
                                                      : Integer;
begin
  for Result := 0 to FEntityInfo.Count - 1 do
    if FEntityInfo[Result] = sEntityName then begin
      if (not aPEAllowed) then begin
        if (not TApdEntityInfo(FEntityInfo.Objects[Result]).IsParameterEntity) then
          Exit;
      end else
        Exit;
    end;
  Result := -1;
end;
{--------}
function TApdParser.GetEntityNotationName(const sEntityName : DOMString)
                                                           : DOMString;
var
  wIdx    : Integer;
  oEntity : TApdEntityInfo;
begin
  Result := '';
  wIdx := GetEntityIndexOf(sEntityName, False);
  if wIdx >= 0 then begin
    oEntity := TApdEntityInfo(FEntityInfo.Objects[wIdx]);
    Result := oEntity.NotationName;
  end;
end;
{--------}
function TApdParser.GetEntityPublicId(const sEntityName : DOMString)
                                                       : DOMString;
var
  wIdx    : Integer;
  oEntity : TApdEntityInfo;
begin
  Result := '';
  wIdx := GetEntityIndexOf(sEntityName, False);
  if wIdx >= 0 then begin
    oEntity := TApdEntityInfo(FEntityInfo.Objects[wIdx]);
    Result := oEntity.PublicId;
  end;
end;
{--------}
function TApdParser.GetEntitySystemId(const sEntityName : DOMString)
                                                       : DOMString;
var
  wIdx    : Integer;
  oEntity : TApdEntityInfo;
begin
  Result := '';
  wIdx := GetEntityIndexOf(sEntityName, False);
  if wIdx >= 0 then begin
    oEntity := TApdEntityInfo(FEntityInfo.Objects[wIdx]);
    Result := oEntity.SystemId;
  end;
end;
{--------}
function TApdParser.GetEntityType(const sEntityName : DOMString;
                                       aPEAllowed  : Boolean)
                                                   : Integer;
var
  wIdx    : Integer;
  oEntity : TApdEntityInfo;
begin
  Result := ENTITY_UNDECLARED;
  wIdx := GetEntityIndexOf(sEntityName, aPEAllowed);