Bo Berglund wrote 48 lines
On Fri, 15 May 2020 21:26:43 +0200, Marc Weustink via lazarus
wrote:
>
>
> On May 14, 2020 10:21:22 AM GMT+02:00, Bo Berglund via lazarus wrote:
>> On Tue, 12 May 2020 13:49:08 +0200, Marc Weustink via lazarus
>> wrote:
>>
>> While going through your post I got into this section:
>>
>>>> 3) Compiling same code with Delphi and FPC?
>>>> Do you convert your projects (manually) to make it possible to use
>>>> both Delphi and Lazarus as the IDE for further work on the same
>>>> sources?
>>>> If so do you have any hints as to what to look out for?
>>>
>>> Yes, it is a manual conversion. But in our case not that hard. Most of
>>
>>> the converted projects are windows (network) services.
>>> The difference between a delphi service and a fpc daemon is covered in
>> a
>>> BaseServer class / unit. So for services derived from it there is no
>>> different code.
>>
>> Since I am dealing with a Windows Service too I wonder how you do it
>> to get a daemon application in Lazarus?
>>
>> I have installed the package lazdaemon 0.9.9 on advice elsewhere.
>> It is said to be implementing services, but I don't know if it is
>> involved in the Delphi conversion...
>>
> I'll see if I can extract some example snippet. I cannot remember that I used a package.
>
> I didn't use the form based service
Well this application also does not use any forms, but inherently the
TService application creates a data module, which supplies some of the
form functionality, I guess.
I tried in Lazarus by creating a new daemon application and look what
it brings into the project...
But I did not figure out how it works by looking at the code framework
so I guess I have to read up a lot about the way daemons work in
FPC...
In any case there is a sort of form here as well, looks a lot like a
data module.
Never used that. I've attached and stripped down and anonymized version of our base server definition. At places where you should place your own code or where it is trivial, I wrote .....
I also didn't include the unit description defining the service derived from TMyBaseServer
Marc
-------------- next part --------------
================================================================================ unit MyDaemon;
interface
uses
daemonapp, Classes, SysUtils, MyBaseServer;
type
TMyDaemon = class(TDaemon)
private
protected
function Install: Boolean; override;
function Execute: Boolean; override;
public
end;
TMyDebugDaemonController = class(TDaemonController)
public
function ReportStatus : Boolean; override;
end;
TMyDaemonThread = class(TDaemonThread)
public
property Terminated;
end;
TMyDaemonMapper = Class(TCustomDaemonMapper)
public
constructor Create(AOwner : TComponent); override;
end;
{ TMyDaemonApplication }
TMyDaemonApplication = class(TDaemonApplication)
private
FDebug: Boolean;
procedure LogEvent(const ALogText: String);
protected
function DoConfig(AParams: TMyCommandParams): Boolean; virtual; abstract;
function DoUpdate: Boolean; virtual; abstract;
function DoDebug: Boolean; virtual;
function ProcessRun: Boolean; virtual; abstract;
procedure CreateDaemonController(var AController : TDaemonController); override;
procedure CreateDaemonInstance(Var ADaemon : TCustomDaemon; DaemonDef : TDaemonDef); override;
procedure DoRun; override;
property Debug: Boolean read FDebug write FDebug;
public
end;
TMyBaseServiceApplication = class(TMyDaemonApplication);
implementation
{ TMyDebugDaemonController }
function TMyDebugDaemonController.ReportStatus: Boolean;
begin
Result := True;
end;
{ TMyDaemonMapper }
constructor TMyDaemonMapper.Create(AOwner: TComponent);
var
D: TDaemonDef;
begin
inherited Create(AOwner);
D := DaemonDefs.Add as TDaemonDef;
D.DisplayName := MyServer.DisplayName;
D.Name := MyServer.Name;
D.DaemonClassName := TMyDaemon.ClassName;
D.WinBindings.ServiceType := stWin32;
end;
{ TMyDaemon }
function TMyDaemon.Install: Boolean;
begin
MyServer.BeforeInstall;
Result := inherited Install;
MyServer.AfterInstall;
end;
function TMyDaemon.Execute: Boolean;
begin
Result := True;
MyServer.Execute;
end;
{ TMyDaemonApplication }
function TMyDaemonApplication.DoDebug: Boolean;
var
T: TThread;
M: TCustomDaemonMapper;
D: TCustomDaemon;
begin
Result := True;
CreateServiceMapper(M);
D := CreateDaemon(M.DaemonDefs[0]);
D.Status := csStartPending;
try
T := TDaemonThread.Create(D);
T.Resume;
T.WaitFor;
FreeAndNil(T);
except
on E : Exception do
D.Logmessage(Format(SErrDaemonStartFailed,[D.Definition.Name,E.Message]));
end;
end;
procedure TMyDaemonApplication.CreateDaemonController(var AController: TDaemonController);
begin
if FDebug
then AController := TMyDebugDaemonController.Create(Self)
else inherited CreateDaemonController(AController);
end;
procedure TMyDaemonApplication.CreateDaemonInstance(var ADaemon: TCustomDaemon; DaemonDef: TDaemonDef);
begin
inherited CreateDaemonInstance(ADaemon, DaemonDef);
MyServer.Daemon := ADaemon;
end;
procedure TMyDaemonApplication.DoRun;
begin
if ProcessRun then Exit;
inherited;
end;
procedure TMyDaemonApplication.LogEvent(const ALogText: String);
begin
WriteLn(AlogText);
end;
procedure InitApplication;
begin
RegisterDaemonClass(TMyDaemon);
RegisterDaemonMapper(TMyDaemonMapper);
end;
initialization
InitApplication;
finalization
end.
================================================================================
unit MyBaseServer;
interface
{$ifndef FPC}
{$define WINDOWS}
{$define CPUI386}
{$endif}
.....
uses
{$ifdef fpc}
daemonapp,
{$else}
SvcMgr, WinSvc,
{$endif}
.....
type
{$ifdef fpc}
{ TMyService }
TMyService = class(TComponent)
private
FDaemon: TCustomDaemon;
FDisplayName: String;
FServiceStartName: String;
FErrCode: DWord;
FWin32ErrorCode: DWord;
protected
function Terminated: Boolean;
function ServiceThread: TThread;
public
procedure AfterInstall; virtual; abstract;
procedure BeforeInstall; virtual; abstract;
procedure Execute; virtual; abstract;
procedure ReportStatus;
property Daemon: TCustomDaemon read FDaemon write FDaemon;
property DisplayName: String read FDisplayName write FDisplayName;
property ServiceStartName: String read FServiceStartName write FServiceStartName;
property ErrCode: DWord read FErrCode write FErrCode;
property Win32ErrCode: DWord read FWin32ErrorCode write FWin32ErrorCode;
end;
{$else fpc}
// delphi part
TMyService = class(TService)
private
procedure ServiceBeforeInstall(Sender: TService);
procedure ServiceAfterInstall(Sender: TService);
procedure ServiceExecute(Sender: TService);
protected
procedure Execute; virtual; abstract;
procedure AfterInstall; virtual; abstract;
procedure BeforeInstall; virtual; abstract;
public
constructor Create(AOwner: TComponent); override;
function GetServiceController: TServiceController; override;
end;
{$endif}
TMyBaseSrv = class(TMyService)
private
.....
var
MyServer: TMyBaseSrv;
implementation
{$ifdef fpc}
uses
MyDaemon;
{$endif}
type
{$ifndef fpc}
TMyBaseServiceApplication = class(TServiceApplication)
private
FDebug: Boolean;
protected
function DoConfig(AParams: TMyCommandParams): Boolean; virtual; abstract;
function DoUpdate: Boolean; virtual; abstract;
function DoDebug: Boolean; virtual;
function ProcessRun: Boolean; virtual; abstract;
property Debug: Boolean read FDebug write FDebug;
public
procedure Run; override;
end;
{$endif}
TMyServiceApplication = class(TMyBaseServiceApplication)
private
protected
function DoConfig(AParams: TMyCommandParams): Boolean; override;
function DoUpdate: Boolean; override;
function ProcessRun: Boolean; override;
public
end;
.....
{ TMyServiceApplication }
{$ifndef MSWINDOWS}
function _GetApplicationName: String;
begin
Result := 'myapp';
end;
{$endif}
function TMyServiceApplication.DoConfig(AParams: TMyCommandParams): Boolean;
begin
Result := True;
......
end;
function TMyServiceApplication.DoUpdate: Boolean;
begin
Result := MyServer.ServiceUpdate;
end;
function TMyServiceApplication.ProcessRun: Boolean;
var
Params: TMyCommandParams;
begin
Result := True;
Params := TMyCommandParams.Create;
try
if Params.GetFlag('update') cfUnset
then begin
if DoUpdate then Exit;
end
else if Params.GetFlag('config') cfUnset
then begin
if DoConfig(Params) then Exit;
end;
Debug := Params.GetFlag('debug') cfUnset
finally
Params.Free;
end;
if Debug
then begin
DoDebug;
Exit;
end;
Result := False;
end;
.....
procedure TMyBaseSrv.Execute;
{$ifndef MSWINDOWS}
const
ERROR_PROCESS_ABORTED = 1;
{$endif}
var
.....
{$ifdef fpc}
TMyDaemonThread(Daemon.DaemonThread).CheckControlMessage(False);
{$else}
ServiceThread.ProcessRequests(False);
{$endif}
.....
{$ifdef fpc}
{ TMyService }
procedure TMyService.ReportStatus;
begin
Daemon.ReportStatus;
end;
function TMyService.ServiceThread: TThread;
begin
Result := TMyDaemonThread(Daemon.DaemonThread);
end;
function TMyService.Terminated: Boolean;
begin
Result := TMyDaemonThread(Daemon.DaemonThread).Terminated;
end;
{$else}
// delphi
procedure ServiceController(CtrlCode: DWord); stdcall;
begin
MyServer.Controller(CtrlCode);
end;
constructor TMyService.Create(AOwner: TComponent);
begin
CreateNew(AOwner, 0);
OnExecute := ServiceExecute;
inherited BeforeInstall := ServiceBeforeInstall;
inherited AfterInstall := ServiceAfterInstall;
end;
function TMyService.GetServiceController: TServiceController;
begin
Result := ServiceController;
end;
procedure TMyService.ServiceAfterInstall(Sender: TService);
begin
AfterInstall;
end;
procedure TMyService.ServiceBeforeInstall(Sender: TService);
begin
BeforeInstall;
end;
procedure TMyService.ServiceExecute(Sender: TService);
begin
Execute;
end;
{ TMyBaseServiceApplication }
function TMyBaseServiceApplication.DoDebug: Boolean;
begin
Result := False;
end;
procedure TMyBaseServiceApplication.Run;
begin
if ProcessRun then Exit;
inherited;
end;
{$endif}
procedure InitApplication;
begin
{$ifdef fpc}
RegisterDaemonApplicationClass(TMyServiceApplication);
{$else}
Application.Free;
Application := TMyServiceApplication.Create(nil);
{$endif}
end;
initialization
InitApplication;
finalization
end.
================================================================================
program MyApp;
{$ifdef fpc}
{$R 'MyApp_version.rc'}
{$else}
{$R 'MyApp_version.res' 'MyApp_version.rc'}
{$endif}
uses
{$ifdef fpc}
interfaces,
daemonapp,
{$else}
svcmgr,
{$endif}
MyBaseServer,
MyServer,
.....
begin
Application.Initialize;
Application.CreateForm(TMySrv, MyServer);
Application.Run;
end.
================================================================================
