ubasexmlclass.pas

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

    Result:=UnZipFile(AinFileName,Stream);
  finally
    FreeandNil(Stream);
  end;
end;

function TestFileType(const FileName:String):TPackedType;
var
  iFileHandle:Integer;
begin
  iFileHandle := FileOpen(FileName, fmOpenRead);
  Result:=TestFileType(iFileHandle);
  FileClose(iFileHandle);
end;

function TestFileType(AFileHandle:Integer):TPackedType;
var
  Code:Word;
const
  cCodeLen=SizeOf(Code);
  cZipCode=$4B50;
  cLibCode=$0178;
  cLibCode2=$9C78;
begin
  Result:=ptNone;
  FileRead(AFileHandle,Code,cCodeLen);
  if Code=cZipCode then
    Result:=ptZip
  else if (Code=cLibCode) or (Code=cLibCode2) then
    Result:=ptZlib2
  else
  begin
    FileSeek(AFileHandle,4,0);
    FileRead(AFileHandle,Code,cCodeLen);
    if (Code=cLibCode) or (Code=cLibCode2) then
      Result:=ptZLib;
  end;
end;



function FindChar(const C: Char; const S: string; const from: Integer): Integer;
{$IFDEF INLINE}inline;
{$ENDIF}
{ Similar to Pos, but must be one Char, and pass the Index to start. }
var
  i: Integer;
begin
  Result := 0;
  for i := from to Length(S) do
    if S[i] = C then
    begin
      Result := i;
      Break;
    end;
end;

function ToPos(const Line, col: Integer): TPos;
begin
  Result.Line := Line;
  Result.col := col;
end;

function PosToLineCol(const S: string; APos: Cardinal): TPos;
{ This function is needed to get Line and Colnumber from an absolute position
  (APos) in the Source (s). We do not parse it linewise and we do not count line
  and colnumber. }
var
  P: Cardinal;
begin
  Result.Line := 1;
  Result.col := 1;
  P := 1;
  while P <= APos do
  begin
    if S[P] in [#10, #13] then
    begin
      if (S[P] = #13) and (S[P + 1] = #10) then
        // We do not rely on a certain line ending style
        Inc(P);
      Result.col := 1;
      Inc(Result.Line);
    end;
    Inc(Result.col);
    Inc(P);
  end;
end;

function StrToBool(const Value: string): Boolean;
var
  V: string;
begin
  V := LowerCase(Value);
  Result :=(V = 'true') or (V = 't') or (V = '1') or (V = 'yes') or (V = 'y') or (V = '-1');
end;

function BoolToStr(const Value: Boolean): string;
begin
  Result := BOOLSTR[Value];
end;

function BinToStr(const Buf; Len: Integer): string;
var
  S: string;
  i: Integer;
begin
  SetLength(Result, Len * 2);
  for i := 0 to Len - 1 do
  begin
    S := IntToHex(TBytes(Buf)[i], 2);
    Move(S[1], Result[i * 2 + 1], 2);
  end;
end;

function StrToBin(const Str: string; var Buf; var Len: Integer): Integer;
var
  i: Integer;
  S: string;
  b: Byte;
  Code: Integer;
begin
  Result := 0;
  Len := Length(Str) div 2;
  for i := 0 to Len - 1 do
  begin
    S := '$' + Copy(Str, (i * 2) + 1, 2);
    Val(S, b, Code);
    if Code <> 0 then
    begin
      Inc(Result);
      b := 0;
    end;
    TBytes(Buf)[i] := b;
  end;
end;

function GetIndent: string;
begin
  {$IFDEF DEBUG}
  Result := StringOfChar(INDENT_CHAR, Indent);
  {$ELSE}
  Result:='';
  {$ENDIF}
end;

function IsInt(const S: string; const hex: Boolean): Boolean;
{$IFDEF INLINE}inline;
{$ENDIF}
{ Returns true when StrToInt could be used on s }
var
  ps: PChar;
  validchars: set of Char;
begin
  Result := True;
  if not hex then
    validchars := ['0'..'9']
  else
    validchars := ['0'..'9', 'A'..'F', 'a'..'f'];
  ps := PChar(S);
  while ps^ <> #0 do
  begin
    if not (ps^ in validchars) then
    begin
      Result := False;
      Break;
    end;
    Inc(ps);
  end;
end;

function ToInt(const S: string; const hex: Boolean): Integer;
{$IFDEF INLINE}inline;
{$ENDIF}
begin
  if not hex then
    Result := StrToInt(S)
  else
    Result := StrToInt('$' + S);
end;
{$IFDEF IsUseOldCode}
function EncodeString(const AToken: string): string;
  function Max(const A, b: Integer): Integer;
    {$IFDEF INLINE}inline;
    {$ENDIF}
  begin
    if A > b then Result := A else Result := b;
  end;
var
  i, ISrc, IDest, SrcLen, DestLen: Integer;
  Replace: string;
  C: Char;
begin
  if AToken <> '' then
  begin
    SrcLen := Length(AToken);
    ISrc := 1;
    DestLen := SrcLen;
    IDest := 1;
    SetLength(Result, DestLen);
    while ISrc <= SrcLen do
    begin
      C := AToken[ISrc];
      if EncodingTable[C] <> nil then
      begin
        Replace := StrPas(EncodingTable[C]);
        Inc(ISrc);
      end else
      begin
        if IDest > DestLen then
        begin
          Inc(DestLen, 32);
          SetLength(Result, DestLen);
        end;
        Result[IDest] := C;
        Inc(ISrc);
        Inc(IDest);
        Continue;
      end;
      if IDest + Length(Replace) - 1 > DestLen then
      begin
        Inc(DestLen, Max(32, IDest + Length(Replace) - DestLen));
        SetLength(Result, DestLen);
      end;
      for i := 1 to Length(Replace) do
      begin
        Result[IDest] := Replace[i];
        Inc(IDest);
      end;
    end;
    SetLength(Result, IDest - 1);
  end else
    Result := '';
end;

function DecodeString(const AString: string): string;
var
  i, P, P2, V, Len: Integer;
  S: string;
  hex: Boolean;
begin
  Result := AString;
  Len := Length(Result);
  i := Len;
  while i > 0 do
  begin
    if Result[i] = '&' then
    begin
      P := i;
      if i < Len then
      begin
        Inc(i);
        if Result[i] = '#' then
        begin
          if Result[i + 1] = 'x' then
          begin
            // HEX Value, like &xFF;
            hex := True;
            Inc(i);
          end else
            hex := False;
          P2 := FindChar(';', Result, i);
          if P2 > 0 then
          begin
            S := Copy(Result, i + 1, P2 - i - 1);
            if IsInt(S, hex) then
            begin
              V := ToInt(S, hex);
              if V <> 0 then
              begin
                Result[P] := Char(V);
                Delete(Result, P + 1, P2 - P);
                // Decrease len by count of deleted chars
                Dec(Len, P2 - P);
              end else
                raise ECMLException.Create('There is an invalid Entity');
            end else
              raise ECMLException.Create('There is an invalid Entity');
          end;
        end else
          Dec(i, 2);
      end else
        Exit;
    end;
    Dec(i);
  end;
end;
{$ELSE}
function DecodeString(const AString: string): string;
var
  SearchStr, Reference, Replace: string;
  i, Offset, Code: Integer;
  b: Byte;
begin
  SearchStr := AString;
  Result := '';
  while SearchStr <> '' do
  begin

    Offset := AnsiPos('&', SearchStr);
    if Offset = 0 then
    begin

      Result := Result + SearchStr;
      Break;
    end;
    Result := Result + Copy(SearchStr, 1, Offset - 1);
    SearchStr := Copy(SearchStr, Offset, MaxInt);

    Offset := AnsiPos(';', SearchStr);
    if Offset = 0 then
    begin

      Result := Result + SearchStr;
      Break;
    end;

    Reference := Copy(SearchStr, 1, Offset);
    SearchStr := Copy(SearchStr, Offset + 1, MaxInt);
    Replace := Reference;

    if Copy(Reference, 1, 2) = '&#' then
    begin
      Reference := Copy(Reference, 3, Length(Reference) - 3);
      if Length(Reference) > 0 then
      begin
        if LowerCase(Reference[1]) = 'x' then

          Reference[1] := '$';
        Code := StrToIntDef(Reference, -1);
        if (Code >= 0) and (Code < $FF) then
        begin
          b := Code;
          Replace := Char(b);
        end;
      end;
    end else
    begin

      for i := 0 to cEscapeCount - 1 do
        if Reference = cReplaces[i] then
        begin

          Replace := cEscapes[i];
          Break;
        end;
    end;

    Result := Result + Replace;
  end;
end;

function EncodeString(const AToken: string): string;
var
  i: Integer;
begin
  Result := AToken;
  for i := 0 to cEscapeCount - 1 do
    Result := StringReplace(Result, cEscapes[i], cReplaces[i], [rfReplaceAll]);
end;
{$ENDIF}

function IsValidName(const AName: string): Boolean;
const
  Alpha = ['A'..'Z', 'a'..'z', '_'];
  ValidNameChars = Alpha + ['0'..'9', '.', '-', ':'];
var
  i: Integer;
begin
  Result := False;
  if (AName = '') or not (AName[1] in Alpha) then Exit;
  for i := 2 to Length(AName) do if not (AName[i] in ValidNameChars) then Exit;
  Result := True;
end;

{ TSMLAttri }

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

constructor TCMLAttri.Create(AOwner: TCMLNode; const AName, AValue: string);
begin
  inherited Create;
  FOwner := AOwner;
  FName := AName;
  fValue := AValue;
end;

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

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

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

procedure TCMLAttri.LoadFromStream(Stream: TStream);
var
  S: string;
begin
  SetLength(S, Stream.Size);
  Stream.Read(S[1], Stream.Size);
  SetText(S);
end;

procedure TCMLAttri.SaveToStream(Stream: TStream);
var
  S: string;
begin
  S := GetText;
  Stream.Write(S[1], Length(S));
end;

procedure TCMLAttri.Assign(Source: TPersistent);
begin
  with (Source as TCMLAttri) do
  begin
    Self.FName := FName;
    Self.fValue := fValue;
  end;
end;

procedure TCMLAttri.ParseAttri(const AToken: string);
var
  P, P2: Integer;
  S, s2: string;
begin
  S := AToken;
  P := FindChar('=', S, 1);
  if P <> 0 then
  begin
    s2 := Trim(Copy(S, 1, P - 1));
    if IsValidName(s2) then
      FName := s2
    else
      raise ECMLException.Create('"' + s2 + '" is not a valid attribute name.');
    P2 := FindChar('"', S, P + 1);
    P := FindChar('"', S, P2 + 1);
    if (P <> 0) and (P2 <> 0) then
      // Double quoted
      fValue := DecodeString(Copy(S, P2 + 1, P - P2 - 1))
    else
    begin
      // Signle quoted
      P2 := FindChar('''', S, P + 1);
      P := FindChar('''', S, P2 + 1);
      if (P <> 0) and (P2 <> 0) then
        fValue := DecodeString(Copy(S, P2 + 1, P - P2 - 1))
      else
        raise ECMLException.Create('Expected either a single or a double quote.');
    end;
  end else if IsValidName(AToken) then
  begin
    FName := AToken;
  end else
    raise ECMLException.Create('"' + AToken + '" is not a valid attribute name.');
end;

procedure TCMLAttri.SetText(Value: string);
begin
  if Value <> GetText then
    ParseAttri(Value);
end;

function TCMLAttri.GetText: string;
begin
  {$IFDEF IsNodeAttEmptyNoQuote}
  if fValue <> '' then
    Result := FName + '=' + QUOTE_CHAR + EncodeString(fValue) + QUOTE_CHAR
  else
    Result := FName;
  {$ELSE}
  Result := FName + '=' + QUOTE_CHAR + EncodeString(fValue) + QUOTE_CHAR
    {$ENDIF}
end;

{ TSMLAttriList }

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

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

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

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

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

procedure TCMLAttriList.Delete(AName: string);
var
  nd: TCMLAttri;
begin
  nd := Find(AName);
  if nd <> nil then
    Delete(nd);
end;

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

function TCMLAttriList.Get(Index: Integer): TCMLAttri;
begin
  Result := TCMLAttri(inherited Get(Index));
end;

procedure TCMLAttriList.Put(Index: Integer; Item: TCMLAttri);
begin
  inherited Put(Index, Pointer(Item));
end;

function TCMLAttriList.Find(const AName: string): TCMLAttri;
var
  i: Integer;
begin
  Result := nil;
  for i := 0 to Count - 1 do
    if CompareText(Items[i].Name, AName) = 0 then
    begin
      Result := Items[i];
      Break;
    end;
end;

function TCMLAttriList.GetText: string;
var
  i: Integer;
begin