From b9d169d5dc29f0ecd458522351e0460178bd67e7 Mon Sep 17 00:00:00 2001 From: "alexey.zablotskiy" Date: Wed, 15 Nov 2023 16:09:09 +0300 Subject: [PATCH] out param fix --- baseconnection.pas | 3 +++ cgireport.pas | 3 ++- commandcol.pas | 1 + lms_cgi.lpi | 67 +++++++++++++++++++++++++++++++++++++++++++++---- lms_cgi.lpr | 59 +++++++++++++++++++++++++------------------ lms_cgi_server.lpi | 26 +++++++++++++++++++ lmsreport.lpi | 72 +++++++++++++++++++++++++++++++++++++++++++++++++++++ maintcpserver.lfm | 60 +++++++++++++++++++++++--------------------- reportdmunit.pas | 3 ++- tcpclient.pas | 2 +- tcpserver.pas | 10 +++++--- tcpthreadhelper.pas | 15 +++++++++++ 12 files changed, 257 insertions(+), 64 deletions(-) diff --git a/baseconnection.pas b/baseconnection.pas index eab657f..d3c05f5 100644 --- a/baseconnection.pas +++ b/baseconnection.pas @@ -120,6 +120,9 @@ var cc: TCommandClass; cmd: TCommand; begin + Errors := nil; + ID := ''; + retCode := 0; log(mtDebug,self,'AddCommand '+ACommandClass+ ' '+ACommandName); fCommandReceived:=Now(); cc := TCommandCollection.Find(ACommandClass,ACommandName); diff --git a/cgireport.pas b/cgireport.pas index d434908..14cf0c5 100644 --- a/cgireport.pas +++ b/cgireport.pas @@ -259,6 +259,7 @@ var i: integer; begin result := false; + Errors := nil; ids := ''; for i := 0 to Arguments.Keys.Count-1 do if ids='' then @@ -422,7 +423,7 @@ begin finally free; end; - ParseCommand(-1,0,ReportName,l,[],nil,e); + ParseCommand(0,0,ReportName,l,[],nil,e); finally l.free; end; diff --git a/commandcol.pas b/commandcol.pas index 87ea0e9..2d8875d 100644 --- a/commandcol.pas +++ b/commandcol.pas @@ -179,6 +179,7 @@ function TCommand.ParseCommand(ACode: DWORD; iParam: QWORD; ACommand: string; Args: TStrings; intArgs: TParamArray; CmdData: TStream; out Errors: TStrings ): boolean; begin + Errors := nil; self.fData := TCommandData.Create(ACode,iParam,ACommand,Args,intArgs,cmdData); result := ParseArguments(fData.Keys,Errors); end; diff --git a/lms_cgi.lpi b/lms_cgi.lpi index 35e9fec..e9f9bc8 100644 --- a/lms_cgi.lpi +++ b/lms_cgi.lpi @@ -16,6 +16,68 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -69,11 +131,6 @@ - - - - - diff --git a/lms_cgi.lpr b/lms_cgi.lpr index a4044dc..c119517 100644 --- a/lms_cgi.lpr +++ b/lms_cgi.lpr @@ -75,34 +75,37 @@ var k,v: string; allfields: TStrings; begin - log(mtInfo,self,'Command '+ARequest.Command); - log(mtInfo,self,'RemoteAddr '+ARequest.RemoteAddr); - log(mtInfo,self,'RemoteAddress '+ARequest.RemoteAddress); - log(mtInfo,self,'CommandLine '+ARequest.CommandLine); - log(mtInfo,self,'ContentRange '+ARequest.ContentRange); - log(mtInfo,self,'HeaderLine '+ARequest.HeaderLine); - log(mtInfo,self,'QueryString '+ARequest.QueryString); - log(mtInfo,self,'Authorization '+ARequest.Authorization); - log(mtInfo,self,'Connection '+ARequest.Connection); - log(mtInfo,self,'WWWAuthenticate '+ARequest.WWWAuthenticate); - log(mtInfo,self,'Content '+ARequest.Content); - log(mtInfo,self,'ContentType '+ARequest.ContentType); - log(mtInfo,self,'From '+ARequest.From); - log(mtInfo,self,'UserAgent '+ARequest.UserAgent); - log(mtInfo,self,'URI '+ARequest.URI); - log(mtInfo,self,'URL '+ARequest.URL); - log(mtInfo,self,'ContentEncoding '+ARequest.ContentEncoding); - log(mtInfo,self,'ContentLanguage '+ARequest.ContentLanguage); - log(mtInfo,self,'Query '+ARequest.Query); - log(mtInfo,self,'Location '+ARequest.Location); - log(mtInfo,self,'Method '+ARequest.Method); - log(mtInfo,self,'PathInfo '+ARequest.PathInfo); - log(mtInfo,self,'Referer '+ARequest.Referer); + + {$IFDEF DEBUG} +log(mtDebug,self,'Command '+ARequest.Command); + log(mtDebug,self,'RemoteAddr '+ARequest.RemoteAddr); + log(mtDebug,self,'RemoteAddress '+ARequest.RemoteAddress); + log(mtDebug,self,'CommandLine '+ARequest.CommandLine); + log(mtDebug,self,'ContentRange '+ARequest.ContentRange); + log(mtDebug,self,'HeaderLine '+ARequest.HeaderLine); + log(mtDebug,self,'QueryString '+ARequest.QueryString); + log(mtDebug,self,'Authorization '+ARequest.Authorization); + log(mtDebug,self,'Connection '+ARequest.Connection); + log(mtDebug,self,'WWWAuthenticate '+ARequest.WWWAuthenticate); + log(mtDebug,self,'Content '+ARequest.Content); + log(mtDebug,self,'ContentType '+ARequest.ContentType); + log(mtDebug,self,'From '+ARequest.From); + log(mtDebug,self,'UserAgent '+ARequest.UserAgent); + log(mtDebug,self,'URI '+ARequest.URI); + log(mtDebug,self,'URL '+ARequest.URL); + log(mtDebug,self,'ContentEncoding '+ARequest.ContentEncoding); + log(mtDebug,self,'ContentLanguage '+ARequest.ContentLanguage); + log(mtDebug,self,'Query '+ARequest.Query); + log(mtDebug,self,'Location '+ARequest.Location); + log(mtDebug,self,'Method '+ARequest.Method); + log(mtDebug,self,'PathInfo '+ARequest.PathInfo); + log(mtDebug,self,'Referer '+ARequest.Referer); LogStrings(mtInfo, @log,self,'QueryFields',Arequest.QueryFields); LogStrings(mtInfo, @log,self,'ContentFields',Arequest.ContentFields); LogStrings(mtInfo, @log,self,'CookieFields',Arequest.CookieFields); LogStrings(mtInfo, @log,self,'CustomHeaders',Arequest.CustomHeaders); +{$ENDIF} allfields := TStringList.Create; try @@ -115,7 +118,15 @@ begin finally allfields.free; end; - log(mtDebug,self,'Data READY'); + {$IFDEF DEBUG} +log(mtDebug,self,'Data READY'); + log(mtDebug,self,'Mode '+ inttostr(fMode)); + log(mtDebug,self,'Code '+ inttostr(fCode)); + log(mtDebug,self,'Answer '+fAnswer); + log(mtDebug,self,'Param '+ inttostr(fParam)); + if assigned(fValues) then + LogStrings(mtDebug,@log,self,'VALUES',fValues); +{$ENDIF} if not assigned(fData) then begin AResponse.ContentType := 'application/json'; diff --git a/lms_cgi_server.lpi b/lms_cgi_server.lpi index f8c6428..0e5996f 100644 --- a/lms_cgi_server.lpi +++ b/lms_cgi_server.lpi @@ -19,6 +19,32 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/lmsreport.lpi b/lmsreport.lpi index 96faebe..c27db85 100644 --- a/lmsreport.lpi +++ b/lmsreport.lpi @@ -16,6 +16,78 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/maintcpserver.lfm b/maintcpserver.lfm index 07ce76c..49e8ef9 100644 --- a/maintcpserver.lfm +++ b/maintcpserver.lfm @@ -8,7 +8,7 @@ object CGIServerGUI: TCGIServerGUI ClientWidth = 870 OnCreate = FormCreate OnDestroy = FormDestroy - LCLVersion = '2.2.4.0' + LCLVersion = '2.2.0.4' object Panel1: TPanel Left = 0 Height = 50 @@ -45,14 +45,14 @@ object CGIServerGUI: TCGIServerGUI Width = 368 Align = alLeft Caption = 'Запрос' - ClientHeight = 226 - ClientWidth = 364 + ClientHeight = 227 + ClientWidth = 366 TabOrder = 1 object Keys: TMemo Left = 0 - Height = 203 - Top = 23 - Width = 364 + Height = 197 + Top = 30 + Width = 366 Align = alClient Lines.Strings = ( 'user=nnz' @@ -62,11 +62,11 @@ object CGIServerGUI: TCGIServerGUI end object edtRequest: TComboBox Left = 0 - Height = 23 + Height = 30 Top = 0 - Width = 364 + Width = 366 Align = alTop - ItemHeight = 15 + ItemHeight = 0 ItemIndex = 3 Items.Strings = ( 'version' @@ -91,41 +91,42 @@ object CGIServerGUI: TCGIServerGUI Width = 497 Align = alClient Caption = 'Ответ' - ClientHeight = 226 - ClientWidth = 493 + ClientHeight = 227 + ClientWidth = 495 TabOrder = 2 object edtAnswer: TEdit Left = 0 - Height = 23 + Height = 30 Top = 25 - Width = 493 + Width = 495 Align = alTop OnDblClick = edtAnswerDblClick TabOrder = 0 end object retValues: TMemo Left = 0 - Height = 105 - Top = 71 - Width = 493 + Height = 92 + Top = 85 + Width = 495 Align = alClient TabOrder = 1 end object intValues: TListBox Left = 0 Height = 50 - Top = 176 - Width = 493 + Top = 177 + Width = 495 Align = alBottom Columns = 4 ItemHeight = 0 TabOrder = 2 + TopIndex = -1 end object edtQValue: TEdit Left = 0 - Height = 23 - Top = 48 - Width = 493 + Height = 30 + Top = 55 + Width = 495 Align = alTop TabOrder = 3 end @@ -133,7 +134,7 @@ object CGIServerGUI: TCGIServerGUI Left = 0 Height = 25 Top = 0 - Width = 493 + Width = 495 Align = alTop TabOrder = 4 end @@ -151,17 +152,17 @@ object CGIServerGUI: TCGIServerGUI Width = 870 Align = alBottom Caption = 'Шаблоны' - ClientHeight = 250 - ClientWidth = 866 + ClientHeight = 251 + ClientWidth = 868 TabOrder = 4 object ReportsPanel: TPanel Left = 0 Height = 50 - Top = 200 - Width = 866 + Top = 201 + Width = 868 Align = alBottom ClientHeight = 50 - ClientWidth = 866 + ClientWidth = 868 TabOrder = 0 object EditTemplate: TButton Left = 760 @@ -175,12 +176,13 @@ object CGIServerGUI: TCGIServerGUI end object ReportsList: TListBox Left = 0 - Height = 200 + Height = 201 Top = 0 - Width = 866 + Width = 868 Align = alClient ItemHeight = 0 TabOrder = 1 + TopIndex = -1 end end end diff --git a/reportdmunit.pas b/reportdmunit.pas index d812a9d..1cbb2d7 100644 --- a/reportdmunit.pas +++ b/reportdmunit.pas @@ -358,7 +358,8 @@ begin try Report := Sender as TfrxReport; Report.PreviewForm.BringToFront; - except + except on e: Exception do + NidbData.log(mtError,self,e.message); end; end; diff --git a/tcpclient.pas b/tcpclient.pas index 47cb239..2e63143 100644 --- a/tcpclient.pas +++ b/tcpclient.pas @@ -92,7 +92,7 @@ end; procedure TClientMainThread.ProcessConnect(thread: TConnectionThread); begin - thread.SendMessage(cmdRequest,0,0,self.Command,self.fFields); + thread.SendMessage(cmdRequest,1,0,self.Command,self.fFields); end; procedure TClientMainThread.ProcessAnswer(const mode: byte; const Code: DWORD; diff --git a/tcpserver.pas b/tcpserver.pas index 05f8ce0..fc6ab57 100644 --- a/tcpserver.pas +++ b/tcpserver.pas @@ -41,6 +41,9 @@ function TServerMainThread.processReceive(const CommandID: DWORD; iValues: TParamArray; out ByteData: TStream): boolean; begin log(mtDebug,self,'ProcessReceive '+ACommand); + rValues := nil; + setLength(iValues,0); + ByteData := nil; if assigned(fOnReceive) then result := fOnReceive(self,CommandID,Param,ACommand,Fields,IParams,Data,Code,RetValue,Answer,rValues,iValues,ByteData) else @@ -50,9 +53,7 @@ begin Code := ErrorProcessor; RetValue := 0; Answer := 'Server error'; - rValues := nil; - setLength(iValues,0); - ByteData := nil; + end; end; @@ -112,6 +113,9 @@ var ok: boolean; begin log(mtDebug, format('ProcessMessage(%d) Param=%x, Command %s ',[code,Param,ACommand])); + Vals := nil; + B := nil; + setlength(iVals,0); try ok := (Owner as TServerMainThread).ProcessReceive(Code,Param,ACommand,Values,IntData,Data,res,rVal,s,Vals,iVals,B); try diff --git a/tcpthreadhelper.pas b/tcpthreadhelper.pas index 8cbe5b3..a632e22 100644 --- a/tcpthreadhelper.pas +++ b/tcpthreadhelper.pas @@ -160,6 +160,7 @@ begin except on e: Exception do begin log(mtError,self, '!!ERROR Destroy ' + e.Message); + raise; end; end; end; @@ -837,6 +838,7 @@ begin except on e:Exception do begin + log(mtError,'TConnectionThread.SendData '+e.message); raise; end; end; @@ -858,6 +860,7 @@ begin except on e:Exception do begin + log(mtError,'TConnectionThread.SendData '+e.message); raise; end; end; @@ -891,6 +894,7 @@ begin except on e:Exception do begin + log(mtError,'TConnectionThread.SendData '+e.message); raise; end; end; @@ -925,6 +929,9 @@ var b,b1: byte; begin result := false; + setlength(intData,0); + Keys := nil; + Data := nil; if Terminated then exit; try log(mtExtra,'ReceiveMessage'); @@ -1060,8 +1067,16 @@ begin Data := nil; try if ReceiveMessage(mode,Sender,num,CommandID,Param,Value,intData,Keys,Data) then + try ProcessMessage(mode,CommandID,Param,Value,Keys,intData,Data); + except on e: Exception do + begin + log(mtError,'TConnectionThread.Execute'+e.message); + terminate; + end; + end; + finally if assigned(Keys) then Keys.Free; if assigned(Data) then Data.Free;