Archive
QuartexDeveloper.com is now active
It’s taken a while but Quartex Pascal now has it’s own website and forum. You can visit QuartexDeveveloper.com and check it out.
The SSL certificates are being applied within 72hrs according to the host, so don’t be alarmed that it shows up under HTTP rather than HTTPS right now – that is just temporary.
Up until now we have operated with a mix of donations and Patreon to help fund the project, but obviously that model doesn’t scale very well. After some debate and polls on the Facebook group I have landed on a new model.
Funding and access model
Starting with the release of version 1.0, which is just around the corner – the model will be as such:
- Backing and support will be handled solely through Patreon
- Facebook group will become open for all
- Patreon tiers will be modified to reflect new model
- Main activity and news will shift to our website, quartexdeveloper.com
- Community build will be available from our website
- Commercial license will also be available from our website
So to sum up, the following 3 options are available:
- Back the project on Patreon, full access to the latest and greatest 24/7
- Community edition, free for educational institutions and open-source projects (non commercial)
- Commercial license is for those that don’t want to back the project on a monthly basis, but instead use the community edition in a professional capacity for commercial work.
With the community edition available, why should anyone bother to back the project you might ask? Well, the public builds will by consequence be behind the latest, bleeding edge builds since the community edition is only updated on minor or major version increments (e.g. when version changes from 1.0 to 1.1). Users who back the project via Patreon will have instant access to new documentation, new packages with visual components, new project templates, RTL fixes and patches as they are released. These things will eventually trickle down to the community edition through version increments, but there is a natural delay involved.

This is how most modern crowd funded projects operate, with LTS builds (long term support) easily available while the latest cutting edge builds are backers only. Documentation, fixes and updates to components, new component packages, hotfixes and so on – is the incentive for backing the project.
This is the only way to keep the ball rolling without a major company backing day to day development, we have to get creative and work with what we got. Projects like Mono C# had the luxury of two major Linux distribution companies backing them, enabling Miguel de Icaza to work full time on the codebase. I must admit I was hoping Embarcadero would have stepped in by now, but either way we will get it done.

Onwards!
Quartex Pascal: Public Alpha
It’s been a long time since I have written a post here on my blog. I have been so busy with work that I quite frankly have not had the extra energy to maintain this website. During the weekdays my hands are full with work, and in the weekends I typically recharge 1 day, with Friday afternoon and Sunday allocated for the Quartex Pascal project. On Saturdays I sleep for as long as I can, go for a walk, and watch Netflix.

Thankfully I am happy to report that Quartex Pascal is more or less ready for a public alpha. I took out a week vacation today to finish the remaining handful of tickets, which are ultimately superficial and fiddly, but nothing difficult compared to what we have already achieved.
Have we reached our goals?
When you start a project it’s easy to get caught up in the potential. One feature quickly avails the next, and if you are not careful – you can be whisked away to vaporware land. Or even worse, end up with a project that never ends and where you keep telling yourself “i just need to add this, then I’m done”. I am happy that we have managed to avoid that, and set a clear boundary of what should be in the initial release. The point of version 1.0 is not to cover all possible features, but rather – to make damn sure the fundamental features work as well as I can make them. Because future revisions and features will build on that foundation. So in short: Yes. As much as 90% of what we set out to include in version 1.0 has been realized. The only thing we had to push to version 1.1 and 1.2 is the database explorer, DAC classes so your web application can work directly with a database through a node.js service, and a few minor features like having a Gr32 powered picture viewer and paint-program included.

There is plenty of room for optimization and refactoring in the code-base, so once the first version is out you can expect regular updates (Patreon backers only) where both the IDE and RTL becomes more and more refined and optimized. One of the things I am really looking forward to is writing new and exciting widgets (controls are called widgets under the QTX paradigm), and also port over more JS modules and frameworks. We already have an impressive list of JS frameworks that you can use out of the box. The benefit of having highly skilled backers is that they are quick to digest new technology and produce packages, so we have a lot of widgets that you can drag & drop that are 1:1 wrappers (a wrapper is a class definition that describes an external object, or a unit that makes the features of an external framework usable from pascal).
The Cloud desktop project
Since a couple of years have passed, most people have probably forgotten why Quartex Pascal was created to begin with. Namely as a development tool to implement and finish the Quartex Media Desktop (also known as Amibian.js). Quartex Pascal was actually a detour we had to make to save the codebase I had already implemented. So the moment version 1.0 goes out the door, my first priority is to refactor and re-implement the desktop client under the Quartex Pascal RTL. The background node.js services already run on my new RTL, so all the work we did a couple of years ago is still there, waiting to be picked up again.

I am not going to spend ages re-hashing the desktop system, but in short this is a client-server system that implements a Windows like desktop, complete with filesystem over websocket, multi user accounts, message based API, and that is 100% JavaScript from the back-end services all the way up to the desktop itself. It is in other words portable and completely hardware and platform agnostic. The point of the desktop is to provide the exact same ecosystem that Windows provides for native applications, for enterprise level web applications. This includes hybrid application modules where half the program is deployed server-side, while the visual part is rendered in the browser (this is how we could have a Torrent client with live status in a web application).
Combine this with a thin Linux bootstrap, where you boot into Chrome in Kiosk mode – and you have a fully working, incredibly powerful desktop system. One that you can literally copy from one machine to the next without recompiling a line of code. As long as the system supports node.js and have a modern browser, Amibian.js will run. Heck, I even booted it on my Smart TV (!).
Release date?
The public alpha is, as the name implies, a pre-release version meant purely to be played around with. There are bound to be hiccups and bugs, but the point is just to get you familiar with the ecosystem (which is very different from Delphi, so don’t think you can just magically compile some old Delphi application).

I am aiming at next weekend. It can be that some delay comes up, but all in all I have only a handful of tickets, most of them small and somewhat fiddly, but nothing too difficult. I will close 2 or 3 tickets a day, so a build should be ready next weekend for you guys.
What License?
The application is released as vanilla shareware, which means that copyright and ownership of all materials (except packages and examples written by others naturally) is tied to me. Once we have enough to establish the Quartex Pascal Foundation (which aims at teaching object pascal and offering free development tools for for students, schools and non-profit organizations) ownership will be isolated there. You can read more about the license on the website, here: https://quartexpascal.wordpress.com/about/licensing/.
We also have a rule that any version of Quartex Pascal will never cost more than €300. The first version will be in the €100-€150 range, which buys you a license to use the development tools in a commercial setting. Quartex Pascal is free to use for open-source work. Students can also use QTX for free, provided they provide proper student identification that can be verified, and they dont use it for commercial gain. Considering the cheap price, buying a license wont exactly break the bank.
The RTL is accessible the exact same way that you are used to under Delphi, so exploring the RTL is encouraged. I have started on the documentation but this is an alpha so you really need to explore a bit.
Just like Delphi all applications have a TApplication object that is the first to be created, and entities like forms are managed by TApplication (they automatically register when you create TQTXForm or TQTXWindow). Once you familiarize yourself with the units, you should have no problem becoming productive in a very short time.
Resources
- Check out the Patreon project page for backing this project
- Check out the Quartex Pascal website
- Check out the Quartex Pascal usergroup on Facebook (backers only!)
When Nicola Tesla slaps you over the head
If you have poked around the Quartex Pascal RTL you might have notice that QTX comes with a serial-number minting system. Creating unique serial numbers that can be mathematically re-traced back to a root key (number sequence) is extremely tricky business. My solution was to dip my fingers into esoteric and occult numerology, because our ancient forbearers had a knack for puzzles and number based riddles.
And here I thought I was super clever, only to discover that Nicola Tesla scribbled a similar system on a napkin back in the late 1800s (figuratively speaking). Turns out that the basis of my system is more or less identical to Tesla’s numbers and ultimately bound by their relationships, where you operate with a growth factor that is a multiple of 12, modulated and held in check by Fibonacci, Lucas or Leonardo sequencing.
So my ego got a well deserved slap (which is always healthy, we should all be humble in the presence of that man).
I have never really been that interested in Tesla until recently, and the little I have read about him makes me incredibly sad. This man was not decades ahead of his time, but centuries.
In my view, the biggest tragedy in human history is without a doubt the loss of the great library in Alexandria, Egypt. Second only with the murder of Hypatia; a series of events that would eventually catapult humanity as a whole into a dark-age that lasted for 2000 years.
But having spent some time this morning reading about Tesla, I would add him to that list of tragic events that have affected our history (or in his case, being prevented from lifting mankind up). This is a man that constructed the walkie-talkie in the late 1800s. He even theorized that both audio and video could be transmitted over a hand-held device. And this was in the late 1800s (!).


Above: The serial-number minting dialog from the IDE. Here we use 12 seed numbers to form the root key, and each serial number is grown from these using natural numbers, as employed by various mystics and esoteric traditions.
Hat off Tesla. It is a great shame that you were born into a world that neither understood or appreciated the wonders you delivered.
Nicolas Tesla’s notebooks is best read on your knees.
Now I need to scotch tape my ego back together and get to work.
C/C++ porting, QTX and general status
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

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!

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.
Quartex Media Desktop, new compiler and general progress
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.
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 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.
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.

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

The LDEF Assembler is a part of the Quartex Media Desktop
The LDEF assembler and bytecode engine is currently implemented in Smart and compiles for Javascript. It’s a complete assembler and VM allowing coders to approach Asm.js from an established instruction-set. In short: you feed it source-code, it spits out bytecodes that you can execute super fast in either the browser or elsewhere. As long as there is a VM implementation available.
The Javascript version works really well, especially on node.js. In essence, i don’t need to re-compile the toolchain when moving between arm, x86, windows, linux or osx. Think of it as a type of Java bytecodes or CLR bytecodes.
Getting the code to run under Oxygene, means that I can move the whole engine into WebAssembly. The parser, assembler and linker (et-al) can thus run as WebAssembly, and I can use that from my JavaScript front-end code. Best of both worlds – the flamboyant creativity of JavaScript, and the raw speed of WebAssembly.
The port
Before I can move over the top-level parser + assembler etc, the generic parser code has to work. I was reluctant to start because I imagined the porting would take at least a day, but luckily it took me less than an hour. There are a few superficial differences between Smart, Delphi, Freepascal and Oxygene; for example the Copy() function for strings is not a lose function in Oxygene, instead you use String.SubString(). Functions like High() and Low() on strings likewise has to be refactored.
But all in all the conversion was straight-forward, and TextCraft is now a part of the QTX library for Oxygene. I’ll be uploading a commit to GIT with the whole shabam soon.
Well, hope the WordPress parser doesnt screw this up too bad.
namespace qtxlib; //################################################################## // TextCraft 1.2 // Written by Jon L. Aasenden // // This is a port of TC 1.2 from Freepascal. TextCraft is initially // a Delphi parser framework. The original repository can be found // on BitBucket at: // // https://bitbucket.org/hexmonks/main // //################################################################## {$DEFINE USE_INCLUSIVE} {$define USE_BMARK} interface uses qtxlib, System, rtl, RemObjects.Elements.RTL.Delphi, RemObjects.Elements.RTL.Delphi.VCL; type // forward declarations TTextBuffer = class; TParserContext = class; TCustomParser = class; TParserModelObject = class; // Exceptions ETextBuffer = class(Exception); EModelObject = class(Exception); // Callback functions TTextValidCB = function (Item: Char): Boolean; // Bookmark datatype TTextBufferBookmark = class public property bbOffset: Integer; property bbCol: Integer; property bbRow: Integer; function Equals(const ThisMark: TTextBufferBookmark): Boolean; end; {.$DEFINE USE_BMARK} TTextBuffer = class(TErrorObject) private FData: String; FOffset: Integer; FLength: Integer; FCol: Integer; FRow: Integer; {$IFDEF USE_BMARK} FBookmarks: List; {$ENDIF} procedure SetCacheData(NewText: String); public property Column: Integer read FCol; property Row: Integer read FRow; property Count: Integer read FLength; property Offset: Integer read FOffset; property CacheData: String read FData write SetCacheData; // These functions map directly to the "Current" // character where the offset is placed, and is used to // write code that makes more sense to human eyes function CrLf: Boolean; function Space: Boolean; function Tab: Boolean; function SemiColon: Boolean; function Colon: Boolean; function ConditionEnter: Boolean; function ConditionLeave: Boolean; function BracketEnter: Boolean; function BracketLeave: Boolean; function Ptr: Boolean; function Punctum: Boolean; function Question: Boolean; function Less: Boolean; function More: Boolean; function Equal: Boolean; function Pipe: Boolean; function Numeric: Boolean; function Empty: Boolean; function BOF: Boolean; function EOF: Boolean; function Current: Char; function First: Boolean; function Last: Boolean; // Same as "Next", but does not automatically // consume CR+LF, used when parsing textfragments function NextNoCrLf: Boolean; // Normal Next function, will automatically consume // CRLF when it encounters it function Next: Boolean; function Back: Boolean; function Bookmark: TTextBufferBookmark; procedure Restore(const Mark: TTextBufferBookmark); {$IFDEF USE_BMARK} procedure Drop; {$ENDIF} procedure ConsumeJunk; procedure ConsumeCRLF; function Compare(const CompareText: String; const CaseSensitive: Boolean): Boolean; function Read(var Fragment: Char): Boolean; overload; function Read: Char; overload; function ReadTo(const CB: TTextValidCB; var TextRead: String): Boolean; overload; function ReadTo(const Resignators: TSysCharSet; var TextRead: String): Boolean; overload; function ReadTo(MatchText: String): Boolean; overload; function ReadTo(MatchText: String; var TextRead: String): Boolean; overload; function ReadToEOL: Boolean; overload; function ReadToEOL(var TextRead: String): Boolean; overload; function Peek: Char; overload; function Peek(CharCount: Integer; var TextRead: String): Boolean; overload; function NextNonControlChar(const CompareWith: Char): Boolean; function NextNonControlText(const CompareWith: String): Boolean; function ReadWord(var TextRead: String): Boolean; function ReadQuotedString: String; function ReadCommaList(var cList: List): Boolean; function NextLine: Boolean; procedure Inject(const TextToInject: String); function GetCurrentLocation: TTextBufferBookmark; function Trail: String; procedure Clear; procedure LoadBufferText(const NewBuffer: String); constructor Create(const BufferText: String); overload; virtual; finalizer; begin {$IFDEF USE_BMARK} FBookmarks.Clear(); disposeAndNil(FBookmarks); {$endif} Clear(); end; end; TParserContext = class(TErrorObject) private FBuffer: TTextBuffer; FStack: Stack; public property Buffer: TTextBuffer read FBuffer; property Model: TParserModelObject; procedure Push(const ModelObj: TParserModelObject); function Pop: TParserModelObject; function Peek: TParserModelObject; procedure ClearStack; constructor Create(const SourceCode: String); reintroduce; virtual; finalizer; begin FStack.Clear(); FBuffer.Clear(); disposeAndNil(FStack); disposeAndNil(FBuffer); end; end; TCustomParser = class(TErrorObject) private FContext: TParserContext; protected procedure SetContext(const NewContext: TParserContext); public property Context: TParserContext read FContext; function Parse: Boolean; virtual; constructor Create(const ParseContext: TParserContext); reintroduce; virtual; end; TParserModelObject = class(TObject) private FParent: TParserModelObject; FChildren: List; protected function GetParent: TParserModelObject; virtual; function ChildGetCount: Integer; virtual; function ChildGetItem(const Index: Integer): TParserModelObject; virtual; function ChildAdd(const Instance: TParserModelObject): TParserModelObject; virtual; public property Parent: TParserModelObject read GetParent; property Context: TParserContext; procedure Clear; virtual; constructor Create(const AParent: TParserModelObject); virtual; finalizer; begin Clear(); FChildren := nil; end; end; implementation //##################################################################### // Error messages //##################################################################### const CNT_ERR_BUFFER_EMPTY = 'Buffer is empty error'; CNT_ERR_OFFSET_BOF = 'Offset at BOF error'; CNT_ERR_OFFSET_EOF = 'Offset at EOF error'; CNT_ERR_COMMENT_NOTCLOSED = 'Comment not closed error'; CNT_ERR_OFFSET_EXPECTED_EOF = 'Expected EOF error'; CNT_ERR_LENGTH_INVALID = 'Invalid length error'; //##################################################################### // TTextBufferBookmark //##################################################################### function TTextBufferBookmark.Equals(const ThisMark: TTextBufferBookmark): boolean; begin result := ( (ThisMark nil) and (ThisMark self) ) and (self.bbOffset = ThisMark.bbOffset) and (self.bbCol = ThisMark.bbCol) and (self.bbRow = ThisMark.bbRow); end; //##################################################################### // TTextBuffer //##################################################################### constructor TTextBuffer.Create(const BufferText: string); begin inherited Create(); if length(BufferText) > 0 then LoadBufferText(BufferText) else Clear(); end; procedure TTextBuffer.Clear; begin FData := ''; FOffset := -1; FLength := 0; FCol := -1; FRow := -1; {$IFDEF USE_BMARK} FBookmarks.Clear(); {$ENDIF} end; procedure TTextBuffer.SetCacheData(NewText: string); begin LoadBufferText(NewText); end; function TTextBuffer.Trail: string; begin if not Empty then begin if not EOF then result := FData.Substring(FOffset, length(FData) ); //result := Copy( FData, FOffset, length(FData) ); end; end; procedure TTextBuffer.LoadBufferText(const NewBuffer: string); begin // Flush existing buffer Clear(); // Load in buffertext, init offset and values var TempLen := NewBuffer.Length; if TempLen > 0 then begin FData := NewBuffer; FOffset := 0; // start at BOF FCol := 0; FRow := 0; FLength := TempLen; end; end; function TTextBuffer.GetCurrentLocation: TTextBufferBookmark; begin if Failed then ClearLastError(); if not Empty then begin result := TTextBufferBookmark.Create; result.bbOffset := FOffset; result.bbCol := FCol; result.bbRow := FRow; end else raise ETextBuffer.Create ('Failed to return position, buffer is empty error'); end; function TTextBuffer.Bookmark: TTextBufferBookmark; begin if Failed then ClearLastError(); if not Empty then begin result := TTextBufferBookmark.Create; result.bbOffset := FOffset; result.bbCol := FCol; result.bbRow := FRow; {$IFDEF USE_BMARK} FBookmarks.add(result); {$ENDIF} end else raise ETextBuffer.Create ('Failed to bookmark location, buffer is empty error'); end; procedure TTextBuffer.Restore(const Mark: TTextBufferBookmark); begin if Failed then ClearLastError(); if not Empty then begin if Mark nil then begin FOffset := Mark.bbOffset; FCol := Mark.bbCol; FRow := Mark.bbRow; Mark.Free; {$IFDEF USE_BMARK} var idx := FBookmarks.Count; if idx > 0 then begin dec(idx); FOffset := FBookmarks[idx].bbOffset; FCol := FBookmarks[idx].bbCol; FRow := FBookmarks[idx].bbRow; FBookmarks.Remove(idx); //FBookmarks.SetLength(idx) //FBookmarks.Delete(idx,1); end else raise ETextBuffer.Create('Failed to restore bookmark, none exist'); {$ENDIF} end else raise ETextBuffer.Create('Failed to restore bookmark, object was nil error'); end else raise ETextBuffer.Create ('Failed to restore bookmark, buffer is empty error'); end; {$IFDEF USE_BMARK} procedure TTextBuffer.Drop; begin if Failed then ClearLastError(); if not Empty then begin if FBookmarks.Count > 0 then FBookmarks.Remove(FBookmarks.Count-1) else raise ETextBuffer.Create('Failed to drop bookmark, none exist'); end else raise ETextBuffer.Create ('Failed to drop bookmark, buffer is empty error'); end; {$ENDIF} function TTextBuffer.Read(var Fragment: char): boolean; begin if Failed then ClearLastError(); if not Empty then begin result := FOffset <= length(FData); if result then begin // return character Fragment := FData[FOffset]; // update offset inc(FOffset) end else begin // return invalid char Fragment := #0; // Set error reason SetLastError('Offset at BOF error'); end; end else begin result := false; Fragment := #0; SetLastError('Buffer is empty error'); end; end; function TTextBuffer.Read: char; begin if Failed then ClearLastError(); if not Empty then begin result := Current; Next(); end else result := #0; end; function TTextBuffer.ReadToEOL: boolean; begin if Failed then ClearLastError(); if not Empty() then begin if BOF() then begin if not First() then exit; end; if EOF() then begin SetLastError(CNT_ERR_OFFSET_EOF); exit; end; // Keep start var LStart := FOffset; // Enum until match of EOF {$IFDEF USE_INCLUSIVE} repeat if (FData[FOffset] = #13) and (FData[FOffset + 1] = #10) then begin result := true; break; end else begin inc(FOffset); inc(FCol); end; until EOF(); {$ELSE} While FOffset < High(FData) do begin if (FData[FOffset] = #13) and (FData[FOffset + 1] = #10) then begin result := true; break; end else begin inc(FOffset); inc(FCol); end; end; {$ENDIF} // Last line in textfile might not have // a CR+LF, so we have to check for termination if not result then begin if EOF then begin if LStart = Low(FData)) and (FOffset = Low(FData)) and (FOffset = Low(FData)) and (FOffset = Low(FData)) and (FOffset = Low(FData)) and (FOffset = Low(FData)) and (FOffset = Low(FData)) and (FOffset = Low(FData)) and (FOffset = Low(FData)) and (FOffset = Low(FData)) and (FOffset = Low(FData)) and (FOffset = Low(FData)) and (FOffset = Low(FData)) and (FOffset <= high(FData) ) ) and ( (FData[FOffset] = '= Low(FData)) and (FOffset ') ); end; function TTextBuffer.Equal: boolean; begin result := (not Empty) and ( (FOffset >= Low(FData)) and (FOffset = Low(FData)) and (FOffset = Low(FData)) and (FOffset LStart then begin // Any text to return? Or did we start // directly on a CR+LF and have no text to give? var LLen := FOffset - LStart; TextRead := FData.Substring(LStart, LLen); //TextRead := Copy(FData, LStart, LLen); end; // Either way, we exit because CR+LF has been found result := true; break; end; inc(FOffset); inc(FCol); until EOF(); {$ELSE} While FOffset LStart then begin // Any text to return? Or did we start // directly on a CR+LF and have no text to give? var LLen := FOffset - LStart; TextRead := copy(FData, LStart, LLen); end; // Either way, we exit because CR+LF has been found result := true; break; end; inc(FOffset); inc(FCol); end; {$ENDIF} // Last line in textfile might not have // a CR+LF, so we have to check for EOF and treat // that as a terminator. if not result then begin if FOffset >= high(FData) then begin if LStart 0 then begin TextRead := FData.Substring(LStart, LLen); //TextRead := Copy(FData, LStart, LLen); result := true; end; exit; end; end; end; end; end; function TTextBuffer.ReadTo(const CB: TTextValidCB; var TextRead: string): boolean; begin if Failed then ClearLastError(); TextRead := ''; if not Empty then begin if BOF() then begin if not First() then exit; end; if EOF() then begin SetLastError(CNT_ERR_OFFSET_EOF); exit; end; if not assigned(CB) then begin SetLastError('Invalid callback handler'); exit; end; {$IFDEF USE_INCLUSIVE} repeat if not CB(Current) then break else TextRead := TextRead + Current; if not Next() then break; until EOF(); {$ELSE} while not EOF do begin if not CB(Current) then break else TextRead := TextRead + Current; if not Next() then break; end; {$ENDIF} result := TextRead.Length > 0; end else begin result := false; SetLastError(CNT_ERR_BUFFER_EMPTY); end; end; function TTextBuffer.ReadTo(const Resignators: TSysCharSet; var TextRead: string): boolean; begin if Failed then ClearLastError(); TextRead := ''; if not Empty then begin if BOF() then begin if not First() then exit; end; if EOF() then begin SetLastError(CNT_ERR_OFFSET_EOF); exit; end; {$IFDEF USE_INCLUSIVE} repeat if not Resignators.Contains(Current) then TextRead := TextRead + Current else break; if not Next() then break; until EOF(); {$ELSE} while not EOF do begin if not (Current in Resignators) then TextRead := TextRead + Current else break; if not Next() then break; end; {$ENDIF} result := TextRead.Length > 0; end else begin result := false; SetLastError(CNT_ERR_BUFFER_EMPTY); end; end; function TTextBuffer.ReadTo(MatchText: string): boolean; begin if Failed then ClearLastError(); if not Empty() then begin if BOF() then begin if not First() then exit; end; if EOF() then begin SetLastError(CNT_ERR_OFFSET_EOF); exit; end; var MatchLen := length(MatchText); if MatchLen > 0 then begin MatchText := MatchText.ToLower(); repeat var TempCache := ''; if Peek(MatchLen, TempCache) then begin TempCache := TempCache.ToLower(); result := SameText(TempCache, MatchText); if result then break; end; if not Next then break; until EOF; end; end else begin result := false; SetLastError(CNT_ERR_BUFFER_EMPTY); end; end; function TTextBuffer.ReadTo(MatchText: string; var TextRead: string): boolean; begin if Failed then ClearLastError(); result := false; TextRead := ''; if not Empty() then begin if BOF() then begin if not First() then exit; end; if EOF() then begin SetLastError(CNT_ERR_OFFSET_EOF); exit; end; if MatchText.Length > 0 then begin MatchText := MatchText.ToLower(); repeat var TempCache := ''; if Peek(MatchText.Length, TempCache) then begin TempCache := TempCache.ToLower(); result := SameText(TempCache, MatchText); if result then break else TextRead := TextRead + Current; end else TextRead := TextRead + Current; if not Next() then break; until EOF; end; end else begin result := false; SetLastError(CNT_ERR_BUFFER_EMPTY); end; end; procedure TTextBuffer.Inject(const TextToInject: string); begin if length(FData) > 0 then begin var lSeg1 := FData.Substring(1, FOffset); var lSeg2 := FData.Substring(FOffset + 1, length(FData)); //var LSeg1 := Copy(FData, 1, FOffset); //var LSeg2 := Copy(FData, FOffset+1, FData.Length); FData := lSeg1 + TextToInject + lSeg2; end else FData := TextToInject; end; function TTextBuffer.Compare(const CompareText: string; const CaseSensitive: boolean): boolean; begin if Failed then ClearLastError(); if not Empty() then begin if BOF() then begin if not First() then exit; end; if EOF() then begin SetLastError(CNT_ERR_OFFSET_EOF); exit; end; var LenToRead := CompareText.Length; if LenToRead > 0 then begin // Peek will set an error message if it // fails, so we dont need to set anything here var ReadData := ''; if Peek(LenToRead, ReadData) then begin case CaseSensitive of false: result := ReadData.ToLower() = CompareText.ToLower(); true: result := ReadData = CompareText; end; end; end else SetLastError(CNT_ERR_LENGTH_INVALID); end else SetLastError(CNT_ERR_BUFFER_EMPTY); end; procedure TTextBuffer.ConsumeJunk; begin if Failed then ClearLastError(); if not Empty then begin if BOF() then begin if not First() then exit; end; if EOF() then begin SetLastError(CNT_ERR_OFFSET_EOF); exit; end; repeat case Current of ' ': begin end; '"': begin break; end; #8, #09: begin end; '/': begin (* Skip C style remark *) if Compare('/*', false) then begin if ReadTo('*/') then begin inc(FOffset, 2); Continue; end else SetLastError(CNT_ERR_COMMENT_NOTCLOSED); end else begin (* Skip Pascal style remark *) if Compare('//', false) then begin if ReadToEOL() then begin continue; end else SetLastError(CNT_ERR_OFFSET_EXPECTED_EOF); end; end; end; '(': begin (* Skip pascal style remark *) if Compare('(*', false) and not Compare('(*)', false) then begin if ReadTo('*)') then begin inc(FOffset, 2); continue; end else SetLastError(CNT_ERR_COMMENT_NOTCLOSED); end else break; end; #13: begin if FData[FOffset + 1] = #10 then inc(FOffset, 2) else inc(FOffset, 1); //if Peek = #10 then // ConsumeCRLF; continue; end; #10: begin inc(FOffset); continue; end; else break; end; if not Next() then break; until EOF; end else SetLastError(CNT_ERR_BUFFER_EMPTY); end; procedure TTextBuffer.ConsumeCRLF; begin if not Empty then begin if BOF() then begin if not First() then exit; end; if EOF() then begin SetLastError(CNT_ERR_OFFSET_EOF); exit; end; if (FData[FOffset] = #13) then begin if FData[FOffset + 1] = #10 then inc(FOffset, 2) else inc(FOffset); inc(FRow); FCol := 0; end; end; end; function TTextBuffer.Empty: boolean; begin result := FLength < 1; end; // This method will look ahead, skipping space, tab and crlf (also known // as control characters), and when a non control character is found it will // perform a string compare. This method uses a bookmark and will restore // the offset to the same position as when it was entered. // // Notes: The method "NextNonControlChar" is a similar method that // performs a char-only compare. function TTextBuffer.NextNonControlText(const CompareWith: string): boolean; begin if Failed then ClearLastError(); if not Empty then begin if BOF() then begin if not First() then exit; end; if EOF() then begin SetLastError(CNT_ERR_OFFSET_EOF); exit; end; var Mark := Bookmark(); try // Iterate ahead repeat if not (Current in [' ', #13, #10, #09]) then break; Next(); until EOF(); // Compare unless we hit the end of the line if not EOF then result := Compare(CompareWith, false); finally Restore(Mark); end; end else SetLastError(CNT_ERR_BUFFER_EMPTY); end; // This method will look ahead, skipping space, tab and crlf (also known // as control characters), and when a non control character is found it will // perform a string compare. This method uses a bookmark and will restore // the offset to the same position as when it was entered. function TTextBuffer.NextNonControlChar(const CompareWith: char): boolean; begin if Failed then ClearLastError(); if not Empty then begin if BOF() then begin if not First() then exit; end; if EOF() then begin SetLastError(CNT_ERR_OFFSET_EOF); exit; end; var Mark := Bookmark(); try repeat if not (Current in [' ', #13, #10, #09]) then break; Next(); until EOF(); //if not EOF then result := Current.ToLower() = CompareWith.ToLower(); //result := LowerCase(Current) = LowerCase(CompareWith); finally Restore(Mark); end; end else SetLastError(CNT_ERR_BUFFER_EMPTY); end; function TTextBuffer.Peek: char; begin if Failed then ClearLastError(); if not Empty then begin if (FOffset 0 do begin TextRead := TextRead + Current; if not Next() then break; dec(CharCount); end; finally Restore(Mark); end; result := TextRead.Length > 0; end else SetLastError(CNT_ERR_OFFSET_EOF); end else SetLastError(CNT_ERR_BUFFER_EMPTY); end; function TTextBuffer.First: boolean; begin if Failed then ClearLastError(); if not Empty then begin FOffset := Low(FData); result := true; end else SetLastError(CNT_ERR_BUFFER_EMPTY); end; function TTextBuffer.Last: boolean; begin if Failed then ClearLastError(); if not Empty then begin FOffset := high(FData); result := true; end else SetLastError(CNT_ERR_BUFFER_EMPTY); end; function TTextBuffer.NextNoCrLf: boolean; begin if Failed then ClearLastError(); if not Empty then begin // Check that we are not EOF result := FOffset <= high(FData); if result then begin // Update offset into buffer inc(FOffset); // update column, but not if its in a lineshift if not (FData[FOffset] in [#13, #10]) then inc(FCol); end else SetLastError(CNT_ERR_OFFSET_EOF); end else SetLastError(CNT_ERR_BUFFER_EMPTY); end; function TTextBuffer.Next: boolean; begin if Failed then ClearLastError(); if not Empty() then begin if BOF() then begin if not First() then exit; end; if EOF() then begin SetLastError(CNT_ERR_OFFSET_EOF); exit; end; // Update offset into buffer inc(FOffset); // update column inc(FCol); // This is the same as ConsumeCRLF // But this does not generate any errors since we PEEK // ahead into the buffer to make sure the combination // is correct before we adjust the ROW + offset if FOffset Low(FData)); if result then dec(FOffset) else SetLastError(CNT_ERR_OFFSET_BOF); end else SetLastError(CNT_ERR_BUFFER_EMPTY); end; function TTextBuffer.Current: char; begin if Failed then ClearLastError(); // Check that buffer is not empty if not Empty then begin // Check that we are on char 1 or more if FOffset >= Low(FData) then begin // Check that we are before or on the last char if (FOffset <= high(FData)) then result := FData[FOffset] else begin SetLastError(CNT_ERR_OFFSET_EOF); result := #0; end; end else begin SetLastError(CNT_ERR_OFFSET_BOF); result := #0; end; end else begin SetLastError(CNT_ERR_BUFFER_EMPTY); result := #0; end; end; function TTextBuffer.BOF: boolean; begin if not Empty then result := FOffset high(FData); end; function TTextBuffer.NextLine: boolean; begin if Failed then ClearLastError(); if not Empty then begin // Make sure we offset to a valid character // in the buffer. ConsumeJunk(); if not EOF then begin var ThisRow := self.FRow; while Row = ThisRow do begin Next(); if EOF then break; end; result := (Row ThisRow) and (not EOF); end; end; end; function TTextBuffer.ReadWord(var TextRead: string): boolean; begin if Failed then ClearLastError(); TextRead := ''; if not Empty then begin // Make sure we offset to a valid character // in the buffer. ConsumeJunk(); // Not at the end of the file? if not EOF then begin repeat var el := Current; if (el in [ 'A'..'Z', 'a'..'z', '0'..'9', '_', '-' ]) then TextRead := TextRead + el else break; if not NextNoCrLf() then break; until EOF; result := TextRead.Length > 0; end else SetLastError('Failed to read word, unexpected EOF'); end else SetLastError('Failed to read word, buffer is empty error'); end; function TTextBuffer.ReadCommaList(var cList: List): boolean; var LTemp: String; LValue: String; begin if cList = nil then cList := new List else cList.Clear(); if not Empty then begin ConsumeJunk(); While not EOF do begin case Current of #09: begin // tab, just skip end; #13, #10: begin // CR+LF, consume and continue; ConsumeCRLF(); end; #0: begin // Unexpected EOL break; end; ';': begin //Perfectly sound ending result := true; break; end; '"': begin LValue := ReadQuotedString; if LValue.Length > 0 then begin cList.add(LValue); LValue := ''; end; end; ',': begin LTemp := LTemp.Trim(); if LTemp.Length>0 then begin cList.add(LTemp); LTemp := ''; end; end; else begin LTemp := LTemp + Current; end; end; if not Next() then break; end; if LTemp.Length > 0 then cList.add(LTemp); result := cList.Count > 0; end; end; function TTextBuffer.ReadQuotedString: string; begin if not Empty then begin if not EOF then begin // Make sure we are on the " entry quote if Current '"' then begin SetLastError('Failed to read quoted string, expected index on " character error'); exit; end; // Skip the entry char if not NextNoCrLf() then begin SetLastError('Failed to skip initial " character error'); exit; end; while not EOF do begin // Read char from buffer var TempChar := Current; // Closing of string? Exit if TempChar = '"' then begin if not NextNoCrLf then SetLastError('failed to skip final " character in string error'); break; end; result := result + TempChar; if not NextNoCrLf() then break; end; end; end; end; //########################################################################## // TParserModelObject //########################################################################## constructor TParserModelObject.Create(const AParent:TParserModelObject); begin inherited Create; FParent := AParent; FChildren := new List; end; function TParserModelObject.GetParent:TParserModelObject; begin result := FParent; end; procedure TParserModelObject.Clear; begin FChildren.Clear(); end; function TParserModelObject.ChildGetCount: integer; begin result := FChildren.Count; end; function TParserModelObject.ChildGetItem(const Index: integer): TParserModelObject; begin result := TParserModelObject(FChildren[Index]); end; function TParserModelObject.ChildAdd(const Instance: TParserModelObject): TParserModelObject; begin if FChildren.IndexOf(Instance) < 0 then FChildren.add(Instance); result := Instance; end; //########################################################################### // TParserContext //########################################################################### constructor TParserContext.Create(const SourceCode: string); begin inherited Create; FBuffer := TTextBuffer.Create(SourceCode); FStack := new Stack; end; procedure TParserContext.Push(const ModelObj: TParserModelObject); begin if Failed then ClearLastError(); try FStack.Push(ModelObj); except on e: Exception do SetLastError('Internal error:' + e.Message); end; end; function TParserContext.Pop: TParserModelObject; begin if Failed then ClearLastError(); try result := FStack.Pop(); except on e: Exception do SetLastError('Internal error:' + e.Message); end; end; function TParserContext.Peek: TParserModelObject; begin if Failed then ClearLastError(); try result := FStack.Peek(); except on e: Exception do SetLastError('Internal error:' + e.Message); end; end; procedure TParserContext.ClearStack; begin if Failed then ClearLastError(); try FStack.Clear(); except on e: Exception do SetLastError('Internal error:' + e.Message); end; end; //########################################################################### // TCustomParser //########################################################################### constructor TCustomParser.Create(const ParseContext: TParserContext); begin inherited Create; FContext := ParseContext; end; function TCustomParser.Parse: boolean; begin result := false; SetLastErrorF('No parser implemented for class %s',[ClassName]); end; procedure TCustomParser.SetContext(const NewContext: TParserContext); begin FContext := NewContext; end; end.
Repository updates
As most know by now, I was running a successful campaign on Patreon until recently. I know that some are happy with Patreon, but hopefully my experience will be a wakeup call about the total lack of rights you as a creator have – should Patreon decide they don’t understand what you are doing (which I can only presume was the case, because I was never given a reason at all). You can read more about my experience with Patreon by clicking here.
Setting up repositories
Having to manually build a package for each tier that I have backers for would be a disaster. It was time-consuming and repetitive enough to create packages on Patreon, and I don’t have time to reverse engineer Patreon either. Which I might do in the future and release as open-source just to give them a kick in the groin back.
To make it easier for my backers to get the code they want, I have isolated each project and sub-project in separate repositories on BitBucket. This covers Delphi, Smart Pascal, LDEF and everything else.
I’m just going to continue with the Tiers I originally made on Patreon, and use my blog as the news-center for everything. Since I tend to blog about things from a personal point of view, be it for Delphi, JavaScript or Smart Pascal — I doubt people will notice the difference.
So far the following repositories have been setup:
- Amibian.js Server (Quartex Web OS)
- Amibian.js Client
- HexLicense
- TextCraft (source-code parser for Delphi and Smart Pascal)
- UAE.js (a fork of SAE, the JS implementation of UAE)
I need to clean up the server repository a bit, because right now it contains both the server-code and various sub projects. The LDEF assembler program for example, is also under that repository — and it belongs in its own repository as a unique sub-project.
The following repositories will be setup shortly:
- Tweening library for Delphi and Smart Pascal
- PixelRage graphics library
- ByteRage bugger library
- LDEF (containing both Delphi and Smart Pascal code)
- LDEF Assembler
It’s been extremely busy days lately so I need to do some thinking about how we can best organize things. But rest assured that everyone that backs the project, or a particular tier, will get access to what they support.
Support and backing
I have been looking at various ways to do this, but since most backers have just said they want Paypal, I decided to go for that. So donations can be done directly via paypal. One of the new features in Paypal is repeated payments, so setting up a backer-plan should be easy enough. I am notified whenever someone gives a donation, so it’s pretty easy to follow-up on.
Updates used to be monthly, but with the changes they will be ad-hoc, meaning that I will commit directly. I do have local backups and a local git server, so for parts of the project the commits will be issued at the end of each month.
While all support is awesome, here are the tiers I used on Patreon:
- $5 – “high-five”, im not a coder but I support the cause
- $10 – Tweening animation library
- $25 – License management and serial minting components
- $35 – Rage libraries: 2 libraries for fast graphics and memory management
- $45 – LDef assembler, virtual machine and debugger
- $50 – Amibian.js (pre compiled) and Ragnarok client / server library
- $100 – Amibian.js binaries, source and setup
- $100+ All the above and pre-made disk images for ODroid XU4 and x86 on completion of the Amibian.js project (12 month timeline).
So to back the project like before, all you do is:
- Register with Bitbucket (free user account)
- Setup donation and inform me of your Bitbucket user-name
- I add you on BitBucket so you are granted access rights
Easy. Fast and reliable.
The QTX RTL
Those that have been following the Amibian.js project might have noticed that a fair bit of QTX units have appeared in the code? QTX is a run-time library compatible with Smart Mobile Studio and DWScript. Eventually the code that makes up Amibian.js will become a whole new RTL. This RTL has nothing to do with Smart Mobile Studio and ships with its own license.
Backers at $45 or beyond access to this code automatically. If you use Smart Mobile Studio then this is a must. It introduces a ton of classes that doesn’t exist in Smart Pascal, and also introduces a much faster and clean visual component framework.
If you want to develop visual applications using QTX and DWScript, then that is OK, providing the license is respected (LGPL, non commercial use).
Well, stay tuned for more info and news!
Amibian.js and the Narcissus hack
Wow, I must admit that I never really thought Amibian.js would become even remotely as popular as it has – yet people respond with incredible enthusiasm to our endeavour. I was just told that an article at Commodore USA mentioned us – that an exposure to 37000 readers. Add that to the roughly 40.000 people that subscribe to my feeds around the world and I must say: I hope I code something worthy of your time!
But there is a lot of stuff on the list before it’s even remotely finished. This is due to the fact that im not just juggling one codebase here – im juggling 5 separate yet interconnected codebases at the same time (!). First there is the Smart Mobile Studio RTL (run time library) which represents the foundation. This gives me object-oriented, fully inheritance driven visual controls. This have roughly 5 years of work behind it.

Still #1 after all these years
On top of that you have the actual visual controls, like buttons, scrollbars, lists, css3 effect engines, tweening, database storage and a ton of low-level stuff. The browser have no idea what a window is for example, let alone how it should look or respond to users. So every little piece has to be coded by someone. And well, that’s what I do.
Next you have the workbench and operating-system itself. What you know as Amibian.js, Smart Workbench or Quartex media desktop – take your pick, but it’s already a substantial codebase spanning some 40 units with thousands of lines of code. It is divided into two parts: the web front-end that you have all seen; and the node.js backend that is not yet made public.
And on top of that you have the external stuff. Quake III didn’t spontaneously self-assemble inside the desktop, someone had to do some coding and make the two interface. Same with all the other features you have.
The worst so far (as in damn hard to get right) is the Ace text editor. Ace by itself is super easy to work with – but you may have noticed that we have removed it’s scrollbars and replaced these with Amiga scrollbars instead? That is a formidable challenge it its own right.
Whats on the menu this weekend?
I noticed that on Linux that text-selection was utterly messed up, so when you moved a window around – it would suddenly start selecting the title text of other elements around the desktop. This is actually a bug in the browser – not my code; but I still have to code around it. Which I have now done.
I also solved selection for the console window (or any “text” container. A window is made up of many parts and the content region can be inherited from and replaced), so that should now work fine regardless of browser and platforms. Ace theming also works, and the vertical scrollbar is responding as expected. Still need a few tweaks to move right, but that is easy stuff. The hard part is behind us thankfully.
Right now I’m working on ScummVM so that should be in place later today 🙂
Thats cool, but what motivates you?

Cult of Joy
Retro gaming is important, and we have to make it as easy for people to enjoy their retro gear without patent trolls ruining the fun. Im just so tired of how ruined the Amiga scene is by these (3 companies in particular).. thieves is the only word I can find that fits.
So fine! I will make my own. Come hell or high water. Free as a bird and untouchable.
So I have made some tools that will make it ridiculously easy for you to share, download and play your games online. Whenever you want, hosted where-ever you need and there is not a god damn thing people can do about it. When you realize how simple the hack is it will make you laugh. I came up with this ages ago and dubbed it Narcissus.
To understand the Narcissus hack, consider the following:
PNG is a lossless compression format, meaning that it doesn’t lose any information when compressed. It’s not like JPEG which scrambles the original and saves a faximile that tricks the eye. Nope, if you compress a PNG image you get the exact same out when you decode it (read: show it).
But who said we have to store pixels? Pixels are just bytes after all. In fact, why can’t we take a whole game disk or rom and store that inside a picture? Sure you can!

This tool is now built into Amibian.js
It’s amusing, I came up with this hack years ago. It has been a part of Smart Mobile Studio since the beginning.
You have to remember that retro games are super small compared to modern games. The average ADF file is what? 880kb or something like that? Well hold on to your hat buddy, because PNG can hold 64 megabyte of data! You can encode a decent Amiga hard disk image in 64 megabyte.
Can you guess what the picture on the right contains? This picture is actually ALL the Amiga rom files packed into a single image. Dont worry, I converted it to JPEG to mess up the data before uploading. But yes, you can now host not just the games as normal picture files, but also roms and whatever you like.
And the beauty of it – who the hell is going to find them? You can host them on Github, Google drive, Dropbox or right your blog — if you don’t have the encryption key the file is useless.
Snap, crackle and pop!
RSS Filesystem
You know RSS feeds right? If you sign up for a blog you automatically get a RSS feed. It’s basically just a list of your recent posts – perhaps with an extract from each article, a thumbnail picture and links to each post. RSS have been around for a decade or more. It’s a great way to keep track of news.
The second hack is that using the data-to-image-encoder you can store a whole read-only filesystem as a normal RSS feed. Always think outside the box!
Let’s say you have a game collection for your Amiga right? Lets say 200 games. Wouldnt it be nice to have all those games online? Just readily available regardless of where you may be? Without “you know who” sending you a nasty email?
Well, just encode your game as described above, include the data-picture in your WordPress post, and do that for each of your games. Since you can encrypt these images they will be worthless to others. But for you its a neat way of hosting all your games online for free (like WordPress or Blogger) and play them via Amibian or the patched UAE4Arm (ops, did I share that, sorry dirk *grin*) and you’re home free.
You know what’s really cool? For this part Amibian doesnt even need a server. So you can just save the Amibian.js html page on your phone and that’s all you need.
Smart desktop: Amibian.js past, future and present
Had someone told me 20 years ago that I would enter my 40’s enjoying JavaScript, my younger self would probably have beaten that someone over the head with a book on hardcore demo coding or something. So yeah, things have changed so much and we are right now in the middle of a paradigm shift that is taking us all to the next level – regardless if we agree or not.
Ask a person what he thinks about “cloud” and you rarely get an answer that resembles what cloud really is. Most will say “its a fancy way of dealing with storage”. Others will say its all about web-services – and others might say it’s about JavaScript.

Old coders never die, we just get better
They are all right and wrong at the same time. Cloud is first of all the total abstraction of all parts that makes up a networked computer system. Storage, processing capacity, memory, operating system, services, programming language and even instruction set.
Where a programmer today works with libraries and classes to create programs that run on a desktop — dragging visual controls like edit-boxes and buttons into place using a form or window designer; a cloud developer builds whole infrastructures. He drags and drops whole servers into place, connects external and internal services.
Storage? Ok I need Dropbox, amazon, Google drive, Microsoft one disk, local disk – and he just drags that onto a module. Done. All of these services now have a common API that allows them to talk with each other. They become like dll files or classes, all built using the same mold – but with wildly different internals. It doesn’t matter as long as they deliver the functionality according to standard.
Processing power? Setup an Azure or Amazon account and if you got the cash, you can compute enough to pre-cacalculate the human brain if you like. It has all been turned into services — that you can link together like lego pieces.
Forget everything you think you know about web; that is but the visual rendering engine over the proverbial death-star of technology hidden beneath. People have only seen the tip of the ice berg.
Operating systems have been reduced to a preference. There is no longer any reason to pick Windows over Linux on the server. Microsoft knew years ago that this day would come. Back in the late 90s I remember reading an interview with Steve Balmer doing one of his black-ops meetings with Norwegian tech holders in Oslo; and he outlined software as a service when people were on 14.4 modems. He also mentioned that “we need a language that is universal” to make this a reality. You can guess why .net was stolen from Borland, not to mention their failed hostile takover of Java (or J#) which Anders Hejlsberg was hired to spear-head.
Amibian.js
Amibian.js is my, Gunnar and Thomas‘s effort to ensure that the Amiga is made portable and can be enjoyed in this new paradigm. It is not made to compete with anyone (as was suggested earlier), but rather to make sure Amiga gets some life into her again – and that people of this generation and the kids growing up now can get to enjoy the same exciting environment that we had.

From Scandinavia with love
The world is going JavaScript. Hardware now speaks JavaScript (!), your TV now speaks JavaScript – heck your digital watch probably runs JavaScript. And just to add insult to injury – asm.js now compiles JS code side-by-side with C/C++ in terms of speed. I think the browser has seen more man years of development time than any other piece of software out there – with the exception of GCC / Gnu Linux perhaps.
Amibian is also an example of a what you can do with Smart Pascal, which is a programming environment that compiles object pascal to JavaScript. One we (The Smart Company AS) made especially for this new paradigm. I knew this was coming years ago – and have been waiting for it. But that’s another story all together.
Future
Well, naturally the desktop system is written from scratch so it needs to be completed. We are at roughly 40% right now. But there is also work to be done on UAE.js (a mild fork of sae, scriptable Amiga emulator) in terms of speed and IO. We want the emulated Amiga side to interact with the modern web desktop – to be able to load and save files to whatever backend you are using.

For those about to rock; We salute you!
Well, it’s not that easy. UAE is like an organism, and introducing new organs into an existing creature is not easily done. UAE.js (or SAE) has omitted a huge chunk of the original code – which also includes the modified boot-code that adds support for external or “virtual” UAE drives (thanks to Frode Solheim of Fs-UAE for explaining the details of the parts here).
But, there are hacker ways. The dark side is a pathway to many abilities, some deemed unnatural. So if all else fails, i will kidnap the hardfile API and delegate the IO signals to the virtual filesystem on the server — in short, UAE.JS will think it’s booting from a hardfile in memory – when in reality it will get its data from node.js.
There are some challenges here. UAE (the original) is not async but ordinary, linear C code. JavaScript is async and may not return the data on exit of the method. So i suspect I will have to cache quite a lot. Perhaps as much as 1 megabyte backwards and forwards from the file-position. But getting data in there we will (and out), come hell or high water.
We can also drop a lot of sub code, like parts of the gayle interface. I found out this is the chip that deals with the IDE interface — so it has to be there, but it can also host memory expansions – but who the hell cares in 2017 in JavaScript about that. More than enough fun via standard chip/fast/rtg memory – so the odd bits can be removed.
So we got our work cut out for us. But hey.. there can only be one .. QUARTEX! And we bring you fire.
Ok. Lets do this!
Amibian + Smart pascal = A new beginning
In the Amiga community there is a sub-group of people with an agenda. They hoard and collect every piece of hardware they can get their hand on – then sell them at absurd prices on ebay to enrich themselves. This is not only ruining the community at large, ensuring that ordinary users cannot get their hands on a plain, vanilla Amiga without having to fork out enough dough to buy a good car.
“We also have a working Facebook clone – but we’re not
going into competition with Mark Zuckerberg either”
Thankfully not everyone is like that. There are some very respected, very good people who buy old machines, restore them – and sell them at affordable prices. People that do this as a hobby or to make a little on the side. Nothing wrong with that. No, its people that try to sell you an A2000 for $3000, or that pimp out Vampire accelerator cards at 700€ a piece thats the problem.
As for the price sharks, well – this has to stop. And Gunnar’s Amibian distro has already given the Amiga scalpers a serious uppercut. Why buy an old Amiga when you can get a high-end A4000 experience with 4 times as much power for around $35? This is what Gunnar has made a reality – and he deserves a medal for his work!
And myself, Thomas and the others in our little band of brothers will pick up the fight and stand by Gunnar in his battle. A battle to make the Amiga affordable for ordinary human beings that love the platform.
Amiga as a service
Yesterday I did a little experiment. You know how Citrix and VMWare services work? In short, they are virtualization application servers. That means that they can create as many instances of Windows or Linux as they want – run your applications on it – and you can connect to your instance and use it. This is a big part of how cloud computing works.
While my little experiment is very humble, I am now streaming a WinUAE instance display from my basement server pc, just some old bucket of chips I use for debugging, directly into Amibian.js (!). It worked! I just created the world’s first Amiga application server. And it took me less than 30 minutes in Delphi !
Amibian, Amibian.js, appserver, what gives?
Let’s clear this up so you dont mix them:
Amibian. This is the original Linux distro made by Gunnar Kristjansson. It boots straight into UAE in full-screen. All it needs is a Raspberry PI, the Amiga rom files and your workbench or hard disk image. This is a purely native (machine code) solution.
Amibian.js – this is a JavaScript remake of AmigaOS that I’m building, with the look and feel of OS 4. It uses uae.js (also called SAE) to run 68k software directly in the browser. It is not a commercial product, but one of many demos that ship with Smart Mobile Studio. “Smart” is a compiler, editor and run-time library sold by The Smart Company AS. So Amibian.js is just a demo, just like Amos shipped with a ton of demo’s and Blitzbasic came with a whole disk full of examples.
Amiga application server (what I mentioned above) was just a 30 minute experiment I did yesterday after work. Again, just for fun.
I hope that clears up any confusion. Amibian.js is a purely JavaScript based desktop made in the spirit of the Amiga – it must not be confused with Amibian the Linux distro, which boots into UAE on a Raspberry PI. Nor is it an appserver – but rather, it can connect to an appserver if I want to.

Generation Amiga post on Amibian.js earlier when I added some look & feel
With a bit of work, and if everything works as expected (I don’t see why not), I will upload both source and binaries to github together with Amibian.js.
There is only one clause: It cannot be used, recreated, included or distributed by Cloanto. Sorry guys, but the ROMS belong to the people, and until you release those into public domain, you wont get access to anything we make. Nothing personal, but pimping out roms and even having audacity to fork UAE and sell it as your own? You should be ashamed of yourself.
Are you in competition with FriendOS?
This question has popped up a couple of times the past two weeks. So I want to address that head on.
I make a product called Smart Mobile Studio. I do that with a group of well-known developers, and we have done so for many years now. The preliminary ideas were presented on my blog during the winter 2009, early 2010 and we started working (and blogging) after that. Smart Mobile Studio and it’s language, Smart Pascal (see Wikipedia article), takes object pascal (like freepascal or Delphi) and compiles to JavaScript rather than machine code.

The Smart compiler is due for OS4 once i get the A1222 in my hands
One of the examples that has shipped with Smart Mobile Studio, and also been available through a library called QTX, is something called Quartex Media Desktop. Which is an example of a NAS server front-end, a kiosk front-end (ticket ordering, cash machines etc) or just an intranet desktop where you centralize media and files. It is also node.js powered to deal with the back-end filesystem. This is now called amibian.js.
In other words – it has nothing to do with Friend software labs at all. In fact, I didn’t even know Friend existed until they approached me a few weeks ago.

The Quartex Media desktop has been around for ages
Amibian.js is just an update of the Quartex Media Desktop example. It is not a commercial venture at all, but an example of how productive you can be with Smart pascal.
And it’s just one example out of more than a hundred that showcase different aspects of our run-time library. This example has been available since version 1.2 or 1.3 of Smart, so no, this is not me trying to reverse engineer FriendOS. Because I was doing this long before FriendOS even was presented. I have just added a windowing manager and made it look like OS4, which also happened before I had any contact with my buddies over at Friend Software Labs (why do you think they were interested in me).

Early 2017 Linux bootloader by Gunnar
So, am I in competition with Friend? NO! I have absolutely no ambition, aspiration or intent for anything of the sorts. And should you be in doubt then let me break it down for you:
- Hogne, Arne, David, Thomas, Francois and everyone at Friend Software Labs are friends of mine. I talk almost daily with David Pleasence who is a wonderful person and an inspiration for everyone who knows him.
- Normal people don’t sneak around stabbing friends in the back. Plain and simple. That is not how I was raised, and such behavior is completely unacceptable.
- Amibian.js is 110% pure Amiga oriented. The core of it has been a part of Smart for years now, and it has been freely available for anyone on google code and github.
- For every change we have made to the Smart RTL, the media desktop example has been updated to reflect this. But ultimately it’s just one out of countless examples. We also have a working Facebook clone – but we’re not going into competition with Mark Zuckerberg for that matter.
- People can invent the same things at the same time. Thats how reality works. There is a natural evolution of ideas, and great minds often think alike.
Why did you call it Amibian.js, it’s so confusing?
Well it’s a long story but to make it short. The first “boot into uae” thing was initially outlined by me (with the help of chips, the UAE4Arm maintainer). But I didn’t do it right because Linux has never really been my thing. So I just posted it on my retro-gaming blog and forgot all about it.
Gunnar picked this up and perfected it. He has worked weeks and months making Amibian into what it is today – together with Thomas, our spanish superhero /slash/ part-time dictator /slash/ minister of propaganda 🙂
We then started talking about making a new system. Not a new UAE, but something new and ground breaking. I proposed Smart Pascal, and we wondered how the Raspberry PI would run JavaScript performance wise. I then spent a couple of hours adding the icon layout grid and the windowing manager to our existing media desktop – and then fired up some HTML5 demos. Gunnar tested them under Chrome on the Raspberry PI — and voila, Amibian.js was born.
And that is all there is to it. No drama, no hidden agendas – and no conspiracy.
I should also add that I do not work at Friend Software Labs, but we have excellent communication and I’m sure we will combine our forces on more than one software title in the future.
On a personal note I have more than a few titles I would like to port to FriendOS. One of my best sellers of all time is an invoice and credit application – which will be re-written in Smart Pascal (its presently a mix of Delphi and C++ builder code). The same program is also due to Amiga OS 4.1 whenever I get my A1222 (looking at you Trevor *smile*).
Well, I hope that clears up any misunderstanding regarding these very separate but superficially related topics. Amibian.js will remain 100% Amiga focused – that has been and remains our goal.
Ode to our childhood
Amibian is and will always be, an ode to the people who gave us such a great childhood. People like David Pleasence who was the face of Commodore in europe. A man who embody the friendliness of the Amiga with his very being. Probably one of the warmest and kindest people I can think of.
Francois Lionet, author of Amos Basic. The man who made me a programmer and that I cannot thank enough. And I know I’m not alone about learning from him.
Mark Sibly, the author of BlitzBasic, the man who taught me all those assembler tricks. A man that deserves to go down in the history books as one of the best programmers in history.
And above all – the people who made the Amiga itself; giants like Jay Miner, Dave Haynie, Carl Sassenrath, Dave Needle, RJ Michal (forgive me for not listing all of you. Your contributions will never be forgotten).
That is what Amibian.js is all about.
Patents and greed may have killed the actual code. But we are free to implement whatever we like from scratch. And when I’m done – your patents will be worthless..
Angular JS + BootStrap and why it’s all bull
Web designers and web “architects” as they like to call themselves, are into bling. Their job is after all to help bussinesses sell whatever product they have; be it a perfectly valid product or a completely useless piece of droppings. But with a good designer at your disposal you can to some degree ensure your product will sell. At least at first. So when designers and bling-doctors set out to create their tools of the trade, it’s pretty much natural that they will make it look like the greatest thing since the discovery of the wheel. And people swallow it, hook line and sinker.
JQuery
Take JQuery for instance. It’s a simple little library to collection (query) information about the DOM (document object model). It allows you to set properties on collections rather than single items and it also have a handful of helper functions for effects, css and dealing with JSON and REST.
Yet when you read the documentation or hear people talk about it – it sounds so fantastic. You can cure cancer with JQuery, did you know that? It’s hype. It’s just spin and you should know that by now.
Angular.js
Angular is, seen from the JS developer’s viewpoint, a fantastic library. It allows you to define content in one place, controller code in another place and Angular gives you the tools to glue those two parts together. The controller is the part which has code, meaning that you access the controller to perform operations on the model (the data) – which is reflected in the view (the html). But wait just one minute! Havent we heard all that before? You have data separated from functions, functions separated from the display — yet they all come together to form a single entity? Yes. You have heard it all before. What I have just described is how a normal class works. The reason it’s divided into controller, model and view has nothing to do with better, next generation or any of that crap — it has to do with the fact that JavaScript doesnt have classes, or inheritance, or polymorphism or any of the fundamental features real programmers expect to find. So if you are a JS programmer Angular is fantastic, because it allows you to break down a presentation (read: component) into logical parts, deal with callbacks and display sequences in an orderly fashion and so on. But for a programmer coming from C++, Delphi or C# — Angular is a childish toy. There is no reason to break these elements apart, that’s why God invented VMT’s (virtual method tables).
I mean, have you heard some of these presentations on youtube about angular? Wow. It even get’s me going for a while there. The mental image they paint is that angular is going to solve everything! If you can just use angular, then your website will scale, dance, sing and even click it’s own likes. But when you start coding with angular you realize that it’s just a non-productive way of emulating OOP through objective thinking. It’s technical masturbation. You isolate your data in one place, your procedures in another place and your visual appearance a third place. This is exactly what OOP was created to solve. It may be a step forward for JavaScript, but compared to Delphi, Smart Mobile Studio, C++ or any “real” programming language with OOP — it’s a gigantic step backwards.
Components is MVC
MVC (model view controller) is a programming pattern, or style, which has become very popular lately. It was initially hyped by Apple to get people onboard their Objective C wagon for iOS and OS X development. Picked up by other languages, especially JS which is the mother of all bling, it has become almost the norm. Both in the world of nodeJS and DOM programming in general.
Oh but you can change things easier and use the same controller with different views, or have different controllers for the same view. So? Thats what inheritance is all about:
type //baseclass for database read values TBaseDBStorage = Class(TW3Object) end; //filtered database values, inherits from base TFilteredDBStorage = Class(TBaseDBStorage) end; //basic display widget TBaseDisplay = Class(TW3CustomControl) private FData: TBaseDBStorage; protected function getDBStorage:TBaseDBStorage;virtual;abstract; End; // display optimized for desktop TDesktopDisplay = Class(TBaseDisplay) protected function getDBStorage:TBaseDBStorage;override; end; // display optimized for mobile devices TMobileDisplay = Class(TBaseDisplay) protected function getDBStorage:TBaseDBStorage;override; end;
I mean, the above OOP code allows you to fetch data from a server, and also specialize it as needed. We also roll out two display controls, one for mobile and one for desktop, and we give them different display and layout rules. This is faster and easier than writing two controllers, two data structure profiles, two html segments and two CSS rulesets. Same result, except the code above can be expanded indefinitely without messing up existing models.
What people fail to notice is that MVC is just plain old TCustomControl. An ordinary TCustomControl has data (fields), which is a model — methods and implementations which is the controller, and a view (surface, canvas or operative-system viewport). And just like under MVC the code is there to act on the data and control the visual output. What angular does is essentially to rip OOP apart under the assumption that this will make things better. But it doesnt make things better, it makes things worse (!)
Mutation events
Now if you’re a JS programmer feeling you have to defend angular, please relax. I know all about the data binding layer – because just like angular Smart Mobile supports mutation event handling as well. And we do it through proper OOP with full inheritance. Mutation events is just a fancy phrase for “tell me whenever anything changes in the DOM”. So a mutation listner can be created and set to listen to changes on either the whole DOM or a particular piece of the DOM (like your panel or a button for that matter). Whenever a property change, an attribute or a CSS style — you get a callback event with the change data. Using this system Google has made a neat system for binding data changes to visual tags. For instance, whenever you change the value of a variable – you can hook that variable up to a section and have it display the change “live”. You can also bind visual input, like from a textbox, to a variable, another field or whatnot. Sounds familiar? Delphi Visual Live bindings anyone? Angular creates the illusion of being black magic; and to the JS punters and kids it probably is. But sadly the only spell it casts is one of blinding hype.
Bootstrap JS
Bootstrap has to be, with the exception of jQuery, the biggest disappointment of them all. And I dont write this just to be negative or anything like that. I am genuinely disappointed at how such a small library, containing nothing particular interesting at all, can get so popular so fast. Bootstrap.js is essentially a theme engine. That’s it. Yes you read right, a plain old vanilla theme engine, like we have had in Delphi and C++ for decades now. Bootstrap allows you to define simple constructs, like a panel. It will then automatically align and position your input controls and DIV’s according to a 12 point grid. Does this sound familiar? It should because every Delphi control has an align property, and TLayoutPanel has been shipping with Delphi since 2006. If you add some clever CSS styling on top of that — you essentially have bootstrap.js
Final verdict
In this post I have told you the truth about some very, very big and popular javascript libraries. They are popular and famous because for a JS developer, which doesnt have the luxury of OOP like we do – these libraries is heaven sent. But for everyone who has OOP, like Smart Mobile Studio, there is absolutely no benefit to using angular, bootstrap or jQuery at all. In fact the RTL was designed in such a way that there should not be any unknown tags in the DOM. Hence jQuery is useless because what exactly should you use it for? TW3CustomControl encapsulates the uber-hyped MVC of Angular, our web units outperforms and outweigh the angular toolbox by a factor of 10 — so again there is absolutely nothing angular provides which has any value to a seasoned and professional Smart Pascal programmer. He would make angular.js himself within days (!). Not because he is so clever, but because OOP and inheritance makes it possible. Modern OOP was designed to better help you deal with problem solving, spanning recursively through a well written and designed architecture. This is why OOP rules the world and procedural and objective programming is a thing of the past.
A better and far more powerful way
Over the next six months I will be presenting my web technology. This means that the tools you will get – through smart mobile studio – and the classes you will also get, will help you create web applications that knock the boots of all these 3 libraries. So far Smart Mobile Studio has only been for mobile application development. Well that is about to change (slowly) as we begin to add more and more support for full-on “page” designs. You can naturally create websites today, but webpages demonstrates a slighly different behavior – both in terms of scaling, scrolling and general navigation. You want to create awesome websites with little code? Sure you do! You want to use your Delphi skills to create fantastic HTML5 user-controls which no other language delivers? Sure you do! And you want to connect to databases, REST API’s and your own nodeJS based service layer? Hell yes you do! Well, let’s teach these JS kids how real programmers solve these things 😉
Smart Mobile ‘retrogaming’ cloud services
Im getting older. It’s with shock I have reached the age of 41 (!) In my sons eyes I am already the proverbial dinosaur. But in my own mind it was only yesterday I ran around with my friends, Amiga in nap-sack, on the way to some copy-party or gathering of Amiga enthusiasts, coders and gamers.
You may be wondering what all of this has to do with Smart Mobile Studio, cloud computing and object pascal. The answer is: everything. Because the Amiga computer was the machine which started all of this. In fact every project I have loved working on my entire life began on the Amiga. The reason I now live as a programmer is because of the Amiga. The reason I became who I am and live where I live, is because of the Amiga. And the reason I work where I do, and know what I know – is yet again because of the Amiga.
Trying to emphasis the impact the Amiga has had on hundreds of thousands of kids during the 80’s and 90’s is almost impossible. It’s like trying to explain the impact the moon landing had, or the cold war (we share a border with Russia, so that was fun). To be blunt: The Amiga has shaped my life more than any other person, education or “thing”.
The IOT phenomenon is about to emerge, so if you wanted a wink that a revolution is about to happen — this is it. Your chance to capitalize and make money is NOW.
Sadly I was to young to realize any of my ideas back then, and the hardware was not even close to deliver them. This is why the death of Amiga was so heartbreaking to a whole generation. Because the Amiga was the platform that gave us everything, yet it was cut down in it’s prime due to sloppy, greedy and outright insane management decisions. The entire IT market and reality of computing for the entire world would have looked very different had the Amiga realized it’s potential. Windows and OS X has only recently managed to catch up with the Amiga operative system. And we are talking about a machine which went out of production 20 years ago (!). It was way beyond anything Microsoft or Apple cooked up in their labs. We enjoyed a responsive and fast multitasking desktop, high-speed games and graphics and fantastic soundtracks – 15 years before the PC (fifteen years! That’s a whole “growing up” phase).
The amiga also had VR equipment more than 18 years ago. So yeah, it was a personal disaster for a whole generation when Commodore went bankrupt. It pushed computing back to the stone age. Could you imagine having to throw away your modern computer and be forced to buy a 15 year old piece of shit instead? Being told by people who know jack shit about the mac or pc you own today, that their old shabby system is better — when you in fact have tried future technology and used it for years, knowing full well that what they say is not true? Well, that was our experience. Having to pay money to get a 486 after having lived with an Amiga 1200/68040 CPU for years was just insane. It was like trading in your iPhone for a 1996 Nokia, or your Tessla car for a 1980 Fiat.
So indeed; we had so much more than kids today have. The experience of connecting your modem up to your dad’s phone, connecting to a BBS on the other side of the world, logging in and talking to people, swapping games, documents and whatnot — take a close look at the underlying technology there and what you see is the seed of cloud-computing.
A BBS functioned as a file-sharing service. So when you connected to the BBS, the files, games etc. you placed in the public folder was immediately shared with the others. And they all went through the server first, which typically picked up whole files first.

The Amiga was a lot more than just a games machine, it was way ahead of both Windows and OS X for roughly 15 years. So for 15 years we had a full multitasking desktop.
Now, going from that – to a reality of mainframes, thin clients, abstracted filesystems and remote data storage (or even better: dispersed data storage, where chunks of data can be stored anywhere on the planet and re-assembed when you need it) — all of this saw the light of day on the Amiga. In fact the second webbrowser ever written (the first was naturally on a unix machine) was written on the Amiga.

A fully working US produced Amiga 500, re-built and fixed by me this weekend. It took 2 days to get it working, but it’s worth it!
But for me personally: did you know that the first programming language I wrote was called “concept basic”? It was written in assembler and blitzbasic on the Amiga. So the idea of programming languages, delivering a fun system that people love — it comes directly from my Amiga days. I would never have created Smart Mobile Studio or connected with the other people of the team had I never owned an Amiga.
Blitzbasic and Amos
Have you ever thought about the people who inspired your childhood? Not your mother and father, but all those people who – behind the scenes, did something which had a huge impact on your life? I have thought about that many times. And I believe hundreds and thousands of teenagers back then was touched by two titles especially, written by two near iconic Amiga personalities.
The first is Marc Sibly who gave us BlitzBasic, which was on the Amiga the closest thing to Turbo Pascal or low-level Delphi as you could get. You could write assembler side-by-side with fast basic, and the compiler gave you a single executable which ran at extreme speeds. Even die-hard assembler coders took their hat of to Marc for his invention.
The other title which enabled a world of children to learn programming and be creative, is Francois Lionet. I have been fortunate enough to talk with him online, where I also expressed my gratitude for Amos Basic. It’s really sad that so few Amiga users have done this, because both Francois and Marc deserves to be recognized.
Thanks to these two people and programming tools – hundreds of thousands of kids became professional programmers.
I cannot express enough just how fun it was to grow up with BlitzBasic and Amos basic. Every day before I went to school I would spend an hour coding. Slowly learning trick by trick. Without the inspiration of these two IDE and compilers, I have no idea what I would be working as right now. But I doubt I would be as happy as I am, or have such a rich intellectual life as I enjoy.
Smart Mobile Studio
What I really want is to re-create that feeling for others. I want people to start Smart Mobile Studio and feel that they can make anything. Be it games, mobile applications or cloud services. I realize of-course that the majority of people using Smart are grown men, but with the student program and a few plans we have — odds are we will be able to reach teenagers who want to master programming. Just like Marc and Francois did for us.
So that is a huge driving force in what I do and my work in programming language research
Raspberry PI
What is a cloud? Well it’s not just storage. Even though that is the first service people think about. So dropbox is not really a cloud service just because it allows seamless backup and re-distribution of data. But it is indeed one of the services cloud delivers.
No, what cloud is – is a very, very old idea. The idea that you log into a huge system, allocate computer time (just like on star-trek) and then work on your task is ancient. It goes back even before the Amiga to the huge IBM mainframes of the fifties, sixties and seventies.
The fun part is that a single $35 Raspberry PI 2 contains more computing power than the entire US government combined in the nineteen sixties. Just think about that for a moment.
But it should also mean that we have something to learn here, or an opportunity to explore and do things our parents never even dreamed about.
And this is where the Raspberry PI cloud system comes in. I have been coding this for a while now, and it still requires work, but when it’s done – you will be able to run your very own cloud using a single or multiple Raspberry PI’s. An the pricetag? For a measily $140 you can now own a 16 core cloud setup. Perfect for writing cloud software, which (let’s face it) the world is heading.
Smart Cloud
So what exactly is this cloud thing? Well, in short it allows you to install cloud resident applications. Meaning applications which live in the cloud, store data in the cloud, and which conforms to the laws of the cloud reality.
This means that you will be able to develop, test, maintain and deploy your own cloud solutions directly on your own mini-cluster at home. When your service is complete, tested and validated — you simply upload the whole system (a zip file) to Amazon or Azure. Now your system is “live” and can be reached by millions of potential customers though mobile phones, pads, smart-tv’s, tabs and computers of any size and form.
The IOT phenomenon is about to emerge, so if you wanted a wink that a revolution is about to happen — this is it. Your chance to capitalize and make money is NOW. If you wait a year, the window will be lost and you will have to wait for the “next big thing”.
Retro computing taken to the extreme
The first service I am going to make, besides the professional tools you need to write kick-ass cloud software, is the ultimate retro gaming platform in the universe. You may have heard of RetroPI, WinUAE and all those emulators which plays Nintendo, Amiga, Playstation and Mame games (NEO GEO) ? Imagine running all of these on a cluster.
Imagine being able to easily upload and download games via our Smart Mobile Studio nodeJS services (which you will get when you buy it, to run in your own home). And imagine (drumroll) being able to start and play those games from anywhere in the world. All you need is a browser, and the emulated screen will be transported to the browser in real-time.
With your cluster running at home, you can be in any hotel in the world and access thousands of games, movies and music. And the good part? It’s all written in Smart Mobile Studio, using the SmartSDI daemon interface (daemon is the same as service on linux).
Sounds hard? Well not really. The cool thing about X, the windowing manager on Linux, is the idea of remote desktop session. So connecting and getting the desktop pixels is there from scratch. The rest is pure RPC service architecture, a handfull of scripts – and cluster software, allowing you to make use of all 16 ARM cores for tasks.
Well, stay tuned!
TQTXReader and TQTXWriter for Smart Mobile Studio
Storage has become a theme the past couple of weeks for Smart Mobile Studio. I have posted twice about the filesystem classes I have added to QTX, but I have also added more – much more! As you will see over the next weeks 🙂
Whenever you need to write or read data, you really end up with variants in HTML5. Javascript has this thing where everything is either an object (read: prototypical object) an array, or an intrinsic value. To make writing and reading named value pairs easier I have created two classes, cleverly called TQTXReader and TQTXWriter.
The writer allows you to, well.. write into a buffer (managed by the class). Like this:
var mObj:=TQTXWriter.Create(null); try mObj.writeStr("first-name",edFirstname.text); mobj.writeStr("last-name",edLastName.text); mObj.writeStr("cardID",edVisa.text); CallCardLookup(mObj.Deserialize, procedure () begin showmessage("Visa card is valid"); end); finally mObj.free; end;
And TQTXReader does the exact same, but in reverse. The constructor can take a variant containing the information you want to read (stored with TQTXWriter) and extract info in the same way.
Practical uses
Loads! You can use it to tailor custom messages to be used with the spanking new message-api. That way you don’t have to fiddle with JObject based classes. Serialize() and Deserialize() are the methods for turning the data into a string and back again.
You can use it to avoid strictly typed records, which can be handy – especially for grid designs and/or “flexible” arrays of content. But please remember that Serialize() and Deserialize() are costly in terms of speed.
It’s also perfect to interface with JS libraries which expects name-value pairs in constructors and setup routines.
But word to the wise – if all you need is a one-shot wonder, then TQTXWriter is overkill. In such a case you can get away with an anonymous record:
Fhandle.setupJS( record mouse := "yes"; startX := 100; startY := 100; end);
You must be logged in to post a comment.