mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-08 02:27:56 +02:00
parent
00e132498e
commit
b82eaf4ce2
8
.gitattributes
vendored
8
.gitattributes
vendored
@ -3455,6 +3455,14 @@ packages/fcl-extra/examples/Makefile svneol=native#text/plain
|
||||
packages/fcl-extra/examples/Makefile.fpc svneol=native#text/plain
|
||||
packages/fcl-extra/examples/daemon.pp svneol=native#text/plain
|
||||
packages/fcl-extra/examples/daemon.txt svneol=native#text/plain
|
||||
packages/fcl-extra/examples/double/daemonmapperunit1.lfm svneol=native#text/plain
|
||||
packages/fcl-extra/examples/double/daemonmapperunit1.pas svneol=native#text/plain
|
||||
packages/fcl-extra/examples/double/daemonunit1.lfm svneol=native#text/plain
|
||||
packages/fcl-extra/examples/double/daemonunit1.pas svneol=native#text/plain
|
||||
packages/fcl-extra/examples/double/daemonunit2.lfm svneol=native#text/plain
|
||||
packages/fcl-extra/examples/double/daemonunit2.pas svneol=native#text/plain
|
||||
packages/fcl-extra/examples/double/double.pp svneol=native#text/plain
|
||||
packages/fcl-extra/examples/double/resdaemonapp.pp svneol=native#text/plain
|
||||
packages/fcl-extra/fpmake.pp svneol=native#text/pascal
|
||||
packages/fcl-extra/src/daemonapp.pp svneol=native#text/plain
|
||||
packages/fcl-extra/src/unix/daemonapp.inc svneol=native#text/plain
|
||||
|
29
packages/fcl-extra/examples/double/daemonmapperunit1.lfm
Normal file
29
packages/fcl-extra/examples/double/daemonmapperunit1.lfm
Normal file
@ -0,0 +1,29 @@
|
||||
object DaemonMapper1: TDaemonMapper1
|
||||
DaemonDefs = <
|
||||
item
|
||||
DaemonClassName = 'TDaemon1'
|
||||
Name = 'TDaemon1'
|
||||
Options = [doAllowStop, doAllowPause]
|
||||
WinBindings.Dependencies = <>
|
||||
WinBindings.StartType = stBoot
|
||||
WinBindings.WaitHint = 0
|
||||
WinBindings.IDTag = 0
|
||||
WinBindings.ServiceType = stWin32
|
||||
WinBindings.ErrorSeverity = esIgnore
|
||||
LogStatusReport = False
|
||||
end
|
||||
item
|
||||
DaemonClassName = 'TDaemon2'
|
||||
Name = 'TDaemon2'
|
||||
Options = [doAllowStop, doAllowPause]
|
||||
WinBindings.Dependencies = <>
|
||||
WinBindings.StartType = stBoot
|
||||
WinBindings.WaitHint = 0
|
||||
WinBindings.IDTag = 0
|
||||
WinBindings.ServiceType = stWin32
|
||||
WinBindings.ErrorSeverity = esIgnore
|
||||
LogStatusReport = False
|
||||
end>
|
||||
Left = 284
|
||||
Top = 140
|
||||
end
|
34
packages/fcl-extra/examples/double/daemonmapperunit1.pas
Normal file
34
packages/fcl-extra/examples/double/daemonmapperunit1.pas
Normal file
@ -0,0 +1,34 @@
|
||||
unit DaemonMapperUnit1;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, DaemonApp;
|
||||
|
||||
type
|
||||
TDaemonMapper1 = class(TDaemonMapper)
|
||||
private
|
||||
|
||||
public
|
||||
|
||||
end;
|
||||
|
||||
var
|
||||
DaemonMapper1: TDaemonMapper1;
|
||||
|
||||
implementation
|
||||
|
||||
procedure RegisterMapper;
|
||||
begin
|
||||
RegisterDaemonMapper(TDaemonMapper1)
|
||||
end;
|
||||
|
||||
{$R *.lfm}
|
||||
|
||||
|
||||
initialization
|
||||
RegisterMapper;
|
||||
end.
|
||||
|
8
packages/fcl-extra/examples/double/daemonunit1.lfm
Normal file
8
packages/fcl-extra/examples/double/daemonunit1.lfm
Normal file
@ -0,0 +1,8 @@
|
||||
object Daemon1: TDaemon1
|
||||
OldCreateOrder = False
|
||||
OnExecute = DataModuleExecute
|
||||
Height = 150
|
||||
HorizontalOffset = 284
|
||||
VerticalOffset = 140
|
||||
Width = 150
|
||||
end
|
52
packages/fcl-extra/examples/double/daemonunit1.pas
Normal file
52
packages/fcl-extra/examples/double/daemonunit1.pas
Normal file
@ -0,0 +1,52 @@
|
||||
unit DaemonUnit1;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, DaemonApp;
|
||||
|
||||
type
|
||||
|
||||
{ TDaemon1 }
|
||||
|
||||
TDaemon1 = class(TDaemon)
|
||||
procedure DataModuleExecute(Sender: TCustomDaemon);
|
||||
private
|
||||
|
||||
public
|
||||
|
||||
end;
|
||||
|
||||
var
|
||||
Daemon1: TDaemon1;
|
||||
|
||||
implementation
|
||||
|
||||
procedure RegisterDaemon;
|
||||
begin
|
||||
RegisterDaemonClass(TDaemon1)
|
||||
end;
|
||||
|
||||
{$R *.lfm}
|
||||
|
||||
{ TDaemon1 }
|
||||
|
||||
procedure TDaemon1.DataModuleExecute(Sender: TCustomDaemon);
|
||||
Var
|
||||
I : Integer;
|
||||
begin
|
||||
I := 0;
|
||||
Application.EventLog.Log('TDaemon1 execution start');
|
||||
While Self.Status = csRunning Do Begin
|
||||
Sleep(10);
|
||||
end;
|
||||
Application.EventLog.Log('TDaemon1 execution stop');
|
||||
end;
|
||||
|
||||
|
||||
initialization
|
||||
RegisterDaemon;
|
||||
end.
|
||||
|
8
packages/fcl-extra/examples/double/daemonunit2.lfm
Normal file
8
packages/fcl-extra/examples/double/daemonunit2.lfm
Normal file
@ -0,0 +1,8 @@
|
||||
object Daemon2: TDaemon2
|
||||
OldCreateOrder = False
|
||||
OnExecute = DataModuleExecute
|
||||
Height = 150
|
||||
HorizontalOffset = 284
|
||||
VerticalOffset = 140
|
||||
Width = 150
|
||||
end
|
52
packages/fcl-extra/examples/double/daemonunit2.pas
Normal file
52
packages/fcl-extra/examples/double/daemonunit2.pas
Normal file
@ -0,0 +1,52 @@
|
||||
unit daemonunit2;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, DaemonApp;
|
||||
|
||||
type
|
||||
|
||||
{ TDaemon2 }
|
||||
|
||||
TDaemon2 = class(TDaemon)
|
||||
procedure DataModuleExecute(Sender: TCustomDaemon);
|
||||
private
|
||||
|
||||
public
|
||||
|
||||
end;
|
||||
|
||||
var
|
||||
Daemon2: TDaemon2;
|
||||
|
||||
implementation
|
||||
|
||||
procedure RegisterDaemon;
|
||||
begin
|
||||
RegisterDaemonClass(TDaemon2)
|
||||
end;
|
||||
|
||||
{$R *.lfm}
|
||||
|
||||
{ TDaemon2 }
|
||||
|
||||
procedure TDaemon2.DataModuleExecute(Sender: TCustomDaemon);
|
||||
Var
|
||||
I : Integer;
|
||||
begin
|
||||
I := 0;
|
||||
Application.EventLog.Log('TDaemon2 execution start');
|
||||
While Self.Status = csRunning Do Begin
|
||||
Sleep(10);
|
||||
end;
|
||||
Application.EventLog.Log('TDaemon2 execution stop');
|
||||
end;
|
||||
|
||||
|
||||
initialization
|
||||
RegisterDaemon;
|
||||
end.
|
||||
|
23
packages/fcl-extra/examples/double/double.pp
Normal file
23
packages/fcl-extra/examples/double/double.pp
Normal file
@ -0,0 +1,23 @@
|
||||
Program double;
|
||||
|
||||
Uses
|
||||
{$IFDEF UNIX}
|
||||
CThreads,
|
||||
{$ENDIF}
|
||||
ResDaemonApp, DaemonApp, DaemonMapperUnit1, DaemonUnit1, daemonunit2, SysUtils, eventlog
|
||||
{ add your units here };
|
||||
|
||||
Var
|
||||
AExecutableFilenamePath : String;
|
||||
begin
|
||||
AExecutableFilenamePath := ParamStr(0);
|
||||
AExecutableFilenamePath := ExpandFileName(AExecutableFilenamePath);
|
||||
AExecutableFilenamePath := ExtractFilePath(AExecutableFilenamePath);
|
||||
Application.Title:='Daemon application';
|
||||
Application.Initialize;
|
||||
Application.EventLog.FileName := SysUtils.ConcatPaths([AExecutableFilenamePath, 'event-log.txt']);
|
||||
Application.EventLog.LogType := ltFile;
|
||||
Application.EventLog.AppendContent := False;
|
||||
Application.EventLog.Active := True;
|
||||
Application.Run;
|
||||
end.
|
32
packages/fcl-extra/examples/double/resdaemonapp.pp
Normal file
32
packages/fcl-extra/examples/double/resdaemonapp.pp
Normal file
@ -0,0 +1,32 @@
|
||||
{
|
||||
*****************************************************************************
|
||||
See the file COPYING.modifiedLGPL.txt, included in this distribution,
|
||||
for details about the license.
|
||||
*****************************************************************************
|
||||
}
|
||||
{$mode objfpc}
|
||||
{$h+}
|
||||
unit resdaemonapp;
|
||||
|
||||
interface
|
||||
|
||||
uses daemonapp;
|
||||
|
||||
Type
|
||||
TResDaemonApplication = Class(TCustomDaemonApplication)
|
||||
Procedure CreateDaemonInstance(Var ADaemon : TCustomDaemon; DaemonDef : TDaemonDef); override;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses classes;
|
||||
|
||||
Procedure TResDaemonApplication.CreateDaemonInstance(Var ADaemon : TCustomDaemon; DaemonDef : TDaemonDef);
|
||||
|
||||
begin
|
||||
ADaemon:=DaemonDef.DaemonClass.Create(Self);
|
||||
end;
|
||||
|
||||
Initialization
|
||||
RegisterDaemonApplicationClass(TResDaemonApplication)
|
||||
end.
|
@ -56,6 +56,7 @@ Type
|
||||
Function Install : Boolean; virtual;
|
||||
Function UnInstall: boolean; virtual;
|
||||
Function HandleCustomCode(ACode : DWord) : Boolean; Virtual;
|
||||
procedure DoThreadTerminate(Sender: TObject);virtual;
|
||||
Public
|
||||
Procedure CheckControlMessages(Wait : Boolean);
|
||||
Procedure LogMessage(const Msg : String);
|
||||
@ -694,7 +695,12 @@ begin
|
||||
Result:=False
|
||||
end;
|
||||
|
||||
Procedure TCustomDaemon.CheckControlMessages(Wait : Boolean);
|
||||
procedure TCustomDaemon.DoThreadTerminate(Sender: TObject);
|
||||
begin
|
||||
Self.FThread := NIL;
|
||||
end;
|
||||
|
||||
procedure TCustomDaemon.CheckControlMessages(Wait: Boolean);
|
||||
|
||||
begin
|
||||
If Assigned(FThread) then
|
||||
|
@ -167,9 +167,8 @@ begin
|
||||
Try
|
||||
T:=TDaemonThread.Create(FDaemon);
|
||||
T.FreeOnTerminate:=True;
|
||||
T.OnTerminate := @FDaemon.DoThreadTerminate;
|
||||
T.Resume;
|
||||
T.WaitFor;
|
||||
FDaemon.FThread:=Nil;
|
||||
except
|
||||
On E : Exception do
|
||||
FDaemon.Logmessage(Format(SErrDaemonStartFailed,[FDaemon.Definition.Name,E.Message]));
|
||||
|
Loading…
Reference in New Issue
Block a user