ubasexmlclass.pas

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

            // <blah/>, nothing more to do for this Node
            Break
          else
            Inc(AToken);
          // </blah> is handled bellow
        end;
      '<':
        begin
          case (AToken + 1)^ of
            '/':
              begin
                // Closing Tag </...
                Inc(AToken, 2);
                SkipBlanks;
                sPos := AToken;
                ScanFor('>');
                SetLength(Tag, Cardinal(AToken) - Cardinal(sPos));
                Move(sPos^, Pointer(Tag)^, Cardinal(AToken) - Cardinal(sPos));
                if CompareText(FName, Tag) = 0 then
                begin
                  // Maybe <nd1>val <nd2>val2</nd2> val</nd1>
                  // Parent should see the >
                  Dec(AToken);
                  Break;
                end else
                  raise ECMLParseException.CreatePos(Self, 'I found no matching Tag for "' + FName
                    +
                    '"', SourcePos);
              end;
            '!':
              begin
                if ((AToken + 2)^ = '-') and ((AToken + 3)^ = '-') then
                begin
                  // Seems this is a comment inside a node
                  Inc(AToken, 3);
                  ParseComment;
                end;
              end;
          else
            begin
              // Another Tag <...
              nd := CreateChild(Self);
              nd.fPos := Cardinal(AToken) - Cardinal(gStartPos);
              nd.ParseNode(AToken);
            end;
          end;
        end;
      '>':
        begin
          // > value... <
          Inc(AToken);
          SkipBlanks;
          sPos := AToken;
          while not (AToken^ in ['<', #0]) do
            Inc(AToken);
          CheckEOF;
          SetLength(Val, Cardinal(AToken) - Cardinal(sPos));
          Move(sPos^, Pointer(Val)^, Cardinal(AToken) - Cardinal(sPos));
          try
            // Append new val to old
            fValue := fValue + DecodeString(Val);
          except
            on E: Exception do
              raise ECMLParseException.CreatePos(Self, E.Message, SourcePos);
          end;
          Dec(AToken);
        end;
      #0: raise ECMLParseException.CreatePos(Self, 'File ended before it should end!', SourcePos)
    end;
    Inc(AToken);
  end;

  if Assigned(fOnNodeParsed) then
  begin
    fOnNodeParsed(Self, Cancel);
    if Cancel then
      // Don't use Abort procedure because it does not report an Error
      raise ECMLAbortException.CreatePos(Self, 'Aborted parsing.', SourcePos);
  end;
end;

function TCMLNode.FindChild(const AName: string; const CanCreate: Boolean): TCMLNode;
begin
  if AName = '' then
    Result := Self
  else
    Result := fChilds.Find(AName, CanCreate);
end;

function TCMLNode.FindAttri(const AName: string): TCMLAttri;
begin
  Result := fAttris.Find(AName);
end;

procedure TCMLNode.Clear;
begin
  fAttris.Clear;
  fChilds.Clear;
  fValue := '';
end;

function TCMLNode.GetPosition: TPos;
var
  st: string;
  nd: TCMLNode;
begin
  st := fOriginalText;
  repeat
    nd := Owner;
    if nd <> nil then
      st := nd.fOriginalText;
  until (nd = nil) or (st <> '');
  Result := PosToLineCol(st, fPos);
end;

function TCMLNode.LoadFromStream(Stream: TStream): Boolean;
var
  V: PChar;
begin
  Result := True;
  try
    Clear;
    if Stream.Size <> 0 then
    begin
      SetLength(fOriginalText, Stream.Size);
      Stream.Read(fOriginalText[1], Stream.Size);
      V := PChar(fOriginalText);
      gStartPos := V;
      ParseNode(V);
    end;
    gStartPos := nil;
  except
    Result := False;
  end;
end;

function TCMLNode.SaveToStream(Stream: TStream): Boolean;
var
  S: string;
begin
  Result := True;
  try
    S := GetText;
    Stream.Write(S[1], Length(S));
  except
    Result := False;
  end;
end;

function TCMLNode.LoadFromFile(const FileName: string): Boolean;
var
  S: TFileStream;
begin
  Result := False;
  if FileExists(FileName) then
  begin
    S := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
    try
      FFileName := FileName;
      Result := LoadFromStream(S);
    finally
      S.Free;
    end;
  end;
end;

function TCMLNode.SaveToFile(const FileName: string): Boolean;
var
  S: TFileStream;
begin
  S := TFileStream.Create(FileName, fmCreate);
  try
    Result := SaveToStream(S);
  finally
    S.Free;
  end;
end;

procedure TCMLNode.Delete;
begin
  if FOwner <> nil then
    FOwner.Childs.Delete(Self)
  else
    Self.Free;
end;

function TCMLNode.GetIndex: Integer;
begin
  if FOwner <> nil then
    Result := FOwner.Childs.IndexOf(Self)
  else
    Result := -1;
end;

function TCMLNode.GetAtt(AName: string): string;
begin
  Result := Attris.Att[AName]
end;

procedure TCMLNode.SetAtt(AName: string; const Value: string);
begin
  Attris.Att[AName] := Value;
end;

function TCMLNode.GetAttAsBoolean(AMc: string): Boolean;
begin
  Result := fAttris.AttAsBoolean[AMc]
end;

function TCMLNode.GetAttAsFloat(AMc: string): Double;
begin
  Result := fAttris.AttAsFloat[AMc]
end;

function TCMLNode.GetAttAsInt(AMc: string): Integer;
begin
  Result := fAttris.AttAsInt[AMc]
end;

procedure TCMLNode.SetAttAsBoolean(AMc: string; const Value: Boolean);
begin
  fAttris.AttAsBoolean[AMc] := Value
end;

procedure TCMLNode.SetAttAsFloat(AMc: string; const Value: Double);
begin
  fAttris.AttAsFloat[AMc] := Value
end;

procedure TCMLNode.SetAttAsInt(AMc: string; const Value: Integer);
begin
  fAttris.AttAsInt[AMc] := Value
end;

function TCMLNode.HasAttribute(const AName: string): Boolean;
begin
  Result := fAttris.HasAttribute(AName)
end;

class function TCMLNode.GetChildClass: TCMLNodeClass;
begin
  Result := TCMLNode;
end;

{ ESMLException }

constructor ECMLException.CreateSender(ASender: TObject; const msg: string);
begin
  fSender := ASender;
  inherited Create(msg);
end;

{ ESMLParseException }

constructor ECMLPosException.CreatePos(ASender: TObject; const msg: string; APos: TPos);
begin
  fPosition := APos;
  inherited CreateSender(ASender, msg);
end;

function TCMLNode.GetName: string;
begin
  Result := FName
end;

class function TCMLNode.GetChildListClass: TCMLNodeListClass;
begin
  Result := TCMLNodeList
end;

class function TCMLNodeList.GetChildClass: TCMLNodeClass;
begin
  Result := TCMLNode
end;

{ TCmlDoc }

constructor TCmlDoc.Create(AName: string);
begin
  FRoot := GetChildClass.Create(nil);
  if AName <> '' then
    FRoot.Name := AName;
end;

destructor TCmlDoc.Destroy;
begin
  FreeAndNil(FRoot);
  inherited;
end;

class function TCmlDoc.GetChildClass: TCMLNodeClass;
begin
  Result := TCMLNode
end;

function TCmlDoc.GetRoot: TCMLNode;
begin
  Result := FRoot;
end;

function TCmlDoc.LoadFromFile(const FileName: string): Boolean;
var
  sXmlFileName,sTmpFile:String;
  IsHaveTmp:Boolean;
begin
  sXmlFileName:=FileName;
  sTmpFile:='';
  IsHaveTmp:=False;
  FPackedType:=TestFileType(sXmlFileName);
  case FPackedType of
    ptZLib:
      begin
        sTmpFile:=GetTmp(ExtractFilePath(sXmlFileName),'~cm');
        if ExtractZLibFileTo(sXmlFileName,sTmpFile) then
        begin
          sXmlFileName:=sTmpFile;
          IsHaveTmp:=True;
        end;
      end;
    ptZlib2:
      begin

      end;
    ptZip:
      begin

      end;
  end;
  Result := FRoot.LoadFromFile(sXmlFileName);
  if FRoot<>nil then FRoot.FileName:=FileName;
  if IsHaveTmp and FileExists(sTmpFile) then DeleteFile(PChar(sTmpFile));
end;

function TCmlDoc.SaveToFile(const FileName: string): Boolean;
var
  BufText:String;
  iLen:integer;
begin
  Result := FRoot.SaveToFile(FileName);
  if IsSavePacked then
    FPackedType:=ptZLib;
    
  FillChar(FIDTAG,cIdTagLen,0);
  BufText:=FRoot.Attris.Text;
  iLen:=Length(BufText);
  if iLen>SizeOf(FIDTAG.Title) then
    iLen:=SizeOf(FIDTAG.Title);
  StrPLCopy(FIDTAG.Title,BufText,iLen);

  case FPackedType of
    ptZLib:
      begin
        FIDTAG.TAGID:=cPackZlib;
        ZipAFile(FileName,WriteIdTag)
      end;
    ptZip:
      begin

      end;
  else
  end;
end;

function TCMLNodeList.CreateNewChild(const AName: string): TCMLNode;
var
  P: Integer;
  remain, na: string;
begin
  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;
  Result := GetChildClass.Create(FOwner, na, '');
  Add(Result);
  if remain <> '' then
    Result := Result.Childs.CreateNewChild(remain);
end;

function TCMLNode.DoCreateNewChild(const AName: string): TCMLNode;
begin
  if AName = '' then
    Result := Self
  else
    Result := Childs.CreateNewChild(AName)
end;

function TCMLNode.XMove(ATab: Integer): Boolean;
var
  i, NewIndex: Integer;
begin
  Result := False;
  if FOwner = nil then Exit;
  i := Index;
  if i < 0 then Exit;
  NewIndex := i + ATab;
  if (NewIndex < 0) or (NewIndex >= FOwner.Childs.Count) then Exit;
  FOwner.Childs.Move(i, NewIndex);
  Result := True;
end;

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

function TCMLNode.GetDeep: Integer;
var
  i,iDeep,iMaxDeep: Integer;
begin
  iMaxDeep:=0;                              // Me
  for i := 0 to fChilds.Count - 1 do
  begin
    iDeep:=fChilds[i].GetDeep;
    if iDeep>iMaxDeep then
      iMaxDeep:=iDeep;
  end;
  Result:=iMaxDeep+1;
end;

function TCMLNode.GetWDeep: Integer;
var
  i: Integer;
begin
  if fChilds.Count>0 then
  begin
    Result:=0;
    for i := 0 to fChilds.Count - 1 do
      Result:=Result+fChilds.Get(i).GetWDeep
  end else
    Result:=1;
end;

procedure TCMLNode.AssignedByNode(ANode: TCMLNode);
begin
  Clear;
  Text:=ANode.Text;
end;

function TCMLNode.NodeNewAtIndex(Index: integer;const AName: string): TCMLNode;
begin
  if (Index=-1) or ((Index >= 0) and (Index <= Childs.Count)) then
  begin
    Result := GetChildClass.Create(Self, AName,'');
    NodeInsert(Index, Result);
  end else
  begin
    Result := nil;
  end;
end;

procedure TCMLNode.NodeInsert(Index: integer; ANode: TCMLNode);
begin
  if not assigned(ANode) then Exit;
  if Index=-1 then
  begin
    ANode.FOwner := Self;
    fChilds.Add(ANode)
  end else if (Index >= 0) and (Index <= Childs.Count) then
  begin
    ANode.FOwner := Self;
    FChilds.Insert(Index, ANode);
  end;
end;

function TCMLNode.NodeRemove(ANode: TCMLNode): integer;
begin
  Result := NodeIndexOf(ANode);
  if Result >= 0 then
    NodeDelete(Result);
end;

function TCMLNode.NodeIndexOf(ANode: TCMLNode): integer;
begin
  if assigned(ANode) then
    Result := Childs.IndexOf(ANode)
  else
    Result := -1;
end;

procedure TCMLNode.NodeDelete(Index: integer);
begin
  if (Index >= 0) and (Index < NodeCount) then
  begin
    TCMLNode(fChilds[Index]).Free;
    fChilds.Delete(Index);
  end;
end;

function TCMLNode.GetNodeCount: integer;
begin
  Result:=FChilds.Count;
end;

function TCMLNode.NodeExtract(ANode: TCMLNode):Pointer;
var
  AIndex: integer;
begin
  Result := nil;
  AIndex := FChilds.IndexOf(ANode);
  if AIndex >= 0 then
  begin
    Result := ANode;
    FChilds.Delete(AIndex);
  end;
end;

procedure TCmlDoc.WriteIdTag(Stream: TStream);
begin
  Stream.Write(FIDTAG,cIdTagLen)
end;

function TCMLNode.GetNext: TCMLNode;
var
  iIndex:Integer;
begin
  Result:=nil;
  iIndex:=index+1;
  if (index>0) and (iIndex<FOwner.Childs.Count) then
    Result := FOwner.Childs[iIndex]
end;

function TCMLNode.GetPrev: TCMLNode;
var
  iIndex:Integer;
begin
  Result:=nil;
  iIndex:=index-1;
  if iIndex >=0  then
    Result := FOwner.Childs[iIndex]
end;

initialization
  // Encoding Table (UNICODE not supported)
  {$IFDEF IsUseOldCode}
  EncodingTable['"'] := '&#034;';
  EncodingTable['&'] := '&#038;';
  EncodingTable['<'] := '&#060;';
  EncodingTable['>'] := '&#062;';
  EncodingTable['