I have written a unit / component in Delphi which helps make it easy to write JSON data. I know there are already existing ways to do this, but the ways I've used are too awkward. I have used an XML writer in Delphi before (not sure exactly what one) but I liked the way it worked, and re-created a JSON version. It's very lightweight, and I'd like to know if I'm missing anything important.

PS - I know there is an unimplemented property LineBreak but that's to come later...

unit JsonBuilder;

interface

uses
  Windows, Classes;

type
  TJsonBuilder = class(TComponent)
  private
    FLines: TStringList;
    FIndent: Integer;
    FLineBreak: Boolean;
    FHierarchy: Integer;
    FNeedComma: Boolean;
    function GetLines: TStrings;
    procedure SetIndent(const Value: Integer);
    procedure SetLineBreak(const Value: Boolean);
    procedure SetLines(const Value: TStrings);
    function GetAsJSON: String;
    procedure SetAsJSON(const Value: String);
    procedure WriteLine(const S: String);
    procedure WriteStartProperty(const Name: String);
    procedure UpdateStat(const H: Integer; const C: Boolean);
    function GetIndent: String;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Clear;
    procedure WriteStartDoc;
    procedure WriteEndDoc;
    procedure WriteStartObject; overload;
    procedure WriteStartObject(const Name: String); overload;
    procedure WriteEndObject;
    procedure WriteStartArray; overload;
    procedure WriteStartArray(const Name: String); overload;
    procedure WriteEndArray;
    procedure WriteString(const Name, Value: String);
    procedure WriteInteger(const Name: String; const Value: Integer);
    procedure WriteBoolean(const Name: String; const Value: Boolean);
    procedure WriteDouble(const Name: String; const Value: Double);
    procedure WriteCurrency(const Name: String; const Value: Currency);
    procedure WriteStream(const Name: String; AStream: TStream);
    procedure WriteBreak;
    property AsJSON: String read GetAsJSON write SetAsJSON;
    property Lines: TStrings read GetLines write SetLines;
  published
    property Indent: Integer read FIndent write SetIndent;
    property LineBreak: Boolean read FLineBreak write SetLineBreak;
  end;

function JsonEncode(const S: String): String;
function Base64Encode(AStream: TStream; const LineBreaks: Boolean = False): string;

implementation

uses
  StrUtils, SysUtils;

const
  Base64Codes: array[0..63] of char =
    'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';

function Base64Encode(AStream: TStream; const LineBreaks: Boolean = False): string;
const
  dSize=57*100;//must be multiple of 3
var
  d:array[0..dSize-1] of byte;
  i,l:integer;
begin
  Result:='';
  l:=dSize;
  while l=dSize do
   begin
    l:=AStream.Read(d[0],dSize);
    i:=0;
    while i<l do
     begin
      if i+1=l then
        Result:=Result+
          Base64Codes[  d[i  ] shr  2]+
          Base64Codes[((d[i  ] and $3) shl 4)]+
          '=='
      else if i+2=l then
        Result:=Result+
          Base64Codes[  d[i  ] shr  2]+
          Base64Codes[((d[i  ] and $3) shl 4) or (d[i+1] shr 4)]+
          Base64Codes[((d[i+1] and $F) shl 2)]+
          '='
      else
        Result:=Result+
          Base64Codes[  d[i  ] shr  2]+
          Base64Codes[((d[i  ] and $3) shl 4) or (d[i+1] shr 4)]+
          Base64Codes[((d[i+1] and $F) shl 2) or (d[i+2] shr 6)]+
          Base64Codes[  d[i+2] and $3F];
      inc(i,3);
      if LineBreaks then
        if ((i mod 57)=0) then Result:=Result+#13#10;
     end;
   end;
end;

function JsonEncode(const S: String): String;
var
  X: Integer;
  C: Char;
  procedure Repl(const Val: String);
  begin
    Delete(Result, X, 1);
    Insert(Val, Result, X);
  end;
begin
  Result:= StringReplace(S, '\', '\\', [rfReplaceAll]);
  Result:= StringReplace(Result, '"', '\"', [rfReplaceAll]);
  Result:= StringReplace(Result, '/', '\/', [rfReplaceAll]);
  for X := Length(Result) downto 1 do begin
    C:= Result[X];
    if C = #10 then Repl('\'+#10);
    if C = #13 then Repl('\'+#13);
  end;
end;

{ TJsonBuilder }

constructor TJsonBuilder.Create(AOwner: TComponent);
begin
  inherited;
  FLines:= TStringList.Create;
  FHierarchy:= 0;
  FIndent:= 4;
  FLineBreak:= True;
  FNeedComma:= False;
end;

destructor TJsonBuilder.Destroy;
begin
  FLines.Free;
  inherited;
end;

procedure TJsonBuilder.Clear;
begin
  FLines.Clear;
end;

procedure TJsonBuilder.SetIndent(const Value: Integer);
begin
  FIndent := Value;
  if FIndent < 0 then FIndent:= 0;
end;

procedure TJsonBuilder.SetLineBreak(const Value: Boolean);
begin
  FLineBreak := Value;
end;

function TJsonBuilder.GetLines: TStrings;
begin
  Result:= TStrings(FLines);
end;

procedure TJsonBuilder.SetLines(const Value: TStrings);
begin
  FLines.Assign(Value);
end;

procedure TJsonBuilder.UpdateStat(const H: Integer; const C: Boolean);
begin
  FHierarchy:= FHierarchy + H;
  FNeedComma:= C;
end;

function TJsonBuilder.GetIndent: String;
var
  X: Integer;
  Y: Integer;
begin
  Result:= '';
  for X := 1 to FHierarchy do
    for Y := 1 to FIndent do
      Result:= Result + ' ';
end;

procedure TJsonBuilder.WriteLine(const S: String);
var
  T: String;
begin
  if FNeedComma then begin
    //Add comma to prior line
    T:= FLines[FLines.Count-1];
    T:= T + ',';
    FLines[FLines.Count-1]:= T;
  end;
  FLines.Add(GetIndent+S);
end;

procedure TJsonBuilder.WriteStartDoc;
begin
  WriteStartObject;
end;

procedure TJsonBuilder.WriteEndDoc;
begin
  WriteEndObject;
end;

procedure TJsonBuilder.WriteStartObject;
begin
  WriteLine('{');
  UpdateStat(1, False);
end;

procedure TJsonBuilder.WriteStartObject(const Name: String);
begin
  WriteStartProperty(Name);
  WriteStartObject;
end;

procedure TJsonBuilder.WriteEndObject;
begin
  UpdateStat(-1, False);
  WriteLine('}');
  UpdateStat(0, True);
end;

procedure TJsonBuilder.WriteStartArray;
begin
  WriteLine('[');
  UpdateStat(1, False);
end;

procedure TJsonBuilder.WriteStartArray(const Name: String);
begin
  WriteStartProperty(Name);
  WriteStartArray;
end;

procedure TJsonBuilder.WriteEndArray;
begin
  UpdateStat(-1, False);
  WriteLine(']');
  UpdateStat(0, True);
end;

procedure TJsonBuilder.WriteStartProperty(const Name: String);
begin
  WriteLine('"'+Name+'" :');
  UpdateStat(0, False);
end;

procedure TJsonBuilder.WriteInteger(const Name: String; const Value: Integer);
begin
  WriteLine('"'+Name+'" : '+IntToStr(Value));
  UpdateStat(0, True);
end;

procedure TJsonBuilder.WriteStream(const Name: String; AStream: TStream);
var
  S: String;
begin
  S:= Base64Encode(AStream);
  WriteLine('"'+Name+'" : "'+S+'"');
  UpdateStat(0, True);
end;

procedure TJsonBuilder.WriteString(const Name, Value: String);
begin
  WriteLine('"'+Name+'" : "'+JsonEncode(Value)+'"');
  UpdateStat(0, True);
end;

procedure TJsonBuilder.WriteBoolean(const Name: String; const Value: Boolean);
begin
  WriteLine('"'+Name+'" : '+IfThen(Value, 'true', 'false'));
  UpdateStat(0, True);
end;

procedure TJsonBuilder.WriteBreak;
begin
  WriteLine('');
  UpdateStat(0, False);
end;

procedure TJsonBuilder.WriteCurrency(const Name: String; const Value: Currency);
begin
  WriteLine('"'+Name+'" : '+FormatFloat('0.#', Value));
  UpdateStat(0, True);
end;

procedure TJsonBuilder.WriteDouble(const Name: String; const Value: Double);
begin
  WriteLine('"'+Name+'" : '+FormatFloat('0.#', Value));
  UpdateStat(0, True);
end;

function TJsonBuilder.GetAsJSON: String;
begin
  Result:= FLines.Text;
end;

procedure TJsonBuilder.SetAsJSON(const Value: String);
begin
  FLines.Text:= Value;
end;

end.

Implementation of this object is like so...

function GetSomething: String;
var
  JB: TJsonBuilder;
  X: Integer;
begin
  JB:= TJsonBuilder.Create(nil);
  try
    JB.WriteStartDoc;
    JB.WriteStartObject('some_object_name');
    JB.WriteString('prop_name', 'Property Value');
    JB.WriteInteger('another_prop', 123);
    JB.WriteStartArray('items');
    for X := 1 to 5 do begin
      JB.WriteStartObject;
      JB.WriteString('some_item_name', 'Item '+IntToStr(X));
      JB.WriteCurrency('item_price', 19.99 * X);
      JB.WriteEndObject;
    end;
    JB.WriteEndArray;
    JB.WriteEndObject;
    JB.WriteEndDoc;
    Result:= JB.AsJSON;
  finally
    JB.Free;
  end;
end;

This outputs the following JSON text:

{
    "some_object_name" :
    {
        "prop_name" : "Property Value",
        "another_prop" : 123,
        "items" :
        [
            {
                "some_item_name" : "Item 1",
                "item_price" : 20
            },
            {
                "some_item_name" : "Item 2",
                "item_price" : 40
            },
            {
                "some_item_name" : "Item 3",
                "item_price" : 60
            },
            {
                "some_item_name" : "Item 4",
                "item_price" : 80
            },
            {
                "some_item_name" : "Item 5",
                "item_price" : 100
            }
        ]
    }
}
  • This seems an awfully complex way to build JSON... Granted, i don't know Delphi, so this may just be how y'all like it. But to me, it looks almost more complicated than doing the JSON generation yourself. – cHao Jul 4 '13 at 3:43
  • @cHao When it comes to small and simple JSON structures, it's simple to use raw string concatenation. But when it comes to larger complex JSON structures, raw concatenation becomes overwhelming. – Jerry Dodge Jul 4 '13 at 4:00
  • 19.99 became 20 – CodesInChaos Nov 5 '13 at 16:27
up vote 1 down vote accepted

It is rather verbose and complicated and it doesn't seem to really allow per your conventions for valid structures like [{"name":"bob"},{"name":"ted"}] (although that may appear to me that way because I just skimmed through it), and property names do need to be proper JSON strings... but if it works for you, you'll hear no arguments from me!

Actually I gave it more than just a skim.

You're doing something weird with your control characters. You can't just put a slash in front of them to escape. The character represented by "\r" -- I think in your code represented by #10, but I always forget which of \r and \n is char(10) and char(13) -- literally needs to have \r in the JSON encoding, most certainly not {the actual contol character! That breaks strings!!

(Please See the http://json.org side panel).

char
any-Unicode-character-
    except-"-or-\-or-
    control-character
\"
\\
\/
\b
\f
\n
\r
\t
\u four-hex-digits

To encode for JSON, you really don't have to do much, but what you do you ought to make the best effort to do correctly!!

Over all, I find your code needlessly verbose to be used regularly. It might work fine for some code automatically generated, though, once you fix the string encoding and any other possible encoding issues.

Your Answer

 

By clicking "Post Your Answer", you acknowledge that you have read our updated terms of service, privacy policy and cookie policy, and that your continued use of the website is subject to these policies.

Not the answer you're looking for? Browse other questions tagged or ask your own question.