TEdit + Steuerzeichen + XML = Exception

[Whookie]

Heute bin ich auf ein (im nach hinein nachvollziehbares) aber doch gut verstecktes Problem gestoßen:
Ich hab ein umfangreiches Programm in dem der Anwender verschiedene "Objekte" anlegen und benennen kann. Das ganze wird dann als XML-Datei gespeichert (z.B.: <Name>Mein Name</Name>).

Das funktioniert schon jahrelang so :shock: aber gestern war dann ein Teil der Datei nicht mehr vorhanden und nach eingehender Analyse liegt der Grund in der Überschrift verpackt! Der Auslöser war der Versuch einen Namen wie "Mein_Test" einzugeben. Dabei ist der Anwender beim Underline unabsichtlich statt auf Umsch+'-' an ein Strg+Umsch+'-' geraten. Das bewirkt aber nicht wirklich etwas (ein Schelm wer da jetzt böses denkt), daher hat er dann nochmal ein "_" eingegeben und den Namen vollendet.

Das funktioniert solange problemlos, bis man versucht die Konfiguration abzuspeichern, den XML mag keine Steuerzeichen und Strg+Umsch+'-' ergibt #$001F (Unit Seperator). Weil der kleine Kerl unsichtbar bleibt ist das natürlich doppelt fies aber gut er ist nicht allein, die meisten Steuercodes im Bereich von $1 - $1f (mit den bekannten Ausnahmen) sind nicht so ganz XML-kompatibel.

Daher jetzt die Frage wie macht ihr das, wenn ihr XML als Dateiformat verwendet. Filtert ihr da einfach alle Eingaben direkt beim Edit-Feld?

Ich würde mir ja eine property wünschen, damit das Editfeld so was erst gar nicht annimmt?

[Stolle58]

Hallo,

ich würde das im OnKeyPress-Event filtern.

Delphi-Quellcode:

if Ord(Key) <= 31 then

[himitsu]

Hier klöppelt aber niemand manuell Strings zusammen, die sowas wie ein XML ergeben sollen,
oder wird hier doch eine XML-Komponente genutzt, und wenn ja, warum behandelt oder kodiert die sowas nicht?

Zitat:

Zitat von Stolle58 (Beitrag 1549931)

ich würde das im OnKeyPress-Event filtern.

Zum Glück kommt niemand auf so eine ungewöhnliche Idee Text einfach reinzukopieren. :duck:

[VoSs2o0o]

Ich hatte das gleiche Problem gestern in Java, und habe es via Regex gelöst:

Code:

line = line.replaceAll("[\\x{00}-\\x{1f}&&[^\\x{09}\\x{0A}\\x{0D}]]+", " ");

Bedeutet soviel wie: "greife alle Zeichen von x00-x1f außer x09,x0A,x0D und ersetze diese durch Leerzeichen.
Ich denke [<group>&&[^<group>]] muss man in Delphis Regex-Engine aber anders schreiben...

[Whookie]

Zitat:

Zitat von himitsu (Beitrag 1549938)

Hier klöppelt aber niemand manuell Strings zusammen, die sowas wie ein XML ergeben sollen,
oder wird hier doch eine XML-Komponente genutzt, und wenn ja, warum behandelt oder kodiert die sowas nicht?

Naja, "behandelt" wird das ja vom MSXML-Framework schon (mehr oder weniger). Das nennt sich Validation und führt zu ein Exception wenn so ein String einer Node zugewiesen wird.
Soweit ich das bisher herausgefunden habe gibt es dafür keine mitgelieferte Funktion, also führt dann wohl nichts um eine eigne Sanitize-Funktion herum.

Laut XML Spezifikation sollte das dann in RegEx etwa so aussehen [^\x09\x0A\x0D\x20-\uD7FF\uE000-\uFFFD] (was in Delphi natürlich nicht umsetzbar ist).

Daher habe ich mich für eine TStringBuilder - Lösung entschieden:

Delphi-Quellcode:

function SanitizeXML(const AValue: String): String;
var
  i: Integer;
  LChr: Char;
  LStrBldr: TStringBuilder;
begin
  LStrBldr := TStringBuilder.Create;
  try
    for i := 1 to Length(AValue) do
    begin
      LChr := AValue[i];
      if (LChr = #9) or (LChr = #10) or (LChr = #13) or
         ((LChr >= #32) and (LChr <= #$D7FF)) or
         ((LChr >= #$E000) and (LChr <= #$FFFD)) then
        LStrBldr.Append(LChr);
    end;
    Result := LStrBldr.ToString;
  finally
    LStrBldr.Free;
  end;
end;

Da ich damals das XML-Handling in einer eigenen XML-File Klasse verpackt habe, um einfach verschiedene XML-Libs zu testen, gibt es ohnehin nur zwei Stellen an denen eine Node.Value oder .Attribute zugewiesen wird und damit bin ich dann hoffentlich auf der sicheren Seite.

Gibt es dagegen bedenken oder etwas das noch schneller ist?

[TiGü]

Zitat:

Zitat von Whookie (Beitrag 1549947)

Gibt es dagegen bedenken oder etwas das noch schneller ist?

Vermute durch das Setzen der Capacity im Constructor kann man noch viel rausholen, der Rest ist eher just for fun:

Delphi-Quellcode:

function SanitizeXML(const AValue: String): String;
var
  i, Len: Integer;
  LChr: Char;
  LStrBldr: TStringBuilder;
begin
  Len := Length(AValue);
  LStrBldr := TStringBuilder.Create(Len);
  try
    for i := 1 to Len do
    begin
      LChr := AValue[i];
      case LChr of
        #9, #10, #13, #32..#$D7FF, #$E000..#$FFFD:
        LStrBldr.Append(LChr);
      end;
    end;
    Result := LStrBldr.ToString;
  finally
    LStrBldr.Free;
  end;
end;

[TiGü]

Na gut, es würde alles noch ein bisschen schneller gehen, wenn man bis zum Maximum optimiert:

Code:

Debug Output: Original TStringBuilder: 53,99 ms Process Project1.exe (27340)
Debug Output: Optimiert mit PChar: 48,4411 ms Process Project1.exe (27340)
Debug Output: Direkter Zugriff: 27,047 ms Process Project1.exe (27340)
Debug Output: Direkter Zugriff 2: 16,019 ms Process Project1.exe (27340)
Debug Output: Direkter Zugriff 3: 12,4765 ms Process Project1.exe (27340)

Delphi-Quellcode:

function SanitizeXML_Original(const AValue: String): String;
var
  i: Integer;
  LChr: Char;
  LStrBldr: TStringBuilder;
begin
  LStrBldr := TStringBuilder.Create;
  try
    for i := 1 to Length(AValue) do
    begin
      LChr := AValue[i];
      if (LChr = #9) or (LChr = #10) or (LChr = #13) or
         ((LChr >= #32) and (LChr <= #$D7FF)) or
         ((LChr >= #$E000) and (LChr <= #$FFFD)) then
        LStrBldr.Append(LChr);
    end;
    Result := LStrBldr.ToString;
  finally
    LStrBldr.Free;
  end;
end;

function SanitizeXML_PChar(const AValue: String): String;
var
  Src, SrcEnd: PChar;
  LStrBldr: TStringBuilder;
  C: Char;
begin
  LStrBldr := TStringBuilder.Create(Length(AValue));
  try
    Src := PChar(AValue);
    SrcEnd := Src + Length(AValue);
    while Src < SrcEnd do
    begin
      C := Src^;
      if (C = #9) or (C = #10) or (C = #13) or
         ((C >= #32) and (C <= #$D7FF)) or
         ((C >= #$E000) and (C <= #$FFFD)) then
        LStrBldr.Append(C);
      Inc(Src);
    end;
    Result := LStrBldr.ToString;
  finally
    LStrBldr.Free;
  end;
end;

function SanitizeXML_Direct(const AValue: String): String;
var
  Src: PChar;
  Dest: PChar;
  Len, i: Integer;
  C: Char;
begin
  Len := Length(AValue);
  SetLength(Result, Len);
  Src := PChar(AValue);
  Dest := PChar(Result);

  for i := 0 to Len - 1 do
  begin
    C := Src[i];
    if (C = #9) or (C = #10) or (C = #13) or
       ((C >= #32) and (C <= #$D7FF)) or
       ((C >= #$E000) and (C <= #$FFFD)) then
    begin
      Dest^ := C;
      Inc(Dest);
    end;
  end;

  SetLength(Result, Dest - PChar(Result));
end;

function SanitizeXML_Direct_2(const AValue: String): String;
var
  Src: PChar;
  Dest: PChar;
  Len, i: Integer;
  C: Char;
begin
  Len := Length(AValue);
  SetLength(Result, Len);
  Src := PChar(AValue);
  Dest := PChar(Result);

  for i := 0 to Len - 1 do
  begin
    C := Src[i];
    case C of
      #9, #10, #13, #32..#$D7FF, #$E000..#$FFFD:
      begin
        Dest^ := C;
        Inc(Dest);
      end;
    end;
  end;

  SetLength(Result, Dest - PChar(Result));
end;

function SanitizeXML_Direct_3(const AValue: String): String;
var
  Src, SrcEnd, Dest: PChar;
  Len: Integer;
begin
  Len := Length(AValue);
  SetLength(Result, Len);
  Src := PChar(AValue);
  Dest := PChar(Result);
  SrcEnd := Src + Len;

  while Src < SrcEnd do
  begin
    case Src^ of
      #9, #10, #13,
      #32..#$D7FF,
      #$E000..#$FFFD:
      begin
        Dest^ := Src^;
        Inc(Dest);
      end;
    end;
    Inc(Src);
  end;

  SetLength(Result, Dest - PChar(Result));
end;

procedure RunBenchmark;
const
  Iterations = 1000;
var
  i: Integer;
  InputStr, ResultStr1, ResultStr2, ResultStr3, ResultStr4, ResultStr5: String;
  SW: TStopwatch;
begin
  // Beispiel-XML mit gültigen/ungültigen Zeichen
  InputStr := StringOfChar('A', 10000) + #0 + #1 + #2 + #3 + #4 + #5 + #6 + #7 +#8 + #$FFFF + StringOfChar('B', 10000);

  // Original
  SW := TStopwatch.StartNew;
  for i := 1 to Iterations do
    ResultStr1 := SanitizeXML_Original(InputStr);
  SW.Stop;
  OutputDebugString(PChar('Original TStringBuilder: ' + SW.Elapsed.TotalMilliseconds.ToString + ' ms'));

  // PChar + TStringBuilder
  SW := TStopwatch.StartNew;
  for i := 1 to Iterations do
    ResultStr2 := SanitizeXML_PChar(InputStr);
  SW.Stop;
  OutputDebugString(PChar('Optimiert mit PChar: ' + SW.Elapsed.TotalMilliseconds.ToString + ' ms'));

  // Direkte Speicherzugriffe
  SW := TStopwatch.StartNew;
  for i := 1 to Iterations do
    ResultStr3 := SanitizeXML_Direct(InputStr);
  SW.Stop;
  OutputDebugString(PChar('Direkter Zugriff: ' + SW.Elapsed.TotalMilliseconds.ToString + ' ms'));

  // Direkte Speicherzugriffe mit case-of
  SW := TStopwatch.StartNew;
  for i := 1 to Iterations do
    ResultStr4 := SanitizeXML_Direct_2(InputStr);
  SW.Stop;
  OutputDebugString(PChar('Direkter Zugriff 2: ' + SW.Elapsed.TotalMilliseconds.ToString + ' ms'));

  // Direkte Speicherzugriffe mit while statt for und mit case-of
  SW := TStopwatch.StartNew;
  for i := 1 to Iterations do
    ResultStr5 := SanitizeXML_Direct_3(InputStr);
  SW.Stop;
  OutputDebugString(PChar('Direkter Zugriff 3: ' + SW.Elapsed.TotalMilliseconds.ToString + ' ms'));
end;

[Whookie]

Zitat:

Zitat von TiGü (Beitrag 1549954)

Na gut, es würde alles noch ein bisschen schneller gehen, wenn man bis zum Maximum optimiert:

:-D Klasse Sache, ich hab mit auch gerade eine Test-App dafür gebaut, direkt muss ja schneller sein!!! Super Sache :thumb:

[VoSs2o0o]

Habs nicht getestet, da hier kein Delphi verfügbar, aber

Delphi-Quellcode:

[^\x09\x0A\x0D\x20-\xD7FF\xE000-\xFFFD]

müsste dem entsprechen: Es gibt keine Unicode Option, aber das sollte Standardmäßig aktivert sein in Delphi. Einfach mal Testen....

[QuickAndDirty]

Zitat:

Zitat von TiGü (Beitrag 1549954)

Na gut, es würde alles noch ein bisschen schneller gehen, wenn man bis zum Maximum optimiert:

Ginge das hier auch???
Ab wann wäre es sinnvoll?

Delphi-Quellcode:

Function BL_GE(const x,y:Integer):Integer;Inline;
Begin
  Result := (x - y + 1) div (abs(x - y) + 1);
End;
Function BL_LE(const x,y:Integer):Integer;Inline;
Begin
  Result := BL_GE(y,x);
End;
Function BL_E(const x,y:Integer):Integer;Inline;
Begin
  Result := BL_GE(x, y) * BL_LE(x, y);
End;
Function BL_NE(const x,y:Integer):Integer;Inline;
Begin
  Result := 1 - BL_E(x,y);
End;
Function BL_L(const x,y:Integer):Integer;Inline;
Begin
  Result := 1 - BL_GE(x, y); // ODER BL_LE(x, y) - BL_E(x, y)
End;
Function BL_G(const x,y:Integer):Integer;Inline;
Begin
  Result := 1 - BL_LE(x, y); // ODER BL_GE(x, y) - BL_E(x, y)
End;
function SanitizeXML_Branchless(const AValue: String): String;
var
  Src, SrcEnd, Dest: PChar;
  Len, Keep: Integer;
  Ch: Integer;
begin
  Len := Length(AValue);
  SetLength(Result, Len);
  Src := PChar(AValue);
  Dest := PChar(Result);
  SrcEnd := Src + Len;

  while Src < SrcEnd do
  begin
    Ch := Ord(Src^);

    // Prüfen, ob das Zeichen in einem der gültigen Bereiche liegt.
    // Das Ergebnis ist 1 für gültige Zeichen, sonst 0.
    Keep := BL_E(Ch, 9) or         // #9
            BL_E(Ch, 10) or        // #10
            BL_E(Ch, 13) or        // #13
            (BL_GE(Ch, 32) and BL_LE(Ch, $D7FF)) or  // #32..#$D7FF
            (BL_GE(Ch, $E000) and BL_LE(Ch, $FFFD)); // #$E000..#$FFFD

    // Den Pointer nur dann erhöhen, wenn das Zeichen behalten wird.
    // Anstatt einer bedingten Anweisung (if Keep = 1) wird der Pointer
    // um den Wert von 'Keep' verschoben (entweder um 1 oder 0).
    Dest^ := Src^;
    Dest := Dest + Keep;

    Inc(Src);
  end;

  SetLength(Result, Dest - PChar(Result));
end;