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
OnCreate = DataModuleCreate
OnDestroy = DataModuleDestroy
OldCreateOrder = False
OnStart = DataModuleStart
OnStop = DataModuleStop
Height = 150
HorizontalOffset = 840
HorizontalOffset = 785
VerticalOffset = 384
Width = 445
end

48
cgi_daemon.pas
View File

@ -5,7 +5,7 @@ unit cgi_daemon;
interface
uses
Classes, SysUtils, DaemonApp;
Classes, SysUtils, DaemonApp, ConnectionsDmUnit;
type
TLMSReportCGI=class;
@ -13,14 +13,19 @@ type
TDaemonThread=class(TThread)
fOwner: TLMSReportCGI;
fData: TConnectionsDM;
procedure Execute;override;
function sleepMin(n: integer): boolean;
constructor Create(AOwner: TLMSReportCGI);
end;
{ TLMSReportCGI }
TLMSReportCGI = class(TDaemon)
procedure DataModuleCreate(Sender: TObject);
procedure DataModuleDestroy(Sender: TObject);
procedure DataModuleStart(Sender: TCustomDaemon; var OK: Boolean);
procedure DataModuleStop(Sender: TCustomDaemon; var OK: Boolean);
private
workThread: TDaemonThread;
public
@ -41,17 +46,56 @@ end;
{ 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);
begin
workThread := TDaemonThread(self);
workThread.Start;
OK := true;
end;
procedure TLMSReportCGI.DataModuleStop(Sender: TCustomDaemon; var OK: Boolean);
begin
workThread.Terminate;
end;
{ TDaemonThread }
procedure TDaemonThread.Execute;
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;
constructor TDaemonThread.Create(AOwner: TLMSReportCGI);

12
connectionsdmunit.pas
View File

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