Porting TextCraft to Oxygene

TextCraft is a simple yet powerful text parser, designed for general purpose parsing jobs. I originally implemented it for Delphi, it’s the base-parser for the LDEF bytecode assembler amongst other things. It was ported to Smart Pascal, then Freepascal – and now finally Oxygene.

The LDEF Assembler is a part of the Quartex Media Desktop

The LDEF assembler and bytecode engine is currently implemented in Smart and compiles for Javascript. It’s a complete assembler and VM allowing coders to approach Asm.js from an established instruction-set. In short: you feed it source-code, it spits out bytecodes that you can execute super fast in either the browser or elsewhere. As long as there is a VM implementation available.

The Javascript version works really well, especially on node.js. In essence, i don’t need to re-compile the toolchain when moving between arm, x86, windows, linux or osx. Think of it as a type of Java bytecodes or CLR bytecodes.

Getting the code to run under Oxygene, means that I can move the whole engine into WebAssembly. The parser, assembler and linker (et-al) can thus run as WebAssembly, and I can use that from my JavaScript front-end code. Best of both worlds – the flamboyant creativity of JavaScript, and the raw speed of WebAssembly.

The port

Before I can move over the top-level parser + assembler etc, the generic parser code has to work. I was reluctant to start because I imagined the porting would take at least a day, but luckily it took me less than an hour. There are a few superficial differences between Smart, Delphi, Freepascal and Oxygene; for example the Copy() function for strings is not a lose function in Oxygene, instead you use String.SubString(). Functions like High() and Low() on strings likewise has to be refactored.

But all in all the conversion was straight-forward, and TextCraft is now a part of the QTX library for Oxygene. I’ll be uploading a commit to GIT with the whole shabam soon.

Well, hope the WordPress parser doesnt screw this up too bad.

namespace qtxlib;

//##################################################################
// TextCraft 1.2
//  Written by Jon L. Aasenden
//
//  This is a port of TC 1.2 from Freepascal. TextCraft is initially
//  a Delphi parser framework. The original repository can be found
//  on BitBucket at:
//
//  https://bitbucket.org/hexmonks/main
//
//##################################################################

{$DEFINE USE_INCLUSIVE}
{$define USE_BMARK}

interface

uses
  qtxlib, System, rtl,
  RemObjects.Elements.RTL.Delphi,
  RemObjects.Elements.RTL.Delphi.VCL;

type

  // forward declarations
  TTextBuffer         = class;
  TParserContext      = class;
  TCustomParser       = class;
  TParserModelObject  = class;

    // Exceptions
  ETextBuffer   = class(Exception);
  EModelObject  = class(Exception);

  // Callback functions
  TTextValidCB = function (Item: Char): Boolean;

  // Bookmark datatype
  TTextBufferBookmark = class
  public
    property bbOffset: Integer;
    property bbCol:    Integer;
    property bbRow:    Integer;
    function Equals(const ThisMark: TTextBufferBookmark): Boolean;
  end;

  {.$DEFINE USE_BMARK}

  TTextBuffer = class(TErrorObject)
  private
    FData:      String;
    FOffset:    Integer;
    FLength:    Integer;
    FCol:       Integer;
    FRow:       Integer;
    {$IFDEF USE_BMARK}
    FBookmarks: List;
    {$ENDIF}
    procedure   SetCacheData(NewText: String);
  public
    property    Column: Integer read FCol;
    property    Row: Integer read FRow;
    property    Count: Integer read FLength;
    property    Offset: Integer read FOffset;
    property    CacheData: String read FData write SetCacheData;

    // These functions map directly to the "Current"
    // character where the offset is placed, and is used to
    // write code that makes more sense to human eyes
    function    CrLf: Boolean;
    function    Space: Boolean;
    function    Tab: Boolean;
    function    SemiColon: Boolean;
    function    Colon: Boolean;
    function    ConditionEnter: Boolean;
    function    ConditionLeave: Boolean;
    function    BracketEnter: Boolean;
    function    BracketLeave: Boolean;
    function    Ptr: Boolean;
    function    Punctum: Boolean;
    function    Question: Boolean;
    function    Less: Boolean;
    function    More: Boolean;
    function    Equal: Boolean;
    function    Pipe: Boolean;
    function    Numeric: Boolean;

    function    Empty: Boolean;
    function    BOF: Boolean;
    function    EOF: Boolean;
    function    Current: Char;

    function    First: Boolean;
    function    Last: Boolean;

    // Same as "Next", but does not automatically
    // consume CR+LF, used when parsing textfragments
    function    NextNoCrLf: Boolean;

    // Normal Next function, will automatically consume
    // CRLF when it encounters it
    function    Next: Boolean;

    function    Back: Boolean;

    function    Bookmark: TTextBufferBookmark;
    procedure   Restore(const Mark: TTextBufferBookmark);
    {$IFDEF USE_BMARK}
    procedure   Drop;
    {$ENDIF}

    procedure   ConsumeJunk;
    procedure   ConsumeCRLF;

    function    Compare(const CompareText: String;
                const CaseSensitive: Boolean): Boolean;

    function    Read(var Fragment: Char): Boolean; overload;
    function    Read: Char; overload;
    function    ReadTo(const CB: TTextValidCB; var TextRead: String): Boolean; overload;
    function    ReadTo(const Resignators: TSysCharSet; var TextRead: String): Boolean; overload;
    function    ReadTo(MatchText: String): Boolean; overload;
    function    ReadTo(MatchText: String; var TextRead: String): Boolean; overload;

    function    ReadToEOL: Boolean;   overload;
    function    ReadToEOL(var TextRead: String): Boolean;   overload;

    function    Peek: Char; overload;
    function    Peek(CharCount: Integer; var TextRead: String): Boolean; overload;

    function    NextNonControlChar(const CompareWith: Char): Boolean;
    function    NextNonControlText(const CompareWith: String): Boolean;

    function    ReadWord(var TextRead: String): Boolean;

    function    ReadQuotedString: String;
    function    ReadCommaList(var cList: List): Boolean;

    function    NextLine: Boolean;

    procedure   Inject(const TextToInject: String);

    function    GetCurrentLocation: TTextBufferBookmark;

    function    Trail: String;

    procedure   Clear;
    procedure   LoadBufferText(const NewBuffer: String);

    constructor Create(const BufferText: String); overload; virtual;

    finalizer;
    begin
      {$IFDEF USE_BMARK}
      FBookmarks.Clear();
      disposeAndNil(FBookmarks);
      {$endif}
      Clear();
    end;
  end;

  TParserContext = class(TErrorObject)
  private
    FBuffer:    TTextBuffer;
    FStack:     Stack;
  public
    property    Buffer: TTextBuffer read FBuffer;
    property    Model: TParserModelObject;

    procedure   Push(const ModelObj: TParserModelObject);
    function    Pop: TParserModelObject;
    function    Peek: TParserModelObject;
    procedure   ClearStack;

    constructor Create(const SourceCode: String); reintroduce; virtual;

    finalizer;
    begin
      FStack.Clear();
      FBuffer.Clear();
      disposeAndNil(FStack);
      disposeAndNil(FBuffer);
    end;
  end;

  TCustomParser = class(TErrorObject)
  private
    FContext:   TParserContext;
  protected
    procedure   SetContext(const NewContext: TParserContext);
  public
    property    Context: TParserContext read FContext;
    function    Parse: Boolean; virtual;
    constructor Create(const ParseContext: TParserContext); reintroduce; virtual;
  end;

  TParserModelObject = class(TObject)
  private
    FParent:    TParserModelObject;
    FChildren:  List;
  protected
    function    GetParent: TParserModelObject; virtual;
    function    ChildGetCount: Integer; virtual;
    function    ChildGetItem(const Index: Integer): TParserModelObject; virtual;
    function    ChildAdd(const Instance: TParserModelObject): TParserModelObject; virtual;
  public
    property    Parent: TParserModelObject read GetParent;
    property    Context: TParserContext;
    procedure   Clear; virtual;
    constructor Create(const AParent: TParserModelObject); virtual;

    finalizer;
    begin
      Clear();
      FChildren := nil;
    end;

  end;

implementation

//#####################################################################
// Error messages
//#####################################################################

const
  CNT_ERR_BUFFER_EMPTY  = 'Buffer is empty error';
  CNT_ERR_OFFSET_BOF    = 'Offset at BOF error';
  CNT_ERR_OFFSET_EOF    = 'Offset at EOF error';
  CNT_ERR_COMMENT_NOTCLOSED = 'Comment not closed error';
  CNT_ERR_OFFSET_EXPECTED_EOF = 'Expected EOF error';
  CNT_ERR_LENGTH_INVALID = 'Invalid length error';

//#####################################################################
// TTextBufferBookmark
//#####################################################################

function TTextBufferBookmark.Equals(const ThisMark: TTextBufferBookmark): boolean;
begin
  result := ( (ThisMark  nil) and (ThisMark  self) )
        and (self.bbOffset = ThisMark.bbOffset)
        and (self.bbCol = ThisMark.bbCol)
        and (self.bbRow = ThisMark.bbRow);
end;

//#####################################################################
// TTextBuffer
//#####################################################################

constructor TTextBuffer.Create(const BufferText: string);
begin
  inherited Create();
  if length(BufferText) > 0 then
    LoadBufferText(BufferText)
  else
    Clear();
end;

procedure TTextBuffer.Clear;
begin
  FData := '';
  FOffset := -1;
  FLength := 0;
  FCol := -1;
  FRow := -1;
  {$IFDEF USE_BMARK}
  FBookmarks.Clear();
  {$ENDIF}
end;

procedure TTextBuffer.SetCacheData(NewText: string);
begin
  LoadBufferText(NewText);
end;

function TTextBuffer.Trail: string;
begin
  if not Empty then
  begin
    if not EOF then
      result := FData.Substring(FOffset, length(FData) );
      //result := Copy( FData, FOffset, length(FData) );
  end;
end;

procedure TTextBuffer.LoadBufferText(const NewBuffer: string);
begin
  // Flush existing buffer
  Clear();

  // Load in buffertext, init offset and values
  var TempLen := NewBuffer.Length;
  if TempLen > 0 then
  begin
    FData := NewBuffer;
    FOffset := 0; // start at BOF
    FCol := 0;
    FRow := 0;
    FLength := TempLen;
  end;
end;

function TTextBuffer.GetCurrentLocation: TTextBufferBookmark;
begin
  if Failed then
    ClearLastError();
  if not Empty then
  begin
    result := TTextBufferBookmark.Create;
    result.bbOffset := FOffset;
    result.bbCol := FCol;
    result.bbRow := FRow;
  end else
  raise ETextBuffer.Create
  ('Failed to return position, buffer is empty error');
end;

function TTextBuffer.Bookmark: TTextBufferBookmark;
begin
  if Failed then
    ClearLastError();
  if not Empty then
  begin
    result := TTextBufferBookmark.Create;
    result.bbOffset := FOffset;
    result.bbCol := FCol;
    result.bbRow := FRow;
    {$IFDEF USE_BMARK}
    FBookmarks.add(result);
    {$ENDIF}
  end else
  raise ETextBuffer.Create
  ('Failed to bookmark location, buffer is empty error');
end;

procedure TTextBuffer.Restore(const Mark: TTextBufferBookmark);
begin
  if Failed then
    ClearLastError();
  if not Empty then
  begin
    if Mark  nil then
    begin
      FOffset := Mark.bbOffset;
      FCol := Mark.bbCol;
      FRow := Mark.bbRow;
      Mark.Free;

      {$IFDEF USE_BMARK}
      var idx := FBookmarks.Count;
      if idx > 0 then
      begin
        dec(idx);
        FOffset := FBookmarks[idx].bbOffset;
        FCol := FBookmarks[idx].bbCol;
        FRow := FBookmarks[idx].bbRow;
        FBookmarks.Remove(idx);
        //FBookmarks.SetLength(idx)
        //FBookmarks.Delete(idx,1);
      end else
      raise ETextBuffer.Create('Failed to restore bookmark, none exist');
      {$ENDIF}
    end else
    raise ETextBuffer.Create('Failed to restore bookmark, object was nil error');
  end else
  raise ETextBuffer.Create
  ('Failed to restore bookmark, buffer is empty error');
end;

{$IFDEF USE_BMARK}
procedure TTextBuffer.Drop;
begin
  if Failed then
    ClearLastError();
  if not Empty then
  begin
    if FBookmarks.Count > 0 then
      FBookmarks.Remove(FBookmarks.Count-1)
    else
      raise ETextBuffer.Create('Failed to drop bookmark, none exist');
  end else
  raise ETextBuffer.Create
  ('Failed to drop bookmark, buffer is empty error');
end;
{$ENDIF}

function TTextBuffer.Read(var Fragment: char): boolean;
begin
  if Failed then
    ClearLastError();

  if not Empty then
  begin
    result := FOffset <= length(FData);
    if result then
    begin
      // return character
      Fragment := FData[FOffset];

      // update offset
      inc(FOffset)
    end else
    begin
      // return invalid char
      Fragment := #0;

      // Set error reason
      SetLastError('Offset at BOF error');
    end;
  end else
  begin
    result := false;
    Fragment := #0;
    SetLastError('Buffer is empty error');
  end;
end;

function TTextBuffer.Read: char;
begin
  if Failed then
    ClearLastError();

  if not Empty then
  begin
    result := Current;
    Next();
  end else
  result := #0;
end;

function TTextBuffer.ReadToEOL: boolean;
begin
  if Failed then
    ClearLastError();

  if not Empty() then
  begin
    if BOF() then
    begin
      if not First() then
        exit;
    end;

    if EOF() then
    begin
      SetLastError(CNT_ERR_OFFSET_EOF);
      exit;
    end;

    // Keep start
    var LStart := FOffset;

    // Enum until match of EOF
    {$IFDEF USE_INCLUSIVE}
    repeat
      if (FData[FOffset] = #13)
      and (FData[FOffset + 1] = #10) then
      begin
        result := true;
        break;
      end else
      begin
        inc(FOffset);
        inc(FCol);
      end;
    until EOF();
    {$ELSE}
    While FOffset < High(FData) do
    begin
      if (FData[FOffset] = #13)
      and (FData[FOffset + 1] = #10) then
      begin
        result := true;
        break;
      end else
      begin
        inc(FOffset);
        inc(FCol);
      end;
    end;
    {$ENDIF}

    // Last line in textfile might not have
    // a CR+LF, so we have to check for termination
    if not result then
    begin
      if EOF then
      begin
        if LStart = Low(FData)) and (FOffset = Low(FData)) and (FOffset = Low(FData)) and (FOffset = Low(FData)) and (FOffset = Low(FData)) and (FOffset = Low(FData)) and (FOffset = Low(FData)) and (FOffset = Low(FData)) and (FOffset = Low(FData)) and (FOffset = Low(FData)) and (FOffset = Low(FData)) and (FOffset = Low(FData)) and (FOffset = Low(FData)) and (FOffset <= high(FData) ) )
        and ( (FData[FOffset] = '= Low(FData)) and (FOffset ') );
end;

function  TTextBuffer.Equal: boolean;
begin
  result := (not Empty)
        and ( (FOffset >= Low(FData)) and (FOffset = Low(FData)) and (FOffset = Low(FData)) and (FOffset  LStart then
        begin
          // Any text to return? Or did we start
          // directly on a CR+LF and have no text to give?
          var LLen := FOffset - LStart;
          TextRead := FData.Substring(LStart, LLen);
          //TextRead := Copy(FData, LStart, LLen);
        end;

        // Either way, we exit because CR+LF has been found
        result := true;
        break;
      end;

      inc(FOffset);
      inc(FCol);
    until EOF();
    {$ELSE}
    While FOffset  LStart then
        begin
          // Any text to return? Or did we start
          // directly on a CR+LF and have no text to give?
          var LLen := FOffset - LStart;
          TextRead := copy(FData, LStart, LLen);
        end;

        // Either way, we exit because CR+LF has been found
        result := true;
        break;
      end;

      inc(FOffset);
      inc(FCol);
    end;
    {$ENDIF}

    // Last line in textfile might not have
    // a CR+LF, so we have to check for EOF and treat
    // that as a terminator.
    if not result then
    begin
      if FOffset >= high(FData) then
      begin
        if LStart  0 then
          begin
            TextRead := FData.Substring(LStart, LLen);
            //TextRead := Copy(FData, LStart, LLen);
            result := true;
          end;
          exit;
        end;
      end;
    end;

  end;
end;

function TTextBuffer.ReadTo(const CB: TTextValidCB; var TextRead: string): boolean;
begin
  if Failed then
    ClearLastError();

  TextRead := '';

  if not Empty then
  begin

    if BOF() then
    begin
      if not First() then
        exit;
    end;

    if EOF() then
    begin
      SetLastError(CNT_ERR_OFFSET_EOF);
      exit;
    end;

    if not assigned(CB) then
    begin
      SetLastError('Invalid callback handler');
      exit;
    end;

    {$IFDEF USE_INCLUSIVE}
    repeat
      if not CB(Current) then
        break
      else
        TextRead := TextRead + Current;

      if not Next() then
        break;
    until EOF();
    {$ELSE}
    while not EOF do
    begin
      if not CB(Current) then
        break
      else
        TextRead := TextRead + Current;

      if not Next() then
        break;
    end;
    {$ENDIF}
    result := TextRead.Length > 0;

  end else
  begin
    result := false;
    SetLastError(CNT_ERR_BUFFER_EMPTY);
  end;
end;

function TTextBuffer.ReadTo(const Resignators: TSysCharSet; var TextRead: string): boolean;
begin
  if Failed then
    ClearLastError();

  TextRead := '';
  if not Empty then
  begin

    if BOF() then
    begin
      if not First() then
        exit;
    end;

    if EOF() then
    begin
      SetLastError(CNT_ERR_OFFSET_EOF);
      exit;
    end;

    {$IFDEF USE_INCLUSIVE}
    repeat
      if not Resignators.Contains(Current) then
        TextRead := TextRead + Current
      else
        break;

      if not Next() then
        break;
    until EOF();
    {$ELSE}
    while not EOF do
    begin
      if not (Current in Resignators) then
        TextRead := TextRead + Current
      else
        break;

      if not Next() then
        break;
    end;
    {$ENDIF}

    result := TextRead.Length > 0;
  end else
  begin
    result := false;
    SetLastError(CNT_ERR_BUFFER_EMPTY);
  end;
end;

function TTextBuffer.ReadTo(MatchText: string): boolean;
begin
  if Failed then
    ClearLastError();

  if not Empty() then
  begin

    if BOF() then
    begin
      if not First() then
        exit;
    end;

    if EOF() then
    begin
      SetLastError(CNT_ERR_OFFSET_EOF);
      exit;
    end;

    var MatchLen := length(MatchText);
    if MatchLen > 0 then
    begin
      MatchText := MatchText.ToLower();

      repeat
        var TempCache := '';
        if Peek(MatchLen, TempCache) then
        begin
          TempCache := TempCache.ToLower();
          result := SameText(TempCache, MatchText);
          if result then
            break;
        end;

        if not Next then
          break;
      until EOF;
    end;

  end else
  begin
    result := false;
    SetLastError(CNT_ERR_BUFFER_EMPTY);
  end;
end;

function TTextBuffer.ReadTo(MatchText: string; var TextRead: string): boolean;
begin
  if Failed then
    ClearLastError();

  result := false;
  TextRead := '';

  if not Empty() then
  begin

    if BOF() then
    begin
      if not First() then
        exit;
    end;

    if EOF() then
    begin
      SetLastError(CNT_ERR_OFFSET_EOF);
      exit;
    end;

    if MatchText.Length > 0 then
    begin
      MatchText := MatchText.ToLower();

      repeat
        var TempCache := '';
        if Peek(MatchText.Length, TempCache) then
        begin
          TempCache := TempCache.ToLower();
          result := SameText(TempCache, MatchText);
          if result then
            break
          else
            TextRead := TextRead + Current;
        end else
          TextRead := TextRead + Current;

        if not Next() then
          break;
      until EOF;
    end;

  end else
  begin
    result := false;
    SetLastError(CNT_ERR_BUFFER_EMPTY);
  end;
end;

procedure TTextBuffer.Inject(const TextToInject: string);
begin
  if length(FData) > 0 then
  begin
    var lSeg1 := FData.Substring(1, FOffset);
    var lSeg2 := FData.Substring(FOffset + 1, length(FData));
    //var LSeg1 := Copy(FData, 1, FOffset);
    //var LSeg2 := Copy(FData, FOffset+1,  FData.Length);
    FData := lSeg1 + TextToInject + lSeg2;
  end else
    FData := TextToInject;
end;

function TTextBuffer.Compare(const CompareText: string;
    const CaseSensitive: boolean): boolean;
begin
  if Failed then
    ClearLastError();

  if not Empty() then
  begin
    if BOF() then
    begin
      if not First() then
        exit;
    end;

    if EOF() then
    begin
      SetLastError(CNT_ERR_OFFSET_EOF);
      exit;
    end;

    var LenToRead := CompareText.Length;
    if LenToRead > 0 then
    begin
      // Peek will set an error message if it
      // fails, so we dont need to set anything here
      var ReadData := '';
      if Peek(LenToRead, ReadData) then
      begin
        case CaseSensitive of
        false: result := ReadData.ToLower() = CompareText.ToLower();
        true:  result := ReadData = CompareText;
        end;
      end;
    end else
    SetLastError(CNT_ERR_LENGTH_INVALID);

  end else
  SetLastError(CNT_ERR_BUFFER_EMPTY);
end;

procedure TTextBuffer.ConsumeJunk;
begin
  if Failed then
    ClearLastError();

  if not Empty then
  begin

    if BOF() then
    begin
      if not First() then
        exit;
    end;

    if EOF() then
    begin
      SetLastError(CNT_ERR_OFFSET_EOF);
      exit;
    end;

    repeat
      case Current of
      ' ':
        begin
        end;
      '"':
        begin
          break;
        end;
      #8, #09:
        begin
        end;
      '/':
        begin
          (* Skip C style remark *)
          if Compare('/*', false) then
          begin
            if ReadTo('*/') then
            begin
              inc(FOffset, 2);
              Continue;
            end else
            SetLastError(CNT_ERR_COMMENT_NOTCLOSED);
          end else
          begin
            (* Skip Pascal style remark *)
            if Compare('//', false) then
            begin
              if ReadToEOL() then
              begin
                continue;
              end else
              SetLastError(CNT_ERR_OFFSET_EXPECTED_EOF);
            end;
          end;
        end;
      '(':
        begin
          (* Skip pascal style remark *)
          if Compare('(*', false)
            and not Compare('(*)', false) then
          begin
            if ReadTo('*)') then
            begin
              inc(FOffset, 2);
              continue;
            end else
            SetLastError(CNT_ERR_COMMENT_NOTCLOSED);
          end else
          break;
        end;
      #13:
        begin
          if FData[FOffset + 1] = #10 then
            inc(FOffset, 2)
          else
            inc(FOffset, 1);
          //if Peek = #10 then
          //  ConsumeCRLF;
          continue;
        end;
      #10:
        begin
          inc(FOffset);
          continue;
        end;
      else
        break;
      end;

      if not Next() then
        break;
    until EOF;

  end else
  SetLastError(CNT_ERR_BUFFER_EMPTY);
end;

procedure TTextBuffer.ConsumeCRLF;
begin
  if not Empty then
  begin

    if BOF() then
    begin
      if not First() then
        exit;
    end;

    if EOF() then
    begin
      SetLastError(CNT_ERR_OFFSET_EOF);
      exit;
    end;

    if  (FData[FOffset] = #13) then
    begin
      if FData[FOffset + 1] = #10 then
        inc(FOffset, 2)
      else
        inc(FOffset);

      inc(FRow);
      FCol := 0;
    end;

  end;
end;

function TTextBuffer.Empty: boolean;
begin
  result := FLength < 1;
end;

// This method will look ahead, skipping space, tab and crlf (also known
// as control characters), and when a non control character is found it will
// perform a string compare. This method uses a bookmark and will restore
// the offset to the same position as when it was entered.
//
// Notes: The method "NextNonControlChar" is a similar method that
// performs a char-only compare.
function TTextBuffer.NextNonControlText(const CompareWith: string): boolean;
begin
  if Failed then
    ClearLastError();

  if not Empty then
  begin

    if BOF() then
    begin
      if not First() then
        exit;
    end;

    if EOF() then
    begin
      SetLastError(CNT_ERR_OFFSET_EOF);
      exit;
    end;

    var Mark := Bookmark();
    try
      // Iterate ahead
      repeat
        if not (Current in [' ', #13, #10, #09]) then
          break;

        Next();
      until EOF();

      // Compare unless we hit the end of the line
      if not EOF then
        result := Compare(CompareWith, false);
    finally
      Restore(Mark);
    end;

  end else
  SetLastError(CNT_ERR_BUFFER_EMPTY);
end;

// This method will look ahead, skipping space, tab and crlf (also known
// as control characters), and when a non control character is found it will
// perform a string compare. This method uses a bookmark and will restore
// the offset to the same position as when it was entered.

function TTextBuffer.NextNonControlChar(const CompareWith: char): boolean;
begin
  if Failed then
    ClearLastError();

  if not Empty then
  begin
    if BOF() then
    begin
      if not First() then
        exit;
    end;

    if EOF() then
    begin
      SetLastError(CNT_ERR_OFFSET_EOF);
      exit;
    end;

    var Mark := Bookmark();
    try
      repeat
        if not (Current in [' ', #13, #10, #09]) then
          break;
        Next();
      until EOF();

      //if not EOF then
      result := Current.ToLower() = CompareWith.ToLower();
      //result := LowerCase(Current) = LowerCase(CompareWith);

    finally
      Restore(Mark);
    end;

  end else
  SetLastError(CNT_ERR_BUFFER_EMPTY);
end;

function TTextBuffer.Peek: char;
begin
  if Failed then
    ClearLastError();
  if not Empty then
  begin
    if (FOffset  0 do
        begin
          TextRead := TextRead + Current;
          if not Next() then
            break;
          dec(CharCount);
        end;
      finally
        Restore(Mark);
      end;

      result := TextRead.Length > 0;

    end else
    SetLastError(CNT_ERR_OFFSET_EOF);
  end else
  SetLastError(CNT_ERR_BUFFER_EMPTY);
end;

function TTextBuffer.First: boolean;
begin
  if Failed then
    ClearLastError();

  if not Empty then
  begin
    FOffset := Low(FData);
    result := true;
  end else
  SetLastError(CNT_ERR_BUFFER_EMPTY);
end;

function TTextBuffer.Last: boolean;
begin
  if Failed then
    ClearLastError();

  if not Empty then
  begin
    FOffset := high(FData);
    result := true;
  end else
  SetLastError(CNT_ERR_BUFFER_EMPTY);
end;

function TTextBuffer.NextNoCrLf: boolean;
begin
  if Failed then
    ClearLastError();

  if not Empty then
  begin
    // Check that we are not EOF
    result := FOffset <= high(FData);
    if result then
    begin
      // Update offset into buffer
      inc(FOffset);

      // update column, but not if its in a lineshift
      if not (FData[FOffset] in [#13, #10]) then
        inc(FCol);

    end else
    SetLastError(CNT_ERR_OFFSET_EOF);
  end else
  SetLastError(CNT_ERR_BUFFER_EMPTY);
end;

function TTextBuffer.Next: boolean;
begin
  if Failed then
    ClearLastError();

  if not Empty() then
  begin

    if BOF() then
    begin
      if not First() then
        exit;
    end;

    if EOF() then
    begin
      SetLastError(CNT_ERR_OFFSET_EOF);
      exit;
    end;

    // Update offset into buffer
    inc(FOffset);

    // update column
    inc(FCol);

    // This is the same as ConsumeCRLF
    // But this does not generate any errors since we PEEK
    // ahead into the buffer to make sure the combination
    // is correct before we adjust the ROW + offset
    if FOffset  Low(FData));
    if result then
      dec(FOffset)
    else
      SetLastError(CNT_ERR_OFFSET_BOF);
  end else
  SetLastError(CNT_ERR_BUFFER_EMPTY);
end;

function TTextBuffer.Current: char;
begin
  if Failed then
    ClearLastError();

  // Check that buffer is not empty
  if not Empty then
  begin
    // Check that we are on char 1 or more
    if FOffset >= Low(FData) then
    begin
      // Check that we are before or on the last char
      if (FOffset <= high(FData)) then
        result := FData[FOffset]
      else
      begin
        SetLastError(CNT_ERR_OFFSET_EOF);
        result := #0;
      end;
    end else
    begin
      SetLastError(CNT_ERR_OFFSET_BOF);
      result := #0;
    end;
  end else
  begin
    SetLastError(CNT_ERR_BUFFER_EMPTY);
    result := #0;
  end;
end;

function TTextBuffer.BOF: boolean;
begin
  if not Empty then
    result := FOffset  high(FData);
end;

function TTextBuffer.NextLine: boolean;
begin
  if Failed then
    ClearLastError();

  if not Empty then
  begin
    // Make sure we offset to a valid character
    // in the buffer.
    ConsumeJunk();

    if not EOF then
    begin
      var ThisRow := self.FRow;
      while Row = ThisRow do
      begin
        Next();
        if EOF then
        break;
      end;

      result := (Row  ThisRow) and (not EOF);
    end;
  end;
end;

function TTextBuffer.ReadWord(var TextRead: string): boolean;
begin
  if Failed then
    ClearLastError();

  TextRead := '';

  if not Empty then
  begin
    // Make sure we offset to a valid character
    // in the buffer.
    ConsumeJunk();

    // Not at the end of the file?
    if not EOF then
    begin
      repeat
        var el := Current;

        if (el in
        [ 'A'..'Z',
          'a'..'z',
          '0'..'9',
          '_', '-' ]) then
          TextRead := TextRead + el
        else
          break;

        if not NextNoCrLf() then
          break;

      until EOF;

      result := TextRead.Length > 0;

    end else
    SetLastError('Failed to read word, unexpected EOF');
  end else
  SetLastError('Failed to read word, buffer is empty error');
end;

function TTextBuffer.ReadCommaList(var cList: List): boolean;
var
  LTemp: String;
  LValue: String;
begin
  if cList = nil then
    cList := new List
  else
    cList.Clear();

  if not Empty then
  begin
    ConsumeJunk();

    While not EOF do
    begin
      case Current of
      #09:
        begin
          // tab, just skip
        end;
      #13, #10:
        begin
          // CR+LF, consume and continue;
          ConsumeCRLF();
        end;
      #0:
        begin
          // Unexpected EOL
          break;
        end;

      ';':
        begin
          //Perfectly sound ending
          result := true;
          break;
        end;
      '"':
        begin
          LValue := ReadQuotedString;
          if LValue.Length > 0 then
          begin
            cList.add(LValue);
            LValue := '';
          end;
        end;
      ',':
        begin
          LTemp := LTemp.Trim();
          if LTemp.Length>0 then
          begin
            cList.add(LTemp);
            LTemp := '';
          end;
        end;
      else
        begin
          LTemp := LTemp + Current;
        end;
      end;

      if not Next() then
        break;
    end;

    if LTemp.Length > 0 then
      cList.add(LTemp);

    result := cList.Count > 0;

  end;
end;

function TTextBuffer.ReadQuotedString: string;
begin
  if not Empty then
  begin
    if not EOF then
    begin

      // Make sure we are on the " entry quote
      if Current  '"' then
      begin
        SetLastError('Failed to read quoted string, expected index on " character error');
        exit;
      end;

      // Skip the entry char
      if not NextNoCrLf() then
      begin
        SetLastError('Failed to skip initial " character error');
        exit;
      end;

      while not EOF do
      begin
        // Read char from buffer
        var TempChar := Current;

        // Closing of string? Exit
        if TempChar = '"' then
        begin
          if not NextNoCrLf then
            SetLastError('failed to skip final " character in string error');
          break;
        end;

        result := result + TempChar;

        if not NextNoCrLf() then
          break;
      end;

    end;
  end;
end;

//##########################################################################
// TParserModelObject
//##########################################################################

constructor TParserModelObject.Create(const AParent:TParserModelObject);
begin
  inherited Create;
  FParent := AParent;
  FChildren := new List;
end;

function TParserModelObject.GetParent:TParserModelObject;
begin
  result := FParent;
end;

procedure TParserModelObject.Clear;
begin
  FChildren.Clear();
end;

function TParserModelObject.ChildGetCount: integer;
begin
  result := FChildren.Count;
end;

function TParserModelObject.ChildGetItem(const Index: integer): TParserModelObject;
begin
  result := TParserModelObject(FChildren[Index]);
end;

function TParserModelObject.ChildAdd(const Instance: TParserModelObject): TParserModelObject;
begin
  if FChildren.IndexOf(Instance) < 0 then
    FChildren.add(Instance);
  result := Instance;
end;

//###########################################################################
// TParserContext
//###########################################################################

constructor TParserContext.Create(const SourceCode: string);
begin
  inherited Create;
  FBuffer := TTextBuffer.Create(SourceCode);
  FStack := new Stack;
end;

procedure TParserContext.Push(const ModelObj: TParserModelObject);
begin
  if Failed then
    ClearLastError();

  try
    FStack.Push(ModelObj);
  except
    on e: Exception do
    SetLastError('Internal error:' + e.Message);
  end;
end;

function TParserContext.Pop: TParserModelObject;
begin
  if Failed then
    ClearLastError();
  try
    result := FStack.Pop();
  except
    on e: Exception do
    SetLastError('Internal error:' + e.Message);
  end;
end;

function TParserContext.Peek: TParserModelObject;
begin
  if Failed then
    ClearLastError();
  try
    result := FStack.Peek();
  except
    on e: Exception do
    SetLastError('Internal error:' + e.Message);
  end;
end;

procedure TParserContext.ClearStack;
begin
  if Failed then
    ClearLastError();
  try
    FStack.Clear();
  except
    on e: Exception do
    SetLastError('Internal error:' + e.Message);
  end;
end;

//###########################################################################
// TCustomParser
//###########################################################################

constructor TCustomParser.Create(const ParseContext: TParserContext);
begin
  inherited Create;
  FContext := ParseContext;
end;

function TCustomParser.Parse: boolean;
begin
  result := false;
  SetLastErrorF('No parser implemented for class %s',[ClassName]);
end;

procedure TCustomParser.SetContext(const NewContext: TParserContext);
begin
  FContext := NewContext;
end;

end.

Generic protect for FPC/Lazarus

Freepascal is not frequently mentioned on my blog. I have written about it from time to time, not always in a positive light though. Just to be clear, FPC (the compiler) is fantastic; it was one particular fork of Lazarus I had issues with, involving a license violation.

On the whole, freepascal and Lazarus is capable of great things. There are a few quirks here and there (if not oddities) that prevents mass adoption (the excessive use of include-files to “fake” partial classes being one), but as object-pascal compilers go, Freepascal is a battle-hardened, production ready system.

It’s been Linux in particular that I have used Freepascal on. In 2015 Hydro Oil wanted to move their back-end from Windows to Linux, and I spent a few months converting windows-only services into Linux daemons.

Today I find myself converting parts of the toolkit I came up with to Oxygene, but that’s a post for another day.

Generic protect

If you work a lot with multithreaded code, the unit im posting here might come in handy. Long story short: sharing composite objects between threads and the main process, always means extra scaffolding. You have to make sure you don’t access the list (or it’s elements) at the same time as another thread for example. To ensure this you can either use a critical-section, or you can deliver the data with a synchronized call. This is more or less universal for all languages, no matter if you are using Oxygene, C/C++, C# or Delphi.

When this unit came into being, I was doing quite elaborate classes with a lot of lists. These classes could not share ancestor, or I could have gotten away with just one locking mechanism. Instead I had to implement the same boilerplate code over and over again.

The unit below makes insulating (or protecting) classes easier. It essentially envelopes whatever class-instance you feed it, and returns the proxy object. Whenever you want to access your instance, you have to unlock it first or use a synchronizer (see below).

Works in both Freepascal and Delphi

The unit works for both Delphi and Freepascal, but there is one little difference. For some reason Freepascal does not support anonymous procedures, so we compensate and use inline-procedures instead. While not a huge deal, I really hope the FPC team add anonymous procedures, it makes life a lot easier for generics based code. Async programming without anonymous procedures is highly impractical too.

So if you are in Delphi you can write:

var
 lValue: TProtectedValue;
 lValue.Synchronize( procedure (var Value: integer)
 begin
   Value := Value * 12;
 end);

But under Freepascal you must resort to:

var
 lValue: TProtectedValue;

procedure _UpdateValue(var Data: integer);
begin
 Data := Data * 12;
end;

begin
  lValue.Synchronize(@_UpdateValue);
end;

On small examples like these, the benefit of this style of coding might be lost; but if you suddenly have 40-50 lists that needs to be shared between 100-200 active threads, it will be a time saver!

You can also use it on intrinsic datatypes:

OK, here we go:

unit safeobjects;

// 	SafeObjects
//	==========================================================================
//	Written by Jon-Lennart Aasenden
//	Copyright Quartex Components LTD, all rights reserved
//
//	This unit is a part of the QTX Patreon Library
//
//	NOTES ABOUT FREEPASCAL:
//	=======================
//	Freepascal does not allow anonymous procedures, which means we must
//	resort to inline procedures instead:
//
// 	Where we in Delphi could write the following for an atomic,
//	thread safe alteration:
//
// var
// 	LValue: TProtectedValue;
//
//	LValue.Synchronize( procedure (var Value: integer)
//	begin
//		Value := Value * 12;
//	end);
//
//	Freepascal demands that we use an inline procedure instead, which
//  is more or less the same code, just organized slightly differently.
//
// var
// 	LValue: TProtectedValue;
//
//  procedure _UpdateValue(var Data: integer);
//  begin
//  	Data := Data * 12;
//  end;
//
// begin
//	LValue.Synchronize(@_UpdateValue);
// end;
//
//
//
//

{$mode DELPHI}
{$H+}

interface

uses
  {$IFDEF FPC}
  SysUtils,
  Classes,
  SyncObjs,
  Generics.Collections;
	{$ELSE}
  System.SysUtils,
  System.Classes,
  System.SyncObjs,
  System.Generics.Collections;
  {$ENDIF}

type

  {$DEFINE INHERIT_FROM_CRITICALSECTION}

  TProtectedValueAccessRights = set of (lvRead, lvWrite);

  EProtectedValue = class(exception);
  EProtectedObject = class(exception);

  (* Thread safe intrinsic datatype container.
     When sharing values between processes, use this class
     to make read/write access safe and protected. *)

  {$IFDEF INHERIT_FROM_CRITICALSECTION}
  TProtectedValue = class(TCriticalSection)
  {$ELSE}
  TProtectedValue = class(TObject)
  {$ENDIF}
  strict private
    {$IFNDEF INHERIT_FROM_CRITICALSECTION}
    FLock: TCriticalSection;
    {$ENDIF}
    FData: T;
    FOptions: TProtectedValueAccessRights;
  strict protected
    function GetValue: T;virtual;
    procedure SetValue(Value: T);virtual;
    function GetAccessRights: TProtectedValueAccessRights;
    procedure SetAccessRights(Rights: TProtectedValueAccessRights);
  public
    type
  		{$IFDEF FPC}
      TProtectedValueEntry = procedure (var Data: T);
  		{$ELSE}
      TProtectedValueEntry = reference to procedure (var Data: T);
      {$ENDIF}
  public
    constructor Create(Value: T); overload; virtual;
    constructor Create(Value: T; const Access: TProtectedValueAccessRights); overload; virtual;
    constructor Create(const Access: TProtectedValueAccessRights); overload; virtual;
    destructor Destroy;override;

    {$IFNDEF INHERIT_FROM_CRITICALSECTION}
    procedure Enter;
    procedure Leave;
    {$ENDIF}
    procedure Synchronize(const Entry: TProtectedValueEntry);

    property AccessRights: TProtectedValueAccessRights read GetAccessRights;
    property Value: T read GetValue write SetValue;
  end;

  (* Thread safe object container.
     NOTE #1: This object container **CREATES** the instance and maintains it!
              Use Edit() to execute a protected block of code with access
              to the object.

     Note #2: SetValue() does not overwrite the object reference, but
              attempts to perform TPersistent.Assign(). If the instance
              does not inherit from TPersistent an exception is thrown. *)
  TProtectedObject = class(TObject)
  strict private
    FData:      T;
    FLock:      TCriticalSection;
    FOptions:   TProtectedValueAccessRights;
  strict protected
    function    GetValue: T;virtual;
    procedure   SetValue(Value: T);virtual;
    function    GetAccessRights: TProtectedValueAccessRights;
    procedure   SetAccessRights(Rights: TProtectedValueAccessRights);
  public
    type
			{$IFDEF FPC}
      TProtectedObjectEntry = procedure (const Data: T);
	    {$ELSE}
      TProtectedObjectEntry = reference to procedure (const Data: T);
      {$ENDIF}
  public
    property    Value: T read GetValue write SetValue;
    property    AccessRights: TProtectedValueAccessRights read GetAccessRights;

    function    Lock: T;
    procedure   Unlock;
    procedure   Synchronize(const Entry: TProtectedObjectEntry);

    Constructor Create(const AOptions: TProtectedValueAccessRights = [lvRead,lvWrite]); virtual;
    Destructor  Destroy; override;
  end;

  (* TProtectedObjectList:
     This is a thread-safe object list implementation.
     It works more or less like TThreadList, except it deals with objects *)
  TProtectedObjectList = class(TInterfacedPersistent)
  strict private
    FObjects: TObjectList;
    FLock: TCriticalSection;
  strict protected
    function GetEmpty: boolean;virtual;
    function GetCount: integer;virtual;

    (* QueryObject Proxy: TInterfacedPersistent allows us to
       act as a proxy for QueryInterface/GetInterface. Override
       and provide another child instance here to expose
       interfaces from that instread *)
  protected
    function GetOwner: TPersistent;override;

  public
    type
      {$IFDEF FPC}
      TProtectedObjectListProc = procedure (Item: TObject; var Cancel: boolean);
      {$ELSE}
      TProtectedObjectListProc = reference to procedure (Item: TObject; var Cancel: boolean);
      {$ENDIF}
  public
    constructor Create(OwnsObjects: Boolean = true); virtual;
    destructor  Destroy; override;

    function    Contains(Instance: TObject): boolean; virtual;
    function    Enter: TObjectList; virtual;
    Procedure   Leave; virtual;
    Procedure   Clear; virtual;

    procedure   ForEach(const CB: TProtectedObjectListProc); virtual;

    Property    Count: integer read GetCount;
    Property    Empty: boolean read GetEmpty;
  end;

implementation

//############################################################################
//  TProtectedObjectList
//############################################################################

constructor TProtectedObjectList.Create(OwnsObjects: Boolean = True);
begin
  inherited Create;
  FObjects := TObjectList.Create(OwnsObjects);
  FLock := TCriticalSection.Create;
end;

destructor TProtectedObjectList.Destroy;
begin
  FLock.Enter;
  FObjects.Free;
  FLock.Free;
  inherited;
end;

procedure TProtectedObjectList.Clear;
begin
  FLock.Enter;
  try
    FObjects.Clear;
  finally
    FLock.Leave;
  end;
end;

function TProtectedObjectList.GetOwner: TPersistent;
begin
  result := NIL;
end;

procedure TProtectedObjectList.ForEach(const CB: TProtectedObjectListProc);
var
  LItem:  TObject;
  LCancel:  Boolean;
begin
	LCancel := false;
  if assigned(CB) then
  begin
    FLock.Enter;
    try
    	{$HINTS OFF}
      for LItem in FObjects do
      begin
        LCancel := false;
        CB(LItem, LCancel);
        if LCancel then
        	break;
      end;
      {$HINTS ON}
    finally
      FLock.Leave;
    end;
  end;
end;

function TProtectedObjectList.Contains(Instance: TObject): boolean;
begin
  result := false;
  if assigned(Instance) then
  begin
    FLock.Enter;
    try
      result := FObjects.Contains(Instance);
    finally
      FLock.Leave;
    end;
  end;
end;

function TProtectedObjectList.GetCount: integer;
begin
  FLock.Enter;
  try
    result :=FObjects.Count;
  finally
    FLock.Leave;
  end;
end;

function TProtectedObjectList.GetEmpty: Boolean;
begin
  FLock.Enter;
  try
    result := FObjects.Count<1;
  finally
    FLock.Leave;
  end;
end;

function TProtectedObjectList.Enter: TObjectList;
begin
  FLock.Enter;
  result := FObjects;
end;

procedure TProtectedObjectList.Leave;
begin
  FLock.Leave;
end;

//############################################################################
//  TProtectedObject
//############################################################################

constructor TProtectedObject.Create(const AOptions: TProtectedValueAccessRights = [lvRead, lvWrite]);
begin
  inherited Create;
  FLock := TCriticalSection.Create;
  FLock.Enter();
  try
  	FOptions := AOptions;
  	FData := T.Create;
  finally
    FLock.Leave();
  end;
end;

destructor TProtectedObject.Destroy;
begin
	FData.free;
  FLock.Free;
  inherited;
end;

function TProtectedObject.GetAccessRights: TProtectedValueAccessRights;
begin
  FLock.Enter;
  try
    result := FOptions;
  finally
    FLock.Leave;
  end;
end;

procedure TProtectedObject.SetAccessRights(Rights: TProtectedValueAccessRights);
begin
  FLock.Enter;
  try
    FOptions := Rights;
  finally
    FLock.Leave;
  end;
end;

function TProtectedObject.Lock: T;
begin
  FLock.Enter;
  result := FData;
end;

procedure TProtectedObject.Unlock;
begin
  FLock.Leave;
end;

procedure TProtectedObject.Synchronize(const Entry: TProtectedObjectEntry);
begin
  if assigned(Entry) then
  begin
    FLock.Enter;
    try
      Entry(FData);
    finally
      FLock.Leave;
    end;
  end;
end;

function TProtectedObject.GetValue: T;
begin
  FLock.Enter;
  try
    if (lvRead in FOptions) then
    	result := FData
  	else
    	raise EProtectedObject.CreateFmt('%s:Read not allowed error',[classname]);
  finally
    FLock.Leave;
  end;
end;

procedure TProtectedObject.SetValue(Value: T);
begin
  FLock.Enter;
  try
    if (lvWrite in FOptions) then
    begin
      if (TObject(FData) is TPersistent)
      or (TObject(FData).InheritsFrom(TPersistent)) then
      	TPersistent(FData).Assign(TPersistent(Value))
    	else
      	raise EProtectedObject.CreateFmt
        	('Locked object assign failed, %s does not inherit from %s',
        	[TObject(FData).ClassName,'TPersistent']);

    end else
    raise EProtectedObject.CreateFmt('%s:Write not allowed error',[classname]);
  finally
    FLock.Leave;
  end;
end;

//############################################################################
//  TProtectedValue
//############################################################################

Constructor TProtectedValue.Create(const Access: TProtectedValueAccessRights);
begin
  inherited Create;
  {$IFNDEF INHERIT_FROM_CRITICALSECTION}
  FLock := TCriticalSection.Create;
  {$ENDIF}
  FOptions := Access;
end;

constructor TProtectedValue.Create(Value: T);
begin
  inherited Create;
  {$IFNDEF INHERIT_FROM_CRITICALSECTION}
  FLock := TCriticalSection.Create;
  {$ENDIF}
  FOptions := [lvRead, lvWrite];
  FData := Value;
end;

constructor TProtectedValue.Create(Value: T; const Access: TProtectedValueAccessRights);
begin
  inherited Create;
  {$IFNDEF INHERIT_FROM_CRITICALSECTION}
  FLock := TCriticalSection.Create;
  {$ENDIF}
  FOptions := Access;
  FData := Value;
end;

Destructor TProtectedValue.Destroy;
begin
  {$IFNDEF INHERIT_FROM_CRITICALSECTION}
  FLock.Free;
  {$ENDIF}
  inherited;
end;

function TProtectedValue.GetAccessRights: TProtectedValueAccessRights;
begin
  Enter();
  try
    result := FOptions;
  finally
    Leave();
  end;
end;

procedure TProtectedValue.SetAccessRights(Rights: TProtectedValueAccessRights);
begin
  Enter();
  try
    FOptions := Rights;
  finally
    Leave();
  end;
end;

{$IFNDEF INHERIT_FROM_CRITICALSECTION}
procedure TProtectedValue.Enter;
begin
  FLock.Enter;
end;

procedure TProtectedValue.Leave;
begin
  FLock.Leave;
end;
{$ENDIF}

procedure TProtectedValue.Synchronize(const Entry: TProtectedValueEntry);
begin
  if assigned(Entry) then
  Begin
    Enter();
    try
      Entry(FData);
    finally
      Leave();
    end;
  end;
end;

function TProtectedValue.GetValue: T;
begin
  Enter();
  try
    if (lvRead in FOptions) then
    	result := FData
    else
    	raise EProtectedValue.CreateFmt('%s: Read not allowed error', [Classname]);
  finally
    Leave();
  end;
end;

procedure TProtectedValue.SetValue(Value: T);
begin
  Enter();
  try
    if (lvWrite in FOptions) then
    	FData:=Value
    else
    	raise EProtectedValue.CreateFmt('%s: Write not allowed error', [Classname]);
  finally
    Leave();
  end;
end;

end.

Quartex Desktop: a brief look at the API

The Quartex Media Desktop (codename Amibian.js) has gotten a lot of cool attention lately. But telling people why it’s so awesome is not always easy. Not everyone is a software developer, and even then – very few Oxygene, Lazarus or Delphi developers have my level of background into HTML5/JS. Not that I have some hidden talent others lack, but rather that I have spent years working on this particular hybrid technology. And summing it all up is a tall order.

The Quartex Media Desktop has come a long way

Once in a while I post a few words about why the desktop matters, and why the system is going to be very important for developers and users alike. It’s growing at a rapid pace, with more and more of the underlying mechanics surfacing. I mean, me spending a month solving god knows how much – don’t mean a thing to users that just was a cool desktop. Some frankly don’t care how it works at all.

Well, in this post I will talk about The Desktop API and how it works. This is more practical information – and its the information that will help you when you start coding applications meant to integrate closely with the system.

The visual desktop

The desktop, despite being a pretty front end, serves no purpose right? Well you could not be more wrong, because there are layers of code beneath the pretty exterior that is unique to the world of JavaScript. But before we dig into that, lets have a look at how the desktop is organized.

The desktop organization is very simple, but highly effective

System Menu

The Quartex Media Desktop (nicknamed “Amibian.js”) follows a long tradition where a small part of the display is always occupied by a system-menu. The menu, once learned is a powerful tool. One that will help you navigate around the system faster.

Menu app-region

The system menu is also capable of hosting smaller, helper applications. The main menu reserves a small region for such apps, simply called the menu app region. This region can stretch depending on it’s content. But such mini-apps are expected with use as little space as possible, with a hard limit of 300 pixels each.

Amibian.js ships with two standard menu apps, those are integral to the system and cannot be deleted, only disabled.

• Time and date
• Account name and IP address

Icon Dock

The Icon dock should be no stranger. Ubuntu Linux has a similar dock (albeit on the left side of the display), and in Windows you can create as many docking regions as you see fit. So a good docking bar is a good thing.

The purpose is to have your favorite applications readily available when you login to your system.

There is not that much to write about the icon-dock. You can edit the list of items there and change other options in the preferences. The dock can alight to the right, the left and even to the bottom of the screen.

The first button on the dock, will always be a quick-link to the preferences display. Instead of isolating preferences outside the desktop, as a separate process. I have made it intrinsic. So clicking on the Preferences button will slide the desktop out of view, and the preferences screen into view.

The preferences view is still under construction, but its always the first item on the dock

Hosted Software

After this quick tour of the superficial, visual layer of the desktop, you could be forgiven for thinking this is all there is too it. Perhaps you imagine that “starting a program” is just loading stuff into frames and making it look like windows?

Actually, its a lot more elaborate that!

The purpose of the Quartex Media Desktop is to provide developers with common grounds. The market is filled with these juiced up, blinged to the hilt, superficial and outright fraudulent “web desktops”. Any idiot can sit down and make a website that looks like a desktop. Which is also why these desktop’s can do much beyond their initial programming.

You also have companies like CodeStamp that use native languages like C/C++ to create a custom server which deals with the grunt-work. Something I find amusing, but mostly sad. They have spent a fortune re-inventing technology that was made available 20 years ago, and that has been in use ever since.

The problem with these companies is that they are dinosaurs. I could have finished Quartex Media Desktop in a few months if I used Delphi or C++ builder. What CodeStamp have missed, is that their so-called revolutionary idea has been active and running for close to 20 years in the Delphi community. We are falling over each other in options for web desktops. I can have a fully fledged, theme based desktop up and running in less than a work day — with kick ass, llvm optimized, bug free code compiled for Windows, Linux and OS X.

The challenge, which is where the true values exists, is to get rid of native code. To write not just the client (desktop) in JavaScript, but beyond all — to write the entire back-end as Javascript! Only then do we have a truly portable and truly scalable platform to build on.

Amibian.js is designed to deal with 4 types of executables:

• Local web applications
• Remote web applications
• LDEF bytecode binaries
• Server-side shell

Let’s look at the first two since these fall into the category of “hosted applications”.

A hosted application is a normal web app that can run anywhere. It can be a simple website if you like. And like i mentioned above, external resources are always executed within the safe confounds of an iFrame.

Amibian.js allows hosted applications to call system functions that the desktop exposes. But in order for that to happen, the application must first complete a security process. But once the application is recognized and known (a process known as hand-shaking), the hosted application can integrate tightly with the desktop – so tight that it becomes indistinguishable from a local application.

But more importantly: communication between the desktop and a hosted application, is exclusively through messages. The hosted application cannot call potentially dangerous code, neither directly or indirectly. The methods it can call is held in check by the security policy for that program, which is under your control. So a bit of thought has gone into this work.

The desktop API

Behind the sweet exterior of our desktop, there are practically thousands of functions. And we must not forget that the back-end servers (Quartex Media Desktop is a distributed, clustered system).

Some of the functions a hosted-program can call, might actually exist on the server. So the desktop will accept the call, but relay that call to the back-end. When the call finishes, the response is likewise routed back to the application that initiated it.

For example, if a hosted application wants to display a “load-file requester”, it would call a function named ShowRequesterFile(). This is a proxy method in the public framework that constructs a message for you, and then send that message to the desktop (browsers use pipes internally).

A hosted application calling the ShowRequesterFile() API method. The desktop will go into modal mode and show the requester, just like you would expect from a native application

The desktop receives the message and executes the code designated for it. This involves setting the screen into modal mode, and show the “open file” dialog. When the user selects a file and the dialog closes, the result is shipped back to the application. The hosted application itself is never in direct contact with the filesystem. That is an important distinction.

Also, like mentioned earlier – some of the functions exposed by the public framework, is not a part of the desktop at all. The code to enumerate files and folders is not a part of the HTML5 code (obviously). So the desktop relay such calls to the back-end server(s) and further relay the response when that arrives.

System services

In my next article on the Quartex Media Desktop, we will have a peek at the system services and some of the functions they expose.

Raspberry PI 4 at last!

It was with astonishment that I opened up my browser this morning to read some daily IT news, only to discover that the Raspberry PI v4 has finally arrived! And boy what a landslide update to the 3.x family it is!

Three times the fun

There are plenty of sites that entertains page-up and page-down with numbers, but I will save all that for an article where I have the physical kit in my posession. But looking at the preliminaries I think it’s safe to say that we are looking at a solid 3x the speed of the older yet capable PI 3b+.

The PI returns, and what a joy it is!

While the 3x speed boost is enough to bump the SoC up, from entertaining to serious for business applications – it’s ultimately the memory footprint that will make all the difference. While the Raspberry PI is probably the most loved SBC (single board computer) of all time, it’s always been cut short due to lack of memory. 512 megabyte can only do so much in 2019, and even the slimmest of Linux distributions quickly consumes more ram that older versions could supply.

VideoCore 6, two screens and 4k video

The new model ships in three different configurations, with 1, 2 and 4 gigabytes of ram respectively. I strongly urge people to get the 4Gb version, because with that amount of memory coupled with a good solid-state-disk, means you can enable a proper swap-partition. No matter how fast a SoC might be, without memory to compliment it – the system simply wont be able to deliver on its potential. But with 4Gb, a nice solid state disk (just use a SSD-To-USB with one of the sexy new USB 3.x ports) and you are looking at an OK mini-computer capable of most desktop applications.

I have to admit I never expected the PI to ship with support for two monitors, but lo-and-behold, the board has two mini-hdmi out ports! The board is also fitted with the VideCore 6 rather than VideoCore 4.

Not missing the boat with Oxygene and Elements

One of the most frustrating episodes in the history of Delphi, is that we never got a Delphi edition that could target Raspberry PI (or ARM-Linux in general). It was especially frustrating since Allen Bauer actually demonstrated Delphi generating code that ran on a PI in 2012. The result of not directly supporting the PI, even on service level without a UI layer – is that Delphi developers have missed the IOT market completely.

Before Delphi developers missed the IOT revolution, Delphi also missed out on iOS and Android. By the time Delphi developers could target any of these platforms, the market was completely saturated, and all opportunities to make money was long gone. In other words, Delphi has missed the boat on 3 revolutionary platforms in a row. Something which is borderline unforgivable.

The good news though is that Oxygene, the object-pascal compiler from RemObjects, supports the Raspberry PI SoC. I have yet to test this on v4, but since the PI v4 is 100% backwards compatible I don’t see any reason why there should be any issues. The code generated by Oxygene is not bound to just the PI either. As long as it runs on a debian based distro, it should run just fine on most ARM-Linux SoC’s that have working drivers.

And like I have written about elsewhere, you can also compile for WebAssembly, running either in node.js or in the browser — so there are plenty of ways to get your products over!

Stay tuned for the lineup

This week im going to do a lot of testing on various ARM devices to find out just how many SBC’s Oxygene can target, starting with the ODroid N2. But for Raspberry PI, that should be a slam-dunk. Meaning that object-pascal developers can finally make use of affordable off-the-shelves parts in their hardware projects.

As of writing im preparing the various boards I will be testing. We have the PI 3b+, the Tinkerboard from ASUS, NanoPI, Dragonboard, Odroid XU4 – and the latest power-board, the ODroid N2. Out of these offerings only the N2 is en-par with the Raspberry PI v4, although I suspect the Videocore 6 GPU will outperform the Mali G52.

Hydra now supports Freepascal and Java

In case you guys missed it, RemObjects Hydra 6.2 now supports FreePascal!

This means that you can now use forms and units from .net and Java from your Freepascal applications – and (drumroll) also mix and match between Delphi, .net, Java and FPC modules! So if you see something cool that Freepascal lacks, just slap it in a Hydra module and you can use it across language barriers.

I have used Hydra for years with Delphi, and being able to use .net forms and components in Delphi is pretty awesome. It’s also a great framework for building modular applications that are easier to manage.

Being able to tap into Freepascal is a great feature. Or the other way around, with Freepascal showing forms from Delphi, .net or Java.

For example, if you are moving to Freepascal, you can isolate the forms or controls that are not available under Freepascal in a Hydra module, and voila – you can gradually migrate.

If you are moving to Oxygene Pascal the same applies, you can implement the immediate logic under .net, and then import and use the parts that can’t easily be ported (or that you want to wait with).

The best of four worlds — You gotta love that!

Check out Hydra here:

https://hydra.remobjects.com/hydra/whatsnew/default.aspx

 

RemObjects VCL, mind blown!

For a guy that spends most of his time online, and can talk for hours about the most nerdy topics known to mankind – being gobsmacked and silenced is a rare event. But this morning that was exactly what happened.

Now, Marc Hoffman has blogged regularly over the years regarding the evolution of the RemObjects toolchain; explaining how they decoupled the parts that make up a programming language, such as syntax, rtl and target, but I must admit haven’t really digested the full implications of that work.

Like most developers I have kept my eyes on the parts relevant for me, like the Remoting SDK, Data Abstract and Javascript support. Before I worked at Embarcadero I pretty much spent 10 years contracting -and building Smart Mobile Studio on the side together with the team at The Smart Company Inc.

Smart Pascal gained support for RemObjects SDK servers quite early

Since both the Remoting SDK and Data Abstract were part of our toolbox as Delphi developers, those were naturally more immediate than anything else. We also added support for RemObjects Remoting SDK inside Smart Mobile Studio, so that people could call existing services from their Javascript applications.

Oxygene then

Like most Delphi developers I remember testing Oxygene Pascal when I bought Delphi 2005. Back then Oxygene was licensed by Borland under the “Prism” name and represented their take on dot net support. I was very excited when it came out, but since my knowledge of the dot net framework was nil, I was 100% relient on the documentation.

In many ways Oxygene was a victim of Rad Studio’s abhorrent help-file system. Documentation for Rad Studio (especially Delphi) up to that point had been exemplary since Delphi 4; but by the time Rad Studio 2005 came out, the bloat had reached epic levels. Even for me as a die-hard Delphi fanatic, Delphi 2005 and 2006 was a tragic experience.

Removing Oxygene was a monumental mistake

I mean, when it takes 15 minutes (literally) just to open the docs, then learning a whole new programming paradigm under those conditions was quite frankly impossible. Like most Delphi developers I was used to Delphi 7 style documentation, where the docs were not just reference material – but actually teaches you the language itself.

In the end Oxygene remained very interesting, but with a full time job, deadlines and kids to take care of, I stuck to what I knew – namely the VCL.

Oxygene today

Just like Delphi has evolved and improved radically since 2005, Oxygene has likewise evolved above and beyond its initial form. Truth be told, we copied a lot of material from Oxygene when we made Smart Pascal, so I feel strangely at home with Oxygene even after a couple of days. The documentation for Oxygene Pascal (and Elements as a whole) is very good: https://docs.elementscompiler.com/Oxygene/

But Oxygene Pascal, while the obvious “first stop” for Delphi developers looking to expand their market impact, is more than “just a language”. It’s a language that is a part of a growing family of languages that RemObjects support and evolve.

As of writing RemObjects offers the following languages. So even if you don’t have a background in Delphi, or perhaps migrated from Delphi to C# years ago – RemObjects will have solutions and benefits to offer:

• Oxygene (object pascal)
• C#
• Swift
• Java

Water is a sexy, slim new IDE for RemObjects languages on Windows. For the OS X version you want to download Fire.

And here is the cool thing: when you hear “Java” you automatically expect that you are bound hands and feet to the Java runtime-libraries right? Same also with C#, you expect C# to be purely limited to the dot-net framework. And if you like me dabbed in Oxygene back in 2005-2006, you probably think Oxygene is purely a dot-net adapted version of Object Pascal right? But RemObjects have turned that on it’s head!

Remember the decoupling I mentioned at the beginning of this post? What that means in practical terms is that they have separated each language into three distinct parts:

1. The syntax
2. The RTL
3. The target

What this means, is that you can pick your own combinations!

Let’s say you are coming from Delphi. You have 20 years of Object Pascal experience under your belt, and while you dont mind learning new things – Object Pascal is where you will be most productive.

Well in that case picking Oxygene Pascal covers the syntax part. But you don’t have to use the dot-net framework if you don’t want to. You can mix and match these 3 parts as you see fit! Let’s look at some combinations you could pick:

• Oxygene Pascal -> dot net framework -> CIL
• Oxygene Pascal -> “VCL” -> CIL
• Oxygene Pascal -> “VCL” -> WinAPI
• Oxygene Pascal -> “VCL” -> WebAssembly

(*) The “VCL” here is a compatibility RTL closely modeled on the Freepascal LCL and Delphi VCL. This is written from scratch and contains no proprietary code. It is purely to get people productive faster.

The whole point of this tripartite decoupling is to allow developers to maximize the value of their existing skill-set. If you know Object Pascal then that is a natural starting point for you. If you know the VCL then obviously the VCL compatibility RTL is going to help you become productive much faster than calling WinAPI on C level. But you can, if you like, go all native. And you can likewise ignore native and opt for WebAssembly.

Sound cool? Indeed it is! But it gets better, let’s look at some of the targets:

• Microsoft Windows
• Apple OS X
• Apple iOS
• Apple WatchOS
• Android
• Android wearables
• Linux x86 / 64
• Linux ARM
• tvOS
• WebAssembly
• * dot-net
• * Java

In short: Pick the language you want, pick the RTL or framework you want, pick the target you want — and start coding!

(*) dot-net and Java are not just frameworks, they are also targets since they are Virtual Machines. WebAssembly also fall under the VM category, although the virtual machine there is bolted into Chrome and Firefox (also node.js).

Some example code

Webassembly is something that interest me more than native these days. Sure I love the speed that native has to offer, but since Javascript has become “the defacto universal platform”, and since most of my work privately is done in Javascript – it seems like the obvious place to start.

Webassembly is a bit like Javascript was 10 years ago. I remember it was a bit of a shock coming from Delphi. We had just created Smart Mobile Studio, and suddenly we realized that the classes and object the browser had to offer were close to barren. We were used to the VCL after all. So my work there was basically to implement something with enough similarity to the VCL to be familiar to to Delphi developer, without wandering too far away from established JS standards.

Webassembly is roughly in the same ballpark. Webassembly is just a runtime engine. It doesn’t give you all those nice and helpful classes out of the box. You are expected to either write that yourself – or (as luck would have it) rely on what language vendors provide.

RemObjects have a lot to offer here, because their “Delphi VCL” compatibility RTL compiles just fine for Webassembly. There is no form designer though, but I haven’t used a form designer in years. I prefer to do everything in code because that’s ultimately what works when your codebase grows large enough anyways. Even my Delphi projects are done mainly as raw code, because I like to have the option to compile with Freepascal and Lazarus.

My first test code for Oxygene Pascal with Webassembly as the target is thus very bare-bone. If there is something that has bugged me to no end, it’s that bloody HTML5 canvas. It’s a powerful thing, but it’s also overkill for per-pixel operations. So I figured that a nice, ad-hoc DIB (device independent bitmap) class will do wonders.

Note: Oxygene supports pointers, even under WebAssembly (!), but out of old habit I have avoided it. I want my code to compile for all the targets, without marking a class as “unsafe” in the dot-net paradigm. So I have avoided pointers and just use offsets instead.

namespace qtxlib;

interface

type

  // in-memory pixel format
  TPixelFormat = public (
      pf8bit  = 0,  //___8 -- palette indexed
      pf15bit = 1,  //_555 -- 15 bit encoded
      pf16bit = 2,  //_565 -- 16 bit encoded
      pf24bit = 3,  //_888 -- 24 bit native
      pf32bit = 4   //888A -- 32 bit native
      );

  TPixelBuffer = public class
  private
    FPixels:  array of Byte;
    FDepthLUT: array of Integer;
    FScanLUT: array of Integer;
    FStride:  Integer;
    FWidth:   Integer;
    FHeight:  Integer;
    FBytes:   Integer;
    FFormat:  TPixelFormat;
  protected
    function  CalcStride(const Value, PixelByteSize, AlignSize: Integer): Integer;
    function  GetEmpty: Boolean;
  public
    property  Width: Integer read FWidth;
    property  Height: Integer read FHeight;
    property  Stride: Integer read FStride;
    property  &Empty: Boolean read GetEmpty;
    property  BufferSize: Integer read FBytes;
    property  PixelFormat: TPixelFormat read FFormat;
    property  Buffer[const index: Integer]: Byte read (FPixels[&index]) write (FPixels[&index]);

    function  OffsetForPixel(const dx, dy: Integer): Integer;
    procedure Alloc(NewWidth, NewHeight: Integer; const PxFormat: TPixelFormat);
    procedure Release();

    function Read(Offset: Integer; ByteLength: Integer): array of Byte;
    procedure Write(Offset: Integer; const Data: array of Byte);

    constructor Create; virtual;

    finalizer;
    begin
      if not GetEmpty() then
        Release();
    end;
end;

TColorMixer = public class
end;

TPainter = public class
private
  FBuffer:    TPixelBuffer;
public
  property    PixelBuffer: TPixelBuffer read FBuffer;

  constructor Create(const PxBuffer: TPixelBuffer); virtual;
end;

implementation

//##################################################################################
// TPainter
//##################################################################################

constructor TPainter.Create(const PxBuffer: TPixelBuffer);
begin
  inherited Create();
  if PxBuffer  nil then
    FBuffer := PxBuffer
  else
    raise new Exception("Pixelbuffer cannot be NIL error");
end;

//##################################################################################
// TPixelBuffer
//##################################################################################

constructor TPixelBuffer.Create;
begin
  inherited Create();
  FDepthLUT := [1, 2, 2, 3, 4];
end;

function TPixelBuffer.GetEmpty: Boolean;
begin
  result := length(FPixels) = 0;
end;

function TPixelBuffer.OffsetForPixel(const dx, dy: integer): Integer;
begin
  if length(FPixels) > 0 then
  begin
    result := dy * FStride;
    inc(result, dx * FDepthLUT[FFormat]);
  end;
end;

procedure TPixelBuffer.Write(Offset: Integer; const Data: array of Byte);
begin
  for each el in Data do
  begin
    FPixels[Offset] := el;
    inc(Offset);
  end;
end;

function TPixelBuffer.Read(Offset: Integer; ByteLength: Integer): array of Byte;
begin
  result := new Byte[ByteLength];
  var xOff := 0;
  while ByteLength > 0 do
  begin
    result[xOff] := FPixels[Offset];
    dec(ByteLength);
    inc(Offset);
    inc(xOff);
  end;
end;

procedure TPixelBuffer.Alloc(NewWidth, NewHeight: Integer; const PxFormat: TPixelFormat);
begin
  if not GetEmpty() then
    Release();

  if NewWidth < 1 then
    raise new Exception("Invalid width error");

  if NewHeight  0 then
    result := ( (Result + AlignSize) - xFetch );
end;

end.

This code is just meant to give you a feel for the dialect. I have used a lot of “Delphi style” coding here, so chances are you will hardly see any difference bar namespaces and a funny looking property declaration.

Stay tuned for more posts as I explore the different aspects of Oxygene and webassembly in the days to come 🙂

RemObjects Remoting SDK?

Reading this you could be forgiven for thinking that I must promote RemObjects products, It’s my job now right? Well yes, but also no.

The thing is, I’m really not “traveling salesman” material by any stretch of the imagination. My tolerance for bullshit is ridiculously low, and being practical of nature I loath fancy products that cost a fortune yet deliver nothing but superficial fluff.

The reasons I went to work at RemObjects are many, but most of all it’s because I have been an avid supporter of their products since they launched. I have used and seen their products in action under intense pressure, and I have come to put some faith in their solutions.

Trying to describe what it’s like to write servers that should handle thousands of active user “with or without” RemObjects Remoting SDK is exhausting, because you end up sounding like a fanatic. Having said that, I feel comfortable talking about the products because I speak from experience.

I will try to outline some of the benefits here, but you really should check it out yourself. You can download a trial directly here: https://www.remotingsdk.com/ro/

Remoting framework, what’s that?

RemObjects Remoting framework (or “RemObjects SDK” as it was called earlier) is a framework for writing large-scale RPC (remote procedure call) servers and services. Unlike the typical solutions available for Delphi and C++ builder, including those from Embarcadero I might add, RemObjects framework stands out because it distinguishes between transport, host and message-format – and above all, it’s sheer quality and ease of use.

RemObjects Remoting SDK ships with a rich selection of channels and message formats

This separation between transport, host and message-format makes a lot of sense, because the parameters and data involved in calling a server-method, shouldn’t really be affected by how it got there.

And this is where the fun begins because the framework offers you a great deal of different server types (channels) and you can put together some interesting combinations by just dragging and dropping components.

How about JSON over email? Or XML over pipes?

The whole idea here is that you don’t have to just work with one standard (and pay through the nose for the privilege). You can mix and match from a rich palette of transport mediums and message-formats and instead focus on your job; to deliver a kick-ass product.

And should you need something special that isn’t covered by the existing components, inheriting out your own channel or message classes is likewise a breeze. For example, Andre Mussche have some additional components on GitHub that adds a WebSocket server and client. So there is a lot of room for expanding and building on the foundation provided by RemObjects.

And this is where RemObjects has the biggest edge (imho), namely that their solutions shaves weeks if not months off your development time. And the central aspect of that is their integrated service designer.

Integration into the Delphi IDE

Dropping components on a form is all good and well, but the moment you start coding services that deploy complex data-types (records or structures) the amount of boilerplate code can become overwhelming.

The whole point of a remoting framework is that it should expose your services to the world. Someone working in .net or Java on the other side of the planet should be able to connect, consume and invoke your services. And for that to happen every minute detail of your service has to follow standards.

The RemObjects Service Builder integrates directly into the Delphi IDE

When you install RemObjects SDK, it also integrates into the Delphi IDE. And one of the features it integrates is a complete, separate service designer. The designer can also be used outside of the Delphi IDE, but I cannot underline enough how handy it is to be able to design your services visually, right there and then, in the Delphi IDE.

This designer doesn’t just help you design your service description (RemObjects has their own RODL file-format, which is a bit like a Microsoft WSDL file), the core purpose is to auto-generate all the boilerplate code for you — directly into your Delphi project (!)

So instead of you having to spend a week typing boilerplate code for your killer solution, you get to focus on implementing the actual methods (which is what you are supposed to be doing in the first place).

DLL services, code re-use and multi-tenancy

The idea of multi-tenancy is an interesting one. One that I talked about with regards to Rad-Server both in Oslo and London before christmas. But Rad-Server is not the only system that allows for multi-tenancy. I was doing multi-tenancy with RemObjects SDK some 14 years ago (if not earlier).

Remember how I said the framework distinguishes between transport, message and host? That last bit, namely host, is going to change how you write applications.

When you install the framework, it registers a series of custom project types inside the Delphi IDE. So if you want to create a brand new RemObjects SDK server project, you can just do that via the ordinary File->New->Other menu option.

One of the project types is called a DLL Server. Which literally means you get to isolate a whole service library inside a single DLL file! You can then load in this DLL file and call the functions from other projects. And that is, ultimately, the fundamental principle for multi-tenancy.

And no, you don’t have to compile your project with external packages for this to work. The term “dll-server” can also be a bit confusing, because we are not compiling a network server into a DLL file, we are placing the code for a service into a DLL file. I used this project type to isolate common code, so I wouldn’t have to copy unit-files all over the place when delivering the same functionality.

It’s also a great way to save money. Don’t want to pay for that new upgrade? Happy with the database components you have? Isolate them in a DLL-Server and continue to use the code from your new Delphi edition. I have Delphi XE3 Database components running inside a RemObjects DLL-Server that I use from Delphi XE 10.3.

DLL server is awesome and elegantly solves real-life problems out of the box

In my example I was doing business-logic for our biggest customers. Each of them used the same database, but they way they registered data was different. The company I worked for had bought up these projects (and thus their customers with them), and in order to keep the customers happy we couldn’t force them to re-code their systems to match ours. So we had to come up with a way to upgrade our technology without forcing a change on them.

The first thing I did was to create a “DLL server” that dealt with the database. It exposed methods like openTable(), createInvoice(), getInvoiceById() and so on. All the functions I would need to work with the data without getting my fingers dirty with SQL outside the DLL. So all the nitty gritty of SQL components, queries and whatnot was neatly isolated in that DLL file.

I then created separate DLL-Server projects for each customer, implemented their service interfaces identical to their older API. These DLL’s directly referenced the database library for authentication and doing the actual work.

When integrated with the IDE, you are greeted with a nice welcome window when you start Delphi. Here you can open examples or check out the documentation

Finally, I wrapped it all up in a traditional Windows system service, which contained two different server-channels and the message formats they needed. When the service was started it would simply load in the DLL’s and manually register their services and types with the central channel — and voila, it worked like a charm!

Rock solid

Some 10 years after I delivered the RemObjects based solution outlined above, I got a call from my old employer. They had been victim of a devastating cyber attack. I got a bit anxious as he went on and on about damages and costs, fearing that I had somehow contributed to the situation.

But it turned out he called to congratulate me! Out of all the services in their server-park, mine were the only ones left standing when the dust settled.

The RemObjects payload balancer had correctly dealt with both DDOS and brute force attacks, and the hackers were left wanting at the gates.