paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-06 12:40:22 +02:00
Code Issues Packages Projects Releases Wiki Activity

laz2_dom: added XmlValueToStr

Browse Source 
git-svn-id: trunk@36348 -
This commit is contained in:
mattias 2012-03-26 18:14:23 +00:00
parent 861c143774
commit d5b401577b
2 changed files with 91 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

75
components/lazutils/laz2_dom.pas
View File

@ -854,7 +854,8 @@ const
stduri_xml: DOMString = 'http://www.w3.org/XML/1998/namespace';
stduri_xmlns: DOMString = 'http://www.w3.org/2000/xmlns/';
function StrToXMLValue(const s: string): string;
function StrToXMLValue(const s: string): string; // removes #0
function XMLValueToStr(const s: string): string; // reverse of StrToXMLValue (except for invalid #0)
function EncodeLesserAndGreaterThan(const s: string): string;
// =======================================================
@ -924,6 +925,78 @@ begin
Convert(PChar(Result),NewLen);
end;
function XMLValueToStr(const s: string): string;
// convert &amp &quot &apos &lt &gt
var
Src: PChar;
Dst: PChar;
begin
if Pos('&',s)<1 then exit(s);
SetLength(Result,length(s));
Src:=PChar(s);
Dst:=PChar(Result);
repeat
case Src^ of
#0:
if Src-PChar(s)=length(s) then
break
else
inc(Src);
'&':
begin
inc(Src);
case Src^ of
'a':
if (Src[1]='m') and (Src[2]='p') then begin
inc(Src,3);
if Src^=';' then inc(Src);
Dst^:='&';
inc(Dst);
continue;
end else if (Src[1]='p') and (Src[2]='o') and (Src[3]='s') then begin
inc(Src,4);
if Src^=';' then inc(Src);
Dst^:='''';
inc(Dst);
continue;
end;
'q':
if (Src[1]='u') and (Src[2]='o') and (Src[3]='t') then begin
inc(Src,4);
if Src^=';' then inc(Src);
Dst^:='"';
inc(Dst);
continue;
end;
'l':
if (Src[1]='t') then begin
inc(Src,2);
if Src^=';' then inc(Src);
Dst^:='<';
inc(Dst);
continue;
end;
'g':
if (Src[1]='t') then begin
inc(Src,2);
if Src^=';' then inc(Src);
Dst^:='>';
inc(Dst);
continue;
end;
end;
Dst^:='&';
inc(Dst);
end;
else
Dst^:=Src^;
inc(Src);
inc(Dst);
end;
until false;
SetLength(Result,Dst-PChar(Result));
end;
function EncodeLesserAndGreaterThan(const s: string): string;
function Convert(Dst: PChar; out NewLen: PtrUInt): boolean;

18
test/lazutils/testlazxml.pas
View File

@ -4,6 +4,7 @@
Test specific with:
./runtests --format=plain --suite=TestStrToXMLValue
./runtests --format=plain --suite=TestXMLValueToStr
}
unit TestLazXML;
@ -22,6 +23,7 @@ type
public
published
procedure TestStrToXMLValue;
procedure TestXMLValueToStr;
end;
implementation
@ -39,7 +41,21 @@ begin
AssertEquals('String with ''','&apos;',StrToXMLValue(''''));
AssertEquals('String with "','&quot;',StrToXMLValue('"'));
AssertEquals('String mix 1','&lt;a&gt;&quot;',StrToXMLValue('<a>'#0'"'));
AssertEquals('String mix 1','abc',StrToXMLValue('abc'));
AssertEquals('String mix 2','abc',StrToXMLValue('abc'));
end;
procedure TTestLazXML.TestXMLValueToStr;
begin
AssertEquals('Empty string','',XMLValueToStr(''));
AssertEquals('Short string','a',XMLValueToStr('a'));
AssertEquals('Short string',#0,XMLValueToStr(#0));
AssertEquals('String with &','&',XMLValueToStr('&amp;'));
AssertEquals('String with <','<',XMLValueToStr('&lt;'));
AssertEquals('String with >','>',XMLValueToStr('&gt;'));
AssertEquals('String with ''','''',XMLValueToStr('&apos;'));
AssertEquals('String with "','"',XMLValueToStr('&quot;'));
AssertEquals('String mix 1','<a>"',XMLValueToStr('&lt;a&gt;&quot;'));
AssertEquals('String mix 2','abc',XMLValueToStr('abc'));
end;
initialization