Delphi/delphimvcframework
1
0
Fork 0
mirror of https://github.com/danieleteti/delphimvcframework.git synced 2024-11-15 15:55:54 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity

Fixed a mleak in caso of disconnection while the request is running (https://github.com/danieleteti/delphimvcframework/issues/323)

Browse Source
This commit is contained in:
Daniele Teti 2020-01-24 10:09:14 +01:00
parent 9d7ff23c11
commit 3233ea123f
11 changed files with 72 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
samples/articles_crud_server/Controllers.Articles.pas
View File

@ -41,12 +41,12 @@ type
[MVCDoc('Creates a new article and returns "201: Created"')]
[MVCPath]
[MVCHTTPMethod([httpPOST])]
procedure CreateArticle(Context: TWebContext);
procedure CreateArticle;
[MVCDoc('Creates new articles from a list and returns "201: Created"')]
[MVCPath('/bulk')]
[MVCHTTPMethod([httpPOST])]
procedure CreateArticles(Context: TWebContext);
procedure CreateArticles;
end;
implementation
@ -58,22 +58,22 @@ uses
BusinessObjects,
Commons,
mvcframework.Serializer.Intf,
System.Generics.Collections;
System.Generics.Collections, System.SysUtils;
procedure TArticlesController.CreateArticle(Context: TWebContext);
procedure TArticlesController.CreateArticle;
var
Article: TArticle;
begin
Article := Context.Request.BodyAs<TArticle>;
try
GetArticlesService.Add(Article);
Render(201, 'Article Created');
ResponseCreated('/articles/' + Article.ID.ToString, 'Article Created');
finally
Article.Free;
end;
end;
procedure TArticlesController.CreateArticles(Context: TWebContext);
procedure TArticlesController.CreateArticles;
var
lArticles: TObjectList<TArticle>;
lArticle: TArticle;

15
samples/articles_crud_server/Controllers.Base.pas
View File

@ -18,6 +18,14 @@ type
end;
[MVCPath('/private')]
TPrivateController = class(TBaseController)
public
[MVCPath('/articles')]
[MVCHTTPMethods([httpDELETE])]
procedure DeleteAllArticles;
end;
implementation
uses
@ -46,4 +54,11 @@ begin
Result := FDM;
end;
{ TPrivateController }
procedure TPrivateController.DeleteAllArticles;
begin
GetArticlesService.DeleteAllArticles();
end;
end.

6
samples/articles_crud_server/Services.pas
View File

@ -27,6 +27,7 @@ type
function GetArticles(const aTextSearch: String): TObjectList<TArticle>;
function GetByID(const AID: Integer): TArticle;
procedure Delete(AArticolo: TArticle);
procedure DeleteAllArticles;
procedure Add(AArticolo: TArticle);
procedure Update(AArticolo: TArticle);
end;
@ -64,6 +65,11 @@ begin
Cmd.Execute;
end;
procedure TArticlesService.DeleteAllArticles;
begin
FDM.Connection.ExecSQL('delete from articoli');
end;
function TArticlesService.GetAll: TObjectList<TArticle>;
begin
FDM.dsArticles.Open('SELECT * FROM ARTICOLI ORDER BY ID', []);

6
samples/articles_crud_server/WebModuleUnit1.pas
View File

@ -20,7 +20,8 @@ implementation
{ %CLASSGROUP 'Vcl.Controls.TControl' }
uses Controllers.Articles, MVCFramework.Middleware.CORS, MVCFramework.Middleware.Compression;
uses Controllers.Articles, MVCFramework.Middleware.CORS, MVCFramework.Middleware.Compression,
Controllers.Base;
{$R *.dfm}
@ -28,6 +29,9 @@ procedure TWebModule1.WebModuleCreate(Sender: TObject);
begin
FEngine := TMVCEngine.Create(self);
FEngine.AddController(TArticlesController);
{$IFDEF TESTINSTANCE}
FEngine.AddController(TPrivateController);
{$ENDIF}
FEngine.AddMiddleware(TCORSMiddleware.Create);
FEngine.AddMiddleware(TMVCCompressionMiddleware.Create(256));

10
samples/articles_crud_server/articles_crud.dproj
View File

@ -68,7 +68,7 @@
<DCC_UsePackage>FireDACSqliteDriver;FireDACDSDriver;DBXSqliteDriver;FireDACPgDriver;fmx;IndySystem;TeeDB;tethering;vclib;DBXInterBaseDriver;DataSnapClient;DataSnapServer;DataSnapCommon;DataSnapProviderClient;DBXSybaseASEDriver;DbxCommonDriver;vclimg;dbxcds;DatasnapConnectorsFreePascal;MetropolisUILiveTile;vcldb;vcldsnap;fmxFireDAC;DBXDb2Driver;DBXOracleDriver;CustomIPTransport;vclribbon;dsnap;IndyIPServer;fmxase;vcl;IndyCore;DBXMSSQLDriver;IndyIPCommon;CloudService;FmxTeeUI;FireDACIBDriver;DataSnapFireDAC;FireDACDBXDriver;soapserver;inetdbxpress;dsnapxml;FireDACInfxDriver;FireDACDb2Driver;adortl;FireDACASADriver;bindcompfmx;FireDACODBCDriver;RESTBackendComponents;rtl;dbrtl;DbxClientDriver;FireDACCommon;bindcomp;inetdb;Tee;DBXOdbcDriver;vclFireDAC;xmlrtl;DataSnapNativeClient;ibxpress;IndyProtocols;DBXMySQLDriver;FireDACCommonDriver;bindcompdbx;bindengine;vclactnband;soaprtl;FMXTee;TeeUI;bindcompvcl;vclie;FireDACADSDriver;vcltouch;VclSmp;FireDACMSSQLDriver;FireDAC;DBXInformixDriver;Intraweb;VCLRESTComponents;DataSnapConnectors;DataSnapServerMidas;dsnapcon;DBXFirebirdDriver;inet;fmxobj;FireDACMySQLDriver;soapmidas;vclx;DBXSybaseASADriver;FireDACOracleDriver;fmxdae;RESTComponents;FireDACMSAccDriver;dbexpress;DataSnapIndy10ServerTransport;IndyIPClient;$(DCC_UsePackage)</DCC_UsePackage>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1)'!=''">
<DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
<DCC_Define>DEBUG;TESTINSTANCE;$(DCC_Define)</DCC_Define>
<DCC_DebugDCUs>true</DCC_DebugDCUs>
<DCC_Optimize>false</DCC_Optimize>
<DCC_GenerateStackFrames>true</DCC_GenerateStackFrames>
@ -153,10 +153,10 @@
<Source Name="MainSource">articles_crud.dpr</Source>
</Source>
<Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\bcboffice2k240.bpl">Embarcadero C++Builder Office 2000 Servers Package</Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\bcbofficexp240.bpl">Embarcadero C++Builder Office XP Servers Package</Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\dcloffice2k240.bpl">Microsoft Office 2000 Sample Automation Server Wrapper Components</Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\dclofficexp240.bpl">Microsoft Office XP Sample Automation Server Wrapper Components</Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\bcboffice2k260.bpl">Embarcadero C++Builder Office 2000 Servers Package</Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\bcbofficexp260.bpl">Embarcadero C++Builder Office XP Servers Package</Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\dcloffice2k260.bpl">Microsoft Office 2000 Sample Automation Server Wrapper Components</Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\dclofficexp260.bpl">Microsoft Office XP Sample Automation Server Wrapper Components</Excluded_Packages>
</Excluded_Packages>
</Delphi.Personality>
<Deployment Version="3">

8
samples/renders/RenderSampleControllerU.pas
View File

@ -41,6 +41,10 @@ type
protected
procedure OnBeforeAction(AContext: TWebContext; const AActionName: string; var AHandled: Boolean); override;
public
[MVCHTTPMethod([httpGET])]
[MVCPath('/customers/withcallback')]
procedure GetCustomersWithCallback;
[MVCHTTPMethod([httpGET])]
[MVCPath('/customers/($ID)')]
[MVCProduces('text/plain')]
@ -54,10 +58,6 @@ type
[MVCPath('/customers')]
procedure GetCustomersAsDataSetWithRefLinks;
[MVCHTTPMethod([httpGET])]
[MVCPath('/customers/withcallback')]
procedure GetCustomersWithCallback;
[MVCHTTPMethod([httpGET])]
[MVCPath('/customers/($ID)/asdataset')]
procedure GetCustomer_AsDataSetRecord(const ID: Integer);

BIN
samples/serversentevents2/bin/serversentevent.db
View File

Binary file not shown.

29
sources/MVCFramework.pas
View File

@ -1506,7 +1506,11 @@ destructor TMVCWebResponse.Destroy;
begin
if FFlushOnDestroy then
begin
try
Flush;
except
//do nothing
end;
end;
inherited Destroy;
end;
@ -1744,11 +1748,23 @@ end;
destructor TWebContext.Destroy;
begin
try
FResponse.Free;
except
end;
try
FRequest.Free;
except
end;
try
FData.Free;
except
end;
try
if Assigned(FLoggedUser) then
FLoggedUser.Free;
except
end;
inherited Destroy;
end;
@ -2093,20 +2109,23 @@ begin
LActionFormalParams := LRouter.MethodToCall.GetParameters;
if (Length(LActionFormalParams) = 0) then
SetLength(LActualParams, 0)
else
if (Length(LActionFormalParams) = 1) and
else if (Length(LActionFormalParams) = 1) and
(SameText(LActionFormalParams[0].ParamType.QualifiedName, 'MVCFramework.TWebContext')) then
begin
SetLength(LActualParams, 1);
LActualParams[0] := LContext;
end
else
begin
try
FillActualParamsForAction(LContext, LActionFormalParams, LRouter.MethodToCall.Name,
LActualParams);
Except
on e:Exception do
SendRawHTTPStatus(Lcontext, HTTP_STATUS.BadRequest, e.Message, e.ClassName);
except
on E: Exception do
begin
SendRawHTTPStatus(LContext, HTTP_STATUS.BadRequest, e.Message, e.ClassName);
end;
end;
end;
LSelectedController.OnBeforeAction(LContext, LRouter.MethodToCall.Name, LHandled);

2
sources/dmvcframeworkbuildconsts.inc
View File

@ -1,2 +1,2 @@
const
DMVCFRAMEWORK_VERSION = '3.2.0 (boron) RC3';
DMVCFRAMEWORK_VERSION = '3.2.0 (boron) RC4';

1
unittests/general/Several/DMVCFrameworkTests.dproj
View File

@ -192,7 +192,6 @@
<DCCReference Include="..\..\common\MVCFramework.Tests.Serializer.Entities.pas"/>
<DCCReference Include="..\..\common\MVCFramework.Tests.Serializer.EntitiesModule.pas">
<Form>EntitiesModule</Form>
<FormType>dfm</FormType>
<DesignClass>TDataModule</DesignClass>
</DCCReference>
<DCCReference Include="..\..\common\MVCFramework.Tests.Serializer.Intf.pas"/>

BIN
unittests/general/Several/Win32/GUI/sqlitetest.db
View File

Binary file not shown.