Archive

Posts Tagged ‘QTX’

C/C++ porting, QTX and general status

March 15, 2020 2 comments

C is a language that I used to play around with a lot back in the Amiga days. I think the last time I used a C compiler to write a library must have been in 1992 or something like that? I held on to my Amiga 1200 for as long as i could – but having fallen completely in love with Pascal, I eventually switched to x86 and went down the Turbo Pascal road.

Lately however, C++ developers have been asking for their own Developer group on Facebook. I run several groups on Facebook in the so-called “developer” family. So you have Delphi Developer, FPC Developer, Node.JS Developer and now – C++Builder developer. The groups more or less tend to themselves, and the node.js and FPC groups are presently being seeded (meaning, that the member count is being grown for a period).

The C++Builder group however, is having the same activity level as the Delphi group almost, thanks to some really good developers that post links, tips and help solve questions. I was also fortunate enough to have David Millington come on the Admin team. David is leading the C++Builder project, so his insight  and knowledge of both language and product is exemplary. Just like Jim McKeeth, he is a wonderful resource for the community and chime in with answers to tricky questions whenever he has time to spare.

Getting back in the saddle

Having working some 30 years with Pascal and Object Pascal, 25 of those years in Delphi, C/C++ is never far away. I have an article on the subject that i’ve written for the Idera Community website, so I wont dig too deep into that here — but needless to say, Rad Studio consists of two languages: Object Pascal and C/C++, so no matter how much you love either language, the other is never far away.

So I figured it was time for this old dog to learn some new tricks! I have always said that it’s wise to learn a language immediately below and above your comfort zone. So if Delphi is your favorite language, then C/C++ is below you (meaning: more low level and complex). Above you are languages like JavaScript and C#. Learning JavaScript makes strategic sense (or use DWScript to compile Pascal to JavaScript like I do).

When I started out, the immediate language below Object Pascal was never C, but assembler. So for the longest time I turned to assembler whenever I needed a speed boost; graphics manipulation and processing pixels is especially a field where assembly makes all the difference.

But since C++Builder is indeed an integral part of Rad Studio, and Object Pascal and C/C++ so intimately connected (they have evolved side by side), why not enjoy both assembly and C right?

So I decided to jump back into the saddle and see what I could make of it.

C/C++ is not as hard as you think

intf

I’m having a ball writing C/C++, and just like Delphi – you can start where you are.

While I’m not going to rehash the article I have already prepared for the Idera Community pages here, I do want to encourage people to give it a proper try. I have always said that if you know an archetypal language, you can easily pick up other languages, because the archetypal languages will benefit you for a lifetime. This has to do with archetypal languages operating according to how computers really work; as opposed to optimistic languages (a term from the DB work, optimistic locking), also called contextual languages, like C#, Java, JavaScript etc. are based on how human beings would like things to be.

So I now had a chance to put my money where my mouth is.

When I left C back in the early 90s, I never bothered with OOP. I mean, I used C purely for shared libraries anyways, while the actual programs were done in Pascal or a hybrid language called Blitz Basic. The latter compiled to razor sharp machine code, and you could use inline assembly – which I used a lot back then (very few programmers on those machines went without assembler, it was almost given that you could use 68k in some capacity).

Without ruining the article about to be published, I had a great time with C++Builder. It took a few hours to get my bearings, but since both the VCL and FMX frameworks are there – you can approach C/C++ just like you would Object Pascal. So it’s a matter of getting an overview really.

Needless to say, I’ll be porting  a fair share of my libraries to C/C++ when I have time (those that makes sense under that paradigme). It’s always good to push yourself and there are plenty of subtle differences that I found useful.

Quartex Media Desktop

When I last wrote about QTX we were nearing the completion of the FileSystem and Task Management service. The prototype had all its file-handling directly in the core service  (or server) which worked just fine — but it was linked to the Smart Pascal RTL. It has taken time to write a new RTL + a full multi-user, platform independent service stack and desktop (phew!) but we are seeing progress!

desktop

The QTX Baseline backend services is now largely done

The filesystem service is now largely done! There are a few synchronous calls I want to get rid of, but thankfully my framework has both async and sync variations of all file procedures – so that is now finished.

To make that clearer: first I have to wrap and implement the functionality for the RTL. Once they are in the RTL, I can use those functions to build the service functions. So yeah, it’s been extremely elaborate — but thankfully it’s also become a rich, well organized codebase (both the RTL and the Quartex Media Desktop codebases) – so I think we are ready to get cracking on the core!

The core is still operating with the older API. So our next step is to remove that from the core and instead delegate calls to the filesystem to our new service. So the core will simply be reduced to a post-office or traffic officer if you like. Messages come in from the desktops, and the core delegates the messages to whatever service is in charge of them.

But, this also means that both the core and the desktop must use the new and fancy messages. And this is where I did something very clever.

While I was writing the service, I also write a client class to test (obviously). And the way the core works — means that the same client that the core use to talk to the services — can be used by the desktop as well.

So our work in the desktop to get file-access and drives running again, is to wrap the client in our TQTXDevice ancestor class. The desktop NEVER accesses the API directly. All it knows about are these device drivers (or object instances). Which is  how we solve things like DropBox and Google Drive support. The desktop wont have the faintest clue that its using Dropbox, or copying files between a local disk and Google Drive for example — because it only communicates with these device classes.

Recursive stuff

One thing that sucked about node.js function for deleting a folder, is that it’s recursive parameter doesn’t work on Windows or OS X. So I had to implement a full recursive deletefolder routine manually. Not a big thing, but slightly more painful than expected under asynchronous execution. Thankfully, Object Pascal allows for inline defined procedures, so I didn’t have to isolate it in a separate class.

Here is some of the code, a tiny spec compared to the full shabam, but it gives you an idea of what life is like under async conditions:

unit service.file.core;

interface

{.$DEFINE DEBUG}

const
  CNT_PREFS_DEFAULTPORT     = 1883;
  CNT_PREFS_FILENAME        = 'QTXTaskManager.preferences.ini';
  CNT_PREFS_DBNAME          = 'taskdata.db';

  CNT_ZCONFIG_SERVICE_NAME  = 'TaskManager';

uses
  qtx.sysutils,
  qtx.json,
  qtx.db,
  qtx.logfile,
  qtx.orm,
  qtx.time,

  qtx.node.os,
  qtx.node.sqlite3,
  qtx.node.zconfig,
  qtx.node.cluster,

  qtx.node.core,
  qtx.node.filesystem,
  qtx.node.filewalker,
  qtx.fileapi.core,

  qtx.network.service,
  qtx.network.udp,

  qtx.inifile,
  qtx.node.inifile,

  NodeJS.child_process,

  ragnarok.types,
  ragnarok.Server,
  ragnarok.messages.base,
  ragnarok.messages.factory,
  ragnarok.messages.network,

  service.base,
  service.dispatcher,
  service.file.messages;

type

  TQTXTaskServiceFactory = class(TMessageFactory)
  protected
    procedure RegisterIntrinsic; override;
  end;

  TQTXFileWriteCB = procedure (TagValue: variant; Error: Exception);
  TQTXFileStateCB = procedure (TagValue: variant; Error: Exception);

  TQTXUnRegisterLocalDeviceCB = procedure (TagValue: variant; DiskName: string; Error: Exception);
  TQTXRegisterLocalDeviceCB = procedure (TagValue: variant; LocalPath: string; Error: Exception);
  TQTXFindDeviceCB = procedure (TagValue: variant; Device: JDeviceInfo; Error: Exception);
  TQTXGetDisksCB = procedure (TagValue: variant; Devices: JDeviceList; Error: Exception);

  TQTXGetFileInfoCB = procedure (TagValue: variant; LocalName: string; Info: JStats; Error: Exception);
  TQTXGetTranslatePathCB = procedure (TagValue: variant; Original, Translated: string; Error: Exception);

  TQTXCheckDevicePathCB = procedure (TagValue: variant; PathName: string; Error: Exception);

  TQTXServerExecuteCB = procedure (TagValue: variant; Data: string; Error: Exception);

  TQTXTaskService = class(TRagnarokService)
  private
    FPrefs:     TQTXIniFile;
    FLog:       TQTXLogEmitter;
    FDatabase:  TSQLite3Database;

    FZConfig:   TQTXZConfigClient;
    FRegHandle: TQTXDispatchHandle;
    FRegCount:  integer;

    procedure   HandleGetDevices(Socket: TNJWebSocketSocket; Request: TQTXBaseMessage);
    procedure   HandleGetDeviceByName(Socket: TNJWebSocketSocket; Request: TQTXBaseMessage);
    procedure   HandleCreateLocalDevice(Socket: TNJWebSocketSocket; Request: TQTXBaseMessage);
    procedure   HandleDestroyDevice(Socket: TNJWebSocketSocket; Request: TQTXBaseMessage);
    procedure   HandleFileRead(Socket: TNJWebSocketSocket; Request: TQTXBaseMessage);
    procedure   HandleFileReadPartial(Socket: TNJWebSocketSocket; Request: TQTXBaseMessage);
    procedure   HandleGetFileInfo(Socket: TNJWebSocketSocket; Request: TQTXBaseMessage);
    procedure   HandleFileDelete(Socket: TNJWebSocketSocket; Request: TQTXBaseMessage);

    procedure   HandleFileWrite(Socket: TNJWebSocketSocket; Request: TQTXBaseMessage);
    procedure   HandleFileWritePartial(Socket: TNJWebSocketSocket; Request: TQTXBaseMessage);
    procedure   HandleFileRename(Socket: TNJWebSocketSocket; Request: TQTXBaseMessage);
    procedure   HandleGetDir(Socket: TNJWebSocketSocket; Request: TQTXBaseMessage);

    procedure   HandleMkDir(Socket: TNJWebSocketSocket; Request: TQTXBaseMessage);
    procedure   HandleRmDir(Socket: TNJWebSocketSocket; Request: TQTXBaseMessage);

    procedure   ExecuteExternalJS(Params: array of string;
      TagValue: variant; const CB: TQTXServerExecuteCB);

    procedure   SendError(Socket: TNJWebSocketSocket; Request: TQTXBaseMessage; Message: string);

  protected
    function    GetFactory: TMessageFactory; override;
    procedure   SetupPreferences(const CB: TRagnarokServiceCB);
    procedure   SetupLogfile(LogFileName: string;const CB: TRagnarokServiceCB);
    procedure   SetupDatabase(const CB: TRagnarokServiceCB);

    procedure   ValidateLocalDiskName(TagValue: variant; Username, DeviceName: string; CB: TQTXCheckDevicePathCB);
    procedure   RegisterLocalDevice(TagValue: variant; Username, DiskName: string; CB: TQTXRegisterLocalDeviceCB);
    procedure   UnRegisterLocalDevice(TagValue: variant; UserName, DiskName:string; CB: TQTXUnRegisterLocalDeviceCB);

    procedure   GetDevicesForUser(TagValue: variant; UserName: string; CB: TQTXGetDisksCB);
    procedure   FindDeviceByName(TagValue: variant; UserName, DiskName: string; CB: TQTXFindDeviceCB);
    procedure   FindDeviceByType(TagValue: variant; UserName: string; &Type: JDeviceType; CB: TQTXGetDisksCB);

    procedure   GetTranslatedPathFor(TagValue: variant; Username, FullPath: string; CB: TQTXGetTranslatePathCB);

    procedure   GetFileInfo(TagValue: variant; UserName: string; FullPath: string; CB: TQTXGetFileInfoCB);

    procedure   SetupTaskTable(const TagValue: variant; const CB: TRagnarokServiceCB);
    procedure   SetupOperationsTable(const TagValue: variant; const CB: TRagnarokServiceCB);
    procedure   SetupDeviceTable(const TagValue: variant; const CB: TRagnarokServiceCB);

    procedure   AfterServerStarted; override;
    procedure   BeforeServerStopped; override;
    procedure   Dispatch(Socket: TNJWebSocketSocket; Message: TQTXBaseMessage); override;

  public
    property    Preferences: TQTXIniFile read FPrefs;
    property    Database: TSQLite3Database read FDatabase;

    procedure   SetupService(const CB: TRagnarokServiceCB);

    constructor Create; override;
    destructor  Destroy; override;
  end;


implementation

//#############################################################################
// TQTXFileenticationFactory
//#############################################################################

procedure TQTXTaskServiceFactory.RegisterIntrinsic;
begin
  writeln("Registering task interface");
  &Register(TQTXFileGetDeviceListRequest);
  &Register(TQTXFileGetDeviceByNameRequest);
  &Register(TQTXFileCreateLocalDeviceRequest);
  &Register(TQTXFileDestroyDeviceRequest);
  &Register(TQTXFileReadPartialRequest);
  &Register(TQTXFileReadRequest);
  &Register(TQTXFileWritePartialRequest);
  &Register(TQTXFileWriteRequest);
  &Register(TQTXFileDeleteRequest);
  &Register(TQTXFileRenameRequest);
  &Register(TQTXFileInfoRequest);
  &Register(TQTXFileDirRequest);
  &Register(TQTXMkDirRequest);
  &Register(TQTXRmDirRequest);
  &Register(TQTXFileRenameRequest);
  &Register(TQTXFileDirRequest);
end;

//#############################################################################
// TQTXTaskService
//#############################################################################

constructor TQTXTaskService.Create;
begin
  inherited Create;
  FPrefs := TQTXIniFile.Create();
  FLog := TQTXLogEmitter.Create();
  FDatabase := TSQLite3Database.Create(nil);

  FZConfig := TQTXZConfigClient.Create();
  FZConfig.Port := 2292;

  self.OnUserSignedOff := procedure (Sender: TObject; Username: string)
  begin
    WriteToLogF("We got a service signal! User [%s] has signed off completely", [Username]);
  end;

  MessageDispatch.RegisterMessage(TQTXFileGetDeviceListRequest, @HandleGetDevices);
  MessageDispatch.RegisterMessage(TQTXFileGetDeviceByNameRequest, @HandleGetDeviceByName);
  MessageDispatch.RegisterMessage(TQTXFileCreateLocalDeviceRequest, @HandleCreateLocalDevice);
  MessageDispatch.RegisterMessage(TQTXFileDestroyDeviceRequest, @HandleDestroyDevice);

  MessageDispatch.RegisterMessage(TQTXFileReadRequest, @HandleFileRead);
  MessageDispatch.RegisterMessage(TQTXFileReadPartialRequest, @HandleFileReadPartial);

  MessageDispatch.RegisterMessage(TQTXFileWriteRequest, @HandleFileWrite);
  MessageDispatch.RegisterMessage(TQTXFileWritePartialRequest, @HandleFileWritePartial);

  MessageDispatch.RegisterMessage(TQTXFileInfoRequest, @HandleGetFileInfo);
  MessageDispatch.RegisterMessage(TQTXFileDeleteRequest, @HandleFileDelete);

  MessageDispatch.RegisterMessage(TQTXMkDirRequest, @HandleMkDir);
  MessageDispatch.RegisterMessage(TQTXRmDirRequest, @HandleRmDir);
  MessageDispatch.RegisterMessage(TQTXFileRenameRequest, @HandleFileRename);

  MessageDispatch.RegisterMessage(TQTXFileDirRequest, @HandleGetDir);
end;

destructor TQTXTaskService.Destroy;
begin
  // decouple logger from our instance
  self.logging := nil;

  // Release prefs + log
  FPrefs.free;
  FLog.free;
  FZConfig.free;
  inherited;
end;

procedure TQTXTaskService.SendError(Socket: TNJWebSocketSocket; Request: TQTXBaseMessage; Message: string);
begin
  var reply := TQTXErrorMessage.Create(request.ticket);
  try
    reply.Code := CNT_MESSAGE_CODE_ERROR;
    reply.Routing.TagValue := Request.Routing.TagValue;
    reply.Response := Message;

    if Socket.ReadyState = rsOpen then
    begin
      try
        Socket.Send( reply.Serialize() );
      except
        on e: exception do
        WriteToLog(e.message);
      end;
    end else
      WriteToLog("Failed to dispatch error, socket is closed error");
  finally
    reply.free;
  end;
end;

procedure TQTXTaskService.ExecuteExternalJS(Params: array of string;
  TagValue: variant; const CB: TQTXServerExecuteCB);
begin
  var LTask: JChildProcess;

  var lOpts := TVariant.CreateObject();
  lOpts.shell := false;
  lOpts.detached := true;

  Params.insert(0, '--no-warnings');

  // Spawn a new process, this creates a new shell interface
  try
    LTask := child_process().spawn('node', Params, lOpts );
  except
    on e: exception do
    begin
      if assigned(CB) then
        CB(TagValue, e.message, e);
      exit;
    end;
  end;

  // Map general errors on process level
  LTask.on('error', procedure (error: variant)
  begin
    {$IFDEF DEBUG}
    writeln("error->" + error.toString());
    {$ENDIF}
    WriteToLog(error.toString());

    if assigned(CB) then
      CB(TagValue, "", nil);
  end);

  // map stdout so we capture the output
  LTask.stdout.on('data', procedure (data: variant)
  begin
    if assigned(CB) then
      CB(TagValue, data.toString(), nil);
  end);

  // map stderr so we can capture exception messages
  LTask.stderr.on('data', procedure (error:variant)
  begin
    {$IFDEF DEBUG}
    writeln("stdErr->" + error.toString());
    {$ENDIF}

    if assigned(CB) then
      CB(TagValue, "", nil);

    WriteToLog(error.toString());
  end);
end;

function TQTXTaskService.GetFactory: TMessageFactory;
begin
  result := TQTXTaskServiceFactory.Create();
end;

procedure TQTXTaskService.SetupService(const CB: TRagnarokServiceCB);
begin
  SetupPreferences( procedure (Error: Exception)
  begin
    // No logfile yet setup (!)
    if Error  nil then
    begin
      WriteToLog("Preferences setup: Failed!");
      WriteToLog(error.message);
      raise error;
    end else
    WriteToLog("Preferences setup: OK");

    // logfile-name is always relative to the executable
    var LLogFileName := TQTXNodeFileUtils.IncludeTrailingPathDelimiter( TQTXNodeFileUtils.GetCurrentDirectory );
    LLogFileName += FPrefs.ReadString('log', 'logfile', 'log.txt');

    // Port is defined in the ancestor, so we assigns it here
    Port := FPrefs.ReadInteger('networking', 'port', CNT_PREFS_DEFAULTPORT);

    SetupLogfile(LLogFileName, procedure (Error: Exception)
    begin
      if Error  nil then
      begin
        WriteToLog("Logfile setup: Failed!");
        WriteToLog(error.message);
        raise error;
      end else
      WriteToLog("Logfile setup: OK");

      SetupDatabase( procedure (Error: Exception)
      begin
        if Error  nil then
        begin
          WriteToLog("Database setup: Failed!");
          WriteToLog(error.message);
          if assigned(CB) then
            CB(Error)
          else
            raise Error;
        end else
        WriteToLog("Database setup: OK");

        if assigned(CB) then
          CB(nil);
      end);

    end);
  end);
end;

procedure TQTXTaskService.SetupPreferences(const CB: TRagnarokServiceCB);
begin
  var lBasePath := TQTXNodeFileUtils.GetCurrentDirectory;
  var LPrefsFile := TQTXNodeFileUtils.IncludeTrailingPathDelimiter(LBasePath) + CNT_PREFS_FILENAME;

  if TQTXNodeFileUtils.FileExists(LPrefsFile) then
  begin
    FPrefs.LoadFromFile(nil, LPrefsFile, procedure (TagValue: variant; Error: Exception)
    begin
      if Error  nil then
      begin
        if assigned(CB) then
          CB(Error)
        else
          raise Error;
        exit;
      end;

      if assigned(CB) then
        CB(nil);
    end);

  end else
  begin
    var LError := Exception.Create('Could not locate preferences file: ' + LPrefsFile);
    WriteToLog(LError.message);
    if assigned(CB) then
      CB(LError)
    else
      raise LError;
  end;
end;

procedure TQTXTaskService.SetupLogfile(LogFileName: string;const CB: TRagnarokServiceCB);
begin
  // Attempt to open logfile
  // Note: Log-object error options is set to throw exceptions
  try
    FLog.Open(LogFileName);
  except
    on e: exception do
    begin
      if assigned(CB) then
      begin
        CB(e);
        exit;
      end else
      begin
        writeln(e.message);
        raise;
      end;
    end;
  end;

  // We inherit from TQTXLogObject, which means we can pipe
  // all errors etc directly using built-in functions. So here
  // we simply glue our instance to the log-file, and its all good
  self.Logging := FLog as IQTXLogClient;

  if assigned(CB) then
    CB(nil);
end;

procedure TQTXTaskService.FindDeviceByType(TagValue: variant; UserName: string; &Type: JDeviceType; CB: TQTXGetDisksCB);
begin
  UserName := username.trim().ToLower();
  if Username.length < 1 then
  begin
    WriteToLog("Failed to lookup disk, username was invalid error");
    var lError := EException.Create("Failed to lookup devices, invalid username");
    if assigned(CB) then
      CB(TagValue, nil, lError)
    else
      raise lError;
    exit;
  end;

  GetDevicesForUser(TagValue, Username,
  procedure (TagValue: variant; Devices: JDeviceList; Error: Exception)
  begin
    if Error  nil then
    begin
      if assigned(CB) then
        CB(TagValue, nil, Error)
      else
        raise Error;
      exit;
    end;

    var x := 0;
    while x < Devices.dlDrives.Count do
    begin
      if Devices.dlDrives[x].&Type  &Type then
      begin
        Devices.dlDrives.delete(x, 1);
        continue;
      end;
      inc(x);
    end;

    if assigned(CB) then
      CB(TagValue, Devices, nil);
  end);
end;

procedure TQTXTaskService.FindDeviceByName(TagValue: variant; Username, DiskName: string; CB: TQTXFindDeviceCB);
begin
  UserName := username.trim().ToLower();
  if Username.length < 1 then
  begin
    var lLogText := "Failed to lookup device, username was invalid error";
    WriteToLog(lLogText);
    var lError := EException.Create(lLogText);
    if assigned(CB) then
      CB(TagValue, nil, lError)
    else
      raise lError;
    exit;
  end;

  DiskName := DiskName.trim();
  if DiskName.length < 1 then
  begin
    var lLogText := "Failed to lookup device, disk-name was invalid error";
    WriteToLog(lLogText);
    var lError := EException.Create(lLogText);
    if assigned(CB) then
      CB(TagValue, nil, lError)
    else
      raise lError;
    exit;
  end;

  GetDevicesForUser(TagValue, Username,
  procedure (TagValue: variant; Devices: JDeviceList; Error: Exception)
  begin
    if Error  nil then
    begin
      if assigned(CB) then
        CB(TagValue, nil, Error)
      else
        raise Error;
      exit;
    end;

    DiskName := DiskName.trim().ToLower();
    var lDiskInfo: JDeviceInfo := nil;


    for var disk in Devices.dlDrives do
    begin
      if disk.Name.ToLower() = DiskName then
      begin
        lDiskInfo := disk;
        break;
      end;
    end;

    if assigned(CB) then
      CB(TagValue, lDiskInfo, nil);
  end);
end;

procedure TQTXTaskService.GetTranslatedPathFor(TagValue: variant; Username, FullPath: string; CB: TQTXGetTranslatePathCB);
begin
  var lParser := TQTXPathParser.Create();
  try
    var lInfo: TQTXPathData;
    if lparser.Parse(FullPath, lInfo) then
    begin
      // Locate the device for the path belonging to the user
      FindDeviceByName(TagValue, UserName, lInfo.MountPart,
      procedure (TagValue: variant; Device: JDeviceInfo; Error: Exception)
      begin
        if Error  nil then
        begin
          if assigned(CB) then
            CB(TagValue, FullPath, '', Error)
          else
            raise Error;
          exit;
        end;

        if Device.&Type  dtLocal then
        begin
          var lError := EException.CreateFmt('Failed to translate path, device [%s] is not local error', [Device.Name]);
          if assigned(CB) then
            CB(TagValue, FullPath, '', Error)
          else
            raise Error;
          exit;
        end;

        // We want the path + filename, so we can append that to
        // the actual localized filesystem
        var lExtract := FullPath;
        delete(lExtract, 1, lInfo.MountPart.Length + 1);

        // Construct complete storage location
        var lFullPath := TQTXNodeFileUtils.GetCurrentDirectory();
        lFullPath := TQTXNodeFileUtils.IncludeTrailingPathDelimiter(lFullPath) + 'userdevices';
        lFullPath := TQTXNodeFileUtils.IncludeTrailingPathDelimiter(lFullPath) + Device.location.trim();
        lFullPath := TQTXNodeFileUtils.IncludeTrailingPathDelimiter(lFullPath) + lExtract;

        // Return translated path
        if assigned(CB) then
          CB(TagValue, FullPath, lFullPath, nil);

      end);
    end else
    begin
      var lErr := EException.CreateFmt("Invalid path [%s] error", [FullPath]);
      if assigned(CB) then
        CB(TagValue, FullPath, '', lErr)
      else
        raise lErr;
    end;
  finally
    lParser.free;
  end;
end;

procedure TQTXTaskService.GetFileInfo(TagValue: variant; UserName, FullPath: string; CB: TQTXGetFileInfoCB);
begin
  var lParser := TQTXPathParser.Create();
  try
    var lInfo: TQTXPathData;
    if lparser.Parse(FullPath, lInfo) then
    begin
      // Locate the device for the path belonging to the user
      FindDeviceByName(TagValue, UserName, lInfo.MountPart,
      procedure (TagValue: variant; Device: JDeviceInfo; Error: Exception)
      begin
        if Error  nil then
        begin
          if assigned(CB) then
            CB(TagValue, '', nil, Error)
          else
            raise Error;
          exit;
        end;

        case Device.&Type of
        dtLocal:
          begin
            // We want the path + filename, so we can append that to
            // the actual localized filesystem
            var lExtract := FullPath;
            delete(lExtract, 1, lInfo.MountPart.Length + 1);

            // Construct complete storage location
            var lFullPath := TQTXNodeFileUtils.GetCurrentDirectory();
            lFullPath := TQTXNodeFileUtils.IncludeTrailingPathDelimiter(lFullPath) + 'userdevices';
            lFullPath := TQTXNodeFileUtils.IncludeTrailingPathDelimiter(lFullPath) + Device.location.trim();
            lFullPath := TQTXNodeFileUtils.IncludeTrailingPathDelimiter(lFullPath) + lExtract;

            // Call the underlying OS to get the file statistics
            NodeJsFsAPI().lStat(lFullPath,
            procedure (Error: JError; Stats: JStats)
            begin
              if Error  nil then
              begin
                var lError := EException.Create(Error.message);
                if assigned(CB) then
                  CB(TagValue, lFullPath, nil, lError)
                else
                  raise lError;
                exit;
              end;

              // And deliver
              if assigned(CB) then
                CB(TagValue, lFullPath, Stats, nil);
            end);
          end;
        dtDropbox, dtGoogle, dtMsDrive:
          begin
            var lError := EException.Create("Cloud bindings not activated error");
            if assigned(CB) then
              CB(TagValue, '', nil, lError)
          end;
        end;
      end);
    end else
    begin
      var lErr := EException.CreateFmt("Invalid path [%s] error", [FullPath]);
      if assigned(CB) then
        CB(TagValue, '', nil, lErr)
      else
        raise lErr;
    end;
  finally
    lParser.free;
  end;
end;

procedure TQTXTaskService.GetDevicesForUser(TagValue: variant; Username: string; CB: TQTXGetDisksCB);
begin
  UserName := username.trim().ToLower();
  if Username.length < 1 then
  begin
    WriteToLog("Failed to lookup devices, username was invalid error");
    var lError := EException.Create("Failed to lookup devices, invalid username");
    if assigned(CB) then
      CB(TagValue, nil, lError)
    else
      raise lError;
    exit;
  end;

  var lTransaction: TQTXReadTransaction;
  if not TSQLite3Database(DataBase).CreateReadTransaction(lTransaction) then
  begin
    var lErr := EException.Create("Failed to create read-transaction error");
    if assigned(cb) then
      CB(TagValue, nil, lErr)
    else
      raise lErr;
    exit;
  end;

  var lQuery := TSQLite3ReadTransaction(lTransaction);
  lQuery.SQL := "select * from devices where owner=?";
  lQuery.Parameters.AddValueOnly(Username);

  lQuery.Execute(
  procedure (Sender: TObject; Error: Exception)
  begin
    if Error  nil then
    begin
      if assigned(CB) then
        CB(TagValue, nil, Error)
      else
        raise Error;
      exit;
    end;

    var lDisks := new JDeviceList();
    lDisks.dlUser := UserName;

    for var x := 0 to lQuery.datarows.length-1 do
    begin
      var lInfo := new JDeviceInfo();
      lInfo.Name := lQuery.datarows[x]["name"];
      lInfo.&Type := JDeviceType( lQuery.datarows[x]["type"] );
      lInfo.owner := lQuery.datarows[x]["owner"];
      lInfo.location := lQuery.datarows[x]["location"];
      lInfo.APIKey := lQuery.datarows[x]["apikey"];
      lInfo.APISecret := lQuery.datarows[x]["apisecret"];
      lInfo.APIPassword := lQuery.datarows[x]["apipassword"];
      lInfo.APIUser := lQuery.datarows[x]["apiuser"];
      lDisks.dlDrives.add(lInfo);
    end;

    try
      if assigned(CB) then
        CB(TagValue, lDisks, nil);
    finally
      lQuery.free;
    end;
  end);
end;

procedure TQTXTaskService.ValidateLocalDiskName(TagValue: variant; Username, DeviceName: string; CB: TQTXCheckDevicePathCB);
begin
  var Filename := 'disk.' + username + '.' + DeviceName + '.' + ord(JDeviceType.dtLocal).ToString();

  var LBasePath := TQTXNodeFileUtils.GetCurrentDirectory();
  LBasePath := TQTXNodeFileUtils.IncludeTrailingPathDelimiter(LBasePath) + 'userdevices';

  // Make sure the device folder is there
  if not TQTXNodeFileUtils.DirectoryExists(LBasePath) then
  begin
    var lError := EException.CreateFmt("Directory not found: %s", [lBasePath]);
    if assigned(CB) then
      CB(TagValue, '', lError)
    else
      raise lError;
    exit;
  end;

  lBasePath := TQTXNodeFileUtils.IncludeTrailingPathDelimiter(LBasePath) + Filename;

  if TQTXNodeFileUtils.DirectoryExists(LBasePath) then
  begin
    var lError := EException.CreateFmt("Path already exist error [%s]", [lBasePath]);
    if assigned(CB) then
      CB(TagValue, '', lError)
    else
      raise lError;
    exit;
  end;

  // OK, folder is not created yet, so its good to go
  if assigned(CB) then
    CB(TagValue, Filename, nil);
end;

procedure TQTXTaskService.UnRegisterLocalDevice(TagValue: variant; UserName, DiskName: string; CB: TQTXUnRegisterLocalDeviceCB);
begin
  WriteToLogF("Removing local device [%s] for user [%s] ", [DiskName, Username]);

  // Check username string
  UserName := username.trim().ToLower();
  if Username.length < 1 then
  begin
    WriteToLog("Failed to unregister device, username was invalid error");
    var lError := EException.Create("Failed to register device, invalid username");
    if assigned(CB) then
      CB(TagValue, DiskName, lError)
    else
      raise lError;
    exit;
  end;

  // Check diskname string
  DiskName := DiskName.trim().ToLower();
  if DiskName.length < 1 then
  begin
    WriteToLog("Failed to unregister device, disk-name was invalid error");
    var lError := EException.Create("Failed to register device, invalid disk-name");
    if assigned(CB) then
      CB(TagValue, DiskName, lError)
    else
      raise lError;
    exit;
  end;

  FindDeviceByName(TagValue, Username, DiskName,
  procedure (TagValue: variant; Device: JDeviceInfo; Error: Exception)
  begin
    // Did the search fail?
    if Error  nil then
    begin
      WriteToLog(Error.message);
      if assigned(CB) then
        CB(TagValue, DiskName, Error)
      else
        raise Error;
      exit;
    end;

    // Make sure the device is local
    if Device.&Type  dtLocal then
    begin
      var lError := EException.CreateFmt('Failed to translate path, device [%s] is not local error', [Device.Name]);
      if assigned(CB) then
        CB(TagValue, DiskName, Error)
      else
        raise Error;
      exit;
    end;

    // Delete record from database
    var lWriter: TQTXWriteTransaction;
    if FDatabase.CreateWriteTransaction(lWriter) then
    begin
      lWriter.SQL := "delete from profiles where user = ? and name = ?;";
      lWriter.Parameters.AddValueOnly(Username);
      lWriter.Parameters.AddValueOnly(DiskName);

      lWriter.Execute(
      procedure (Sender: TObject; Error: Exception)
      begin
        try

          if Error  nil then
          begin
            if assigned(CB) then
              CB(TagValue, DiskName, Error)
            else
              raise Error;
            exit;
          end;

          // Construct complete storage location
          var lFullPath := TQTXNodeFileUtils.GetCurrentDirectory();
          lFullPath := TQTXNodeFileUtils.IncludeTrailingPathDelimiter(lFullPath) + 'userdevices';
          lFullPath := TQTXNodeFileUtils.IncludeTrailingPathDelimiter(lFullPath) + Device.location.trim();

          // Now delete the disk-drive directory
          TQTXNodeFileUtils.DeleteDirectory(nil, lFullPath,
          procedure (TagValue: variant; Path: string; Error: Exception)
          begin
            if assigned(CB) then
              CB(TagValue, DiskName, Error)
          end);

        finally
          lWriter.free;
          lWriter := nil;
        end;
      end);
    end;
  end);
end;

procedure TQTXTaskService.RegisterLocalDevice(TagValue: variant; Username, DiskName: string; CB: TQTXRegisterLocalDeviceCB);
begin
  WriteToLogF("Adding local device [%s] for user [%s] ", [DiskName, Username]);

  UserName := username.trim().ToLower();
  if Username.length < 1 then
  begin
    WriteToLog("Failed to register device, username was invalid error");
    var lError := EException.Create("Failed to register device, invalid username");
    if assigned(CB) then
      CB(TagValue, '', lError)
    else
      raise lError;
    exit;
  end;

  DiskName := DiskName.trim().ToLower();
  if DiskName.length < 1 then
  begin
    WriteToLog("Failed to register device, disk-name was invalid error");
    var lError := EException.Create("Failed to register device, invalid disk-name");
    if assigned(CB) then
      CB(TagValue, '', lError)
    else
      raise lError;
    exit;
  end;

  FindDeviceByName(TagValue, Username, DiskName,
  procedure (TagValue: variant; Device: JDeviceInfo; Error: Exception)
  begin
    // Did the search fail?
    if Error  nil then
    begin
      WriteToLog(Error.message);
      if assigned(CB) then
        CB(TagValue, '', Error)
      else
        raise Error;
      exit;
    end;

    // Does a device that match already exist?
    if Device  nil then
    begin
      var lError := EException.CreateFmt("Failed to create device [%s], device already exists", [DiskName]);
      if assigned(CB) then
        CB(TagValue, '', lError)
      else
        raise lError;
      exit;
    end;

    //  make sure the device-folder does not exist, so we can create it
    ValidateLocalDiskName(TagValue, Username, DiskName,
    procedure (TagValue: variant; PathName: string; Error: Exception)
    begin
      if Error  nil then
      begin
        if assigned(CB) then
          CB(TagValue, '', Error)
        else
          raise Error;
        exit;
      end;

      // ValidateLocalDiskName only returns the valid directory-name,
      // not a full path -- so we need to build up the full targetpath
      var lFullPath := TQTXNodeFileUtils.GetCurrentDirectory();
      lFullPath := TQTXNodeFileUtils.IncludeTrailingPathDelimiter(lFullPath) + 'userdevices';
      lFullPath := TQTXNodeFileUtils.IncludeTrailingPathDelimiter(lFullPath) + PathName;

      TQTXNodeFileUtils.CreateDirectory(nil, lFullPath,
      procedure (TagValue: variant; Path: string; Error: exception)
      begin
        if Error  nil then
        begin
          var lError := EException.CreateFmt("Failed to create device [%s] with path: %s", [DiskName, lFullPath]);
          if assigned(CB) then
            CB(TagValue, PathName, lError)
          else
            raise lError;
          exit;
        end;

        FDatabase.Execute(
          #'insert into devices (type, owner, name, location)
            values(?, ?, ?, ?);',
            [ord(JDeviceType.dtLocal), UserName, Diskname, PathName] ,
        procedure (Sender: TObject; Error: Exception)
        begin
          if Error  nil then
          begin
            WriteToLog(Error.message);
            if assigned(CB) then
              CB(TagValue, PathName, Error)
            else
              raise Error;
            exit;
          end;

          WriteToLogF("Device [%s] added to database user [%s]", [DiskName, UserName]);
          if assigned(CB) then
            CB(TagValue, PathName, nil);
        end);

      end);



    end);
  end);
end;

procedure TQTXTaskService.SetupDeviceTable(const TagValue: variant; const CB: TRagnarokServiceCB);
begin

  FDatabase.Execute(
    #'
      create table if not exists devices
          (
            id integer primary key AUTOINCREMENT,
            type        integer,
            owner       text,
            name        text,
            location    text,
            apikey      text,
            apisecret   text,
            apipassword text,
            apiuser     text
          );
          ', [],
    procedure (Sender: TObject; Error: Exception)
    begin
      if Error  nil then
      begin
        WriteToLog(Error.message);
        if assigned(CB) then
          CB(Error)
        else
          raise Error;
        exit;
      end else
      if assigned(CB) then
        CB(nil);
    end);
end;

procedure TQTXTaskService.SetupTaskTable(const TagValue: variant; const CB: TRagnarokServiceCB);
begin

  FDatabase.Execute(
    #'
      create table if not exists tasks
          (
            id integer primary key AUTOINCREMENT,
            state     integer,
            username  text,
            created   real
          );
          ', [],
    procedure (Sender: TObject; Error: Exception)
    begin
      if Error  nil then
      begin
        WriteToLog(Error.message);
        if assigned(CB) then
          CB(Error)
        else
          raise Error;
        exit;
      end else
      if assigned(CB) then
        CB(nil);
    end);
end;


procedure TQTXTaskService.SetupOperationsTable(const TagValue: variant; const CB: TRagnarokServiceCB);
begin
  FDatabase.Execute(
    #'
      create table if not exists operations
          (
            id integer primary key AUTOINCREMENT,
            username text,
            taskid integer,
            name text,
            filename text
          );
          ', [],
    procedure (Sender: TObject; Error: Exception)
    begin
      if Error  nil then
      begin
        WriteToLog(Error.message);
        if assigned(CB) then
          CB(Error)
        else
          raise Error;
        exit;
      end else
      if assigned(CB) then
        CB(nil);
    end);
end;

procedure TQTXTaskService.SetupDatabase(const CB: TRagnarokServiceCB);
begin
  // Try to read database-path from preferences file
  var LDbFileToOpen := FPrefs.ReadString("database", "database_name", "");

  // Trim away spaces, check if there is a filename
  LDbFileToOpen := LDbFileToOpen.trim();
  if LDbFileToOpen.length < 1 then
  begin
    // No filename? Fall back on pre-defined file in CWD
    var LBasePath := TQTXNodeFileUtils.GetCurrentDirectory();
    LDbFileToOpen := TQTXNodeFileUtils.IncludeTrailingPathDelimiter(LBasePath) + CNT_PREFS_DBNAME;
  end;

  FDatabase.AccessMode := TSQLite3AccessMode.sqaReadWriteCreate;
  FDatabase.Open(LDbFileToOpen,
    procedure (Sender: TObject; Error: Exception)
    begin
      if Error  nil then
      begin
        WriteToLog(Error.message);
        if assigned(CB) then
          CB(Error)
        else
          raise Error;
        exit;
      end;

      WriteToLog("Initializing task table");
      SetupTaskTable(nil, procedure (Error: exception)
      begin
        if Error  nil then
        begin
          WriteToLog("Tasks initialized: **failed");
          WriteToLog(error.message);
          if assigned(CB) then
            CB(Error)
          else
            raise Error;
          exit;
        end else
        writeToLog("Tasks initialized: OK");

        WriteToLog("Initializing operations table");
        SetupOperationsTable(nil, procedure (Error: exception)
        begin
          if Error  nil then
          begin
            WriteToLog("Operations initialized: **failed");
            WriteToLog(error.message);
            if assigned(CB) then
              CB(Error);
            exit;
          end else
          writeToLog("Operations initialized: OK");

          WriteToLog("Initializing device table");
          SetupDeviceTable(nil, procedure (Error: exception)
          begin
            if Error  nil then
            begin
              WriteToLog("Device-table initialized: **failed");
              WriteToLog(error.message);
              if assigned(CB) then
                CB(Error);
              exit;
            end else
            writeToLog("Device-table initialized: OK");

            if assigned(CB) then
              CB(nil);
          end);
        end);
      end);
    end);
end;


procedure TQTXTaskService.HandleFileRead(Socket: TNJWebSocketSocket; Request: TQTXBaseMessage);
begin
  var lRequest := TQTXFileReadRequest(request);
  var lUserName := lRequest.UserName;
  var lFileName := lRequest.FileName;

  // Check filename length
  if lFileName.length  0 then
  begin
    SendError(Socket, Request, Format("Unsupported path sequence [%s] detected error", [lTemp]) );
    exit;
  end;

  lTemp := './';
  if pos(lTemp, lFileName) > 0 then
  begin
    SendError(Socket, Request, Format("Unsupported path sequence [%s] detected error", [lTemp]) );
    exit;
  end;

  GetFileInfo(lRequest, lUserName, lFileName,
  procedure (TagValue: variant; LocalFile: string; Info: JStats; Error: Exception)
  begin
    if Error  nil then
    begin
      WriteToLog(Error.message);
      SendError(Socket, Request, Error.Message);
      exit;
    end;

    var lOptions: TReadFileOptions;
    lOptions.encoding := 'binary';

    NodeJsFsAPI().readFile(LocalFile, lOptions,
    procedure (Error: JError; Data: JNodeBuffer)
    begin
      if Error  nil then
      begin
        WriteToLog(Error.message);
        SendError(Socket, Request, Error.Message);
        exit;
      end;

      var lResponse := TQTXFileReadResponse.Create(Request.Ticket);
      lResponse.UserName := lUserName;
      lResponse.Routing.TagValue := request.routing.tagValue;
      lResponse.FileName := lFileName;
      lResponse.Code := CNT_MESSAGE_CODE_OK;
      lResponse.Response := CNT_MESSAGE_TEXT_OK;

      // Convert filedata in one pass
      try
        var lConvert := TDataTypeConverter.Create();
        try
          lResponse.Attachment.AppendBytes( lConvert.TypedArrayToBytes(Data) );
        finally
          lConvert.free;
        end;
      except
        on e: exception do
        begin
          WriteToLog(e.message);
          SendError(Socket, Request, e.Message);
          exit;
        end;
      end;

      try
        Socket.Send( lResponse.Serialize() );
      except
        on e: exception do
          WriteToLog(e.message);
      end;
    end);
  end);
end;

procedure TQTXTaskService.HandleFileReadPartial(Socket: TNJWebSocketSocket; Request: TQTXBaseMessage);
begin
  var lRequest := TQTXFileReadPartialRequest(request);
  var lUserName := lRequest.UserName;
  var lFileName := lRequest.FileName;
  var lStart := lRequest.Offset;
  var lSize := lRequest.Size;

  // Check filename length
  if lFileName.length  0 then
  begin
    SendError(Socket, Request, Format("Unsupported path sequence [%s] detected error", [lTemp]) );
    exit;
  end;

  lTemp := './';
  if pos(lTemp, lFileName) > 0 then
  begin
    SendError(Socket, Request, Format("Unsupported path sequence [%s] detected error", [lTemp]) );
    exit;
  end;

  if lSize < 1 then
  begin
    SendError(Socket, Request, "Read failed, invalid size error");
    exit;
  end;

  if lStart < 0 then
  begin
    SendError(Socket, Request, "Read failed, invalid offset error");
    exit;
  end;

  GetFileInfo(lRequest, lUserName, lFileName,
  procedure (TagValue: variant; LocalFile: string; Info: JStats; Error: Exception)
  begin
    if Error  nil then
    begin
      WriteToLog(Error.message);
      SendError(Socket, Request, Error.Message);
      exit;
    end;

    if lStart > Info.size then
    begin
      SendError(Socket, Request, "Read failed, offset beyond filesize error");
      exit;
    end;

    NodeJsFsAPI().open(LocalFile, "r",
    procedure (Error: JError; Fd: THandle)
    begin
      if error  nil then
      begin
        WriteToLog(Error.message);
        SendError(Socket, Request, Error.Message);
        exit;
      end;

      var Data = new JNodeBuffer(lSize);
      NodeJsFsAPI().read(Fd, Data, 0, lSize, lStart,
      procedure (Error: JError; BytesRead: integer; buffer: JNodeBuffer)
      begin
        if Error  nil then
        begin
          NodeJsFsAPI().closeSync(Fd);
          WriteToLog(Error.message);
          SendError(Socket, Request, Error.Message);
          exit;
        end;

        // Close the file-handle and return data
        NodeJsFsAPI().close(Fd, procedure (Error: JError)
        begin
          var lResponse := TQTXFileReadPartialResponse.Create(Request.Ticket);
          lResponse.UserName := lUserName;
          lResponse.Routing.TagValue := request.routing.tagValue;
          lResponse.FileName := lFileName;
          lResponse.Code := CNT_MESSAGE_CODE_OK;
          lResponse.Response := CNT_MESSAGE_TEXT_OK;

          // Only encode data if read
          if BytesRead > 0 then
          begin
            // Convert filedata in one pass
            try
              var lConvert := TDataTypeConverter.Create();
              try
                lResponse.Attachment.AppendBytes( lConvert.TypedArrayToBytes(buffer) );
              finally
                lConvert.free;
              end;
            except
              on e: exception do
              begin
                WriteToLog(e.message);
                SendError(Socket, Request, e.Message);
                exit;
              end;
            end;
          end;

          try
            Socket.Send( lResponse.Serialize() );
          except
            on e: exception do
              WriteToLog(e.message);
          end;

        end);
      end);
    end);
  end);
end;

procedure TQTXTaskService.HandleFileWrite(Socket: TNJWebSocketSocket; Request: TQTXBaseMessage);
begin
  var lRequest  := TQTXFileWriteRequest(request);
  var lFileName := lRequest.FileName.trim();
  var lUserName := lRequest.UserName.trim();

  var FullPath  := lFileName;

  // Check filename length
  if lFileName.length  0 then
  begin
    SendError(Socket, Request, Format("Unsupported path sequence [%s] detected error", [lTemp]) );
    exit;
  end;

  lTemp := './';
  if pos(lTemp, lFileName) > 0 then
  begin
    SendError(Socket, Request, Format("Unsupported path sequence [%s] detected error", [lTemp]) );
    exit;
  end;

  var lParser := TQTXPathParser.Create();
  try
    var lInfo: TQTXPathData;
    if lparser.Parse(FullPath, lInfo) then
    begin
      // Locate the device for the path belonging to the user
      FindDeviceByName(nil, lUserName, lInfo.MountPart,
      procedure (TagValue: variant; Device: JDeviceInfo; Error: Exception)
      begin
        if Error  nil then
        begin
          WriteToLog(Error.Message);
          SendError(Socket, Request, Error.Message);
          exit;
        end;

        case Device.&Type of
        dtLocal:
          begin
            // We want the path + filename, so we can append that to
            // the actual localized filesystem
            var lExtract := FullPath;
            delete(lExtract, 1, lInfo.MountPart.Length + 1);

            // Construct complete storage location
            var lFullPath := TQTXNodeFileUtils.GetCurrentDirectory();
            lFullPath := TQTXNodeFileUtils.IncludeTrailingPathDelimiter(lFullPath) + 'userdevices';
            lFullPath := TQTXNodeFileUtils.IncludeTrailingPathDelimiter(lFullPath) + Device.location.trim();
            lFullPath := TQTXNodeFileUtils.IncludeTrailingPathDelimiter(lFullPath) + lExtract;

            // Extract data to be appended, if any
            // note: null bytes should be allowed, it should just create the file
            var lBytes: array of UInt8;
            if lRequest.attachment.Size > 0 then
              lBytes := lRequest.Attachment.ToBytes();

            // Write the data to the file
            NodeJsFsAPI().writeFile(lFullPath, lBytes,
            procedure (Error: JError)
            begin
              if Error  nil then
              begin
                WriteToLog(Error.Message);
                SendError(Socket, Request, Error.Message);
                exit;
              end;

              // Setup response object
              var lResponse := TQTXFileWriteResponse.Create(lRequest.Ticket);
              lResponse.UserName := lUserName;
              lResponse.FileName := lFileName;
              lResponse.Code := CNT_MESSAGE_CODE_OK;
              lResponse.Response := CNT_MESSAGE_TEXT_OK;

              // Send success response
              try
                Socket.Send( lResponse.Serialize() );
              except
                on e: exception do
                  WriteToLog(e.message);
              end;

            end);

          end;
        dtDropbox, dtGoogle, dtMsDrive:
          begin
            var lErrorText := Format("Clound bindings not active error [%s]", [lRequest.FileName]);
            WriteToLog(lErrorText);
            SendError(Socket, Request, lErrorText);
          end;
        end;
      end);
    end else
    begin
      SendError(Socket, Request, format("Invalid path [%s] error", [FullPath]));
    end;
  finally
    lParser.free;
  end;
end;

procedure TQTXTaskService.HandleFileWritePartial(Socket: TNJWebSocketSocket; Request: TQTXBaseMessage);
begin
  var lRequest  := TQTXFileWritePartialRequest(request);
  var lFileName  := lRequest.FileName.trim();
  var lUserName := lRequest.UserName.trim();
  var lFileOffset := lRequest.Offset;

  // Check filename length
  if lFileName.length  0 then
  begin
    SendError(Socket, Request, Format("Unsupported path sequence [%s] detected error", [lTemp]) );
    exit;
  end;

  lTemp := './';
  if pos(lTemp, lFileName) > 0 then
  begin
    SendError(Socket, Request, Format("Unsupported path sequence [%s] detected error", [lTemp]) );
    exit;
  end;

  var FullPath := lFileName;

  var lParser := TQTXPathParser.Create();
  try
    var lInfo: TQTXPathData;
    if lparser.Parse(FullPath, lInfo) then
    begin
      // Locate the device for the path belonging to the user
      FindDeviceByName(nil, lUserName, lInfo.MountPart,
      procedure (TagValue: variant; Device: JDeviceInfo; Error: Exception)
      begin
        if Error  nil then
        begin
          WriteToLog(Error.Message);
          SendError(Socket, Request, Error.Message);
          exit;
        end;

        case Device.&Type of
        dtLocal:
          begin
            // We want the path + filename, so we can append that to
            // the actual localized filesystem
            var lExtract := FullPath;
            delete(lExtract, 1, lInfo.MountPart.Length + 1);

            // Construct complete storage location
            var lFullPath := TQTXNodeFileUtils.GetCurrentDirectory();
            lFullPath := TQTXNodeFileUtils.IncludeTrailingPathDelimiter(lFullPath) + 'userdevices';
            lFullPath := TQTXNodeFileUtils.IncludeTrailingPathDelimiter(lFullPath) + Device.location.trim();
            lFullPath := TQTXNodeFileUtils.IncludeTrailingPathDelimiter(lFullPath) + lExtract;

            // Extract data to be appended, if any
            // note: null bytes should be allowed, it should just create the file
            var lBytes: array of UInt8;
            if lRequest.attachment.Size > 0 then
              lBytes := lRequest.Attachment.ToBytes();

            var lAccess := TQTXNodeFile.Create();
            lAccess.Open(lFullPath, TQTXNodeFileMode.nfWrite,
            procedure (Error: Exception)
            begin
              if Error  nil then
              begin
                WriteToLog(Error.Message);
                SendError(Socket, Request, Error.Message);
                exit;
              end;

              lAccess.Write(lBytes, lFileOffset,
              procedure (Error: Exception)
              begin
                if Error  nil then
                begin
                  WriteToLog(Error.Message);
                  SendError(Socket, Request, Error.Message);
                  exit;
                end;

                // Setup response object
                var lResponse := TQTXFileWriteResponse.Create(lRequest.Ticket);
                lResponse.UserName := lUserName;
                lResponse.FileName := lFileName;
                lResponse.Code := CNT_MESSAGE_CODE_OK;
                lResponse.Response := CNT_MESSAGE_TEXT_OK;

                // Send success response
                try
                  Socket.Send( lResponse.Serialize() );
                except
                  on e: exception do
                    WriteToLog(e.message);
                end;

              end);
            end);
          end;
        dtDropbox, dtGoogle, dtMsDrive:
          begin
            var lErrorText := Format("Clound bindings not active error [%s]", [lRequest.FileName]);
            WriteToLog(lErrorText);
            SendError(Socket, Request, lErrorText);
          end;
        end;
      end);
    end else
    begin
      SendError(Socket, Request, format("Invalid path [%s] error", [FullPath]));
    end;
  finally
    lParser.free;
  end;
end;

procedure TQTXTaskService.HandleRmDir(Socket: TNJWebSocketSocket; Request: TQTXBaseMessage);
begin
  var lRequest := TQTXRmDirRequest(request);
  var lUserName := lRequest.UserName.trim();
  var lDirPath := lRequest.DirPath.trim();

  if lDirPath.length  0 then
  begin
    SendError(Socket, Request, Format("Unsupported path sequence [%s] detected error", [lTemp]) );
    exit;
  end;

  lTemp := './';
  if pos(lTemp, lDirPath) > 0 then
  begin
    SendError(Socket, Request, Format("Unsupported path sequence [%s] detected error", [lTemp]) );
    exit;
  end;

  var lParser := TQTXPathParser.Create();
  try
    var lInfo: TQTXPathData;
    if lParser.Parse(lDirPath, lInfo) then
    begin
      GetTranslatedPathFor(nil, lUserName, lDirPath,
      procedure (TagValue: variant; Original, Translated: string; Error: Exception)
      begin
        if Error  nil then
        begin
          WriteToLog(Error.message);
          SendError(Socket, Request, Error.Message);
          exit;
        end;

        if not TQTXNodeFileUtils.DirectoryExists(Translated) then
        begin
          WriteToLogF("RmDir Failed, directory [%s] does not exist", [Translated]);
          SendError(Socket, Request, Format("RmDir failed, directory [%s] does not exist", [Original]));
          exit;
        end;

        TQTXNodeFileUtils.DeleteDirectory(nil, Translated,
        procedure (TagValue: variant; Path: string; Error: Exception)
        begin
          if error  nil then
          begin
            WriteToLog(Error.message);
            SendError(Socket, Request, Error.Message);
            exit;
          end;

          // Setup response object
          var lResponse := TQTXRmDirResponse.Create(lRequest.Ticket);
          lResponse.UserName := lUserName;
          lResponse.DirPath := lDirPath;
          lResponse.Code := CNT_MESSAGE_CODE_OK;
          lResponse.Response := CNT_MESSAGE_TEXT_OK;
          lResponse.Routing.TagValue := lRequest.Routing.TagValue;

          // Send success response
          try
            Socket.Send( lResponse.Serialize() );
          except
            on e: exception do
              WriteToLog(e.message);
          end;
        end);
      end);
    end else
    begin
      var lText := format("RmDir failed, invalid path [%s] error", [lDirPath]);
      WriteToLog(lText);
      SendError(Socket, Request, lText);
    end;
  finally
    lParser.free;
  end;
end;

procedure TQTXTaskService.HandleMkDir(Socket: TNJWebSocketSocket; Request: TQTXBaseMessage);
begin
  var lRequest := TQTXMkDirRequest(request);
  var lUserName := lRequest.UserName.trim();
  var lDirPath := lRequest.DirPath.trim();

  if lDirPath.length  0 then
  begin
    SendError(Socket, Request, Format("Unsupported path sequence [%s] detected error", [lTemp]) );
    exit;
  end;

  lTemp := './';
  if pos(lTemp, lDirPath) > 0 then
  begin
    SendError(Socket, Request, Format("Unsupported path sequence [%s] detected error", [lTemp]) );
    exit;
  end;

  var lParser := TQTXPathParser.Create();
  try
    var lInfo: TQTXPathData;
    if lparser.Parse(lDirPath, lInfo) then
    begin
      GetTranslatedPathFor(nil, lUserName, lDirPath,
      procedure (TagValue: variant; Original, Translated: string; Error: Exception)
      begin
        if Error  nil then
        begin
          WriteToLog(Error.message);
          SendError(Socket, Request, Error.Message);
          exit;
        end;

        TQTXNodeFileUtils.DirectoryExists(nil, Translated,
        procedure (TagValue: variant; Path: string; Error: Exception)
        begin
          if Error  nil then
          begin
            WriteToLogF("MkDir Failed, directory [%s] already exists", [Translated]);
            SendError(Socket, Request, Format("MkDir Failed, directory [%s] already exists", [Original]));
            exit;
          end;

          TQTXNodeFileUtils.CreateDirectory(nil, Translated,
          procedure (TagValue: variant; Path: string; Error: Exception)
          begin
            if Error  nil then
            begin
              WriteToLogF("MkDir Failed, directory [%s] could not be created", [Original]);
              SendError(Socket, Request, Format("MkDir Failed, directory [%s] could not be created", [Translated]));
              exit;
            end;

            // Setup response object
            var lResponse := TQTXMkDirResponse.Create(lRequest.Ticket);
            lResponse.UserName := lUserName;
            lResponse.DirPath := lDirPath;
            lResponse.Code := CNT_MESSAGE_CODE_OK;
            lResponse.Response := CNT_MESSAGE_TEXT_OK;
            lResponse.Routing.TagValue := lRequest.Routing.TagValue;

            // Send success response
            try
              Socket.Send( lResponse.Serialize() );
            except
              on e: exception do
                WriteToLog(e.message);
            end;

          end);
        end);
      end);

    end else
    begin
      var lText := format("MkDir Failed, invalid path [%s] error", [lDirPath]);
      WriteToLog(lText);
      SendError(Socket, Request, lText);
    end;
  finally
    lParser.free;
  end;
end;

procedure TQTXTaskService.HandleFileDelete(Socket: TNJWebSocketSocket; Request: TQTXBaseMessage);
begin
  var lRequest := TQTXFileDeleteRequest(Request);
  var lUserName := lRequest.UserName.trim();
  var lFileName := lRequest.FileName.trim();

  if lFileName.length  0 then
  begin
    SendError(Socket, Request, Format("Unsupported path sequence [%s] detected error", [lTemp]) );
    exit;
  end;

  lTemp := './';
  if pos(lTemp, lFileName) > 0 then
  begin
    SendError(Socket, Request, Format("Unsupported path sequence [%s] detected error", [lTemp]) );
    exit;
  end;

  GetFileInfo(lRequest, lUserName, lFileName,
  procedure (TagValue: variant; LocalFile: string; Info: JStats; Error: Exception)
  begin
    if Error  nil then
    begin
      WriteToLog(Error.message);
      SendError(Socket, Request, Error.Message);
      exit;
    end;

    if not Info.isFile then
    begin
      SendError(Socket, Request, "Filesystem object is not a file error");
      exit;
    end;

    NodeJsFsAPI().unlink(LocalFile,
    procedure (Error: JError)
    begin
      if Error  nil then
      begin
        WriteToLog(Error.message);
        SendError(Socket, Request, Error.message);
        exit;
      end;

      var lResponse := new TQTXFileDeleteResponse(lRequest.Ticket);
      lResponse.Routing.TagValue := request.Routing.TagValue;
      lResponse.UserName := lUserName;
      lResponse.FileName := lFileName;
      lResponse.Code := CNT_MESSAGE_CODE_OK;
      lResponse.Response := CNT_MESSAGE_TEXT_OK;

      try
        Socket.Send( lResponse.Serialize() );
      except
        on e: exception do
          WriteToLog(e.message);
      end;
    end);
  end);
end;

procedure TQTXTaskService.HandleFileRename(Socket: TNJWebSocketSocket; Request: TQTXBaseMessage);
begin
  var lRequest := TQTXFileRenameRequest(Request);
  var lUserName := lRequest.UserName.trim();
  var lFileName := lRequest.FileName.trim();
  var lNewName := lRequest.NewName.trim();

  // Check filename length
  if lFileName.length < 1 then
  begin
    SendError(Socket, Request, Format("Invalid or empty from-filename [%s] error", [lFileName]) );
    exit;
  end;

  // check newname length
  if lNewName.length  0 then
  begin
    SendError(Socket, Request, Format("Unsupported path sequence [%s] detected error", [lTemp]) );
    exit;
  end;

  if pos(lTemp, lNewName) > 0 then
  begin
    SendError(Socket, Request, Format("Unsupported path sequence [%s] detected error", [lTemp]) );
    exit;
  end;

  lTemp := './';
  if pos(lTemp, lFileName) > 0 then
  begin
    SendError(Socket, Request, Format("Unsupported path sequence [%s] detected error", [lTemp]) );
    exit;
  end;

  if pos(lTemp, lNewName) > 0 then
  begin
    SendError(Socket, Request, Format("Unsupported path sequence [%s] detected error", [lTemp]) );
    exit;
  end;


  GetFileInfo(lRequest, lUserName, lFileName,
  procedure (TagValue: variant; LocalFile: string; Info: JStats; Error: Exception)
  begin
    if Error  nil then
    begin
      WriteToLog(Error.message);
      SendError(Socket, Request, Error.Message);
      exit;
    end;

    if not Info.isFile then
    begin
      SendError(Socket, Request, "Filesystem object is not a file error");
      exit;
    end;

    GetTranslatedPathFor(nil, lUsername, lNewName,
    procedure (TagValue: variant; Original, Translated: string; Error: Exception)
    begin
      if Error  nil then
      begin
        WriteToLog(Error.message);
        SendError(Socket, Request, Error.Message);
        exit;
      end;

      NodeJsFsAPI().rename(LocalFile, Translated,
      procedure (Error: JError)
      begin
        if Error  nil then
        begin
          WriteToLog(Error.message);
          SendError(Socket, Request, Error.message);
          exit;
        end;

        var lResponse := new TQTXFileRenameResponse(lRequest.Ticket);
        lResponse.Routing.TagValue := request.Routing.TagValue;
        lResponse.UserName := lUserName;
        lResponse.FileName := lFileName;
        lResponse.Code := CNT_MESSAGE_CODE_OK;
        lResponse.Response := CNT_MESSAGE_TEXT_OK;

        try
          Socket.Send( lResponse.Serialize() );
        except
          on e: exception do
            WriteToLog(e.message);
        end;
      end);

    end);

  end);
end;

procedure TQTXTaskService.HandleGetDir(Socket: TNJWebSocketSocket; Request: TQTXBaseMessage);
begin
  var lRequest := TQTXFileDirRequest(Request);
  var lUserName := lRequest.UserName.trim();
  var lPath := lRequest.Path.trim();

  // prevent path escape attempts
  var lTemp := "../";
  if pos(lTemp, lPath) > 0 then
  begin
    SendError(Socket, Request, Format("Unsupported path sequence [%s] detected error", [lTemp]) );
    exit;
  end;

  lTemp := './';
  if pos(lTemp, lPath) > 0 then
  begin
    SendError(Socket, Request, Format("Unsupported path sequence [%s] detected error", [lTemp]) );
    exit;
  end;

  GetTranslatedPathFor(nil, lUserName, lPath,
  procedure (TagValue: variant; Original, Translated: string; Error: Exception)
  begin
    if Error  nil then
    begin
      WriteToLog(Error.message);
      SendError(Socket, Request, Error.Message);
      exit;
    end;

    //writeln("Translated path is:" + Translated);

    if not TQTXNodeFileUtils.DirectoryExists(Translated) then
    begin
      WriteToLogF("GetDir Failed, directory [%s] does not exist", [Translated]);
      SendError(Socket, Request, Format("GetDir failed, directory [%s] does not exist", [Original]));
      exit;
    end;

    var lWalker := TQTXFileWalker.Create();
    lWalker.Examine(Translated, procedure (Sender: TQTXFileWalker; Error: EException)
    begin
      if Error  nil then
      begin
        WriteToLogF("GetDir Failed: %s", [Error.Message]);
        SendError(Socket, Request, Format("GetDir failed: %s", [Error.Message]));
        exit;
      end;

      // Get the directory data, swap out the path
      // record with the original [amiga] style path
      var lData := Sender.ExtractList();
      lData.dlPath := Original;

      var lResponse := new TQTXFileDirResponse(lRequest.Ticket);
      lResponse.Routing.TagValue := request.Routing.TagValue;
      lResponse.UserName := lUserName;
      lResponse.Path := lPath;
      lResponse.Assign( lData );

      try
        Socket.Send( lResponse.Serialize() );
      except
        on e: exception do
          WriteToLog(e.message);
      end;

      // release instance in 100ms
      TQTXDispatch.execute(procedure ()
      begin
        try
          lWalker.free
        except
          on e: exception do
          begin
            WriteToLogF("Failed to release file-walker instance: %s", [e.message]);
          end;
        end;
      end, 100);
    end);
  end);
end;

procedure TQTXTaskService.HandleGetFileInfo(Socket: TNJWebSocketSocket; Request: TQTXBaseMessage);
begin
  var lRequest := TQTXFileInfoRequest(Request);
  var lUserName := lRequest.UserName.trim();
  var lFileName := lRequest.FileName.trim();

  // prevent path escape attempts
  var lTemp := "../";
  if pos(lTemp, lFileName) > 0 then
  begin
    SendError(Socket, Request, Format("Unsupported path sequence [%s] detected error", [lTemp]) );
    exit;
  end;

  lTemp := './';
  if pos(lTemp, lFileName) > 0 then
  begin
    SendError(Socket, Request, Format("Unsupported path sequence [%s] detected error", [lTemp]) );
    exit;
  end;

  GetFileInfo(lRequest, lUserName, lFileName,
  procedure (TagValue: variant; LocalFile: string; Info: JStats; Error: Exception)
  begin
    if Error  nil then
    begin
      WriteToLog(Error.message);
      SendError(Socket, Request, Error.Message);
      exit;
    end;

    // Collect the data
    var lData := new JFileItem();
    lData.diFileName := lFileName;
    lData.diFileType := if Info.isFile then JFileItemType.wtFile else JFileItemType.wtFolder;
    lData.diFileSize := Info.size;
    lData.diFileMode := IntToStr(Info.mode);
    lData.diCreated  := TDateUtils.FromJsDate( Info.cTime );
    lData.diModified := TDateUtils.FromJsDate( Info.mTime );

    var lResponse := new TQTXFileInfoResponse(lRequest.Ticket);
    lResponse.Routing.TagValue := request.Routing.TagValue;
    lResponse.UserName := lUserName;
    lResponse.FileName := lFileName;
    lResponse.Assign(lData);

    try
      Socket.Send( lResponse.Serialize() );
    except
      on e: exception do
        WriteToLog(e.message);
    end;
  end);
end;

procedure TQTXTaskService.HandleDestroyDevice(Socket: TNJWebSocketSocket; Request: TQTXBaseMessage);
begin
  var lMessage := TQTXFileDestroyDeviceRequest(request);

  // This will also destroy any files + unregister the device in the
  // database table for the service -- do not mess with this!
  UnRegisterLocalDevice(nil, lMessage.Username, lMessage.DeviceName,
  procedure (TagValue: variant; LocalPath: string; Error: Exception)
  begin
    if Error  nil then
    begin
      WriteToLog(Error.Message);
      SendError(Socket, Request, Error.Message);
      exit;
    end;

    var lResponse := TQTXFileDestroyDeviceResponse.Create(request.ticket);
    lResponse.UserName := lMessage.UserName;
    lResponse.DeviceName := lMessage.DeviceName;
    lResponse.Routing.TagValue := Request.Routing.TagValue;
    lResponse.Code := CNT_MESSAGE_CODE_OK;
    lResponse.Response := CNT_MESSAGE_TEXT_OK;

    try
      Socket.Send( lResponse.Serialize() );
    except
      on e: exception do
      begin
        WriteToLog(e.message);
      end;
    end;
  end);
end;

procedure TQTXTaskService.HandleCreateLocalDevice(Socket: TNJWebSocketSocket; Request: TQTXBaseMessage);
begin
  var lMessage := TQTXFileCreateLocalDeviceRequest(request);

  // Attempt to register.
  // NOTE: This will automatically create a matching folder
  //       under $cwd/userdevices/[calculated_name_of_device]

  RegisterLocalDevice(nil, lMessage.Username, lMessage.DeviceName,
  procedure (TagValue: variant; LocalPath: string; Error: Exception)
  begin
    if Error  nil then
    begin
      WriteToLog(Error.Message);
      SendError(Socket, Request, Error.Message);
      exit;
    end;

    FindDeviceByName(nil, lMessage.Username, lMessage.DeviceName,
    procedure (TagValue: variant; Device: JDeviceInfo; Error: Exception)
    begin
      if Error  nil then
      begin
        WriteToLog(Error.Message);
        SendError(Socket, Request, Error.Message);
        exit;
      end;

      var lResponse := TQTXFileCreateLocalDeviceResponse.Create(request.ticket);
      lResponse.UserName := lMessage.UserName;
      lResponse.Routing.TagValue := Request.Routing.TagValue;
      lResponse.Code := CNT_MESSAGE_CODE_OK;
      lResponse.Response := CNT_MESSAGE_TEXT_OK;
      if Device  nil then
        lResponse.assign(Device);

      try
        Socket.Send( lResponse.Serialize() );
      except
        on e: exception do
        begin
          WriteToLog(e.message);
        end;
      end;

    end);
  end);
end;

procedure TQTXTaskService.HandleGetDeviceByName(Socket: TNJWebSocketSocket; Request: TQTXBaseMessage);
begin
  var lMessage := TQTXFileGetDeviceByNameRequest(request);

  FindDeviceByName(nil, lMessage.Username, lMessage.DeviceName,
  procedure (TagValue: variant; Device: JDeviceInfo; Error: Exception)
  begin
    if Error  nil then
    begin
      WriteToLog(Error.Message);
      SendError(Socket, Request, Error.Message);
      exit;
    end;

    var lResponse := TQTXFileGetDeviceByNameResponse.Create(request.ticket);
    lResponse.UserName := lMessage.UserName;
    lResponse.Code := CNT_MESSAGE_CODE_OK;
    lResponse.Response := CNT_MESSAGE_TEXT_OK;
    if Device  nil then
      lResponse.assign(Device);

    try
      Socket.Send( lResponse.Serialize() );
    except
      on e: exception do
      begin
        WriteToLog(e.message);
      end;
    end;
  end);

end;

procedure TQTXTaskService.HandleGetDevices(Socket: TNJWebSocketSocket; Request: TQTXBaseMessage);
begin
  var lMessage := TQTXFileGetDeviceListRequest(Request);
  GetDevicesForUser(nil, lMessage.Username,
  procedure (TagValue: variant; Devices: JDeviceList; Error: Exception)
  begin
    if Error  nil then
    begin
      WriteToLog(Error.Message);
      SendError(Socket, Request, Error.Message);
      exit;
    end;

    var lResponse := TQTXFileGetDeviceListResponse.Create(request.ticket);
    lResponse.UserName := lMessage.UserName;
    lResponse.Code := CNT_MESSAGE_CODE_OK;
    lResponse.Response := CNT_MESSAGE_TEXT_OK;
    if Devices  nil then
      lResponse.assign(Devices);

    try
      Socket.Send( lResponse.Serialize() );
    except
      on e: exception do
      begin
        WriteToLog(e.message);
      end;
    end;

  end);
end;

procedure TQTXTaskService.AfterServerStarted;
begin
  inherited;

  // Check prefs if zconfig should be applied
  if self.FPrefs.ReadBoolean("zconfig", "active", false) then
  begin
    // ZConfig should only run on the master instance.
    // We dont want to register our endpoint for each worker
    if NodeJSClusterAPI().isWorker then
      exit;

    writeln("Setting up Zero-Configuration layer");
    FZConfig.port := FPrefs.ReadInteger('zconfig', 'bindport', 2109);
    FZConfig.address := GetMachineIP();
    FZConfig.Start(nil, procedure (Sender: TObject; TagValue: variant; Error: Exception)
    begin
      if FPrefs.ReadBoolean("zconfig", "broadcast", true) then
        FZConfig.Socket.setBroadcast(true);

      // Build up the endpoint (URL) for our websocket server
      var lEndpoint := '';

      if FPrefs.ReadBoolean('networking', 'secure', false) then
        lEndpoint := 'wss://'
      else
        lEndpoint := 'ws://';

      lEndpoint += GetMachineIP();
      lEndpoint += ':' + Port.ToString();

      // Ping the ZConfig service on interval, until our service is registered
      // We keep track of the interval handle so we can stop calling on interval later
      FRegHandle := TQTXDispatch.SetInterval( procedure ()
      begin
        inc(FRegCount);

        // Only output once to avoid overkill in the log
        if FRegCount = 1 then
          WriteToLogF("ZConfig registration begins [%s]", [lEndpoint]);

        FZConfig.RegisterService(nil, CNT_ZCONFIG_SERVICE_NAME, SERVICE_ID_TASKMANAGER, lEndpoint,
        procedure (TagValue: variant; Error: Exception)
        begin
          if Error = nil then
          begin
            WriteToLog("Service registered");
            TQTXDispatch.ClearInterval(FRegHandle);
            FRegCount := 0;
            exit;
          end;
        end);
      end, 1000);

    end);
  end;
end;

procedure TQTXTaskService.BeforeServerStopped;
begin
  inherited;
end;

procedure TQTXTaskService.Dispatch(Socket: TNJWebSocketSocket; Message: TQTXBaseMessage);
begin
  var LInfo := MessageDispatch.GetMessageInfoForClass(Message);
  if LInfo  nil then
  begin
    try
      LInfo.MessageHandler(Socket, Message);
    except
      on e: exception do
      begin
        //Log error
        WriteToLog(e.message);
      end;
    end;
  end;
end;

end.


 

Nodebuilder, QTX and the release of my brand new social platform

January 2, 2020 9 comments

First, let me wish everyone a wonderful new year! With xmas and the silly season firmly behind us, and my batteries recharged – I feel my coding fingers itch to get started again.

2019 was a very busy year for me. Exhausting even. I have juggled both a full time job, kids and family, as well as our community project, Quartex Media Desktop. And since that project has grown considerably, I had to stop and work on the tooling. Which is what NodeBuilder is all about.

I have also released my own social media platform (see further down). This was initially scheduled for Q4 2020, but Facebook pissed me off something insanely, so I set it up in december instead.

NodeBuilder

node

For those of you that read my blog you probably remember the message system I made for the Quartex Desktop, called Ragnarok? This is a system for dealing with message dispatching and RPC, except that the handling is decoupled from the transport medium. In other words, it doesnt care how you deliver a message (WebSocket, UDP, REST), but rather takes care of serialization, binary data and security.

All the back-end services that make up the desktop system, are constructed around Ragnarok. So each service exposes a set of methods that the core can call, much like a normal RPC / SOAP service would. Each method is represented by a request and response object, which Ragnarok serialize to a JSON message envelope.

In our current model I use WebSocket, which is a full duplex, long-term connection (to avoid overhead of having to connect and perform a handshake for each call). But there is nothing in the way of implementing a REST transport layer (UDP is already supported, it’s used by the Zero-Config system. The services automatically find each other and register, as long as they are connected to the same router or switch). For the public service I think REST makes more sense, since it will better utilize the software clustering that node.js offers.

nodebuilder

Node Builder is a relatively simple service designer, but highly effective for our needs

 

Now for small services that expose just a handful of methods (like our chat service), writing the message classes manually is not really a problem. But the moment you start having 20 or 30 methods – and need to implement up to 60 message classes manually – this approach quickly becomes unmanageable and prone to errors. So I simply had to stop before xmas and work on our service designer. That way we can generate the boilerplate code in seconds rather than days and weeks.

While I dont have time to evolve this software beyond that of a simple service designer (well, I kinda did already), I have no problem seeing this system as a beginning of a wonderful, universal service authoring system. One that includes coding, libraries and the full scope of the QTX runtime-library.

In fact, most of the needed parts are in the codebase already, but not everything has been activated. I don’t have time to build both a native development system AND the development system for the desktop.

nodebuilder4

NodeBuilder already have a fully functional form designer and code editor, but it is dormant for now due to time restrictions. Quartex Media Desktop comes first

But right now, we have bigger fish to fry.

Quartex Media Desktop

We have made tremendous progress on our universal desktop environment, to the point where the baseline services are very close to completion. A month should be enough to finish this unless something unforeseen comes up.

desktop

Quartex Media Desktop provides an ecosystem for advanced web applications

You have to factor in that, this project has only had weekends and the odd after work hours allocated for it. So even though we have been developing this for 12 months, the actual amount of days is roughly half of that.

So all things considered I think we have done a massive amount of code in such a short time. Even simple 2d games usually take 2 years of daily development, and that includes a team of at least 5 people! Im a single developer working in my spare time.

So what exactly is left?

The last thing we did before xmas was upon us, was to throw out the last remnants of Smart Mobile Studio code. The back-end services are now completely implemented in our own QTX runtime-library, which has been written from scratch. There is not a line of code from Smart Mobile Studio in QTX, which means we no longer have to care what that system does or where it goes.

To sum up:

  • Push all file handling code out of the core
  • Implement file-handling as it’s own service

Those two steps might seem simple enough, but you have to remember that the older code was based on the Linux path system, and was read-only.

So when pushing that code out of the core, we also have to add all the functionality that was never implemented in our prototype.

nodebuilder2

Each class actually represents a separate “mini” program, and there are still many more methods to go before we can put this service into production.

Since Javascript does not support threads, each method needs to be implemented as a separate program. So when a method is called, the file/task manager literally spawns a new process just for that task. And the result is swiftly returned back to the caller in async manner.

So what is ultimately simple, becomes more elaborate if you want to do it right. This is the price we pay for universality and a cluster enabled service-stack.

This is also why I have put the service development on pause until we have finished the NodeBuilder tooling. And I did this because I know by experience that the moment the baseline is ready, both myself and users of the system is going to go “oh we need this, and that and those”. Being able to quickly design and auto-generate all the boilerplate code will save us months of work. So I would rather spend a couple of weeks on NodeBuilder than wasting months having to manually write all that boilerplate code down the line.

What about the QTX runtime-library?

Writing an RTL from scratch was not something I could have anticipated before we started this project. But thankfully the worst part of this job is already finished.

The RTL is divided into two parts:

  • Non Visual code. Classes and methods that makes QTX an RTL
  • Visual code. Custom Controls + standard controls (buttons, lists etc)
  • Visual designer

As you can see, the non-visual aspect of the system is finished and working beautifully. It’s a lot faster than the code I wrote for Smart Mobile Studio (roughly twice as fast on average). I also implemented a full visual designer, both as a Delphi visual component and QTX visual component.

nodebuilder3

Quartex Media Desktop makes running on several machines [cluster] easy and seamless

So fundamental visual classes like TCustomControl is already there. What I haven’t had time to finish are the standard-controls, like TButton, TListBox, TEdit and those type of visual components. That will be added after the release of QTX, at which point we throw out the absolute last remnants of Smart Mobile Studio from the client (HTML5 part) software too.

Why is the QTX Runtime-Library important again?

When the desktop is out the door, the true work begins! The desktop has several roles to play, but the most important aspect of the desktop – is to provide an ecosystem capable of hosting web based applications. Offering features and methods traditionally only found in Windows, Linux or OS X. It truly is a complete cloud system that can scale from a single affordable SBC (single board computer), to a high-end cluster of powerful servers.

Clustering and writing distributed applications has always been difficult, but Quartex Media Desktop makes it simple. It is no more difficult for a user to work on a clustered system, as it is to work on a normal, single OS. The difficult part has already been taken care of, and as long as people follow the rules, there will be no issues beyond ordinary maintenance.

And the first commercial application to come out of Quartex Components, is Cloud Forge, which is the development system for the platform. It has the same role as Visual Studio for Windows, or X Code for Apple OS X.

78498221_438784840394351_7041317054627971072_n

The Quartex Media Desktop Cluster cube. A $400 super computer

I have prepared 3 compilers for the system already. First there is C/C++ courtesy of Clang. So C developers will be able to jump in and get productive immediately. The second compiler is freepascal, or more precise pas2js, which allows you to compile ordinary freepascal code (which is highly Delphi compatible) to both JavaScript and WebAssembly.

And last but not least, there is my fork of DWScript, which is the same compiler that Smart Mobile Studio uses. Except that my fork is based on the absolute latest version, and i have modified it heavily to better match special features in QTX. So right out of the door CloudForge will have C/C++, two Object Pascal compilers, and vanilla Javascript and typescript. TypeScript also has its own WebAssembly compiler, so doing hard-core development directly in a browser or HTML5 viewport is where we are headed.

Once the IDE is finished I can finally, finally continue on the LDEF bytecode runtime, which will be used in my BlitzBasic port and ultimately replace both clang, freepascal and DWScript. As a bonus it will emit native code for a variety of systems, including x86, ARM, 68k [including 68080] and PPC.

This might sound incredibly ambitious, if not impossible. But what I’m ultimately doing here -is moving existing code that I already have into a new paradigm.

The beauty of object pascal is the sheer size and volume of available components and code. Some refactoring must be done due to the async nature of JS, but when needed we fall back on WebAssembly via Freepascal (WASM executes linear, just like ordinary native code does).

A brand new social platform

During december Facebook royally pissed me off. I cannot underline enough how much i loath A.I censorship, and the mistakes that A.I does – in which you are utterly powerless to complain or be heard by a human being. In my case i posted a gif from their own mobile application, of a female body builder that did push-ups while doing hand-stands. In other words, a completely harmless gif with strength as the punchline. The A.I was not able to distinguish between a leotard and bare-skin, and just like that i was muted for over a week. No human being would make such a ruling. As an admin of a fairly large set of groups, there are many cases where bans are the result. Disgruntled members that acts out of revenge and report technical posts about coding as porn or offensive. Again, you are helpless because there are nobody you can talk to about resolving the issue. And this time I had enough.

It was always planned that we would launch our own social media platform, an alternative to Facebook aimed at adult geeks rather than kids (Facebook operates with an age limit of 12 years). So instead of waiting I rushed out and set up a brand new social network. One where those banale restrictions Facebook has conditioned us with, does not apply.

Just to underline, this is not some simple and small web forum. This is more or less a carbon copy of Facebook the way it used to be 8-9 years ago. So instead of having a single group on facebook, we can now have as many groups as we like, on a platform that looks more or less identical to Facebook – but under our control and human rules.

AD1

Amigadisrupt.com is a brand new social media platform for geeks

You can visit the site right now at https://www.amigadisrupt.com. Obviously the major content on the platform right now is dominated by retro computing – but groups like Delphi Developer and FPC developer has already been setup and are in use. But if you are expecting thousands of active users, that will take time. We are now closing in on 250 active users which is pretty good for such a short period of time. I dont want a platform anywhere near as big as FB. The goal is to get 10k users and have a stable community of coders, retro geeks, builders and creative individuals.

AD (Amiga Disrupt) will be a standard application that comes with Quartex Media Desktop. This is the beauty of web technology, in that it can unify different resources under one roof. And we will have our cake and eat it come hell or high water.

Disclaimer: Amiga Disrupt has a lower age limit of 18 years. This is a platform meant for adults. Which means there will be profanity, jokes that would get you banned on Facebook and content that is not meant for kids. This is hacker-land, and political correctness is considered toilet paper. So if you need social toffery like FB and Twitter deals with, you will be kicked by one of the admins.

After you sign up your feed will be completely empty. Here is how to get it started. And feel free to add me to your friends-list!thumb

Quartex Media Desktop, new compiler and general progress

September 11, 2019 3 comments

It’s been a few weeks since my last update on the project. The reason I dont blog that often about Quartex Media Desktop (QTXMD), is because the official user-group has grown to 2000+ members. So it’s easier for me to post developer updates directly to the audience rather than writing articles about it.

desktop_01

Quartex Media Desktop ~ a complete environment that runs on every device

If you haven’t bothered digging into the project, let me try to sum it up for you quickly.

Quick recap on Quartex Media Desktop

To understand what makes this project special, first consider the relationship between Microsoft Windows and a desktop program. The operating system, be it Windows, Linux or OSX – provides an infrastructure that makes complex applications possible. The operating-system offers functions and services that programs can rely on.

The most obvious being:

  • A filesystem and the ability to save and load data
  • A windowing toolkit so programs can be displayed and have a UI
  • A message system so programs can communicate with the OS
  • A service stack that takes care of background tasks
  • Authorization and identity management (security)

I have just described what the Quartex Media Desktop is all about. The goal is simple:

to provide for JavaScript what Windows and OS X provides for ordinary programs.

Just stop and think about this. Every “web application” you have ever seen, have all lacked these fundamental features. Sure you have libraries that gives you a windowing environment for Javascript, like Embarcadero Sencha; but im talking about something a bit more elaborate. Creating windows and buttons is easy, but what about ownership? A runtime environment has to keep track of the resources a program allocates, and make sure that security applies at every step.

Target audience and purpose

Take a second and think about how many services you use that have a web interface. In your house you probably have a router, and all routers can be administered via the browser. Sadly, most routers operate with a crude design and that leaves much to be desired.

router

Router interfaces for web are typically very limited and plain looking. Imagine what NetGear could do with Quartex Media Desktop instead

If you like to watch movies you probably have a Plex or Kodi system running somewhere in your house; perhaps you access that directly via your TV – or via a modern media system like Playstation 4 or XBox one. Both Plex and Kodi have web-based interfaces.

Netflix is now omnipresent and have practically become an institution in it’s own right. Netflix is often installed as an app – but the app is just a thin wrapper around a web-interface. That way they dont have to code apps for every possible device and OS out there.

If you commute via train in Scandinavia, chances are you buy tickets on a kiosk booth. Most of these booths run embedded software and the interface is again web based. That way they can update the whole interface without manually installing new software on each device.

plex-desktop-movies-1024x659

Plex is a much loved system. It is based on a mix of web and native technologies

These are just examples of web based interfaces you might know and use; devices that leverage web technology. As a developer, wouldn’t it be cool if there was a system that could be forked, adapted and provide advanced functionality out of the box?

Just imagine a cheap Jensen router with a Quartex Media Desktop interface! It could provide a proper UI interface with applications that run in a windowing environment. They could disable ordinary desktop functionality and run their single application in kiosk mode. Taking full advantage of the underlying functionality without loss of security.

And the same is true for you. If you have a great idea for a web based application, you can fork the system, adjust it to suit your needs – and deploy a cutting edge cloud system in days rather than months!

New compiler?

Up until recently I used Smart Mobile Studio. But since I have left that company, the matter became somewhat pressing. I mean, QTXMD is an open-source system and cant really rely on third-party intellectual property. Eventually I fired up Delphi, forked the latest  DWScript, and used that to roll a new command-line compiler.

desktop_02

Web technology has reached a level of performance that rivals native applications. You can pretty much retire Photoshop in favour of web based applications these days

But with a new compiler I also need a new RTL. Thankfully I have been coding away on the new RTL for over a year, but there is still a lot of work to do. I essentially have to implement the same functionality from scratch.

There will be more info on the new compiler / codegen when its production ready.

Progress

If I was to list all the work I have done since my last post, this article would be a small book. But to sum up the good stuff:

  • Authentication has been moved into it’s own service
  • The core (the main server) now delegates login messages to said service
  • We no longer rely on the Smart Pascal filesystem drivers, but use the raw node.js functions instead  (faster)
  • The desktop now use the Smart Theme engine. This means that we can style the desktop to whatever we like. The OS4 theme that was hardcoded will be moved into its own proper theme-file. This means the user can select between OS4, iOS, Android and Ubuntu styling. Creating your own theme-files is also possible. The Smart theme-engine will be replaced by a more elaborate system in QTX later
  • Ragnarok (the message api) messages now supports routing. If a routing structure is provided,  the core will relay the message to the process in question (providing security allows said routing for the user)
  • The desktop now checks for .info files when listing a directory. If a file is accompanied by an .info file, the icon is extracted and shown for that file
  • Most of the service layer now relies on the QTX RTL files. We still have some dependencies on the Smart Pascal RTL, but we are making good progress on QTX. Eventually  the whole system will have no dependencies outside QTX – and can thus be compiled without any financial obligations.
  • QTX has it’s own node.js classes, including server and client base-classes
  • Http(s) client and server classes are added to QTX
  • Websocket and WebSocket-Secure are added to QTX
  • TQTXHybridServer unifies http and websocket. Meaning that this server type can handle both orinary http requests – but also websocket connections on the same network socket. This is highly efficient for websocket based services
  • UDP classes for node.js are implemented, both client and server
  • Zero-Config classes are now added. This is used by the core for service discovery. Meaning that the child services hosted on another machine will automatically locate the core without knowing the IP. This is very important for machine clustering (optional, you can define a clear IP in the core preferences file)
  • Fixed a bug where the scrollbars would corrupt widget states
  • Added API functions for setting the scrollbars from hosted applications (so applications can tell the desktop that it needs scrollbar, and set the values)
  • .. and much, much more

I will keep you all posted about the progress — the core (the fundamental system) is set for release in december – so time is of the essence! Im allocating more or less all my free time to this, and it will be ready to rock around xmas.

When the core is out, I can focus solely on the applications. Everything from Notepad to Calculator needs to be there, and more importantly — the developer tools. The CloudForge IDE for developers is set for 2020. With that in place you can write applications for iOS, Android, Windows, OS X and Linux directly from Quartex Media Desktop. Nothing to install, you just need a modern browser and a QTX account.

The system is brilliant for small teams and companies. They can setup their own instance, communicate directly via the server (text chat and video chat is scheduled) and work on their products in concert.

Porting TextCraft to Oxygene

June 30, 2019 Leave a comment

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.

ldef

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.

QTX IDE for freepascal

May 5, 2015 Leave a comment

It’s been a hectic couple of weeks that’s for sure. I’ve been called the death of freepascal, a devil with anterior motives, a civil war monger and much, much more. It’s quite dramatic don’t you think? I mean “civil war” (insert dark voice here) and all that. We are talking about programming languages, not the borders of Bosnia. Yet drama these guys spin like spiders on drugs.

And killing the guy that raises the red flag, when did that become popular? So when I go “yo — there is something wrong here, be careful”, they just respond “Why did you say that, I don’t want to know there are bad things in the world!”. Guess I should be glad we’re not in the army together huh? That could get messy.:”Me: Guys there are mines here, go around, seven o’clock!” — “FPC/Lazarus: Everyone into the minefield and twirk like mad! That’s an order!”.

So the entertainment is priceless. Just wonderful to watch people allergic to the words “im sorry i thrash talked you, my bad, you were right to tell us” squirm around like vipers being cooked alive on a chinese barbeque .. pride can be an ugly thing.

Be very careful when using CodeTyphon, wait until it's clear of all GPL and copyright violations

Be very careful when using CodeTyphon, wait until it’s clear of all GPL and copyright violations. I wouldnt go near it personally.

Well, despite all the bad news, the slandering and negativity – I remain cheerful through it all. Why? Because rather than stealing code from others or trying to bypass laws and regulations, I put my time into writing the Quartex IDE from scratch without the help on anyone. And I did that exactly to avoid the awful mess PilotLogic and freepascal now find itself in.

It’s really simple:

  • If i need help, I ask politely
  • If i want to use a component which is free, I ask politely
  • If i want to use a full GPL piece of code, I still ask politely!
  • I dont remove author names, but instead put them in the About box to respect the authors, thanking them for their work
  • I try to solve things first myself before asking for help
  • I use standard packages like SynEdit and Jedi exactly to avoid GPL/copyright problems

Incidentally I was trying to stop problems from happening, but everyone needs someone to blame so if blaming me for pointing out copyright theft and GPL violations — whatever makes you happy I guess. I honestly don’t care any more what happens to these systems. I should not have wasted my time trying to help FPC/Lazarus and CodeTyphon. I guess there is a reason these groups have a bad reputation – sadly I have them the benefit of the doubt.

The best comment on the FPC forum must have been “Who has given you the right to prosecute pilotlogic!” — well, in that case: who has give you the right to make FPC better? Because protecting FPC was what I was doing. So who the hell made you king and decided that you could fix bugs? Do you think you’re better than anyone else?  Huh? — that’s the kind of insane thinking I’m faced with. It’s just unbelievable.

QTX for freepascal

That would be a no I think. Since people actually believe that I am a devil incarnate in all of this, it would only serve to make their insanity a self-fulfilling prophecy. And QTX will render Lazarus useless, so … dont think they would be to happu about that either. They would no doubt scream “I told you so, he was plotting this all along!”. Which is fun because I’m not that diabolical even on my best of days, I couldn’t because there is a limit to how much evil scheming I get done with 3 kids, homework, brownie baking and a full time day job as a C# programmer.

Freepascal is a great product, but the forum is full of characters which do more harm to the product then good.. All projects get's nutcase

Freepascal is a great product, but the forum is full of “characters” which do more harm to the product then good.. All projects get’s nutcase “groupies” but usually the leaders have the sense to get rid of them. This has sadly not been the case here

So, I guess the plans to support freepascal has to be canceled. Which is really a shame because I truly believe in FPC/Lazarus as a universal platform. QTX would sort of be the icing on the cake. And even if you don’t like it – it would still be good to have it, because the more alternative we have the better.

But nope, I will not be supporting freepascal or lazarus after all. If people want it they can ask of course, I might change my mind in a couple of years; but right now I wont go near that copyright mess with a 10 foot pole. Nor would I support people who verbally abuse supporters when trying to help them (months in advance btw). They can blame themselves. A user group that hostile serves little or no purpose what so ever.

Alternatives

But there are always solutions for those that look; in heaps and buckets. QTX is designed to be a transcending platform, meaning that it compiles to an intermediate format (LDEF) which in turn can be represented in other languages through a code-generator API. A bit like .net but on source level rather than binary.

This means that I will be focusing on vanilla C++, shipping QTX with the free GNU C++ compiler, which is the fastest most widely developed and used compiler in the world. And I do believe it has the widest support for hardware out there as well, so it’s not bad news at all.

So to sum up:

  • You write object pascal just like Delphi or FPC
  • The compiler compiles to LDEF
  • LDEF is compiled into C++
  • C++ is compiled to machine code using the free GNU C++ compiler
  • Voila, you have a free path on both Unix, Linux, Windows, OS X and pretty much every platform out there

What have you been doing lately?

That is a good question. I have been very busy with my day-job coding in C# so there has been limited time for personal projects. But last weekend I added a new cool feature to QTX, namely a second way of opening units by cursor.

QTX is still young, but packs a mean punch

QTX is still young, but packs a mean punch

You know that you can CTRL + Click on a unit-keyword and the IDE opens the file automatically for you right? Well, what if that unit is a part of a package? Wouldnt it be great if the IDE not just opened the file – but mapped the file to the treeview so you can see all the files? This is optionally of course, but it will save you a lot of time when writing packages yourself or porting packages from Delphi/FPC.

This is a humble change I agree, but sometimes making the ground-level functions rock solid is valuable. It’s exactly those functions that have been crashing Lazarus for ages. Lazarus is really only perfect on Linux, on Ubuntu for instance it’s just bloody brilliant and really hits the mark. But on OS X and Windows it’s often the small functions, those you take for granted that crash and burn.

So I’ll be spending a few extra months before alfa release just doing those functions really well. The advanced stuff can wait. I’m going for stable and rock solid over super-modern and unstable.

Messages in Smart Mobile Studio

January 29, 2015 Leave a comment

If you have missed message coding from Delphi under Smart Pascal then you are in for a treat. The QTX library now supports application-wide messages in the browser; allowing you to send and subscribe to as many messages as you like. More or less duplicating the stuff you are used to under WinAPI.

In fact, you can subscribe to the same message in the same object as many times as you want — and also instantiate as many subscription objects as you like.

Receiving messages

Here is how you would create and setup a message-subscription for a form:

procedure TForm1.InitializeObject;
begin
  inherited;
  {$I 'Form1:impl'}

  //create our message subscriber object
  FMsgPort:=TQTXMessageSubscriber.Create;

  // subscribe to message-type $100
  FMsgPort.Subscribe($100,procedure (Message:TQTXMessageData)
    begin
      writeln("Data received:" + message.data);
    end);

  // subscribe to message-type $200
  FMsgPort.Subscribe($200,procedure (Message:TQTXMessageData)
    begin
      writeln("Data received:" + message.data);
    end);
end;

To send real objects through messages, simply use JSON to serialize it, then de-serialize it in your message handler.

Sending messages

The simplest way to send messages are through the two API methods:

  • QTX_SendMessage(Message:TQTXMessageData);
  • QTX_BroadcastMessage(Message:TQTXMessageData);

Alternatively, although highly unpractical, you could create your own message-port. The whole message system uses just a single message-port so you would never really create these yourself. If all you want to do is send and receive messages – you have more or less the same support as Delphi as for WinAPI messages — but simpler and easier to use!

Practical uses

Messages have been a part of Windows since the beginning, and it’s also hard-coded into Delphi. Their uses are almost limitless and you can use then to notify changes across controls and forms, transport data from one place to another — it’s really only creativity that sets the bounds.

What is cool about Smart Mobile Studio – is that you now have the same system under JavaScript. It works in every browser and allows your HTML5 forms and controls to communicate indirectly.

The technology is based on the HTML5 message system, which is a part of modern browsers. It’s extremely efficient and very reliable.

QTX Library for Smart Mobile Studio updated

January 27, 2015 4 comments

QTX (Quartex) is a library written for Smart Mobile Studio users. It extends the run-time library with a wide range of capabilities, including database (dataset) support, custom effects, tag-attribute storage and much, much more.

If you are a serious HTML5 developer using Smart Mobile Studio, then this library is a must. The font and content measurement alone is worth the download – and did I mention that it’s free?

Facebook clone, coded in a couple of hours using QTX for Smart Mobile Studio

Facebook clone, coded in a couple of hours using QTX for Smart Mobile Studio

Library overview

QTX is packed with classes and methods, and I have done my best to make it as easy as possible to understand. I take it for granted that you understand the concept of HTML-Tags, and that you understand that Smart Mobile Studio code creates TAGS when it’s constructor fires, and removes the tag when the destructor executes. As such, we have no need for libraries like JQuery – because the handle (reference) to the element is always known. JQuery is ultimately about extracting tags within a criteria from the DOM (hence “Query” in the title, as in SQL for querying a database).

What we do like however, is plenty of effects – and dead simple syntax for using them. Well it doesnt get any easier than with QTX. The QTX library extends TW3CustomControl with it’s own class helper, meaning that once you have included the qtx.effects unit – all your controls supports the whole range of effects.

Also, effects are executed in sequence. You can trigger 10 effects and they will execute one by one, which is no small feat under HTML5 (but easy with QTX tag attribute support).

Here is a brief overview of the classes and methods you get when installing QTX:

Database

  • TQTXDataset
  • TQTXDatasetField
  • TQTXBooleanField
  • TQTXIntegerField
  • TQTXFloatField
  • TQTXStringField
  • TQTXDatasetFields
  • TQTXFieldDef
  • TQTXFieldDefs

Tag-Attribute Storage

  • TQTXAttrAccess

CSS3 GPU powered animations

  • TQTXMoveAnimation
  • TQTXFadeAnimation
  • TQTXSizeAnimation
  • TQTXAnimationHelper

Effect management

  • TQTXEffectsHelper
    • fxSetBusy
    • fxBusy:boolean
    • fxScaleUp
    • fxScaleDown
    • fxSizeTo
    • fxMoveDown
    • fxMoveUp
    • fxMoveBy
    • fxMoveTo
    • fxScaleTo
    • fxZoomOut
    • fxZoomIn
    • fxWarpIn
    • fxWarpOut
    • fxFadeIn
    • fxFadeOut

Font and content measurement

  • TQTXTextMetric
  • TQTXFontInfo
  • TQTXFontDetector

Helper classes

  • TQTXHandleHelper
  • TQTXIntegerHelper
  • TQTXStringHelper

Media IO management

  • TQTXIOAccess
    • LoadXML
    • LoadFile
    • LoadCSS
    • LoadScript
    • LoadImage
    • PreloadImages

Delayed execution

  • TQTXRuntime
    • DelayedDispatch
    • CancelDelayedDispatch
    • Execute
    • Ready
    • ExecuteDocumentReady

Dynamic stylesheets

  • TQTXStyleSheet

Flicker free, smooth momentum scroll baseclasses

  • TQTXScrollOptions,
  • TQTXScrollController
  • TQTXScrollWindow

3D for any HTML elements

  • TQTXSprite3DController

Custom controls

  • TQTXHeaderButton
  • TQTXBackButton
  • TQTXNextButton
  • TQTXHeaderTitle
  • TQTXHeaderBar
  • TQTXLabel
  • TQTXScrollText

Downloading

Simply point your SVN client to: svn checkout http://qtxlibrary.googlecode.com/svn/trunk/ and grab the units.

Installing

Copy the target folder into your Smart Mobile Studio -> Libraries folder and re-start the IDE. That’s it! Now include the units in your uses-clause and kick some serious HTML5 butt!

Caching effects

August 17, 2014 Leave a comment

Sort of discovered this by surprise. I was making the typical “mouse-over” effects for buttons, where they grow a few pixels when you hover over them. But, since only one webkit transformation can be applied to an element at any given time, I decided to use a callback to catch effects that overlap.

Well, it’s pretty cool! Move the mouse pointer in and out of the control very quickly to see what I mean. And naturally, the element never looses its original size. This is perfect for music vumeter’s — or perhaps a ripple effect that never loses track of the original size?

  W3Button1.OnMouseEnter:=Procedure (sender:TObject; Shift: TShiftState; X, Y: Integer)
  Begin
    if not w3button1.fxBusy then
    w3Button1.fxScaleUp(4,0.2) else
    w3_callback( procedure ()
      Begin
        w3Button1.OnMouseEnter(sender,shift,x,y);
      end, 100);
  end;

  w3button1.OnMouseExit:=procedure (sender:TObject; Shift: TShiftState; X, Y: Integer)
  Begin
    if not w3button1.fxBusy then
    w3Button1.fxScaleDown(4,0.2) else
    w3_callback( procedure ()
      Begin
        w3Button1.onMouseExit(sender,shift,x,y);
      end, 100);
  end;

Oh, and remember to update the QTX svn library before trying it !

Updated

I decided to add this form of caching to the library itself. This completely removes the need for an effect-stack (linear “list” of effects to execute one after the other).

Well, everything is now in place to write some interesting, dynamic and awesome Smart Pascal visual components. I could be tempted to write a book on advanced Smart Mobile coding — interested?

Storing stuff inside the tag

User definable per-tag attributes

User definable per-tag attributes

Another thing I learned today. As you probably understand by now, a Smart Visual Component consists of two parts. First, there is the javascript object which is what you compile from Object Pascal, secondly there is the HTML element which your control manages via code.

But what if you want to store some data which can be read/written without access to the JS code?

Let me introduce you to the problem. The effects library is capable of animating any TW3CustomControl based element, regardless of what basetype it implements (DIV, PRE, IFRAME etc..). But it does this via class helpers – so how can we store a boolean value informing us that an effect is active? We dont want to re-mold the RTL (at least not before the technology is rock solid) — so how can we attach data to an element without altering the virtual method table data?

Ta-Da! —  HTML5 introduces something called Data Attributes (read more here: http://html5doctor.com/html5-custom-data-attributes/) . Basically, whenever you use attributes on a tag which begins with “data-“, the browser leaves them in place (ordinarily it would remove them or not include them in the DOM). This allows us to do stuff like below, without affecting javascript, the RTL or the DOM negatively in any way (!):

<DIV ID="w3Panel1" data-fxActive="true">
..
</DIV>

In the QTX library read/write access to data-attributes is introduced in the class TQTXAttrAccess (qtxutils.pas). So if you include this unit in your project, all TW3CustomControl based elements gain an extra property called ElementData of type TQTXAttrAccess. Think of it like an unlimited box of TComponent.Tag values 🙂

Effects without stylesheet punching

Unless you have been living under a rock you would know that the GPU can only be accessed via CSS. This means you have to write stylesheet code (which you can edit inside Smart Mobile Studio). But this ties you down a bit, because what if you want to re-use some effects in another app? You either have to copy the CSS and Pascal code over — or… you can author the effect CSS in smart pascal directly.

And that my friend is why you will find a class called TQTXStyleSheet in the qtxstyles.pas unit. It allows you to write cutting edge GPU effects that are portable between projects — and you can leave the default, model view stylesheet intact.

You are welcome!

QTXLibrary on google code

August 15, 2014 3 comments
Quartex is 4ever

Quartex is 4ever

To make things easier in the future I decided to push all my Smart Pascal examples into one basket and upload them to Google Code. That way people don’t have to copy & paste from this website, but rather just update their SVN repo folder.

Point your SVN client at: https://code.google.com/p/qtxlibrary/

Only human

I must however stress that these units should be considered “examples”. This blog is more about experimentation, research and education than it is anything else. I do not provide any form of support. I work full-time as a professional software developer, so there is quite frankly not enough time for large-scale hobby projects.

For new features and ideas around Smart Pascal, send an email to the Smart Mobile Studio team. It will be registered in the system and receive a proper ticket.

Ayways, do a checkout of the google repository – remember to check out to the Smart Mobile Studio Libraries folder – and have a peek 🙂

What can it do?

All sorts of cool stuff! You have the in-memory dataset class, which is very handy. And the latest additions are the effect helpers. Smart Mobile Studio RTL contains a lot of cool stuff – but for beginners it may be hard to get to grips with all the new terminology. If you are serious about y0ur HTML5 coding, you should get a book and learn some JS. It makes all the difference.

So how are the effect helpers useful? Well, for instance, to make buttons that “grow” when you move your mouse hovers over them, you would write this:

  W3Button1.OnMouseEnter:=Procedure (sender:TObject; Shift: TShiftState; X, Y: Integer)
  Begin
    //grow the button by 4x4 pixels in 0.2 seconds
    w3Button1.fxScaleUp(4,0.2);
  end;

  w3button1.OnMouseExit:=procedure (sender:TObject; Shift: TShiftState; X, Y: Integer)
  Begin
    // Shrink button back to original size
    w3Button1.fxScaleDown(4,0.2);
  end;

Effect stack

What I have been playing with lately (thought only for now) is an effect stack. Basically a “mini” effect language that you can use to script effect chains inside your SMS application.

For instance, a script could look like:

var script:String := #"fadeout(0);
  fadeIn(0.6);
  moveTo(100,100);
  rotate(-30,-60,-70);
  scale(200,200);
  Scew3d(-90,-90-36);
  warpOut(0.9);";
FStack.push(script,w3button1);
FStack.execute(esImmediate);

Reminds me a bit about the old Amos Basic “sprite language” that we used in the 90’s for writing shoot’em up enemies for games and demos.