A Delphi propertybag

A long, long time ago, way back in the previous century, I often had to adjust a Visual Basic project my company maintained. Going from object-pascal to VB was more than a little debilitating; Visual Basic was not a compiled language like Delphi is, and it lacked more or less every feature you needed to produce good software.

I could probably make a VB clone using Delphi pretty easily. But I think the world has experienced enough suffering, no need to add more evil to the universe

Having said that, I have always been a huge fan of Basic (it was my first language after all, it’s what schools taught in the 70s and 80s). I think it was a terrible mistake for Microsoft to retire Basic as a language, because it’s a great way to teach kids the fundamentals of programming.

Visual Basic is still there though, available for the .Net framework, but to call it Basic is an insult of the likes of GFA Basic, Amos Basic and Blitz Basic; the mighty compilers of the past. If you enjoyed basic before Microsoft pushed out the monstrosity that is Visual Basic, then perhaps swing by GitHub and pick up a copy of BlitzBasic?  BlitzBasic is a completely different beast. It compiles to machine-code, allows inline assembly, and has been wildly popular for game developers over the years.

A property bag

The only feature that I found somewhat useful in Visual Basic, was an object called a propertybag. It’s just a fancy name for a dictionary, but it had a couple of redeeming factors beyond lookup ability. Like being able to load name-value-pairs from a string, recognizing datatypes and exposing type-aware read/write methods. Nothing fancy but handy when dealing with database connection-strings, shell parameters and the like.

So you could feed it strings like this:

first=12;second=hello there;third=3.14

And the class would parse out the names and values, stuff it in a dictionary, and you could easily extract the data you needed. Nothing fancy, but handy on rare occasions.

A Delphi version

Im mostly porting code from Delphi to Oxygene these days, but here is my Delphi implementation of the propertybag object. Please note that I haven’t bothered to implement the propertybag available in .Net. The Delphi version below is based on the Visual Basic 6 version, with some dependency injection thrown in for good measure.

unit fslib.params;

interface

{.$DEFINE SUPPORT_URI_ENCODING}

uses
  System.SysUtils,
  System.Classes,
  Generics.Collections;

type

  (* Exceptions *)
  EPropertybag           = class(exception);
  EPropertybagReadError  = class(EPropertybag);
  EPropertybagWriteError = class(EPropertybag);
  EPropertybagParseError = class(EPropertybag);

  (* Datatypes *)
  TPropertyBagDictionary = TDictionary ;

  IPropertyElement = interface
    ['{C6C937DF-50FA-4984-BA6F-EBB0B367D3F3}']
    function  GetAsInt: integer;
    procedure SetAsInt(const Value: integer);

    function  GetAsString: string;
    procedure SetAsString(const Value: string);

    function  GetAsBool: boolean;
    procedure SetAsBool(const Value: boolean);

    function  GetAsFloat: double;
    procedure SetAsFloat(const Value: double);

    function  GetEmpty: boolean;

    property Empty: boolean read GetEmpty;
    property AsFloat: double read GetAsFloat write SetAsFloat;
    property AsBoolean: boolean read GetAsBool write SetAsBool;
    property AsInteger: integer read GetAsInt write SetAsInt;
    property AsString: string read GetAsString write SetAsString;
  end;

  TPropertyBag = Class(TInterfacedObject)
  strict private
    FLUT:       TPropertyBagDictionary;
  strict protected
    procedure   Parse(NameValuePairs: string);
  public
    function    Read(Name: string): IPropertyElement;
    function    Write(Name: string; Value: string): IPropertyElement;

    procedure   SaveToStream(const Stream: TStream);
    procedure   LoadFromStream(const Stream: TStream);
    function    ToString: string; override;
    procedure   Clear; virtual;

    constructor Create(NameValuePairs: string); virtual;
    destructor  Destroy; override;
  end;

implementation

{$IFDEF SUPPORT_URI_ENCODING}
uses
  system.NetEncoding;
{$ENDIF}

const
  cnt_err_sourceparameters_parse =
  'Failed to parse input, invalid or damaged text error [%s]';

  cnt_err_sourceparameters_write_id =
  'Write failed, invalid or empty identifier error';

  cnt_err_sourceparameters_read_id =
  'Read failed, invalid or empty identifier error';

type

  TPropertyElement = class(TInterfacedObject, IPropertyElement)
  strict private
    FName:      string;
    FData:      string;
    FStorage:   TPropertyBagDictionary;
  strict protected
    function    GetEmpty: boolean; inline;

    function    GetAsInt: integer; inline;
    procedure   SetAsInt(const Value: integer); inline;

    function    GetAsString: string; inline;
    procedure   SetAsString(const Value: string); inline;

    function    GetAsBool: boolean; inline;
    procedure   SetAsBool(const Value: boolean); inline;

    function    GetAsFloat: double; inline;
    procedure   SetAsFloat(const Value: double); inline;

  public
    property    AsFloat: double read GetAsFloat write SetAsFloat;
    property    AsBoolean: boolean read GetAsBool write SetAsBool;
    property    AsInteger: integer read GetAsInt write SetAsInt;
    property    AsString: string read GetAsString write SetAsString;
    property    Empty: boolean read GetEmpty;

    constructor Create(const Storage: TPropertyBagDictionary; Name: string; Data: string); overload; virtual;
    constructor Create(Data: string); overload; virtual;
  end;

//#############################################################################
// TPropertyElement
//#############################################################################

constructor TPropertyElement.Create(Data: string);
begin
  inherited Create;
  FData := Data.Trim();
end;

constructor TPropertyElement.Create(const Storage: TPropertyBagDictionary;
  Name: string; Data: string);
begin
  inherited Create;
  FStorage := Storage;
  FName := Name.Trim().ToLower();
  FData := Data.Trim();
end;

function TPropertyElement.GetEmpty: boolean;
begin
  result := FData.Length < 1;
end;

function TPropertyElement.GetAsString: string;
begin
  result := FData;
end;

procedure TPropertyElement.SetAsString(const Value: string);
begin
  if Value  FData then
  begin
    FData := Value;
    if FName.Length > 0 then
    begin
      if FStorage  nil then
        FStorage.AddOrSetValue(FName, Value);
    end;
  end;
end;

function TPropertyElement.GetAsBool: boolean;
begin
  TryStrToBool(FData, result);
end;

procedure TPropertyElement.SetAsBool(const Value: boolean);
begin
  FData := BoolToStr(Value, true);

  if FName.Length > 0 then
  begin
    if FStorage  nil then
      FStorage.AddOrSetValue(FName, FData);
  end;
end;

function TPropertyElement.GetAsFloat: double;
begin
  TryStrToFloat(FData, result);
end;

procedure TPropertyElement.SetAsFloat(const Value: double);
begin
  FData := FloatToStr(Value);
  if FName.Length > 0 then
  begin
    if FStorage  nil then
      FStorage.AddOrSetValue(FName, FData);
  end;
end;

function TPropertyElement.GetAsInt: integer;
begin
  TryStrToInt(FData, Result);
end;

procedure TPropertyElement.SetAsInt(const Value: integer);
begin
  FData := IntToStr(Value);
  if FName.Length > 0 then
  begin
    if FStorage  nil then
      FStorage.AddOrSetValue(FName, FData);
  end;
end;

//#############################################################################
// TPropertyBag
//#############################################################################

constructor TPropertyBag.Create(NameValuePairs: string);

begin
  inherited Create;
  FLUT := TDictionary.Create();

  NameValuePairs := NameValuePairs.Trim();
  if NameValuePairs.Length > 0 then
    Parse(NameValuePairs);
end;

destructor TPropertyBag.Destroy;
begin
  FLut.Free;
  inherited;
end;

procedure TPropertyBag.Clear;
begin
  FLut.Clear;
end;

procedure TPropertyBag.Parse(NameValuePairs: string);
var
  LList:      TStringList;
  x:          integer;
  LId:        string;
  LValue:     string;
  LOriginal:  string;
  {$IFDEF SUPPORT_URI_ENCODING}
  LPos:       integer;
  {$ENDIF}
begin
  // Reset content
  FLUT.Clear();

  // Make a copy of the original text
  LOriginal := NameValuePairs;

  // Trim and prepare
  NameValuePairs := NameValuePairs.Trim();

  // Anything to work with?
  if NameValuePairs.Length > 0 then
  begin
    {$IFDEF SUPPORT_URI_ENCODING}
    // Check if the data is URL-encoded
    LPos := pos('%', NameValuePairs);
    if  (LPos >= low(NameValuePairs) )
    and (LPos  0 then
    Begin
      (* Populate our lookup table *)
      LList := TStringList.Create;
      try
        LList.Delimiter := ';';
        LList.StrictDelimiter := true;
        LList.DelimitedText := NameValuePairs;

        if LList.Count = 0 then
          raise EPropertybagParseError.CreateFmt(cnt_err_sourceparameters_parse, [LOriginal]);

        try
          for x := 0 to LList.Count-1 do
          begin
            LId := LList.Names[x].Trim().ToLower();
            if (LId.Length > 0) then
            begin
              LValue := LList.ValueFromIndex[x].Trim();
              Write(LId, LValue);
            end;
          end;
        except
          on e: exception do
          raise EPropertybagParseError.CreateFmt(cnt_err_sourceparameters_parse, [LOriginal]);
        end;
      finally
        LList.Free;
      end;
    end;
  end;
end;

function TPropertyBag.ToString: string;
var
  LItem: TPair;
begin
  setlength(result, 0);
  for LItem in FLut do
  begin
    if LItem.Key.Trim().Length > 0 then
    begin
      result := result + Format('%s=%s;', [LItem.Key, LItem.Value]);
    end;
  end;
end;

procedure TPropertyBag.SaveToStream(const Stream: TStream);
var
  LData: TStringStream;
begin
  LData := TStringStream.Create(ToString(), TEncoding.UTF8);
  try
    LData.SaveToStream(Stream);
  finally
    LData.Free;
  end;
end;

procedure TPropertyBag.LoadFromStream(const Stream: TStream);
var
  LData: TStringStream;
begin
  LData := TStringStream.Create('', TEncoding.UTF8);
  try
    LData.LoadFromStream(Stream);
    Parse(LData.DataString);
  finally
    LData.Free;
  end;
end;

function TPropertyBag.Write(Name: string; Value: string): IPropertyElement;
begin
  Name := Name.Trim().ToLower();
  if Name.Length > 0 then
  begin
    if not FLUT.ContainsKey(Name) then
      FLut.Add(Name, Value);

    result := TPropertyElement.Create(FLut, Name, Value) as IPropertyElement;
  end else
  raise EPropertybagWriteError.Create(cnt_err_sourceparameters_write_id);
end;

function TPropertyBag.Read(Name: string): IPropertyElement;
var
  LData:  String;
begin
  Name := Name.Trim().ToLower();
  if Name.Length > 0  then
  begin
    if FLut.TryGetValue(Name, LData) then
      result := TPropertyElement.Create(LData) as IPropertyElement
    else
      raise EPropertybagReadError.Create(cnt_err_sourceparameters_read_id);
  end else
  raise EPropertybagReadError.Create(cnt_err_sourceparameters_read_id);
end;


end.