diff --git a/lms_cgi.lpi b/lms_cgi.lpi index e9f9bc8..56d4458 100644 --- a/lms_cgi.lpi +++ b/lms_cgi.lpi @@ -17,6 +17,9 @@ + + + @@ -40,7 +43,6 @@ - @@ -53,6 +55,9 @@ + + + @@ -72,12 +77,19 @@ - + + + + + + + + + + @@ -88,6 +100,9 @@ + + + @@ -127,6 +142,11 @@ + + + + + 0 then + AResponse.Contents.Add(fValues[0]); + for i := 1 to fValues.Count-1 do begin - AResponse.Contents.Add(fValues[i]+','); + AResponse.Contents.Add(','+fValues[i]); end; AResponse.Contents.add(']'); fValues.Free; @@ -191,18 +211,8 @@ log(mtDebug,self,'Data READY'); end; procedure TMyCGIHandler.log(ALevel: TLogLevel; Sender: TObject; msg: string); -var - f: TextFile; - s: string; begin - if (Owner as TMyCGIApp).Logger=nil then exit; - case ALevel of - mtError: (Owner as TMyCGIApp).Logger.Error(msg); - mtWarning: (Owner as TMyCGIApp).Logger.Warning(msg); - mtInfo: (Owner as TMyCGIApp).Logger.Info(msg); - mtDebug: (Owner as TMyCGIApp).Logger.Debug(msg); - mtExtra: (Owner as TMyCGIApp).Logger.Log(msg); - end; + (Owner as TMyCGIApp).Log(ALevel,Sender,msg); end; procedure TMyCGIApp.LoadConfig; @@ -222,12 +232,28 @@ end; function TMyCGIApp.InitializeWebHandler: TWebHandler; begin LoadConfig; - flogger.FileName:=LogFolder; - flogger.Active:=true; - flogger.Info('start'); + if assigned(flogger) then + begin + flogger.FileName:=LogFolder; + flogger.Active:=true; + flogger.Info('start'); + end; Result:=TMyCgiHandler.Create(self); end; +procedure TMyCGIApp.Test; +var + clt: TClientMainThread; +begin + clt := TClientMainThread.Create('reports',nil,@Log,'10.120.7.20',6543,nil); + try + clt.start; + clt.waitFor; + finally + clt.free; + end; +end; + constructor TMyCGIApp.CreateWithLogger(AOwner: TComponent); begin flogger := TEventLog.Create(self); @@ -239,10 +265,24 @@ end; destructor TMyCGIApp.Destroy; begin - flogger.free; + if assigned(flogger) then + FreeAndNil(flogger); inherited Destroy; end; +procedure TMyCGIApp.log(ALevel: TLogLevel; Sender: TObject; msg: string); +begin + if Logger=nil then exit; + case ALevel of + mtError: Logger.Error(msg); + mtWarning: Logger.Warning(msg); + mtInfo: Logger.Info(msg); + mtDebug: Logger.Debug(msg); + {$IFDEF DEBUG} mtExtra: Logger.Log(msg); {$ENDIF} + end; + +end; + begin diff --git a/lmsreport.ini b/lmsreport.ini index 152728e..b065667 100644 --- a/lmsreport.ini +++ b/lmsreport.ini @@ -4,4 +4,4 @@ port=7079 database=lms [PARAMS] port=6543 -log=D:\PROJECTS\LAZARUS\LMS\out\server.log \ No newline at end of file +log=server.log diff --git a/lmsreport.lpi b/lmsreport.lpi index c27db85..8bd8e2c 100644 --- a/lmsreport.lpi +++ b/lmsreport.lpi @@ -223,6 +223,9 @@ + + + diff --git a/maintcpserver.lfm b/maintcpserver.lfm index 49e8ef9..031ca8b 100644 --- a/maintcpserver.lfm +++ b/maintcpserver.lfm @@ -8,7 +8,7 @@ object CGIServerGUI: TCGIServerGUI ClientWidth = 870 OnCreate = FormCreate OnDestroy = FormDestroy - LCLVersion = '2.2.0.4' + LCLVersion = '2.2.2.0' object Panel1: TPanel Left = 0 Height = 50 diff --git a/maintcpserver.pas b/maintcpserver.pas index 95be83e..08c0098 100644 --- a/maintcpserver.pas +++ b/maintcpserver.pas @@ -90,13 +90,19 @@ procedure TCGIServerGUI.SendButtonClick(Sender: TObject); begin if not started and StartButton.enabled then exit; client := TClientMainThread.Create(edtRequest.Text,Keys.Lines,@Server.log,'localhost',6543,@onAnswer); - LogQuery(0,edtRequest.Text,Keys.Lines,0,0,[]); - cmdDone := false; - edtAnswer.Text := ''; - edtQValue.Text := ''; - StatusPanel.Caption := 'Ожидание'; - retValues.Clear; - client.Start; + try + LogQuery(0,edtRequest.Text,Keys.Lines,0,0,[]); + cmdDone := false; + edtAnswer.Text := ''; + edtQValue.Text := ''; + StatusPanel.Caption := 'Ожидание'; + retValues.Clear; + client.Start; + client.WaitFor; + + finally + client.free; + end; end; diff --git a/tcpclient.pas b/tcpclient.pas index 2e63143..325550a 100644 --- a/tcpclient.pas +++ b/tcpclient.pas @@ -48,6 +48,7 @@ implementation procedure TClientMainThread.SynchAnswer; begin + log(mtExtra,self,'SynchAnswer'); if assigned(fOnComplete) then fOnComplete(self,fmode,fResult.code,fResult.Param,fResult.Name,fResult.Keys,fResult.iValues,fResult.Data); end; @@ -56,7 +57,7 @@ constructor TClientMainThread.Create(ACommand: string; AFields: TStrings; ALogger: TLogger; AHost: string; APort: integer; OnReceive: TRequestComplete); begin inherited Create(TClientThread,ALogger,APort); - FreeOnTerminate:=true; + FreeOnTerminate:=false; fOnComplete:=onReceive; Connect.OnConnect:=@doConnect; fCommand := ACommand; @@ -80,11 +81,16 @@ begin doStart; log(mtExtra, self,'start main thread'); Connect.Connect(Host,Port); + try while not terminated and not Complete do begin Connect.CallAction; sleep(10); end; + + finally + log(mtExtra,self,'main thread terminated'); + end; TerminateClients; Connect.Disconnect(); log(mtExtra, self,'terminated'); @@ -99,6 +105,7 @@ procedure TClientMainThread.ProcessAnswer(const mode: byte; const Code: DWORD; const QValue: QWORD; const Answer: string; const Values: TStrings; const iValues: TParamArray; const Data: TStream); begin + log(mtExtra,self,'ProcessAnswer '+Answer); try if assigned(fOnComplete) then begin @@ -108,7 +115,7 @@ begin end; - + SetComplete; except on e:Exception do begin log(mtError, self,'!!ERROR ProcessAnswer '+e.message); @@ -126,9 +133,7 @@ procedure TClientThread.ProcessMessage(const mode: byte; const Code: DWORD; const Param: QWord; const ACommand: string; const Values: TStrings; const intData: TParamArray; const Data: TStream); begin - log(mtDebug,format('ProcessMessage(%d) Param=%x, Answer=%s ',[code,Param,ACommand])); - terminate; - Owner.Terminate; + log(mtExtra,format('ProcessMessage(%d) Param=%x, Answer=%s ',[code,Param,ACommand])); (Owner as TClientMainThread).ProcessAnswer(mode,code,Param,ACommand,Values,intData,Data); end; diff --git a/tcpthreadhelper.pas b/tcpthreadhelper.pas index a632e22..b6325e8 100644 --- a/tcpthreadhelper.pas +++ b/tcpthreadhelper.pas @@ -259,6 +259,7 @@ end; procedure TMainThread.TerminatedSet; begin + log(mtExtra,self,'terminated required'); inherited TerminatedSet(); end; @@ -293,6 +294,8 @@ end; destructor TMainThread.Destroy; begin + log(mtExtra,self,'Destroy'); + TerminateClients; fClients.Free; fCon.Free; Inherited Destroy; @@ -300,6 +303,7 @@ end; procedure TMainThread.SetComplete; begin + log(mtExtra,self,'setcomplete'); fComplete:=true; end; @@ -1041,8 +1045,8 @@ end; destructor TConnectionThread.Destroy; begin + log(mtExtra,'destroy'); fCache.Free; - fOwner.removeClient(self); inherited Destroy; end; @@ -1084,6 +1088,7 @@ begin end; end; Cache.Close; + log(mtExtra,'terminated'); //Socket.Disconnect(); end; @@ -1091,7 +1096,7 @@ procedure TConnectionThread.TerminatedSet; begin log(mtExtra,'terminate required'); Cache.Close; - fOwner.removeClient(self); + end;