XML Fehler

[Koma-Code]

Hi,

ich habe dafür zwei funktionen geschrieben. Die erste überprüft den eingehenden String auf die richtige syntax. Die Zweite löscht die Fehlerstelle.

Die Lösung ist aber ziemlich speziell ...

Delphi-Quellcode:

  XMLString:= FixXML (XMLString);

  oXMLDoc.loadXML(XMLString);

  while oXMLDoc.parseError.errorCode <> 0 Do
   begin
    XMLString:= FixXMLDel (XMLString, oXMLDoc.parseError.line, oXMLDoc.parseError.linepos);
    oXMLDoc.loadXML(XMLString);
   end;

und die Funktionen sind:

Delphi-Quellcode:

function FixXMLDel (Str : String; Line: Integer; Pos : Integer) : String;
var
 SL : TStringList;
 temp : String;

begin
 SL := TStringList.Create;
 SL.Text  := Str;

 temp := SL.Strings[line-1];
 Delete (temp, Pos-1, 1);
 SL.Strings[line-1] := temp;

 Result := SL.Text;
 SL.Free;
end;

function CheckStr (Str : String) : Boolean;
 var
  e, Opened, Closed : Integer;
begin
 Opened := 0;
 Closed := 0;
 e := 1;

 While e <= length (Str) Do
  begin
   {If Str[e] = '&' then
    begin
     Delete (Str, e, 1);
     If (Str[e-1] = ' ') and (Str[e] = ' ') then
      Delete (Str, e-1, 1);
    end;   }

   If Str[e] = '<' then Opened := Opened + 1;
   If Str[e] = '>' then Closed := Closed + 1;
   e := e + 1;
  end;

 Result := Opened <> Closed;
end;

function RepairStr (Str : String) : String;
var
  e, Opened, Closed : Integer;
  Finished : Boolean;
begin
 Opened := 0;
 Closed := 0;

 For e := 1 To length (Str) Do
  begin
   If Str[e] = '<' then Opened := Opened + 1;
   If Str[e] = '>' then Closed := Closed + 1;
  end;

 Finished := false;
 if Opened < Closed then
  begin
   for e := 1 To Trunc(length (Str)/2) Do
    begin
     if not Finished then
      begin
       if Str[e] = '>' then
        begin
         Insert ('<', Str, length(Str)-e+2);
         if Str[length(Str)-e+1] = '?' then Delete (Str, length(Str)-e+1, 1);
         if Str[length(Str)-e+3] <> '/' then Insert ('/', Str, length(Str)-e+3);
         Finished := true;
        end;

        if Str[1] <> '<' then
         begin
          Insert ('<', Str, 1);
          Finished := True;
         end;
      end;
   end
  end
  else
  begin
   for e := 1 To Trunc(length (Str)/2) Do
    begin
     if not Finished then
      begin
       if Str[length(Str)-e+1] = '<' then
        begin
         Insert ('>', Str, e);
         Finished := true;
        end;

        if Str[length(Str)] <> '<' then
         begin
          Insert ('>', Str, length(Str));
          Finished := True;
         end;
      end;
   end
  end;
 end;

function FixXML (Str : String) : String;
var
 SL : TStringList;
 e : Integer;

begin
 SL := TStringList.Create;
 SL.Text  := Str;

 For e:= 0 To SL.Count-1 Do
  begin
   if CheckStr (SL.Strings[e]) then
    SL.Strings[e] := RepairStr(SL.Strings[e]);
  end;
 Result := SL.Text;
 SL.Free;
end;