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;
cmd: TCommand;
begin
Errors := nil;
ID := '';
retCode := 0;
log(mtDebug,self,'AddCommand '+ACommandClass+ ' '+ACommandName);
fCommandReceived:=Now();
cc := TCommandCollection.Find(ACommandClass,ACommandName);

3
cgireport.pas
View File

@ -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;

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
): boolean;
begin
Errors := nil;
self.fData := TCommandData.Create(ACode,iParam,ACommand,Args,intArgs,cmdData);
result := ParseArguments(fData.Keys,Errors);
end;

67
lms_cgi.lpi
View File

@ -16,6 +16,68 @@
</General>
<BuildModes>
<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>
<PublishOptions>
<Version Value="2"/>
@ -69,11 +131,6 @@
<CustomOptions Value="-dDEBUG
-dLOG
-dCGI"/>
<OtherDefines Count="3">
<Define0 Value="DEBUG"/>
<Define1 Value="LOG"/>
<Define2 Value="CGI"/>
</OtherDefines>
</Other>
</CompilerOptions>
<Debugging>

59
lms_cgi.lpr
View File

@ -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';

26
lms_cgi_server.lpi
View File

@ -19,6 +19,32 @@
</MacroValues>
<BuildModes>
<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">
<Item1 ID="700255898348" Modes="Default" Type="IDEMacro" MacroName="LCLWidgetType" Value="nogui"/>
</SharedMatrixOptions>

72
lmsreport.lpi
View File

@ -16,6 +16,78 @@
</General>
<BuildModes>
<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>
<PublishOptions>
<Version Value="2"/>

60
maintcpserver.lfm
View File

@ -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

3
reportdmunit.pas
View File

@ -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;

2
tcpclient.pas
View File

@ -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;

10
tcpserver.pas
View File

@ -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

15
tcpthreadhelper.pas
View File

@ -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;