Service application in Delphi - 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 can 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.

Answer 2

Your timer code will not execute because timers rely on a window handle and message pump that TService does not provide. Furthermore, TTimer is not thread-safe because in uses the VCL's AllocateHwnd() function which is not thread-safe and should not be used outside the context of the main thread. Generally, when writing service applications you would spawn a worker thread to perform the main logic.
If you need a thread-safe timer, I would suggest you use a different timer mechanism, such as WaitForSingleObject()
Assitionally, services should not contain any visual controls as they should not interact with the desktop at all.

Answer 3

Could somebody give me an example of service application with threads.
If your code is doing all its work in a thread, you are almost done.
Just start your thread in the service start event. For debugging, run the thread in a small (console) program.
Instead of a timer, let your main thread sleep for a while.