1. Cromis IMC added: IMC stands for inter machine communication. Just as my IPC which is inter process oriented, this aims at easy, message oriented communication between machines. Forget about TCP/IP, Indy, Synapse, ICS or any other technology. You want to send a message with data from one machine to the other and not worry about how to technically do that. IMC offers just that. Its fast its easy to use and abstracts the communication layer from you. Another good thing is that it uses exactly the same message carrier as IPC does. This basically means all the code you used in IPC for preparing the messages will work here. You can also chain data from IPC to IMC. The code uses Indy as TCP layer as that guarantees that it will work on any new delphi version. For now it is Indy 10 only but if there will be demand I can make it Indy 9 compatible.
2. Cromis IPC:
   

   Change Log

   • 1.3.1
     • Added error description for the client
   • 1.3.0
     • 64 bit compiler compatible
   • 1.2.2
     • Improved wait for ERROR_IO_PENDING
     • Usage of CommTimeouts
3. Cromis Threading:
   

   Change Log

   • 1.5.0
     • 64 bit compiler compatible
   • 1.4.3
     • Added StopAllTasks for TTaskPool
   • 1.4.2 (breaking change)
     • TTaskQueue is not only available as ITaskQueue interface
4. Cron Scheduler:
   

   Change Log

   • 2.1.0
     • 64 bit compiler compatible
5. Cron Scheduler:
   

   Change Log

   • 1.1.0
     • 64 bit compiler compatible
     • Fixed thread termination bug

I also made demo applications for most parts of the Cromis library, but one unit has almost no documentation and a lot of hidden content. This is the Cromis.Threading unit. Part of why this is so, is because this unit was made as a helper unit for Cromis.IPC. It contains the task (thread) pool that is used by Cromis.IPC. I needed my own lightweight implementation of a task pool so I wrote one. Then with time some other functionality regarding threading came into this unit. Mostly because I needed it here or there. But the side effects  of this are that this functionality is not documented and probably not so easy to use for someone who is not very familiar with the code. The e-mails I got recently just prove that. So I decided I will quickly write a few examples of how to use the code and show all of the functions that this unit provides.

TTaskPool

This is the most obvious class that gives you control over a pool of tasks (threads). You start using it like this

procedure TfMain.btnStartClick(Sender: TObject);
var
  Task: ITask;
begin
  FTaskPool.DynamicSize := cbDynamicPoolSize.Checked;
  FTaskPool.MinPoolSize := StrToInt(ePoolSize.Text);
  FTaskPool.OnTaskMessage := OnTaskMessage;
  FTaskPool.Initialize;
 
  tmPoolStatus.Enabled := False;
  btnStart.Enabled := False;
  btnStop.Enabled := True;
  FTerminate := False;
 
  while not FTerminate do
  begin
    Task := FTaskPool.AcquireTask(OnTaskExecute, 'RandomTask');
    Task.Values.Ensure('RandomNumber').AsInteger := Random(tbThreadTimeout.Position);
    Task.Run;
 
    pbPoolSize.Position := FTaskPool.PoolSize - FTaskPool.FreeTasks;
    stFreeThreadsValue.Caption := IntToStr(FTaskPool.FreeTasks);
    stPoolSizeValue.Caption := IntToStr(FTaskPool.PoolSize);
    Sleep(Random(tbCreationTimeout.Position));
    Application.ProcessMessages;
  end;
end;

You have two important properties here that I will explain:

DynamicSize:

This boolean property controls if the size of the pool is dynamic. Let me explain. If you start with MinPoolSize of 20 and DynamicSize is FALSE then when all 20 threads are used, the pool will assign a new thread for each request it needs. So it will adjust to the peak load of the pool. But it will then stay at that peak number of threads. If your peak is at 60 it will stay there even if the load will then drop. But if DynamicSize is TRUE it will destroy unneeded threads until you again have the 20 (MinPoolSize) of threads. In other words it will dynamically adjust to the load. Each may have its uses.

MinPoolSize:

This one is simple. It is the number of threads you start with. You cannot have less then MinPoolSize of threads in the pool.

Ok now lets look at other parts of the workings of the pool. First is when the each task is executed:

procedure TfMain.OnTaskExecute(const Task: ITask);
var
  Interval: Integer;
begin
  Interval := Task.Values.Get('RandomNumber').AsInteger;
  try
    Task.Message.Ensure('Result').AsInteger := Interval;
    Sleep(Interval);
  finally
    Task.SendMessageAsync;
  end;
end;

And the second is processing the messages that tasks send back:

procedure TfMain.OnTaskMessage(const Msg: ITaskMessage);
var
  Interval: Integer;
begin
  Inc(FTaskCounter);
  Interval := Msg.Values.Get('Result').AsInteger;
  stThreadsFinishedValue.Caption := IntToStr(FTaskCounter);
end;

As you can see all is very straightforward. Before the task is run, you fill in the values of the task and then run it. You write the code for each task and each task can send back messages to the main thread. You can do that in two ways:

Task.SendMessageAsync;
Task.SendMessageSync;

Each one speaks for itself.

Let me be clear here. This is a simple implementation of the task pool build for my internal needs. Some find it usefull and that is great. But it is in no way comparable to the OmniThreadLibrary.

TThreadSafeQueue

This is a simple implementation of the thread safe Queue, that uses locking. It is very spartan and fast.  Gabr wrote about it doing tests, some time ago:

http://www.thedelphigeek.com/2011/05/lock-free-vs-locking.html
http://www.thedelphigeek.com/2011/06/lock-free-vs-locking-rematch.html

The usage is very straightforward so no need to write about that.

TLockFreeStack

This class is a simple wrapper around the windows API and it enables the use of lock free stack.

ITaskQueue

This is a task queue that enables you to queue tasks even if the are run in multiple threads. This will ensure that your tasks will be executed in order that you want. The usage is very simple:

You create it like this:

  FTaskQueue := AcquireTaskQueue;

Then you enqueue

  FTaskQueue.EnqueueTask.WaitFor;

and dequeue

  FTaskQueue.DequeueTask;

1. The size is not to big. In today desktop environment a megabyte, or few of them don’t matter. The difference between 50K and 1MB executable just doesn’t matter. There is enough RAM and hard drive space, that very few situations need a smaller executable.
2. And in cases when you need that, you can get to that in Delphi. You don’t need C/C++. Sure you can make the same result there, but why? Even if you only use API calls, you can still reuse some of the low level code you have written in Delphi. And that is a good enough reason to do it in your known IDE and language. You already know your tool and can save a lot of time not writing support code you already have written.

Ok, so I dusted off a very old example I made years back and recompiled it with the Delphi 2006 and Delphi XE compiler. (I have those currently at hand). The result are:

• Delphi 2006: 526 KB
• Delphi XE: 1018 KB

These are the result of opening a new service application and just clicking build. No settings were adjusted. Then I cleaned that old example a little removed the unneeded code and made sure it works (I tested the service). The results were the following:

• Delphi 2006: 22 KB
• Delphi XE: 32 KB

Here I striped XE version of RTTI as suggested on stack overflow (actually as there is only procedural code the RTTI has no effect whatsoever on the code as noticed by Cris). I left the Delphi 2006 intact. The code I used is posted bellow. It is basically a service skeleton made of two parts. One is the part that installs and controls the service. And the other is the service code itself that spawns a new “service control manager” attached process and then just waits until it is told to stop. It also reports the status to SCM.

And now the challenge. How small can you make a static linked, single c/c++ executable service. It would be fun to know. I will play more with this latter trying different compiler settings and other tricks to see it I can squeeze a byte or two out of my current size

A word of advice. Do not just copy and paste the sample service skeleton. It is just a prototype to show what can be done. It is in no way complete and does not have good error coverage. If enough people finds it important I can finish the code and polish it, but otherwise it is not worth the time.

{
  NT Service  model based completely on API calls. Version 0.1
  Inspired by NT service skeleton from Aphex
  Adapted by Runner
}
 
program PureAPIService;
 
{$APPTYPE CONSOLE}
 
uses
  Windows,
  WinSvc;
 
const
  ServiceName     = 'PureAPIService';
  DisplayName     = 'Pure Windows API Service';
  NUM_OF_SERVICES = 2;
 
var
  ServiceStatus : TServiceStatus;
  StatusHandle  : SERVICE_STATUS_HANDLE;
  ServiceTable  : array [0..NUM_OF_SERVICES] of TServiceTableEntry;
  Stopped       : Boolean;
  Paused        : Boolean;
 
var
  ghSvcStopEvent: Cardinal;
 
procedure OnServiceCreate;
begin
  // do your stuff here;
end;
 
procedure AfterUninstall;
begin
  // do your stuff here;
end;
 
procedure ReportSvcStatus(dwCurrentState, dwWin32ExitCode, dwWaitHint: DWORD);
begin
  // fill in the SERVICE_STATUS structure.
  ServiceStatus.dwCurrentState := dwCurrentState;
  ServiceStatus.dwWin32ExitCode := dwWin32ExitCode;
  ServiceStatus.dwWaitHint := dwWaitHint;
 
  case dwCurrentState of
    SERVICE_START_PENDING: ServiceStatus.dwControlsAccepted := 0;
    else
      ServiceStatus.dwControlsAccepted := SERVICE_ACCEPT_STOP;
  end;
 
  case (dwCurrentState = SERVICE_RUNNING) or (dwCurrentState = SERVICE_STOPPED) of
    True: ServiceStatus.dwCheckPoint := 0;
    False: ServiceStatus.dwCheckPoint := 1;
  end;
 
  // Report the status of the service to the SCM.
  SetServiceStatus(StatusHandle, ServiceStatus);
end;
 
procedure MainProc;
begin
  // we have to do something or service will stop
  ghSvcStopEvent := CreateEvent(nil, True, False, nil);
 
  if ghSvcStopEvent = 0 then
  begin
    ReportSvcStatus(SERVICE_STOPPED, NO_ERROR, 0);
    Exit;
  end;
 
  // Report running status when initialization is complete.
  ReportSvcStatus( SERVICE_RUNNING, NO_ERROR, 0 );
 
  // Perform work until service stops.
  while True do
  begin
    // Check whether to stop the service.
    WaitForSingleObject(ghSvcStopEvent, INFINITE);
    ReportSvcStatus(SERVICE_STOPPED, NO_ERROR, 0);
    Exit;
  end;
end;
 
procedure ServiceCtrlHandler(Control: DWORD); stdcall;
begin
  case Control of
    SERVICE_CONTROL_STOP:
      begin
        Stopped := True;
        SetEvent(ghSvcStopEvent);
        ServiceStatus.dwCurrentState := SERVICE_STOP_PENDING;
        SetServiceStatus(StatusHandle, ServiceStatus);
      end;
    SERVICE_CONTROL_PAUSE:
      begin
        Paused := True;
        ServiceStatus.dwcurrentstate := SERVICE_PAUSED;
        SetServiceStatus(StatusHandle, ServiceStatus);
      end;
    SERVICE_CONTROL_CONTINUE:
      begin
        Paused := False;
        ServiceStatus.dwCurrentState := SERVICE_RUNNING;
        SetServiceStatus(StatusHandle, ServiceStatus);
      end;
    SERVICE_CONTROL_INTERROGATE: SetServiceStatus(StatusHandle, ServiceStatus);
    SERVICE_CONTROL_SHUTDOWN: Stopped := True;
  end;
end;
 
procedure RegisterService(dwArgc: DWORD; var lpszArgv: PChar); stdcall;
begin
  ServiceStatus.dwServiceType := SERVICE_WIN32_OWN_PROCESS;
  ServiceStatus.dwCurrentState := SERVICE_START_PENDING;
  ServiceStatus.dwControlsAccepted := SERVICE_ACCEPT_STOP or SERVICE_ACCEPT_PAUSE_CONTINUE;
  ServiceStatus.dwServiceSpecificExitCode := 0;
  ServiceStatus.dwWin32ExitCode := 0;
  ServiceStatus.dwCheckPoint := 0;
  ServiceStatus.dwWaitHint := 0;
 
  StatusHandle := RegisterServiceCtrlHandler(ServiceName, @ServiceCtrlHandler);
 
  if StatusHandle <> 0 then
  begin
    ReportSvcStatus(SERVICE_RUNNING, NO_ERROR, 0);
    try
      Stopped := False;
      Paused  := False;
      MainProc;
    finally
      ReportSvcStatus(SERVICE_STOPPED, NO_ERROR, 0);
    end;
  end;
end;
 
procedure UninstallService(const ServiceName: PChar; const Silent: Boolean);
const
  cRemoveMsg = 'Your service was removed sucesfuly!';
var
  SCManager: SC_HANDLE;
  Service: SC_HANDLE;
begin
  SCManager := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
  if SCManager = 0 then
    Exit;
  try
    Service := OpenService(SCManager, ServiceName, SERVICE_ALL_ACCESS);
    ControlService(Service, SERVICE_CONTROL_STOP, ServiceStatus);
    DeleteService(Service);
    CloseServiceHandle(Service);
    if not Silent then
      MessageBox(0, cRemoveMsg, ServiceName, MB_ICONINFORMATION or MB_OK or MB_TASKMODAL or MB_TOPMOST);
  finally
    CloseServiceHandle(SCManager);
    AfterUninstall;
  end;
end;
 
procedure InstallService(const ServiceName, DisplayName, LoadOrder: PChar;
  const FileName: string; const Silent: Boolean);
const
  cInstallMsg = 'Your service was Installed sucesfuly!';
  cSCMError = 'Error trying to open SC Manager';
var
  SCMHandle  : SC_HANDLE;
  SvHandle   : SC_HANDLE;
begin
  SCMHandle := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
 
  if SCMHandle = 0 then
  begin
    MessageBox(0, cSCMError, ServiceName, MB_ICONERROR or MB_OK or MB_TASKMODAL or MB_TOPMOST);
    Exit;
  end;
 
  try
    SvHandle := CreateService(SCMHandle,
                              ServiceName,
                              DisplayName,
                              SERVICE_ALL_ACCESS,
                              SERVICE_WIN32_OWN_PROCESS,
                              SERVICE_AUTO_START,
                              SERVICE_ERROR_IGNORE,
                              pchar(FileName),
                              LoadOrder,
                              nil,
                              nil,
                              nil,
                              nil);
    CloseServiceHandle(SvHandle);
 
    if not Silent then
      MessageBox(0, cInstallMsg, ServiceName, MB_ICONINFORMATION or MB_OK or MB_TASKMODAL or MB_TOPMOST);
  finally
    CloseServiceHandle(SCMHandle);
  end;
end;
 
procedure WriteHelpContent;
begin
  WriteLn('To install your service please type  /install');
  WriteLn('To uninstall your service please type  /remove');
  WriteLn('For help please type  /? or /h');
end;
 
begin
  if (ParamStr(1) = '/h') or (ParamStr(1) = '/?') then
    WriteHelpContent
  else if ParamStr(1) = '/install' then
    InstallService(ServiceName, DisplayName, 'System Reserved', ParamStr(0), ParamStr(2) = '/s')
  else if ParamStr(1) = '/remove' then
    UninstallService(ServiceName, ParamStr(2) = '/s')
  else if ParamCount = 0 then
  begin
    OnServiceCreate;
 
    ServiceTable[0].lpServiceName := ServiceName;
    ServiceTable[0].lpServiceProc := @RegisterService;
    ServiceTable[1].lpServiceName := nil;
    ServiceTable[1].lpServiceProc := nil;
 
    StartServiceCtrlDispatcher(ServiceTable[0]);
  end
  else
    WriteLn('Wrong argument!');
end.

(You can get all new releases from the download page)

SimpleStorage

This a new major release (1.7.3) of SimpleStorage. And sadly also a breaking one. At least if you were writing your own filters and adapters. There was no other way around if I wanted to write a good and clean code. All changes that were made revolve around filters and adapters. Here is the list of important changes

• Filters were extended to the document level. This means you can now compress and encrypt XML nodes or whole document in a transparent manner.
• Chaining was introduced to filters. This means you can now encrypt and compress a document in a single step or if you like, in a single line of code
• Encryption and compression are now integral part of SimpleStorage and no third party components are needed anymore.
• Adapters and Filter now use cleaner approach, so no more strings as identifiers, to specify which filter or adapter you want.

Let me give you some examples:

Compressing and the encrypting a whole document.

NormalXML.Filter(ZLIB).Filter(XTEA('MyStrongKey')).SaveToFile(FilteredXMLFileTwo);

The same but using a document fiter chain interface.

DocumentFilterChain := CreateDocumentFilterChain;
DocumentFilterChain.AddFilter(CompressedStorage);
DocumentFilterChain.AddFilter(EncryptedStorage('MyStrongKey'));
NormalXML := DocumentFilterChain.LoadFromFile(FilteredXMLFileOne);
NormalXML.SaveToFile(NormalXMLFileOne);

Compressing using the compressed storage interface.

CompressedStorage.SaveToFile(DecompressedXML, CompressedXMLFileOne);

Compressing using the build in ZLIB filter.

DecompressedXML.Filter(ZLIB).SaveToFile(CompressedXMLFileTwo);

Do you see how simple it is to compress and encrypt a XML document. The other change is in the adapter code. There are no more strings to specify which adapter to use. It looks like this:

  SS.Ensure('MemTable').Adapter(DataSet).Load(ClientDS);

and

  SS.Get('MemTable').Adapter(DataSet).Save(ClientDS);

There are other smaller changes, but this are the major ones. Just a warning here. If you were writing adapters or filters (your own) then this is a breaking release and you will have to update your code to the new specifications. The examples that come withe the library are clear enough that it should be a breeze. For normal user nothing changes and the code will stay the same. I also left the old version of SimpleStorage available for download if people don’t want to upgrade right away.

Also I would like to announce that I will begin writing basic documentation for SimpleStorage.

ISAPIServer

This is a new component in the library. It is a standalone ISAPI server capable of processing Delphi ISAPI modules. You don’t need Apache or IIS. And it is build in the way, that you can use your favorite HTTP library to use it. It comes with already made bindings for Indy, but it would be equally simple to do bindings for Synapse or ICS. This is possible because it is designed in a very modular way. If any of you are interested in that, you can contact me and I can help with it. I am posting the whole ISAPI request code for Indy as an example:

procedure TfMain.HTTPServerCommandGet({$IFDEF Indy9}
                                        AThread: TIdPeerThread;
                                      {$ELSE}
                                        AContext: TIdContext;
                                      {$ENDIF}
                                      ARequestInfo: TIdHTTPRequestInfo;
                                      AResponseInfo: TIdHTTPResponseInfo);
var
  ECB: TECBData;
  Port: string;
  TempStr: string;
  PathStr: string;
  RootDir: string;
  DDLFileName: string;
begin
  TempStr := Copy(ARequestInfo.Document, 2, Length(ARequestInfo.Document));
  RootDir := IncludeTrailingPathDelimiter(ExtractFilePath(ParamStr(0)));
  PathStr := '/' + StrAfter('/', TempStr);
  DDLFileName := StrBefore('/', TempStr);
 
  {$IFDEF Indy9}
    Port := IntToStr(AThread.Connection.Socket.Binding.Port);
  {$ELSE}
    Port := IntToStr(AContext.Binding.Port);
  {$ENDIF}
 
  ECB := ECBDataList.AcquireNewECB;
  try
    FillECBFromRequest(ECB, HTTPServer.KeepAlive, ARequestInfo, RootDir, DDLFileName, Port, PathStr);
    try
      FISAPIServer.Execute(DDLFileName, ECB);
    finally
      FillResponseFromECB(ECB, AResponseInfo);
    end;
  finally
    ECBDataList.DeleteECB(ECB.ECB.ConnID);
  end;
end;

RoboMailer

This is also a new component. It is intended as a simplified mass mailer component. It can also be used to send a single mail easily with no worries on how to set everything up correctly. It comes with a demo application, which can send mass mails. You can personify each mail with the data you provide.  Maybe it will be of use to somebody. It uses ICS as an engine.

Threading unit

This unit got two interesting additions. First one is a lock free stack based on the windows API. No home made code here, just a wrapper around windows API. And the second one is a thread safe queue. It uses critical sections but tries to lock as little as possible. I have done some tests and it is very fast. In fact it is almost as fast as a lock free one, but the code is much much simpler. There is very little difference in speed in fact it is negligible in real world problems.

ChangleLog:

• 1.4.0
  • Added TLockFreeStack based on Windows SLISTS
  • Added TThreadSafeQueue based on linked lists
• 1.3.7
  • Added ShutdownTimeout (INFINITE by default)
  • Wait for all tasks to finish then shutting down the task pool

CRON Scheduler

Change Log:

• 2.0.3
  • added HasValue function for TChronEntry

Change Log:

• 1.2.0
  • Use the new rewritten Cromis.Exceptions
  • Log file limit is now working correctly