Author Archives: Jon Lennart

When talking to your REST server or nodeJS service, it can sometimes be overkill to ship a huge and complex wad of JSON or XML over the wire. I noticed that WebSocket transferes can sometimes get a tiny delay if the server is dealing with high payloads. Although we are talking milliseconds here, it’s always good to refactor and make things as small as possible.

The solution I came up with is essentially a dynamically created “record”. Where you would normally write:

type
  TMyData = record
    field1: String;
    field2: TDateTime;
    field3: Integer;
  end;

TW3Structure allows you to do this programatically, both for binary and JSON. Which can be handy when playing around with your own protocols. So with TW3Structure you can do stuff like:

var Structure := TW3JsonStructure.Create(null);
Structure.WriteString('field1','some value');
Structure.WriteDateTime('field1',Now);
Structure.WriteInt('field2',1200);

var JSONData:String;
Structure.SaveToJSON(JSONData);

WebSocket.Send(JSONData);

I also added support for TStream which does the exact same thing, but in true binary form. Perfect for storing simple data in the browser cache or your mobile device’s sandbox.

unit system.namepair;

interface

uses
  System.types,
  System.streams,
  SmartCL.System;

type

  EW3Structure = class(EW3Exception);
  TW3Structure = Class(TObject)
  public
    procedure   WriteString(name:string;value:String;
                const encode:Boolean);overload;
    procedure   WriteInt(name:string;Value:Integer);overload;
    procedure   WriteBool(name:string;value:Boolean);overload;
    procedure   WriteFloat(name:String;value:Float);overload;
    procedure   WriteDateTime(name:String;value:TDateTime);overload;

    procedure   Write(name:String;value:variant);overload;virtual;abstract;

    procedure   Clear;virtual;abstract;

    procedure   SaveToJSON(var Data:String);virtual;abstract;
    procedure   LoadFromJSON(Value:String);virtual;abstract;

    procedure   SaveToStream(Stream:TStream);virtual;abstract;
    procedure   LoadFromStream(Stream:TStream);virtual;abstract;
  end;

  TW3JsonStructure = Class(TW3Structure)
  private
    FBuffer:  Variant;
  public
    procedure   Clear;override;
    procedure   SaveToJson(var Data:String);override;
    procedure   LoadFromJson(Value:String);override;
    procedure   SaveToStream(Stream:TStream);override;
    procedure   LoadFromStream(Stream:TStream);override;

    procedure   Write(name:String;value:variant);overload;override;
    Constructor Create(const Data:Variant);virtual;
  end;


  TW3BinProxyItem = Record
    daName:   String;
    daValue:  Variant;
  end;

  TW3BinaryStructure = Class(TW3Structure)
  private
    FData:      Array of TW3BinProxyItem;
    function    IndexOfName(name:String):Integer;
  protected
    procedure   Clear;override;
    procedure   SaveToJson(var Data:String);override;
    procedure   LoadFromJson(Value:String);override;
    procedure   SaveToStream(Stream:TStream);override;
    procedure   LoadFromStream(Stream:TStream);override;
    procedure   Write(name:String;value:variant);overload;override;
  end;


implementation

resourcestring

CNT_ERR_STRUCTURE_FUNCTION  =
'Stream storage failed, structure contains function reference error';

CNT_ERR_STRUCTURE_SYMBOL  =
'Stream storage failed, structure contains symbol reference error';

CNT_ERR_STRUCTURE_UNKNOWN =
'Stream storage failed, structure contains uknown data-type error';

CNT_ERR_STRUCTURE_FAILEDREAD =
'Failed to read structure, invalid datatype error';

CNT_ERR_STRUCTURE_INVALIDSIGN =
'Failed to read structure, invalid data signature error';

//############################################################################
// TW3BinaryStructure
//###########################################################################

const
CNT_STRUCT_SIGNATURE  = $CCCCFF00;

function TW3BinaryStructure.IndexOfName(name:String):Integer;
var
  x:  Integer;
begin
  result:=-1;
  if FData.Count>0 then
  for x:=FData.low to FData.high do
  begin
    if Sametext(Fdata[x].daName,Name) then
    begin
      result:=x;
      break;
    end;
  end;
end;

procedure TW3BinaryStructure.Write(name:String;value:variant);
var
  mIndex: Integer;
  mItem:  TW3BinProxyItem;
Begin
  mIndex:=IndexOfName(name);
  if mIndex<0 then
  begin
    mItem.daName:=name;
    mItem.daValue:=Value;
    FData.add(mItem);
  end else
  FData[mIndex].daValue:=Value;
end;

procedure TW3BinaryStructure.Clear;
Begin
  FData.Clear;
end;

procedure TW3BinaryStructure.SaveToJson(var Data:String);
Begin
  asm
    @Data = json.stringify( (@self.FData) );
  end;
end;

procedure TW3BinaryStructure.LoadFromJson(Value:String);
Begin
  asm
    (@self.FData) = json.parse(@Value);
  end;
end;

procedure TW3BinaryStructure.SaveToStream(Stream:TStream);
var
  x:  Integer;
  mWriter:  TWriter;
Begin
  mWriter:=TWriter.Create(Stream);
  try
    mWriter.WriteInteger(CNT_STRUCT_SIGNATURE);
    mWriter.WriteInteger(FData.Count);
    if FData.Count>0 then
    begin
      for x:=0 to FData.Count-1 do
      begin
        /* Write the name */
        mWriter.WriteString(FData[x].daName);

        /* Write the datatype */
        mWriter.WriteInteger(ord(FData[x].daValue.datatype));

        /* Write the value */
        case FData[x].daValue.datatype of
        vdBoolean:
          begin
            mWriter.WriteBoolean(FData[x].daValue);
          end;
        vdInteger:
          begin
            mWriter.WriteInteger(FData[x].daValue);
          end;
        vdFloat:
          begin
            mWriter.WriteDouble(FData[x].daValue);
          end;
        vdString:
          begin
            mWriter.WriteString(FData[x].daValue);
          end;
        vdFunction:
          begin
            Raise EW3Structure.Create(CNT_ERR_STRUCTURE_FUNCTION);
          end;
        vdSymbol:
          begin
            Raise EW3Structure.Create(CNT_ERR_STRUCTURE_SYMBOL);
          end;
        vdUnknown:
          begin
            Raise EW3Structure.Create(CNT_ERR_STRUCTURE_UNKNOWN);
          end;
        end;
      end;
    end;
  finally
    mWriter.free;
  end;
end;

procedure TW3BinaryStructure.LoadFromStream(Stream:TStream);
var
  mCount:   Integer;
  mReader:  TReader;
  mKind:    Integer;
  mRec:     TW3BinProxyItem;
Begin
  Clear;
  mReader:=TReader.Create(Stream);
  try
    if mReader.ReadInteger = CNT_STRUCT_SIGNATURE then
    begin
      mCount:=mReader.ReadInteger;
      while mCount>0 do
      begin
        mRec.daName:=mReader.ReadString;
        mKind:=mReader.ReadInteger;
        case TW3VariantDataType(mKind) of
        vdBoolean:  mRec.daValue:=mReader.ReadBoolean;
        vdInteger:  mRec.daValue:=mReader.ReadInteger;
        vdFloat:    mRec.daValue:=mReader.ReadDouble;
        vdString:   mRec.daValue:=mReader.ReadString;
        else
          Raise EW3Structure.Create(CNT_ERR_STRUCTURE_FAILEDREAD);
        end;

        FData.add(mRec);
        mRec.daName:="";
        mRec.daValue:=null;

        dec(mCount);
      end;
    end else
    Raise EW3Structure.Create(CNT_ERR_STRUCTURE_INVALIDSIGN);
  finally
    mReader.free;
  end;
end;

//############################################################################
// TW3Structure
//###########################################################################

procedure TW3Structure.WriteString(name:string;
          value:String;const encode:Boolean);
begin
  (* base64 encode string to avoid possible recursion
     should someone store another JSON object as a string *)
  if encode then
  Begin
    asm
      @value = btoa(@value);
    end;
  end;
  Write(name,value);
end;

procedure TW3Structure.WriteInt(name:string;Value:Integer);
begin
  Write(name,value);
end;

procedure TW3Structure.WriteBool(name:string;value:Boolean);
begin
  Write(name,value);
end;

procedure TW3Structure.WriteFloat(name:String;value:Float);
begin
  Write(name,value);
end;

procedure TW3Structure.WriteDateTime(name:String;value:TDateTime);
begin
  Write(name,value);
end;

//############################################################################
// TW3JsonStructure
//###########################################################################

Constructor TW3JsonStructure.Create(const Data:Variant);
begin
  inherited Create;
  if not TVariant.IsNull(Data)
  and not Data.IsUnassigned then
  FBuffer:=Data else
  FBuffer:=TVariant.CreateObject;
end;

procedure TW3JsonStructure.SaveToJSON(var Data:String);
begin
  if (FBuffer<>unassigned)
  and (FBuffer<>NULL) then
  Data:=JSON.Stringify(FBuffer) else
  Data:=null;
end;

procedure TW3JsonStructure.LoadFromJSON(Value:String);
begin
  value:=trim(Value);
  if value.length>0 then
  FBuffer:=JSON.Parse(value) else
  FBuffer:=TVariant.CreateObject;
end;

procedure TW3JsonStructure.SaveToStream(Stream:TStream);
var
  mWriter:  TWriter;
  mtext:    String;
begin
  SaveToJSON(mText);
  mWriter:=TWriter.Create(Stream);
  try
    mWriter.writeString(mText);
  finally
    mWriter.free;
  end;
end;

procedure TW3JsonStructure.LoadFromStream(Stream:TStream);
var
  mText:    String;
  mReader:  TReader;
begin
  mReader:=TReader.Create(stream);
  try
    mText:=mReader.ReadString;
  finally
    mReader.free;
  end;
  LoadFromJSON(mtext);
end;

procedure TW3JsonStructure.Clear;
begin
  FBuffer:=TVariant.CreateObject;
end;

procedure TW3JsonStructure.Write(name:String;value:variant);
begin
  FBuffer[name]:=value;
end;

end.