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;