[Lazarus] Where to define conditionals for FPC

[Marc Weustink]

On 15-5-2020 23:54, Bo Berglund via lazarus wrote:
> On Fri, 15 May 2020 21:26:43 +0200, Marc Weustink via lazarus
> <lazarus at lists.lazarus-ide.org> wrote:
> 
>>
>>
>> On May 14, 2020 10:21:22 AM GMT+02:00, Bo Berglund via lazarus <lazarus at lists.lazarus-ide.org> wrote:
>>> On Tue, 12 May 2020 13:49:08 +0200, Marc Weustink via lazarus
>>> <lazarus at lists.lazarus-ide.org> 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.

================================================================================