* Added XML beautification

This commit is contained in:
Andreas Schneider 2015-09-17 20:54:21 +02:00
parent 6033ea1046
commit f1cf1e16b6
1 changed files with 40 additions and 7 deletions

View File

@ -26,7 +26,9 @@ uses
SysUtils, Classes, strutils, IniFiles,
{$ifdef use_synapse}httpsend, ssl_openssl,{$endif}
{$ifdef use_fclweb}fphttpclient,{$endif}
JTemplate, fpjson, jsonparser;
JTemplate,
fpjson, jsonparser,
DOM, XMLRead, XMLWrite;
var
data: TextFile;
@ -42,6 +44,9 @@ var
sessionIni: TIniFile;
beautify: Boolean;
type
TContentType = (ctOther, ctJSON, ctXML);
procedure CmdAskUser(AName: String);
var
value, default: String;
@ -88,6 +93,18 @@ begin
{$endif}
end;
function IdentifyContentType(AString: String; out ContentType: TContentType): Boolean;
begin
if Pos('application/json', AString) > 0 then
ContentType := ctJSON
else if Pos('application/xml', AString) > 0 then
ContentType := ctXML
else
ContentType := ctOther;
Result := (ContentType <> ctOther);
end;
procedure ProcessCall(AURL: String);
var
s: String;
@ -96,6 +113,8 @@ var
{$endif}
jsonParser: TJSONParser;
jsonData: TJSONData;
contentType: TContentType;
xmlDoc: TXMLDocument;
begin
parser.Content := AURL;
parser.Replace;
@ -171,13 +190,27 @@ begin
response.Position := 0;
if beautify and (Pos('application/json', http.GetHeader(http.ResponseHeaders, 'Content-Type')) > 0) then
if beautify and IdentifyContentType(http.GetHeader(http.ResponseHeaders, 'Content-Type'), contentType) then
begin
jsonParser := TJSONParser.Create(response);
jsonData := jsonParser.Parse;
writeln(jsonData.FormatJSON);
jsonData.Free;
jsonParser.Free;
case contentType of
ctJSON:
begin
jsonParser := TJSONParser.Create(response);
jsonData := jsonParser.Parse;
writeln(jsonData.FormatJSON);
jsonData.Free;
jsonParser.Free;
end;
ctXML:
begin
ReadXMLFile(xmlDoc, response);
response.Size := 0;
WriteXMLFile(xmlDoc, response);
response.Position := 0;
content.LoadFromStream(response);
writeln(content.Text);
end;
end;
end else
begin
content.LoadFromStream(response);