diff --git a/cgi_daemon.lfm b/cgi_daemon.lfm index 48f798d..e991164 100644 --- a/cgi_daemon.lfm +++ b/cgi_daemon.lfm @@ -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 diff --git a/cgi_daemon.pas b/cgi_daemon.pas index 9b9d2b5..8c6c150 100644 --- a/cgi_daemon.pas +++ b/cgi_daemon.pas @@ -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); diff --git a/connectionsdmunit.pas b/connectionsdmunit.pas index 7320f03..0305c51 100644 --- a/connectionsdmunit.pas +++ b/connectionsdmunit.pas @@ -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 diff --git a/lms_cgi_server.ini b/lms_cgi_server.ini new file mode 100644 index 0000000..152728e --- /dev/null +++ b/lms_cgi_server.ini @@ -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 \ No newline at end of file diff --git a/lms_cgi_server.lpi b/lms_cgi_server.lpi new file mode 100644 index 0000000..edd5fe9 --- /dev/null +++ b/lms_cgi_server.lpi @@ -0,0 +1,138 @@ + + + + + + + + + + + + <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> diff --git a/lms_cgi_server.lpr b/lms_cgi_server.lpr new file mode 100644 index 0000000..917b707 --- /dev/null +++ b/lms_cgi_server.lpr @@ -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.