Service application in Delphi

Question

I am struggling with service application in Delphi but no major success so far. I tried to recreate this project, but it doesn't seem to work properly. File is created, but date and time aren't added to file every 10 seconds. I also don't see a message popping up from my ShowMessage. I successfully install and start service application.

Here is my code:

unit TMS;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.SvcMgr, Vcl.Dialogs,
  Vcl.ExtCtrls;

type
  TWorkflow = class(TService)
    Timer1: TTimer;
    procedure ServiceExecute(Sender: TService);
    procedure Timer1Timer(Sender: TObject);
    procedure ServiceBeforeInstall(Sender: TService);
  private
    { Private declarations }
  public
    function GetServiceController: TServiceController; override;
    { Public declarations }
  end;

var
  Workflow: TWorkflow;

implementation

{$R *.dfm}

procedure ServiceController(CtrlCode: DWord); stdcall;
begin
  Workflow.Controller(CtrlCode);
end;

function TWorkflow.GetServiceController: TServiceController;
begin
  Result := ServiceController;
end;

procedure TWorkflow.ServiceBeforeInstall(Sender: TService);
begin
  Interactive := True;
end;

procedure TWorkflow.ServiceExecute(Sender: TService);
begin
  while not Terminated do
  begin
    ServiceThread.ProcessRequests(True);
  end;
end;

procedure TWorkflow.Timer1Timer(Sender: TObject);
const
  FileName = 'D:\Projekti\EMBRACADERO\TMSWorkflow\Win32\Debug\Log.txt';
var
  F : TextFile;
begin
  AssignFile(F, FileName);
  if FileExists(FileName) then
    Append(F)
  else
    Rewrite(F);
  Writeln(F, DateTimeToStr(Now), ' ', DiskFree(0));
  ShowMessage(DateTimeToStr(Now));
  CloseFile(F);
end;

end.

Could somebody give me an example of a service application with threads maybe or service with visual components included?

UPDATE1:

It is working with following code for inserting some data in database every 3 seconds.

private
    thread : TThread;  

procedure TWorkflow.InsertInDatabase;
begin
  FDTransaction1.StartTransaction;
  try
    FDQuery1.Execute;
    FDTransaction1.Commit;
  except
    FDTransaction1.Rollback;
  end;
end;

procedure TWorkflow.ServiceExecute(Sender: TService);
begin
  while not Terminated do
  begin
    ServiceThread.ProcessRequests(False);
    InsertInDatabase();
    thread.sleep(3000);
  end;
end;

procedure TWorkflow.ServiceStart(Sender: TService; var Started: Boolean);
begin
  thread := TThread.Create;
end;

procedure TWorkflow.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
  FreeAndNil(thread);
end;

Answer 1

The TTimer code you showed is fine (though your OnExecute event is redundant and should be completely removed), except for the call to ShowMessage(), which you cannot use in a service at all (the TService.Interactive property has no effect on Windows Vista+). If you must display a popup message box from a service (which you should strive not to), you must use the Win32 API MessageBox() with the MB_SERVICE_NOTIFICATION flag specified, or use WTSSendMessage() instead. Otherwise, you have to delegate any UI to a separate non-service process that the service spawns and/or communicates with as needed.

Your TThread code, on the other hand, is completely wrong. It should be more like this instead:

unit TMS;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, Vcl.SvcMgr;

type
  TWorkflowThread = class(TThread)
  protected
    procedure Execute; override;
  end;

  TWorkflow = class(TService)
    FDTransaction1: TFDTransaction;
    FDQuery1: TFDQuery;
    procedure ServiceStart(Sender: TService; var Started: Boolean);
    procedure ServiceStop(Sender: TService; var Stopped: Boolean);
    procedure ServiceShutdown(Sender: TService);
  private
    { Private declarations }
    thread: TWorkflowThread;
    procedure InsertInFile;
    procedure InsertInDatabase;
  public
    function GetServiceController: TServiceController; override;
    { Public declarations }
  end;

var
  Workflow: TWorkflow;

implementation

{$R *.dfm}

procedure ServiceController(CtrlCode: DWord); stdcall;
begin
  Workflow.Controller(CtrlCode);
end;

function TWorkflow.GetServiceController: TServiceController;
begin
  Result := ServiceController;
end;

procedure TWorkflow.InsertInFile;
const
  FileName = 'D:\Projekti\EMBRACADERO\TMSWorkflow\Win32\Debug\Log.txt';
var
  F : TextFile;
begin
  try
    AssignFile(F, FileName);
    try
      if FileExists(FileName) then
        Append(F)
      else
        Rewrite(F);
      Writeln(F, DateTimeToStr(Now), ' ', DiskFree(0));
      //ShowMessage(DateTimeToStr(Now));
    finallly
      CloseFile(F);
    end;
  except
  end;
end;

procedure TWorkflow.InsertInDatabase;
begin
  try
    FDTransaction1.StartTransaction;
    try
      FDQuery1.Execute;
      FDTransaction1.Commit;
    except
      FDTransaction1.Rollback;
    end;
  except
  end;
end;

procedure TWorkflow.ServiceStart(Sender: TService; var Started: Boolean);
begin
  thread := TWorkflowThread.Create(False);
  Started := True;
end;

procedure TWorkflow.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
  ServiceShutdown(Sender);
  Stopped := True;
end;

procedure TWorkflow.ServiceShutdown(Sender: TService);
begin
  if Assigned(thread) then
  begin
    thread.Terminate;
    while WaitForSingleObject(thread.Handle, WaitHint-100) = WAIT_TIMEOUT do
      ReportStatus;
    FreeAndNil(thread);
  end;
end;

procedure TWorkflowThread.Execute;
begin
  while not Terminated do
  begin
    Workflow.InsertInFile;
    Workflow.InsertInDatabase;
    TThread.Sleep(3000);
  end;
end;

end.