ubasexmlclass.pas

批量 Xml 修改 Modify 批量 Xml 修改 批量 Xml 修改

  Result := '';
  for i := 0 to Count - 1 do
    Result := Result + ' ' + Items[i].Text;
  if (Result <> '') and (Result[1] = ' ') then
    System.Delete(Result, 1, 1);
end;

procedure TCMLAttriList.SetText(Value: string);
begin
  Clear;
  AddText(Value);
end;

procedure TCMLAttriList.AddText(Value: string);
var
  i, P, Len: Integer;
  A: TCMLAttri;
  S: string;
begin
  Len := Length(Value);
  P := 1;
  i := 1;
  while i <= Len do
  begin
    if (i = Len) or (Value[i] = ' ') or (Value[i] = '"') or (Value[i] = '''') then
    begin
      if Value[i] = '"' then
        i := FindChar('"', Value, i + 1)
      else if Value[i] = '''' then
        i := FindChar('''', Value, i + 1);
      S := Trim(Copy(Value, P, i - P + 1));
      P := i + 1;
      if S <> '' then
      begin
        A := TCMLAttri.Create(FOwner);
        A.ParseAttri(S);
        Add(A);
        Inc(i);
      end else
        Break;
    end;
    Inc(i);
  end;
end;

procedure TCMLAttriList.Assign(Source: TList);
var
  i: Integer;
  A: TCMLAttri;
begin
  Clear;
  with Source as TCMLAttriList do
    for i := 0 to Count - 1 do
    begin
      A := TCMLAttri.Create(FOwner);
      A.Assign(Items[i]);
      Add(A);
    end;
end;

function TCMLAttriList.GetAtt(AName: string): string;
var
  objNd: TCMLAttri;
begin
  Result := '';
  objNd := Find(AName);
  if objNd <> nil then
    Result := objNd.Value;
end;

procedure TCMLAttriList.SetAtt(AName: string; const Value: string);
var
  objNd: TCMLAttri;
begin
  objNd := Find(AName);
  if objNd <> nil then
    objNd.Value := Value
  else
  begin
    objNd := TCMLAttri.Create(FOwner, AName, Value);
    Add(objNd);
  end;
end;

function TCMLAttriList.GetAttAsBoolean(AMc: string): Boolean;
begin
  Result := StrToBool(GetAtt(AMc))
end;

function TCMLAttriList.GetAttAsFloat(AMc: string): Double;
begin
  Result := StrToFloatDef(GetAtt(AMc), 0)
end;

function TCMLAttriList.GetAttAsInt(AMc: string): Integer;
begin
  Result := StrToIntDef(GetAtt(AMc), 0)
end;

procedure TCMLAttriList.SetAttAsBoolean(AMc: string; const Value: Boolean);
begin
  SetAtt(AMc, BoolToStr(Value))
end;

procedure TCMLAttriList.SetAttAsFloat(AMc: string; const Value: Double);
begin
  SetAtt(AMc, FloatToStr(Value))
end;

procedure TCMLAttriList.SetAttAsInt(AMc: string; const Value: Integer);
begin
  SetAtt(AMc, inttostr(Value))
end;

function TCMLAttriList.HasAttribute(const AName: string): Boolean;
begin
  Result := Find(AName) <> nil;
end;

{ TSMLNodeList }

constructor TCMLNodeList.Create(AOwner: TCMLNode);
begin
  inherited Create;
  FOwner := AOwner;
end;

destructor TCMLNodeList.Destroy;
begin
  Clear;
  inherited;
end;

function TCMLNodeList.Get(Index: Integer): TCMLNode;
begin
  Result := TCMLNode(inherited Get(Index));
end;

procedure TCMLNodeList.Put(Index: Integer; Item: TCMLNode);
begin
  inherited Put(Index, Pointer(Item));
end;

function TCMLNodeList.Find(const AName: string; const CanCreate: Boolean): TCMLNode;
var
  i, P: Integer;
  remain, na: string;
begin
  Result := nil;
  P := FindChar(NODEDELIMITER, AName, 1);
  if P <> 0 then
  begin
    na := Copy(AName, 1, P - 1);
    remain := Copy(AName, P + 1, MaxInt);
  end else
  begin
    na := AName;
    remain := '';
  end;
  for i := 0 to Count - 1 do
    if CompareText(Items[i].Name, na) = 0 then
    begin
      Result := Items[i];
      Break;
    end;
  if (Result = nil) and CanCreate then
  begin
    Result := GetChildClass.Create(FOwner, na, '');
    Add(Result);
  end;
  if (Result <> nil) and (remain <> '') then
    Result := Result.Childs.Find(remain, CanCreate);
end;

procedure TCMLNodeList.Assign(Source: TList);
var
  i: Integer;
  A: TCMLNode;
begin
  Clear;
  with Source as TCMLNodeList do
    for i := 0 to Count - 1 do
    begin
      A := GetChildClass.Create(Items[i].Owner);
      A.Assign(Items[i]);
      Add(A);
    end;
end;

procedure TCMLNodeList.Clear;
var
  i: Integer;
begin
  for i := Count - 1 downto 0 do
    Delete(i);
  inherited;
end;

procedure TCMLNodeList.Delete(Index: Integer);
var
  nd: TCMLNode;
begin
  nd := Items[Index];
  nd.Free;
  inherited Delete(Index);
end;

procedure TCMLNodeList.Delete(Item: TCMLNode);
var
  i: Integer;
begin
  i := IndexOf(Item);
  if i <> -1 then
    Delete(i);
end;

procedure TCMLNodeList.Delete(AName: string);
var
  nd: TCMLNode;
begin
  nd := Find(AName, False);
  if nd <> nil then
    Delete(nd);
end;

procedure TCMLNodeList.Remove(Item: TCMLNode);
{ Same as Delete but does not free the Item }
var
  i: Integer;
begin
  i := IndexOf(Item);
  if i <> -1 then
    inherited Delete(i);
end;

{ TSMLNode }

constructor TCMLNode.Create(AOwner: TCMLNode);
begin
  inherited Create;
  fAttris := TCMLAttriList.Create(Self);
  fChilds := GetChildListClass.Create(Self);
  FOwner := AOwner;
end;

constructor TCMLNode.Create(AOwner: TCMLNode; const AName, AValue: string);
begin
  Create(AOwner);
  SetName(AName);
  SetValue(AValue);
end;

constructor TCMLNode.Create(AOwner: TCMLNode; const AName: string; const AValue: Integer);
begin
  Create(AOwner, AName, inttostr(AValue));
end;

constructor TCMLNode.Create(AOwner: TCMLNode; const AName: string; const AValue: Double);
begin
  Create(AOwner, AName, FloatToStr(AValue));
end;

constructor TCMLNode.Create(AOwner: TCMLNode; const AName: string; const AValue: Boolean);
begin
  Create(AOwner, AName, BoolToStr(AValue));
end;

constructor TCMLNode.CreateForScript(AOwner: TCMLNode);
begin
  Create(AOwner);
end;

destructor TCMLNode.Destroy;
begin
  Pointer(FOwner):=nil;
  FreeAndNil(fAttris);
  FreeAndNil(fChilds);
  inherited;
end;

procedure TCMLNode.Assign(Source: TPersistent);
begin
  with (Source as TCMLNode) do
  begin
    Self.fAttris.Assign(Attris);
    Self.fChilds.Assign(Childs);
    Self.FName := FName;
    Self.FOwner := FOwner;
    Self.fOnNodeParsed := fOnNodeParsed;
    Self.fValue := fValue;
  end;
  inherited;
end;

function TCMLNode.GetCount: Integer;
var
  i: Integer;
begin
  Result := 1 + fChilds.Count;                              // Me
  for i := 0 to fChilds.Count - 1 do
    Inc(Result, fChilds[i].Count);
end;

procedure TCMLNode.SetOwner(AOwner: TCMLNode);
begin
  if FOwner <> nil then
    FOwner.Childs.Remove(Self);
  if AOwner <> nil then
    AOwner.Childs.Add(Self);
  FOwner := AOwner;
end;

procedure TCMLNode.SetName(Value: string);
begin
  if IsValidName(Value) then
    FName := Value
  else
    raise ECMLException.Create('Sorry, but "' + Value + '" is not a valid name for a Node');
end;

function TCMLNode.GetValue: string;
begin
  Result := fValue;
end;

procedure TCMLNode.SetValue(Value: string);
begin
  fValue := Value;
end;

procedure TCMLNode.SetText(Value: string);
var
  V: PChar;
begin
  Clear;
  V := PChar(Value);
  ParseNode(V);
end;

function TCMLNode.GetText: string;
var
  i: Integer;
  S: string;
begin
  if fXMLType <> '' then
    Result := GetIndent + '<?xml ' + fXMLType + '?>' + NEWLINE
  else
    Result := '';
  if fDocType <> '' then
    Result := Result + GetIndent + '<!DOCTYPE ' + fDocType + '>' + NEWLINE;
  Result := Result + GetIndent + '<' + FName;
  S := fAttris.Text;
  if S <> '' then
    Result := Result + ' ' + S;
  if (fValue = '') and (fChilds.Count = 0) then
    // If no Value and no Child Nodes save it as
    // <node[ attribs...]/>
    Result := Result + '/>' + NEWLINE
  else
  begin
    // <node[ attribs]>
    //   ...
    // </node>
    Result := Result + '>';
    if fChilds.Count > 0 then
      Result := Result + NEWLINE;
    Inc(Indent, INDENT_INC);
    if fValue <> '' then
    begin
      S := EncodeString(fValue);
      if fChilds.Count > 0 then
      begin
        if not (S[Length(S)] in [#10, #13]) then
          // Only append new line when there isn't already one
          S := S + NEWLINE;
        Result := Result + GetIndent + S;
      end else
        Result := Result + S;
    end;
    for i := 0 to fChilds.Count - 1 do
      Result := Result + fChilds[i].Text;
    Dec(Indent, INDENT_INC);
    if fChilds.Count > 0 then
      Result := Result + GetIndent;
    Result := Result + '</' + FName + '>' + NEWLINE;
  end;
end;

function TCMLNode.CreateChild(AOwner: TCMLNode): TCMLNode;
begin
  Result := GetChildClass.Create(AOwner);
  Result.OnNodeParsed := fOnNodeParsed;
  //  Result.Filename := fFilename;
  fChilds.Add(Result);
end;

procedure TCMLNode.ParseNode(var AToken: PChar);
{
  Parse
    <tag[ params ...]>[value ...]</tag>
  or
    <tag[ params ...]/>
}

  function SourcePos: TPos;
  var
    S: string;
  begin
    if gStartPos <> nil then
    begin
      S := gStartPos;
      Result := PosToLineCol(S, Cardinal(AToken) - Cardinal(gStartPos));
    end else
      Result := ToPos(0, 0);
  end;

  procedure CheckEOF;
    {$IFDEF INLINE}inline;
    {$ENDIF}
  begin
    if AToken^ = #0 then
      raise ECMLParseException.CreatePos(Self,
        'Why did the file end here??? I still expected something.', SourcePos);
  end;

  procedure ScanFor(const AChar: Char);
    {$IFDEF INLINE}inline;
    {$ENDIF}
  begin
    // Skip to AChar
    Inc(AToken);
    while not (AToken^ in [AChar, #0]) do
      Inc(AToken);
    CheckEOF;
  end;

  procedure SkipBlanks;
    {$IFDEF INLINE}inline;
    {$ENDIF}
  begin
    while (AToken^ in [#32, #9, #10, #13, #0]) do
      Inc(AToken);
    CheckEOF;
  end;

  procedure ParseComment;
  label
    try_again;
  begin
    // Parse <!-- ... -->
    try_again:                                              { LABEL! }
    ScanFor('-');
    Inc(AToken);
    if AToken^ = '-' then
    begin
      Inc(AToken);
      if AToken^ = '>' then
        Inc(AToken)
      else
        goto try_again;
    end else
      goto try_again;
  end;

  procedure ParseDocType;
  var
    P: PChar;
  begin
    // Parse <!DOCTYPE ...>
    SkipBlanks;
    P := AToken;
    ScanFor('>');
    SetLength(fDocType, Cardinal(AToken) - Cardinal(P));
    Move(P^, Pointer(fDocType)^, Cardinal(AToken) - Cardinal(P));
  end;

  procedure ParseXML;
  var
    P, P2: PChar;
  begin
    // Parse <?xml ...?>
    SkipBlanks;
    P := AToken;
    ScanFor('?');
    P2 := AToken;
    Inc(AToken);
    if AToken^ <> '>' then
      raise ECMLParseException.CreatePos(Self, 'Expecting ">"', SourcePos);
    SetLength(fXMLType, Cardinal(P2) - Cardinal(P));
    Move(P^, Pointer(fXMLType)^, Cardinal(P2) - Cardinal(P));
    Inc(AToken);
  end;

var
  sPos: PChar;
  Tag, Param, Val, N: string;
  nd: TCMLNode;
  Cancel: Boolean;
label
  start;
begin
  Cancel := False;
  start:                                                    { LABEL! }
  while AToken^ <> '<' do
  begin
    if AToken^ = #0 then
      Exit;
    Inc(AToken);
  end;
  Inc(AToken);

  sPos := AToken;

  while not (AToken^ in [#32, #9, '>', '/', #10, #13, #0]) do
    // Parse Tag Name
    Inc(AToken);
  CheckEOF;
  SetLength(N, Cardinal(AToken) - Cardinal(sPos));
  Move(sPos^, Pointer(N)^, Cardinal(AToken) - Cardinal(sPos));
  if CompareText(N, '?xml') = 0 then
  begin
    // Parse <?xml ...?>
    ParseXML;
    goto start;
  end else if CompareText(N, '!DOCTYPE') = 0 then
  begin
    // Parse <!DOCTYPE ...>
    ParseDocType;
    goto start;
  end else if N = '!--' then
  begin
    // Parse <!-- ... -->
    ParseComment;
    goto start;
  end;
  if IsValidName(N) then
    FName := N
  else
    raise ECMLParseException.CreatePos(Self, 'A Node must not have a Name like "' + N + '"',
      SourcePos);

  while AToken^ <> #0 do
  begin
    case AToken^ of
      'a'..'z', 'A'..'Z', '_':                              // At the beginning allowed
        begin
          // Attribute
          sPos := AToken;
          while not (AToken^ in ['>', '/', #0]) do
          begin
            if (AToken^ in ['''', '"']) then
              // Something in quotes should pass
              ScanFor(AToken^);
            Inc(AToken);
          end;
          CheckEOF;
          SetLength(Param, Cardinal(AToken) - Cardinal(sPos));
          Move(sPos^, Pointer(Param)^, Cardinal(AToken) - Cardinal(sPos));
          if (Param <> '') then
          begin
            try
              fAttris.AddText(Param);
            except
              on E: Exception do
                raise ECMLParseException.CreatePos(Self, E.Message, SourcePos);
            end;
          end;
          Dec(AToken);
        end;
      '/':
        begin
          if (AToken + 1)^ = '>' then