alexey.zablotskiy/LMS-2_ReportAPI
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

daemon

Browse Source
This commit is contained in:
Алексей Заблоцкий 2023-10-19 01:06:22 +03:00
parent d6ad951e55
commit e93b74e31b
6 changed files with 226 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
cgi_daemon.lfm
View File

@ -1,8 +1,11 @@
object LMSReportCGI: TLMSReportCGI object LMSReportCGI: TLMSReportCGI
OnCreate = DataModuleCreate
OnDestroy = DataModuleDestroy
OldCreateOrder = False OldCreateOrder = False
OnStart = DataModuleStart OnStart = DataModuleStart
OnStop = DataModuleStop
Height = 150 Height = 150
HorizontalOffset = 840 HorizontalOffset = 785
VerticalOffset = 384 VerticalOffset = 384
Width = 445 Width = 445
end end

48
cgi_daemon.pas
View File

@ -5,7 +5,7 @@ unit cgi_daemon;
interface interface
uses uses
Classes, SysUtils, DaemonApp; Classes, SysUtils, DaemonApp, ConnectionsDmUnit;
type type
TLMSReportCGI=class; TLMSReportCGI=class;
@ -13,14 +13,19 @@ type
TDaemonThread=class(TThread) TDaemonThread=class(TThread)
fOwner: TLMSReportCGI; fOwner: TLMSReportCGI;
fData: TConnectionsDM;
procedure Execute;override; procedure Execute;override;
function sleepMin(n: integer): boolean;
constructor Create(AOwner: TLMSReportCGI); constructor Create(AOwner: TLMSReportCGI);
end; end;
{ TLMSReportCGI } { TLMSReportCGI }
TLMSReportCGI = class(TDaemon) TLMSReportCGI = class(TDaemon)
procedure DataModuleCreate(Sender: TObject);
procedure DataModuleDestroy(Sender: TObject);
procedure DataModuleStart(Sender: TCustomDaemon; var OK: Boolean); procedure DataModuleStart(Sender: TCustomDaemon; var OK: Boolean);
procedure DataModuleStop(Sender: TCustomDaemon; var OK: Boolean);
private private
workThread: TDaemonThread; workThread: TDaemonThread;
public public
@ -41,17 +46,56 @@ end;
{ TLMSReportCGI } { TLMSReportCGI }
procedure TLMSReportCGI.DataModuleCreate(Sender: TObject);
begin
workThread := TDaemonThread.create(self);
end;
procedure TLMSReportCGI.DataModuleDestroy(Sender: TObject);
begin
workthread.free;
end;
procedure TLMSReportCGI.DataModuleStart(Sender: TCustomDaemon; var OK: Boolean); procedure TLMSReportCGI.DataModuleStart(Sender: TCustomDaemon; var OK: Boolean);
begin begin
workThread := TDaemonThread(self);
workThread.Start; workThread.Start;
OK := true;
end;
procedure TLMSReportCGI.DataModuleStop(Sender: TCustomDaemon; var OK: Boolean);
begin
workThread.Terminate;
end; end;
{ TDaemonThread } { TDaemonThread }
procedure TDaemonThread.Execute; procedure TDaemonThread.Execute;
begin begin
fData := TConnectionsDM.Create(nil);
try
fData.Start;
while not terminated do
begin
if sleepMin(2) then
fData.Idle(self);
end;
fData.Stop;
finally
fData.free;
end;
end;
function TDaemonThread.sleepMin(n: integer): boolean;
var
i: integer;
begin
for i := 1 to n*60 do
begin
if terminated then break
else sleep(1000);
end;
result := not terminated;
end; end;
constructor TDaemonThread.Create(AOwner: TLMSReportCGI); constructor TDaemonThread.Create(AOwner: TLMSReportCGI);

12
connectionsdmunit.pas
View File

@ -53,6 +53,7 @@ type
property DataBase: string read fDataBase; property DataBase: string read fDataBase;
procedure Log(Sender: TObject; msg: string); procedure Log(Sender: TObject; msg: string);
procedure Start; procedure Start;
procedure Stop;
procedure Idle(Sender: TObject); procedure Idle(Sender: TObject);
property Running: boolean read fRunning; property Running: boolean read fRunning;
function ProcessRequest(Sender: TMainThread; function ProcessRequest(Sender: TMainThread;
@ -471,6 +472,7 @@ begin
fServicePort := ini.ReadInteger('PARAMS','port',6543); fServicePort := ini.ReadInteger('PARAMS','port',6543);
flogFolder:=ini.ReadString('PARAMS','log',''); flogFolder:=ini.ReadString('PARAMS','log','');
fTimeOut:=ini.ReadInteger('PARAMS','timeout',CONNECT_TIMEOUT); fTimeOut:=ini.ReadInteger('PARAMS','timeout',CONNECT_TIMEOUT);
log(self,format('server %s:%d/%s',[fDataHost,fDataPort,fDataBase]));
finally finally
ini.free; ini.free;
end; end;
@ -514,11 +516,19 @@ begin
MainCon.connection.RemotePort:=DataPort; MainCon.connection.RemotePort:=DataPort;
MainCon.connection.Database:=DataBase; MainCon.connection.Database:=DataBase;
MainCon.OpenConnection; MainCon.OpenConnection;
Input.OnIdle:=@Idle; //Input.OnIdle:=@Idle;
Input.Start; Input.Start;
fRunning:=true; fRunning:=true;
end; end;
procedure TConnectionsDM.Stop;
begin
if fRunning then
Input.Terminate;
Input.WaitFor;
fRunning := false;
end;
procedure TConnectionsDM.Idle(Sender: TObject); procedure TConnectionsDM.Idle(Sender: TObject);
var var

7
lms_cgi_server.ini Normal file
View File

@ -0,0 +1,7 @@
[DATA]
host=10.120.7.20
port=7079
database=lms
[PARAMS]
port=6543
log=D:\PROJECTS\LAZARUS\LMS\out\server.log

138
lms_cgi_server.lpi Normal file
View File

@ -0,0 +1,138 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="12"/>
<PathDelim Value="\"/>
<General>
<Flags>
<MainUnitHasCreateFormStatements Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<Title Value="Daemon application"/>
<UseAppBundle Value="False"/>
<ResourceType Value="res"/>
</General>
<BuildModes>
<Item Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<UseFileFilters Value="True"/>
</PublishOptions>
<RunParams>
<FormatVersion Value="2"/>
</RunParams>
<RequiredPackages>
<Item>
<PackageName Value="Abbrevia"/>
</Item>
<Item>
<PackageName Value="nnzdata"/>
</Item>
<Item>
<PackageName Value="fr_lazarus"/>
</Item>
<Item>
<PackageName Value="frxe_lazarus"/>
</Item>
<Item>
<PackageName Value="dcpcrypt"/>
</Item>
<Item>
<PackageName Value="lnetbase"/>
</Item>
<Item>
<PackageName Value="LazDaemon"/>
</Item>
<Item>
<PackageName Value="LCL"/>
</Item>
<Item>
<PackageName Value="FCL"/>
</Item>
</RequiredPackages>
<Units>
<Unit>
<Filename Value="lms_cgi_server.lpr"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="cgi_mapper.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="DaemonMapper1"/>
<HasResources Value="True"/>
</Unit>
<Unit>
<Filename Value="cgi_daemon.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="LMSReportCGI"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="DataModule"/>
</Unit>
<Unit>
<Filename Value="tcpthreadhelper.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="connectionsdmunit.pas"/>
<IsPartOfProject Value="True"/>
<HasResources Value="True"/>
<UnitName Value="ConnectionsDmUnit"/>
</Unit>
<Unit>
<Filename Value="baseconnection.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="tcpserver.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="cgireport.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="cgiReport"/>
</Unit>
<Unit>
<Filename Value="cgidm.pas"/>
<IsPartOfProject Value="True"/>
<HasResources Value="True"/>
<UnitName Value="cgiDM"/>
</Unit>
<Unit>
<Filename Value="exttypes.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="extTypes"/>
</Unit>
<Unit>
<Filename Value="reportdmunit.pas"/>
<IsPartOfProject Value="True"/>
<HasResources Value="True"/>
<UnitName Value="reportDMUnit"/>
</Unit>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="lms_cgi_server"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
</CompilerOptions>
<Debugging>
<Exceptions>
<Item>
<Name Value="EAbort"/>
</Item>
<Item>
<Name Value="ECodetoolError"/>
</Item>
<Item>
<Name Value="EFOpenError"/>
</Item>
</Exceptions>
</Debugging>
</CONFIG>

20
lms_cgi_server.lpr Normal file
View File

@ -0,0 +1,20 @@
Program lms_cgi_server;
Uses
{$IFDEF UNIX}
cthreads,
{$ENDIF}
{$IFDEF HASAMIGA}
athreads,
{$ENDIF}
Interfaces, // this includes the LCL widgetset
sysutils,
DaemonApp, lazdaemonapp, cgi_mapper, cgi_daemon, tcpthreadhelper,
ConnectionsDmUnit, baseconnection, tcpserver, cgiReport, cgiDM, extTypes,
reportDMUnit, abbrevia, lnetbase
{ add your units here };
begin
Application.Initialize;
Application.Run;
end.