alexey.zablotskiy/LMS-2_ReportAPI
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

out param fix

Browse Source
This commit is contained in:
Алексей Заблоцкий 2023-11-15 16:09:09 +03:00
parent c7a88f0d6c
commit b9d169d5dc
12 changed files with 257 additions and 64 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
baseconnection.pas
View File

@ -120,6 +120,9 @@ var
cc: TCommandClass; cc: TCommandClass;
cmd: TCommand; cmd: TCommand;
begin begin
Errors := nil;
ID := '';
retCode := 0;
log(mtDebug,self,'AddCommand '+ACommandClass+ ' '+ACommandName); log(mtDebug,self,'AddCommand '+ACommandClass+ ' '+ACommandName);
fCommandReceived:=Now(); fCommandReceived:=Now();
cc := TCommandCollection.Find(ACommandClass,ACommandName); cc := TCommandCollection.Find(ACommandClass,ACommandName);

3
cgireport.pas
View File

@ -259,6 +259,7 @@ var
i: integer; i: integer;
begin begin
result := false; result := false;
Errors := nil;
ids := ''; ids := '';
for i := 0 to Arguments.Keys.Count-1 do for i := 0 to Arguments.Keys.Count-1 do
if ids='' then if ids='' then
@ -422,7 +423,7 @@ begin
finally finally
free; free;
end; end;
ParseCommand(-1,0,ReportName,l,[],nil,e); ParseCommand(0,0,ReportName,l,[],nil,e);
finally finally
l.free; l.free;
end; end;

1
commandcol.pas
View File

@ -179,6 +179,7 @@ function TCommand.ParseCommand(ACode: DWORD; iParam: QWORD; ACommand: string;
Args: TStrings; intArgs: TParamArray; CmdData: TStream; out Errors: TStrings Args: TStrings; intArgs: TParamArray; CmdData: TStream; out Errors: TStrings
): boolean; ): boolean;
begin begin
Errors := nil;
self.fData := TCommandData.Create(ACode,iParam,ACommand,Args,intArgs,cmdData); self.fData := TCommandData.Create(ACode,iParam,ACommand,Args,intArgs,cmdData);
result := ParseArguments(fData.Keys,Errors); result := ParseArguments(fData.Keys,Errors);
end; end;

67
lms_cgi.lpi
View File

@ -16,6 +16,68 @@
</General> </General>
<BuildModes> <BuildModes>
<Item Name="Default" Default="True"/> <Item Name="Default" Default="True"/>
<Item Name="Debug">
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<IncludeAssertionCode Value="True"/>
</SyntaxOptions>
</Parsing>
<CodeGeneration>
<Checks>
<IOChecks Value="True"/>
<RangeChecks Value="True"/>
<OverflowChecks Value="True"/>
<StackChecks Value="True"/>
</Checks>
<VerifyObjMethodCallValidity Value="True"/>
</CodeGeneration>
<Linking>
<Debugging>
<DebugInfoType Value="dsDwarf3"/>
<UseHeaptrc Value="True"/>
<TrashVariables Value="True"/>
<UseExternalDbgSyms Value="True"/>
</Debugging>
</Linking>
<Other>
<CustomOptions Value="-dDEBUG
-dLOG
-dCGI"/>
</Other>
</CompilerOptions>
</Item>
<Item Name="Release">
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
</SearchPaths>
<CodeGeneration>
<SmartLinkUnit Value="True"/>
<Optimizations>
<OptimizationLevel Value="3"/>
</Optimizations>
</CodeGeneration>
<Linking>
<Debugging>
<GenerateDebugInfo Value="False"/>
</Debugging>
<LinkSmart Value="True"/>
</Linking>
<Other>
<CustomOptions Value="-dDEBUG
-dLOG
-dCGI"/>
</Other>
</CompilerOptions>
</Item>
</BuildModes> </BuildModes>
<PublishOptions> <PublishOptions>
<Version Value="2"/> <Version Value="2"/>
@ -69,11 +131,6 @@
<CustomOptions Value="-dDEBUG <CustomOptions Value="-dDEBUG
-dLOG -dLOG
-dCGI"/> -dCGI"/>
<OtherDefines Count="3">
<Define0 Value="DEBUG"/>
<Define1 Value="LOG"/>
<Define2 Value="CGI"/>
</OtherDefines>
</Other> </Other>
</CompilerOptions> </CompilerOptions>
<Debugging> <Debugging>

57
lms_cgi.lpr
View File

@ -75,34 +75,37 @@ var
k,v: string; k,v: string;
allfields: TStrings; allfields: TStrings;
begin begin
log(mtInfo,self,'Command '+ARequest.Command);
log(mtInfo,self,'RemoteAddr '+ARequest.RemoteAddr); {$IFDEF DEBUG}
log(mtInfo,self,'RemoteAddress '+ARequest.RemoteAddress); log(mtDebug,self,'Command '+ARequest.Command);
log(mtInfo,self,'CommandLine '+ARequest.CommandLine); log(mtDebug,self,'RemoteAddr '+ARequest.RemoteAddr);
log(mtInfo,self,'ContentRange '+ARequest.ContentRange); log(mtDebug,self,'RemoteAddress '+ARequest.RemoteAddress);
log(mtInfo,self,'HeaderLine '+ARequest.HeaderLine); log(mtDebug,self,'CommandLine '+ARequest.CommandLine);
log(mtInfo,self,'QueryString '+ARequest.QueryString); log(mtDebug,self,'ContentRange '+ARequest.ContentRange);
log(mtInfo,self,'Authorization '+ARequest.Authorization); log(mtDebug,self,'HeaderLine '+ARequest.HeaderLine);
log(mtInfo,self,'Connection '+ARequest.Connection); log(mtDebug,self,'QueryString '+ARequest.QueryString);
log(mtInfo,self,'WWWAuthenticate '+ARequest.WWWAuthenticate); log(mtDebug,self,'Authorization '+ARequest.Authorization);
log(mtInfo,self,'Content '+ARequest.Content); log(mtDebug,self,'Connection '+ARequest.Connection);
log(mtInfo,self,'ContentType '+ARequest.ContentType); log(mtDebug,self,'WWWAuthenticate '+ARequest.WWWAuthenticate);
log(mtInfo,self,'From '+ARequest.From); log(mtDebug,self,'Content '+ARequest.Content);
log(mtInfo,self,'UserAgent '+ARequest.UserAgent); log(mtDebug,self,'ContentType '+ARequest.ContentType);
log(mtInfo,self,'URI '+ARequest.URI); log(mtDebug,self,'From '+ARequest.From);
log(mtInfo,self,'URL '+ARequest.URL); log(mtDebug,self,'UserAgent '+ARequest.UserAgent);
log(mtInfo,self,'ContentEncoding '+ARequest.ContentEncoding); log(mtDebug,self,'URI '+ARequest.URI);
log(mtInfo,self,'ContentLanguage '+ARequest.ContentLanguage); log(mtDebug,self,'URL '+ARequest.URL);
log(mtInfo,self,'Query '+ARequest.Query); log(mtDebug,self,'ContentEncoding '+ARequest.ContentEncoding);
log(mtInfo,self,'Location '+ARequest.Location); log(mtDebug,self,'ContentLanguage '+ARequest.ContentLanguage);
log(mtInfo,self,'Method '+ARequest.Method); log(mtDebug,self,'Query '+ARequest.Query);
log(mtInfo,self,'PathInfo '+ARequest.PathInfo); log(mtDebug,self,'Location '+ARequest.Location);
log(mtInfo,self,'Referer '+ARequest.Referer); 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,'QueryFields',Arequest.QueryFields);
LogStrings(mtInfo, @log,self,'ContentFields',Arequest.ContentFields); LogStrings(mtInfo, @log,self,'ContentFields',Arequest.ContentFields);
LogStrings(mtInfo, @log,self,'CookieFields',Arequest.CookieFields); LogStrings(mtInfo, @log,self,'CookieFields',Arequest.CookieFields);
LogStrings(mtInfo, @log,self,'CustomHeaders',Arequest.CustomHeaders); LogStrings(mtInfo, @log,self,'CustomHeaders',Arequest.CustomHeaders);
{$ENDIF}
allfields := TStringList.Create; allfields := TStringList.Create;
try try
@ -115,7 +118,15 @@ begin
finally finally
allfields.free; allfields.free;
end; end;
{$IFDEF DEBUG}
log(mtDebug,self,'Data READY'); 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 if not assigned(fData) then
begin begin
AResponse.ContentType := 'application/json'; AResponse.ContentType := 'application/json';

26
lms_cgi_server.lpi
View File

@ -19,6 +19,32 @@
</MacroValues> </MacroValues>
<BuildModes> <BuildModes>
<Item Name="Default" Default="True"/> <Item Name="Default" Default="True"/>
<Item Name="Release">
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="lms_cgi_server"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<OtherUnitFiles Value="reports"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<CodeGeneration>
<SmartLinkUnit Value="True"/>
<Optimizations>
<OptimizationLevel Value="3"/>
</Optimizations>
</CodeGeneration>
<Linking>
<Debugging>
<GenerateDebugInfo Value="False"/>
</Debugging>
<LinkSmart Value="True"/>
</Linking>
</CompilerOptions>
</Item>
<SharedMatrixOptions Count="1"> <SharedMatrixOptions Count="1">
<Item1 ID="700255898348" Modes="Default" Type="IDEMacro" MacroName="LCLWidgetType" Value="nogui"/> <Item1 ID="700255898348" Modes="Default" Type="IDEMacro" MacroName="LCLWidgetType" Value="nogui"/>
</SharedMatrixOptions> </SharedMatrixOptions>

72
lmsreport.lpi
View File

@ -16,6 +16,78 @@
</General> </General>
<BuildModes> <BuildModes>
<Item Name="Default" Default="True"/> <Item Name="Default" Default="True"/>
<Item Name="Debug">
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="lmsreport"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<OtherUnitFiles Value="reports"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<IncludeAssertionCode Value="True"/>
</SyntaxOptions>
</Parsing>
<CodeGeneration>
<Checks>
<IOChecks Value="True"/>
<RangeChecks Value="True"/>
<OverflowChecks Value="True"/>
<StackChecks Value="True"/>
</Checks>
<VerifyObjMethodCallValidity Value="True"/>
</CodeGeneration>
<Linking>
<Debugging>
<DebugInfoType Value="dsDwarf3"/>
<UseHeaptrc Value="True"/>
<TrashVariables Value="True"/>
<UseExternalDbgSyms Value="True"/>
</Debugging>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
</CompilerOptions>
</Item>
<Item Name="Release">
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="lmsreport"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<OtherUnitFiles Value="reports"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<CodeGeneration>
<SmartLinkUnit Value="True"/>
<Optimizations>
<OptimizationLevel Value="3"/>
</Optimizations>
</CodeGeneration>
<Linking>
<Debugging>
<GenerateDebugInfo Value="False"/>
</Debugging>
<LinkSmart Value="True"/>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
</CompilerOptions>
</Item>
</BuildModes> </BuildModes>
<PublishOptions> <PublishOptions>
<Version Value="2"/> <Version Value="2"/>

60
maintcpserver.lfm
View File

@ -8,7 +8,7 @@ object CGIServerGUI: TCGIServerGUI
ClientWidth = 870 ClientWidth = 870
OnCreate = FormCreate OnCreate = FormCreate
OnDestroy = FormDestroy OnDestroy = FormDestroy
LCLVersion = '2.2.4.0' LCLVersion = '2.2.0.4'
object Panel1: TPanel object Panel1: TPanel
Left = 0 Left = 0
Height = 50 Height = 50
@ -45,14 +45,14 @@ object CGIServerGUI: TCGIServerGUI
Width = 368 Width = 368
Align = alLeft Align = alLeft
Caption = 'Запрос' Caption = 'Запрос'
ClientHeight = 226 ClientHeight = 227
ClientWidth = 364 ClientWidth = 366
TabOrder = 1 TabOrder = 1
object Keys: TMemo object Keys: TMemo
Left = 0 Left = 0
Height = 203 Height = 197
Top = 23 Top = 30
Width = 364 Width = 366
Align = alClient Align = alClient
Lines.Strings = ( Lines.Strings = (
'user=nnz' 'user=nnz'
@ -62,11 +62,11 @@ object CGIServerGUI: TCGIServerGUI
end end
object edtRequest: TComboBox object edtRequest: TComboBox
Left = 0 Left = 0
Height = 23 Height = 30
Top = 0 Top = 0
Width = 364 Width = 366
Align = alTop Align = alTop
ItemHeight = 15 ItemHeight = 0
ItemIndex = 3 ItemIndex = 3
Items.Strings = ( Items.Strings = (
'version' 'version'
@ -91,41 +91,42 @@ object CGIServerGUI: TCGIServerGUI
Width = 497 Width = 497
Align = alClient Align = alClient
Caption = 'Ответ' Caption = 'Ответ'
ClientHeight = 226 ClientHeight = 227
ClientWidth = 493 ClientWidth = 495
TabOrder = 2 TabOrder = 2
object edtAnswer: TEdit object edtAnswer: TEdit
Left = 0 Left = 0
Height = 23 Height = 30
Top = 25 Top = 25
Width = 493 Width = 495
Align = alTop Align = alTop
OnDblClick = edtAnswerDblClick OnDblClick = edtAnswerDblClick
TabOrder = 0 TabOrder = 0
end end
object retValues: TMemo object retValues: TMemo
Left = 0 Left = 0
Height = 105 Height = 92
Top = 71 Top = 85
Width = 493 Width = 495
Align = alClient Align = alClient
TabOrder = 1 TabOrder = 1
end end
object intValues: TListBox object intValues: TListBox
Left = 0 Left = 0
Height = 50 Height = 50
Top = 176 Top = 177
Width = 493 Width = 495
Align = alBottom Align = alBottom
Columns = 4 Columns = 4
ItemHeight = 0 ItemHeight = 0
TabOrder = 2 TabOrder = 2
TopIndex = -1
end end
object edtQValue: TEdit object edtQValue: TEdit
Left = 0 Left = 0
Height = 23 Height = 30
Top = 48 Top = 55
Width = 493 Width = 495
Align = alTop Align = alTop
TabOrder = 3 TabOrder = 3
end end
@ -133,7 +134,7 @@ object CGIServerGUI: TCGIServerGUI
Left = 0 Left = 0
Height = 25 Height = 25
Top = 0 Top = 0
Width = 493 Width = 495
Align = alTop Align = alTop
TabOrder = 4 TabOrder = 4
end end
@ -151,17 +152,17 @@ object CGIServerGUI: TCGIServerGUI
Width = 870 Width = 870
Align = alBottom Align = alBottom
Caption = 'Шаблоны' Caption = 'Шаблоны'
ClientHeight = 250 ClientHeight = 251
ClientWidth = 866 ClientWidth = 868
TabOrder = 4 TabOrder = 4
object ReportsPanel: TPanel object ReportsPanel: TPanel
Left = 0 Left = 0
Height = 50 Height = 50
Top = 200 Top = 201
Width = 866 Width = 868
Align = alBottom Align = alBottom
ClientHeight = 50 ClientHeight = 50
ClientWidth = 866 ClientWidth = 868
TabOrder = 0 TabOrder = 0
object EditTemplate: TButton object EditTemplate: TButton
Left = 760 Left = 760
@ -175,12 +176,13 @@ object CGIServerGUI: TCGIServerGUI
end end
object ReportsList: TListBox object ReportsList: TListBox
Left = 0 Left = 0
Height = 200 Height = 201
Top = 0 Top = 0
Width = 866 Width = 868
Align = alClient Align = alClient
ItemHeight = 0 ItemHeight = 0
TabOrder = 1 TabOrder = 1
TopIndex = -1
end end
end end
end end

3
reportdmunit.pas
View File

@ -358,7 +358,8 @@ begin
try try
Report := Sender as TfrxReport; Report := Sender as TfrxReport;
Report.PreviewForm.BringToFront; Report.PreviewForm.BringToFront;
except except on e: Exception do
NidbData.log(mtError,self,e.message);
end; end;
end; end;

2
tcpclient.pas
View File

@ -92,7 +92,7 @@ end;
procedure TClientMainThread.ProcessConnect(thread: TConnectionThread); procedure TClientMainThread.ProcessConnect(thread: TConnectionThread);
begin begin
thread.SendMessage(cmdRequest,0,0,self.Command,self.fFields); thread.SendMessage(cmdRequest,1,0,self.Command,self.fFields);
end; end;
procedure TClientMainThread.ProcessAnswer(const mode: byte; const Code: DWORD; procedure TClientMainThread.ProcessAnswer(const mode: byte; const Code: DWORD;

10
tcpserver.pas
View File

@ -41,6 +41,9 @@ function TServerMainThread.processReceive(const CommandID: DWORD;
iValues: TParamArray; out ByteData: TStream): boolean; iValues: TParamArray; out ByteData: TStream): boolean;
begin begin
log(mtDebug,self,'ProcessReceive '+ACommand); log(mtDebug,self,'ProcessReceive '+ACommand);
rValues := nil;
setLength(iValues,0);
ByteData := nil;
if assigned(fOnReceive) then if assigned(fOnReceive) then
result := fOnReceive(self,CommandID,Param,ACommand,Fields,IParams,Data,Code,RetValue,Answer,rValues,iValues,ByteData) result := fOnReceive(self,CommandID,Param,ACommand,Fields,IParams,Data,Code,RetValue,Answer,rValues,iValues,ByteData)
else else
@ -50,9 +53,7 @@ begin
Code := ErrorProcessor; Code := ErrorProcessor;
RetValue := 0; RetValue := 0;
Answer := 'Server error'; Answer := 'Server error';
rValues := nil;
setLength(iValues,0);
ByteData := nil;
end; end;
end; end;
@ -112,6 +113,9 @@ var
ok: boolean; ok: boolean;
begin begin
log(mtDebug, format('ProcessMessage(%d) Param=%x, Command %s ',[code,Param,ACommand])); log(mtDebug, format('ProcessMessage(%d) Param=%x, Command %s ',[code,Param,ACommand]));
Vals := nil;
B := nil;
setlength(iVals,0);
try try
ok := (Owner as TServerMainThread).ProcessReceive(Code,Param,ACommand,Values,IntData,Data,res,rVal,s,Vals,iVals,B); ok := (Owner as TServerMainThread).ProcessReceive(Code,Param,ACommand,Values,IntData,Data,res,rVal,s,Vals,iVals,B);
try try

15
tcpthreadhelper.pas
View File

@ -160,6 +160,7 @@ begin
except on e: Exception do except on e: Exception do
begin begin
log(mtError,self, '!!ERROR Destroy ' + e.Message); log(mtError,self, '!!ERROR Destroy ' + e.Message);
raise;
end; end;
end; end;
end; end;
@ -837,6 +838,7 @@ begin
except on e:Exception do except on e:Exception do
begin begin
log(mtError,'TConnectionThread.SendData '+e.message);
raise; raise;
end; end;
end; end;
@ -858,6 +860,7 @@ begin
except on e:Exception do except on e:Exception do
begin begin
log(mtError,'TConnectionThread.SendData '+e.message);
raise; raise;
end; end;
end; end;
@ -891,6 +894,7 @@ begin
except on e:Exception do except on e:Exception do
begin begin
log(mtError,'TConnectionThread.SendData '+e.message);
raise; raise;
end; end;
end; end;
@ -925,6 +929,9 @@ var
b,b1: byte; b,b1: byte;
begin begin
result := false; result := false;
setlength(intData,0);
Keys := nil;
Data := nil;
if Terminated then exit; if Terminated then exit;
try try
log(mtExtra,'ReceiveMessage'); log(mtExtra,'ReceiveMessage');
@ -1060,8 +1067,16 @@ begin
Data := nil; Data := nil;
try try
if ReceiveMessage(mode,Sender,num,CommandID,Param,Value,intData,Keys,Data) then if ReceiveMessage(mode,Sender,num,CommandID,Param,Value,intData,Keys,Data) then
try
ProcessMessage(mode,CommandID,Param,Value,Keys,intData,Data); ProcessMessage(mode,CommandID,Param,Value,Keys,intData,Data);
except on e: Exception do
begin
log(mtError,'TConnectionThread.Execute'+e.message);
terminate;
end;
end;
finally finally
if assigned(Keys) then Keys.Free; if assigned(Keys) then Keys.Free;
if assigned(Data) then Data.Free; if assigned(Data) then Data.Free;