BUGFIXES

New sample: articles_crud

samples/articles_crud/BusinessObjects.pas

@@ -0,0 +1,92 @@
+unit BusinessObjects;
+
+interface
+
+uses
+  ObjectsMappers;
+
+type
+  TBaseBO = class
+  private
+    FID: Integer;
+    procedure SetID(const Value: Integer);
+  public
+    procedure CheckInsert; virtual;
+    procedure CheckUpdate; virtual;
+    procedure CheckDelete; virtual;
+  public
+    property ID: Integer read FID write SetID;
+  end;
+
+  [MapperJSONNaming(JSONNameLowerCase)]
+  TArticle = class(TBaseBO)
+  private
+    FPrice: Currency;
+    FCode: string;
+    FDescription: string;
+    procedure SetCode(const Value: string);
+    procedure SetDescription(const Value: string);
+    procedure SetPrice(const Value: Currency);
+  public
+    procedure CheckDelete; override;
+  public
+    [MapperColumn('CODICE')]
+    property Code: string read FCode write SetCode;
+    [MapperColumn('DESCRIZIONE')]
+    property Description: string read FDescription write SetDescription;
+    [MapperColumn('PREZZO')]
+    property Price: Currency read FPrice write SetPrice;
+  end;
+
+implementation
+
+uses
+  System.SysUtils;
+
+{ TBaseBO }
+
+procedure TBaseBO.CheckDelete;
+begin
+
+end;
+
+procedure TBaseBO.CheckInsert;
+begin
+
+end;
+
+procedure TBaseBO.CheckUpdate;
+begin
+
+end;
+
+procedure TBaseBO.SetID(const Value: Integer);
+begin
+  FID := Value;
+end;
+
+{ TArticolo }
+
+procedure TArticle.CheckDelete;
+begin
+  inherited;
+  if Price > 0 then
+    raise Exception.Create('Cannot delete an article with a price greater than 0 (yes, it is a silly check)');
+end;
+
+procedure TArticle.SetCode(const Value: string);
+begin
+  FCode := Value;
+end;
+
+procedure TArticle.SetDescription(const Value: string);
+begin
+  FDescription := Value;
+end;
+
+procedure TArticle.SetPrice(const Value: Currency);
+begin
+  FPrice := Value;
+end;
+
+end.

samples/articles_crud/Commons.pas

@@ -0,0 +1,15 @@
+unit Commons;
+
+interface
+
+uses
+  System.SysUtils;
+
+type
+  EServiceException = class(Exception)
+
+  end;
+
+implementation
+
+end.

samples/articles_crud/Controllers.Articles.pas

@@ -0,0 +1,86 @@
+unit Controllers.Articles;
+
+interface
+
+uses mvcframework, Controllers.Base;
+
+type
+
+  [MVCPath('/articles')]
+  TArticlesController = class(TBaseController)
+  public
+    [MVCPath]
+    [MVCHTTPMethod([httpGET])]
+    procedure GetArticles(context: TWebContext);
+    [MVCPath('/($id)')]
+    [MVCHTTPMethod([httpGET])]
+    procedure GetArticleByID(context: TWebContext);
+    [MVCPath('/($id)')]
+    [MVCHTTPMethod([httpDelete])]
+    procedure DeleteArticleByID(context: TWebContext);
+    [MVCPath]
+    [MVCHTTPMethod([httpPOST])]
+    procedure CreateArticle(context: TWebContext);
+  end;
+
+implementation
+
+{ TArticlesController }
+
+uses Services, BusinessObjects, Commons, mvcframework.Commons;
+
+procedure TArticlesController.CreateArticle(context: TWebContext);
+var
+  Article: TArticle;
+begin
+  Article := context.Request.BodyAs<TArticle>;
+  try
+    GetArticlesService.Add(Article);
+    Render(201, 'Article creato');
+  finally
+    Article.Free;
+  end;
+end;
+
+procedure TArticlesController.DeleteArticleByID(context: TWebContext);
+var
+  Article: TArticle;
+begin
+  GetArticlesService.StartTransaction;
+  try
+    Article := GetArticlesService.GetByID(context.Request.ParamsAsInteger['id']);
+    try
+      GetArticlesService.Delete(Article);
+    finally
+      Article.Free;
+    end;
+    GetArticlesService.Commit;
+  except
+    GetArticlesService.Rollback;
+    raise;
+  end;
+end;
+
+procedure TArticlesController.GetArticles(context: TWebContext);
+begin
+  Render<TArticle>(GetArticlesService.GetAll);
+end;
+
+procedure TArticlesController.GetArticleByID(context: TWebContext);
+var
+  Article: TArticle;
+begin
+  try
+    Article := GetArticlesService.GetByID(context.Request.ParamsAsInteger['id']);
+    Render(Article);
+  except
+    on E: EServiceException do
+    begin
+      raise EMVCException.Create(E.Message, '', 0, 404);
+    end
+    else
+      raise;
+  end;
+end;
+
+end.

samples/articles_crud/Controllers.Base.pas

@@ -0,0 +1,49 @@
+unit Controllers.Base;
+
+interface
+
+uses
+  MVCFramework, Services, MainDM;
+
+type
+  TBaseController = class abstract(TMVCController)
+  strict private
+    FDM: TdmMain;
+    FArticlesService: TArticlesService;
+    function GetDataModule: TdmMain;
+  strict protected
+    function GetArticlesService: TArticlesService;
+  public
+    destructor Destroy; override;
+
+  end;
+
+implementation
+
+uses
+  System.SysUtils;
+
+{ TBaseController }
+
+destructor TBaseController.Destroy;
+begin
+  FArticlesService.Free;
+  FDM.Free;
+  inherited;
+end;
+
+function TBaseController.GetArticlesService: TArticlesService;
+begin
+  if not Assigned(FArticlesService) then
+    FArticlesService := TArticlesService.Create(GetDataModule);
+  Result := FArticlesService;
+end;
+
+function TBaseController.GetDataModule: TdmMain;
+begin
+  if not Assigned(FDM) then
+    FDM := TdmMain.Create(nil);
+  Result := FDM;
+end;
+
+end.

samples/articles_crud/MainDM.dfm

@@ -0,0 +1,56 @@
+object dmMain: TdmMain
+  OldCreateOrder = False
+  Height = 214
+  Width = 438
+  object Connection: TFDConnection
+    Params.Strings = (
+      
+        'Database=C:\DEV\DMVCFramework\samples\ordersmanager\bin\TOMSORDE' +
+        'RS_DEVELOPMENT.FDB'
+      'User_Name=sysdba'
+      'Password=masterkey'
+      'DriverID=FB')
+    ConnectedStoredUsage = []
+    BeforeConnect = ConnectionBeforeConnect
+    Left = 64
+    Top = 48
+  end
+  object dsArticles: TFDQuery
+    Connection = Connection
+    UpdateOptions.AssignedValues = [uvFetchGeneratorsPoint, uvGeneratorName]
+    UpdateOptions.FetchGeneratorsPoint = gpImmediate
+    UpdateOptions.GeneratorName = 'GEN_ARTICOLI_ID'
+    UpdateOptions.UpdateTableName = 'ARTICOLI'
+    UpdateOptions.KeyFields = 'ID'
+    UpdateObject = updArticles
+    SQL.Strings = (
+      'SELECT * FROM ARTICOLI')
+    Left = 144
+    Top = 48
+  end
+  object updArticles: TFDUpdateSQL
+    Connection = Connection
+    InsertSQL.Strings = (
+      'INSERT INTO ARTICOLI'
+      '(ID, CODICE, DESCRIZIONE, PREZZO)'
+      'VALUES (:NEW_ID, :NEW_CODICE, :NEW_DESCRIZIONE, :NEW_PREZZO)'
+      'RETURNING ID, CODICE, DESCRIZIONE, PREZZO')
+    ModifySQL.Strings = (
+      'UPDATE ARTICOLI'
+      
+        'SET ID = :NEW_ID, CODICE = :NEW_CODICE, DESCRIZIONE = :NEW_DESCR' +
+        'IZIONE, '
+      '  PREZZO = :NEW_PREZZO'
+      'WHERE ID = :OLD_ID'
+      'RETURNING ID, CODICE, DESCRIZIONE, PREZZO')
+    DeleteSQL.Strings = (
+      'DELETE FROM ARTICOLI'
+      'WHERE ID = :OLD_ID')
+    FetchRowSQL.Strings = (
+      'SELECT ID, CODICE, DESCRIZIONE, PREZZO'
+      'FROM ARTICOLI'
+      'WHERE ID = :ID')
+    Left = 144
+    Top = 112
+  end
+end

samples/articles_crud/MainDM.pas

@@ -0,0 +1,35 @@
+unit MainDM;
+
+interface
+
+uses
+  System.SysUtils, System.Classes, FireDAC.Stan.Intf, FireDAC.Stan.Option,
+  FireDAC.Stan.Error, FireDAC.UI.Intf, FireDAC.Phys.Intf, FireDAC.Stan.Def,
+  FireDAC.Stan.Pool, FireDAC.Stan.Async, FireDAC.Phys, FireDAC.Phys.FB, Data.DB,
+  FireDAC.Comp.Client, FireDAC.Stan.Param, FireDAC.DatS, FireDAC.DApt.Intf,
+  FireDAC.DApt, FireDAC.Comp.DataSet;
+
+type
+  TdmMain = class(TDataModule)
+    Connection: TFDConnection;
+    dsArticles: TFDQuery;
+    updArticles: TFDUpdateSQL;
+    procedure ConnectionBeforeConnect(Sender: TObject);
+  private
+    { Private declarations }
+  public
+    { Public declarations }
+  end;
+
+implementation
+
+{%CLASSGROUP 'Vcl.Controls.TControl'}
+
+{$R *.dfm}
+
+procedure TdmMain.ConnectionBeforeConnect(Sender: TObject);
+begin
+  Connection.Params.Values['Database'] := '..\..\data\ORDERSMANAGER.FDB';
+end;
+
+end.

samples/articles_crud/Services.pas

@@ -0,0 +1,98 @@
+unit Services;
+
+interface
+
+uses
+  System.Generics.Collections, BusinessObjects, MainDM, System.SysUtils, Commons;
+
+type
+
+  TServiceBase = class abstract
+  strict protected
+    FDM: TdmMain;
+  public
+    constructor Create(AdmMain: TdmMain); virtual;
+    procedure Commit;
+    procedure Rollback;
+    procedure StartTransaction;
+  end;
+
+  TArticlesService = class(TServiceBase)
+  public
+    function GetAll: TObjectList<TArticle>;
+    function GetByID(const AID: Integer): TArticle;
+    procedure Delete(AArticolo: TArticle);
+    procedure Add(AArticolo: TArticle);
+  end;
+
+implementation
+
+uses
+  ObjectsMappers, FireDAC.Stan.Option, FireDAC.Comp.Client;
+
+{ TArticoliService }
+
+procedure TArticlesService.Add(AArticolo: TArticle);
+var
+  Cmd: TFDCustomCommand;
+begin
+  AArticolo.CheckInsert;
+  Cmd := FDM.updArticles.Commands[arInsert];
+  Mapper.ObjectToFDParameters(Cmd.Params, AArticolo, 'NEW_');
+  Cmd.OpenOrExecute;
+end;
+
+procedure TArticlesService.Delete(AArticolo: TArticle);
+var
+  Cmd: TFDCustomCommand;
+begin
+  AArticolo.CheckDelete;
+  Cmd := FDM.updArticles.Commands[arDelete];
+  Mapper.ObjectToFDParameters(Cmd.Params, AArticolo, 'OLD_');
+  Cmd.Execute;
+end;
+
+function TArticlesService.GetAll: TObjectList<TArticle>;
+begin
+  FDM.dsArticles.Open('SELECT * FROM ARTICOLI ORDER BY ID');
+  Result := FDM.dsArticles.AsObjectList<TArticle>;
+  FDM.dsArticles.Close;
+end;
+
+function TArticlesService.GetByID(const AID: Integer): TArticle;
+begin
+  FDM.dsArticles.Open('SELECT * FROM ARTICOLI WHERE ID = :ID', [AID]);
+  try
+    if not FDM.dsArticles.Eof then
+      Result := FDM.dsArticles.AsObject<TArticle>
+    else
+      raise EServiceException.Create('Article not found');
+  finally
+    FDM.dsArticles.Close;
+  end;
+end;
+
+{ TServiceBase }
+
+procedure TServiceBase.Commit;
+begin
+  FDM.Connection.Commit;
+end;
+
+constructor TServiceBase.Create(AdmMain: TdmMain);
+begin
+  inherited Create;
+  FDM := AdmMain;
+end;
+
+procedure TServiceBase.Rollback;
+begin
+  FDM.Connection.Rollback;
+end;
+
+procedure TServiceBase.StartTransaction;
+begin
+  FDM.Connection.StartTransaction;
+end;
+
+end.

samples/articles_crud/WebModuleUnit1.dfm

@@ -0,0 +1,13 @@
+object WebModule1: TWebModule1
+  OldCreateOrder = False
+  OnCreate = WebModuleCreate
+  Actions = <
+    item
+      Default = True
+      Name = 'DefaultHandler'
+      PathInfo = '/'
+      OnAction = WebModule1DefaultHandlerAction
+    end>
+  Height = 230
+  Width = 415
+end

samples/articles_crud/WebModuleUnit1.pas

@@ -0,0 +1,46 @@
+unit WebModuleUnit1;
+
+interface
+
+uses System.SysUtils, System.Classes, Web.HTTPApp, mvcframework;
+
+type
+  TWebModule1 = class(TWebModule)
+    procedure WebModule1DefaultHandlerAction(Sender: TObject;
+      Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
+    procedure WebModuleCreate(Sender: TObject);
+  private
+    FEngine: TMVCEngine;
+  public
+    { Public declarations }
+  end;
+
+var
+  WebModuleClass: TComponentClass = TWebModule1;
+
+implementation
+
+{ %CLASSGROUP 'Vcl.Controls.TControl' }
+
+uses Controllers.Articles;
+
+{$R *.dfm}
+
+
+procedure TWebModule1.WebModule1DefaultHandlerAction(Sender: TObject;
+  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
+begin
+  Response.Content :=
+    '<html>' +
+    '<head><title>Web Server Application</title></head>' +
+    '<body>Web Server Application</body>' +
+    '</html>';
+end;
+
+procedure TWebModule1.WebModuleCreate(Sender: TObject);
+begin
+  FEngine := TMVCEngine.Create(self);
+  FEngine.AddController(TArticlesController);
+end;
+
+end.

samples/articles_crud/articles_crud.dpr

@@ -0,0 +1,60 @@
+program articles_crud;
+{$APPTYPE CONSOLE}
+
+
+uses
+  System.SysUtils,
+  Winapi.Windows,
+  IdHTTPWebBrokerBridge,
+  Web.WebReq,
+  Web.WebBroker,
+  WebModuleUnit1 in 'WebModuleUnit1.pas' {WebModule1: TWebModule},
+  Controllers.Base in 'Controllers.Base.pas',
+  Controllers.Articles in 'Controllers.Articles.pas',
+  Services in 'Services.pas',
+  BusinessObjects in 'BusinessObjects.pas',
+  MainDM in 'MainDM.pas' {dmMain: TDataModule},
+  Commons in 'Commons.pas';
+
+{$R *.res}
+
+
+procedure RunServer(APort: Integer);
+var
+  LInputRecord: TInputRecord;
+  LEvent: DWord;
+  LHandle: THandle;
+  LServer: TIdHTTPWebBrokerBridge;
+begin
+  Writeln(Format('Starting HTTP Server on port %d', [APort]));
+  LServer := TIdHTTPWebBrokerBridge.Create(nil);
+  try
+    LServer.DefaultPort := APort;
+    LServer.Active := True;
+    Writeln('Press ESC to stop the server');
+    LHandle := GetStdHandle(STD_INPUT_HANDLE);
+    while True do
+    begin
+      ReadConsoleInput(LHandle, LInputRecord, 1, LEvent);
+      if (LInputRecord.EventType = KEY_EVENT) and
+        LInputRecord.Event.KeyEvent.bKeyDown and
+        (LInputRecord.Event.KeyEvent.wVirtualKeyCode = VK_ESCAPE) then
+        break;
+    end;
+  finally
+    LServer.Free;
+  end;
+end;
+
+begin
+  ReportMemoryLeaksOnShutdown := True;
+  try
+    if WebRequestHandler <> nil then
+      WebRequestHandler.WebModuleClass := WebModuleClass;
+    RunServer(8080);
+  except
+    on E: Exception do
+      Writeln(E.ClassName, ': ', E.Message);
+  end
+
+end.

samples/articles_crud/articles_crud.dproj

@@ -0,0 +1,168 @@
+<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
+    <PropertyGroup>
+        <ProjectGuid>{41237016-48D9-45F1-8FFC-66D1B61A206B}</ProjectGuid>
+        <ProjectVersion>15.4</ProjectVersion>
+        <FrameworkType>VCL</FrameworkType>
+        <MainSource>articles_crud.dpr</MainSource>
+        <Base>True</Base>
+        <Config Condition="'$(Config)'==''">Debug</Config>
+        <Platform Condition="'$(Platform)'==''">Win32</Platform>
+        <TargetedPlatforms>1</TargetedPlatforms>
+        <AppType>Console</AppType>
+    </PropertyGroup>
+    <PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
+        <Base>true</Base>
+    </PropertyGroup>
+    <PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Base)'=='true') or '$(Base_Win32)'!=''">
+        <Base_Win32>true</Base_Win32>
+        <CfgParent>Base</CfgParent>
+        <Base>true</Base>
+    </PropertyGroup>
+    <PropertyGroup Condition="('$(Platform)'=='Win64' and '$(Base)'=='true') or '$(Base_Win64)'!=''">
+        <Base_Win64>true</Base_Win64>
+        <CfgParent>Base</CfgParent>
+        <Base>true</Base>
+    </PropertyGroup>
+    <PropertyGroup Condition="'$(Config)'=='Debug' or '$(Cfg_1)'!=''">
+        <Cfg_1>true</Cfg_1>
+        <CfgParent>Base</CfgParent>
+        <Base>true</Base>
+    </PropertyGroup>
+    <PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_1)'=='true') or '$(Cfg_1_Win32)'!=''">
+        <Cfg_1_Win32>true</Cfg_1_Win32>
+        <CfgParent>Cfg_1</CfgParent>
+        <Cfg_1>true</Cfg_1>
+        <Base>true</Base>
+    </PropertyGroup>
+    <PropertyGroup Condition="'$(Config)'=='Release' or '$(Cfg_2)'!=''">
+        <Cfg_2>true</Cfg_2>
+        <CfgParent>Base</CfgParent>
+        <Base>true</Base>
+    </PropertyGroup>
+    <PropertyGroup Condition="'$(Base)'!=''">
+        <Icns_MainIcns>$(BDS)\bin\delphi_PROJECTICNS.icns</Icns_MainIcns>
+        <VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
+        <SanitizedProjectName>articles_crud</SanitizedProjectName>
+        <VerInfo_Locale>1040</VerInfo_Locale>
+        <Icon_MainIcon>$(BDS)\bin\delphi_PROJECTICON.ico</Icon_MainIcon>
+        <Manifest_File>None</Manifest_File>
+        <DCC_Namespace>System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace)</DCC_Namespace>
+        <DCC_UNSUPPORTED_CONSTRUCT>error</DCC_UNSUPPORTED_CONSTRUCT>
+        <DCC_DcuOutput>.\$(Platform)\$(Config)</DCC_DcuOutput>
+        <DCC_ExeOutput>.\$(Platform)\$(Config)</DCC_ExeOutput>
+        <DCC_E>false</DCC_E>
+        <DCC_N>false</DCC_N>
+        <DCC_S>false</DCC_S>
+        <DCC_F>false</DCC_F>
+        <DCC_K>false</DCC_K>
+    </PropertyGroup>
+    <PropertyGroup Condition="'$(Base_Win32)'!=''">
+        <DCC_ExeOutput>bin</DCC_ExeOutput>
+        <VerInfo_Locale>1033</VerInfo_Locale>
+        <DCC_UsePackage>FireDACSqliteDriver;FireDACDSDriver;DBXSqliteDriver;SampleListViewMultiDetailAppearancePackage;FireDACPgDriver;fmx;IndySystem;TeeDB;tethering;ITDevCon2012AdapterPackage;inetdbbde;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;CodeSiteExpressPkg;DataSnapFireDAC;FireDACDBXDriver;soapserver;inetdbxpress;dsnapxml;FireDACInfxDriver;FireDACDb2Driver;adortl;CustomAdaptersMDPackage;FireDACASADriver;bindcompfmx;vcldbx;FireDACODBCDriver;RESTBackendComponents;rtl;dbrtl;DbxClientDriver;FireDACCommon;bindcomp;inetdb;SampleListViewRatingsAppearancePackage;Tee;DBXOdbcDriver;vclFireDAC;xmlrtl;DataSnapNativeClient;svnui;ibxpress;IndyProtocols;DBXMySQLDriver;FireDACCommonDriver;bindcompdbx;bindengine;vclactnband;soaprtl;FMXTee;TeeUI;bindcompvcl;vclie;FireDACADSDriver;vcltouch;VclSmp;FireDACMSSQLDriver;FireDAC;DBXInformixDriver;Intraweb;VCLRESTComponents;DataSnapConnectors;DataSnapServerMidas;dsnapcon;DBXFirebirdDriver;SampleGenerator1Package;inet;fmxobj;FireDACMySQLDriver;soapmidas;vclx;svn;DBXSybaseASADriver;FireDACOracleDriver;fmxdae;RESTComponents;bdertl;FireDACMSAccDriver;dbexpress;DataSnapIndy10ServerTransport;IndyIPClient;$(DCC_UsePackage)</DCC_UsePackage>
+        <DCC_Namespace>Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)</DCC_Namespace>
+    </PropertyGroup>
+    <PropertyGroup Condition="'$(Base_Win64)'!=''">
+        <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_DebugDCUs>true</DCC_DebugDCUs>
+        <DCC_Optimize>false</DCC_Optimize>
+        <DCC_GenerateStackFrames>true</DCC_GenerateStackFrames>
+        <DCC_DebugInfoInExe>true</DCC_DebugInfoInExe>
+        <DCC_RemoteDebug>true</DCC_RemoteDebug>
+    </PropertyGroup>
+    <PropertyGroup Condition="'$(Cfg_1_Win32)'!=''">
+        <VerInfo_Locale>1033</VerInfo_Locale>
+        <DCC_RemoteDebug>false</DCC_RemoteDebug>
+    </PropertyGroup>
+    <PropertyGroup Condition="'$(Cfg_2)'!=''">
+        <DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
+        <DCC_Define>RELEASE;$(DCC_Define)</DCC_Define>
+        <DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
+        <DCC_DebugInformation>0</DCC_DebugInformation>
+    </PropertyGroup>
+    <ItemGroup>
+        <DelphiCompile Include="$(MainSource)">
+            <MainSource>MainSource</MainSource>
+        </DelphiCompile>
+        <DCCReference Include="WebModuleUnit1.pas">
+            <Form>WebModule1</Form>
+            <FormType>dfm</FormType>
+            <DesignClass>TWebModule</DesignClass>
+        </DCCReference>
+        <DCCReference Include="Controllers.Base.pas"/>
+        <DCCReference Include="Controllers.Articles.pas"/>
+        <DCCReference Include="Services.pas"/>
+        <DCCReference Include="BusinessObjects.pas"/>
+        <DCCReference Include="MainDM.pas">
+            <Form>dmMain</Form>
+            <FormType>dfm</FormType>
+            <DesignClass>TDataModule</DesignClass>
+        </DCCReference>
+        <DCCReference Include="Commons.pas"/>
+        <None Include="ModelSupport_ordersmanager\default.txvpck"/>
+        <None Include="ModelSupport_ordersmanager\Services\default.txvpck"/>
+        <None Include="ModelSupport_ordersmanager\ordersmanager\default.txvpck"/>
+        <None Include="ModelSupport_ordersmanager\Services\default.txaPackage"/>
+        <None Include="ModelSupport_ordersmanager\BusinessObjects\default.txaPackage"/>
+        <None Include="ModelSupport_ordersmanager\BusinessObjects\default.txvpck"/>
+        <None Include="ModelSupport_ordersmanager\Controllers\Articoli\default.txaPackage"/>
+        <None Include="ModelSupport_articles_crud\default.txaPackage"/>
+        <None Include="ModelSupport_articles_crud\default.txvpck"/>
+        <None Include="ModelSupport_articles_crud\Commons\default.txvpck"/>
+        <None Include="ModelSupport_articles_crud\MainDM\default.txvpck"/>
+        <None Include="ModelSupport_articles_crud\BusinessObjects\default.txvpck"/>
+        <None Include="ModelSupport_articles_crud\Services\default.txvpck"/>
+        <None Include="ModelSupport_articles_crud\articles_crud\default.txvpck"/>
+        <None Include="ModelSupport_articles_crud\WebModuleUnit1\default.txvpck"/>
+        <None Include="ModelSupport_articles_crud\Controllers\default.txvpck"/>
+        <None Include="ModelSupport_articles_crud\Controllers\Articoli\default.txvpck"/>
+        <None Include="ModelSupport_articles_crud\Controllers\Base\default.txvpck"/>
+        <None Include="ModelSupport_articles_crud\MainDM\default.txaPackage"/>
+        <None Include="ModelSupport_articles_crud\Controllers\Base\default.txaPackage"/>
+        <None Include="ModelSupport_articles_crud\Services\default.txaPackage"/>
+        <None Include="ModelSupport_articles_crud\Controllers\default.txaPackage"/>
+        <None Include="ModelSupport_articles_crud\WebModuleUnit1\default.txaPackage"/>
+        <None Include="ModelSupport_articles_crud\articles_crud\default.txaPackage"/>
+        <None Include="ModelSupport_articles_crud\Commons\default.txaPackage"/>
+        <None Include="ModelSupport_articles_crud\BusinessObjects\default.txaPackage"/>
+        <None Include="ModelSupport_articles_crud\Controllers\Articoli\default.txaPackage"/>
+        <BuildConfiguration Include="Release">
+            <Key>Cfg_2</Key>
+            <CfgParent>Base</CfgParent>
+        </BuildConfiguration>
+        <BuildConfiguration Include="Base">
+            <Key>Base</Key>
+        </BuildConfiguration>
+        <BuildConfiguration Include="Debug">
+            <Key>Cfg_1</Key>
+            <CfgParent>Base</CfgParent>
+        </BuildConfiguration>
+    </ItemGroup>
+    <ProjectExtensions>
+        <Borland.Personality>Delphi.Personality.12</Borland.Personality>
+        <Borland.ProjectType/>
+        <BorlandProject>
+            <Delphi.Personality>
+                <Source>
+                    <Source Name="MainSource">articles_crud.dpr</Source>
+                </Source>
+                <Excluded_Packages>
+                    <Excluded_Packages Name="$(BDSBIN)\dcloffice2k200.bpl">Microsoft Office 2000 Sample Automation Server Wrapper Components</Excluded_Packages>
+                    <Excluded_Packages Name="$(BDSBIN)\dclofficexp200.bpl">Microsoft Office XP Sample Automation Server Wrapper Components</Excluded_Packages>
+                </Excluded_Packages>
+            </Delphi.Personality>
+            <Deployment/>
+            <Platforms>
+                <Platform value="Win32">True</Platform>
+                <Platform value="Win64">False</Platform>
+            </Platforms>
+            <ModelSupport>True</ModelSupport>
+        </BorlandProject>
+        <ProjectFileVersion>12</ProjectFileVersion>
+    </ProjectExtensions>
+    <Import Project="$(BDS)\Bin\CodeGear.Delphi.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Delphi.Targets')"/>
+    <Import Project="$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj" Condition="Exists('$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj')"/>
+</Project>

samples/renders/renders.dproj

@@ -91,6 +91,15 @@
         </DCCReference>
         <DCCReference Include="RenderSampleControllerU.pas"/>
         <DCCReference Include="..\commons\BusinessObjectsU.pas"/>
+        <None Include="ModelSupport_renders\default.txaPackage"/>
+        <None Include="ModelSupport_renders\default.txvpck"/>
+        <None Include="ModelSupport_renders\renders1\default.txvpck"/>
+        <None Include="ModelSupport_renders\BusinessObjectsU\default.txaPackage"/>
+        <None Include="ModelSupport_renders\BusinessObjectsU\default.txvpck"/>
+        <None Include="ModelSupport_renders\WebModuleU\default.txvpck"/>
+        <None Include="ModelSupport_renders\renders\default.txvpck"/>
+        <None Include="ModelSupport_renders\RenderSampleControllerU\default.txvpck"/>
+        <None Include="ModelSupport_renders\renders\default.txaPackage"/>
         <BuildConfiguration Include="Release">
             <Key>Cfg_2</Key>
             <CfgParent>Base</CfgParent>
@@ -173,6 +182,7 @@
                 <Platform value="Win32">True</Platform>
                 <Platform value="Win64">False</Platform>
             </Platforms>
+            <ModelSupport>True</ModelSupport>
         </BorlandProject>
         <ProjectFileVersion>12</ProjectFileVersion>
     </ProjectExtensions>

sources/MVCFramework.Commons.pas

@@ -25,7 +25,7 @@ type
   TMVCConstants = class sealed
   public const
     SESSION_TOKEN_NAME = 'dtsessionid';
-    DEFAULT_CONTENT_CHARSET = 'utf-8';
+    DEFAULT_CONTENT_CHARSET = 'UTF-8';
     DEFAULT_CONTENT_TYPE = TMVCMimeType.APPLICATION_JSON;
   end;
 

sources/MVCFramework.RESTClient.pas

@@ -29,10 +29,10 @@ type
     function ResponseCode: Word;
     function ResponseText: string;
     function Headers: TStringlist;
-    function GetContentType: String;
-    function GetContentEncoding: String;
+    function GetContentType: string;
+    function GetContentEncoding: string;
     function Body: TStringStream;
-    function GetHeaderValue(const Name: String): String;
+    function GetHeaderValue(const Name: string): string;
     procedure SetResponseCode(AResponseCode: Word);
     procedure SetResponseText(AResponseText: string);
     procedure SetHeaders(AHeaders: TStrings);
@@ -46,8 +46,8 @@ type
     FHeaders: TStringlist;
     FBodyAsJSONValue: TJSONValue;
     FContentType: string;
-    FContentEncoding: String;
-    function GetHeader(const Value: String): String;
+    FContentEncoding: string;
+    function GetHeader(const Value: string): string;
   public
 
     function BodyAsString: string;
@@ -57,8 +57,8 @@ type
     function ResponseText: string;
     function Headers: TStringlist;
     function Body: TStringStream;
-    function GetContentType: String;
-    function GetContentEncoding: String;
+    function GetContentType: string;
+    function GetContentEncoding: string;
 
     procedure SetResponseCode(AResponseCode: Word);
     procedure SetResponseText(AResponseText: string);
@@ -87,7 +87,7 @@ type
     FAsynchProcAlways: TProc;
     FProtocol: string;
     FSynchronized: Boolean;
-    FContentEncoding: String;
+    FContentEncoding: string;
     function EncodeQueryStringParams(const AQueryStringParams: TStrings;
       IncludeQuestionMark: Boolean = true): string;
     procedure SetBodyParams(const Value: TStringlist);
@@ -102,7 +102,7 @@ type
     procedure SetReadTimeout(const Value: Integer);
     function GetReadTimeout: Integer;
     procedure StartAsynchRequest(AHTTPMethod: THttpCommand; AUrl: string;
-      ABodyString: String); overload;
+      ABodyString: string); overload;
     procedure StartAsynchRequest(AHTTPMethod: THttpCommand;
       AUrl: string); overload;
     procedure SetConnectionTimeout(const Value: Integer);
@@ -120,7 +120,7 @@ type
       const AAccept, AContentType, AUrl: string; ABodyParams: TStrings)
       : IRESTResponse;
     function SendHTTPCommandWithBody(const ACommand: THttpCommand;
-      const AAccept, AContentType, AUrl: string; ABodyString: String)
+      const AAccept, AContentType, AUrl: string; ABodyString: string)
       : IRESTResponse;
     procedure HandleRequestCookies;
     function GetMultipartFormData: TIdMultiPartFormDataStream;
@@ -154,19 +154,19 @@ type
       AJSONValue: TJSONValue; AOwnsJSONBody: Boolean = true)
       : IRESTResponse; overload;
     function doPOST(AResource: string; AResourceParams: array of string;
-      ABodyString: String): IRESTResponse; overload;
+      ABodyString: string): IRESTResponse; overload;
     function doPATCH(AResource: string; AResourceParams: array of string;
       AJSONValue: TJSONValue; AOwnsJSONBody: Boolean = true)
       : IRESTResponse; overload;
     function doPATCH(AResource: string; AResourceParams: array of string;
-      ABodyString: String): IRESTResponse; overload;
+      ABodyString: string): IRESTResponse; overload;
     function doPUT(AResource: string; AResourceParams: array of string)
       : IRESTResponse; overload;
     function doPUT(AResource: string; AResourceParams: array of string;
       AJSONValue: TJSONValue; AOwnsJSONBody: Boolean = true)
       : IRESTResponse; overload;
     function doPUT(AResource: string; AResourceParams: array of string;
-      ABodyString: String): IRESTResponse; overload;
+      ABodyString: string): IRESTResponse; overload;
     function doDELETE(AResource: string; AResourceParams: array of string)
       : IRESTResponse;
     property BodyParams: TStringlist read GetBodyParams write SetBodyParams;
@@ -180,9 +180,9 @@ type
     property RequestHeaders: TStringlist read FRequestHeaders
       write SetRequestHeaders;
     // dataset specific methods
-    function DSUpdate(const URL: String; DataSet: TDataSet; const KeyValue: String): IRESTResponse;
-    function DSInsert(const URL: String; DataSet: TDataSet): IRESTResponse;
-    function DSDelete(const URL: String; const KeyValue: String): IRESTResponse;
+    function DSUpdate(const URL: string; DataSet: TDataSet; const KeyValue: string): IRESTResponse;
+    function DSInsert(const URL: string; DataSet: TDataSet): IRESTResponse;
+    function DSDelete(const URL: string; const KeyValue: string): IRESTResponse;
   end;
 
 function StringsToArrayOfString(const AStrings: TStrings): TArrayOfString;
@@ -221,6 +221,7 @@ function TRESTClient.AddFile(const FieldName, FileName, ContentType: string)
   : TRESTClient;
 begin
   GetMultipartFormData.AddFile(FieldName, FileName, ContentType);
+  Result := Self;
 end;
 
 function TRESTClient.Asynch(AProc: TProc<IRESTResponse>;
@@ -276,7 +277,7 @@ end;
 
 constructor TRESTClient.Create(const AServerName: string; AServerPort: Word; AIOHandler: TIdIOHandler);
 var
-  Pieces: TArray<String>;
+  Pieces: TArray<string>;
 begin
   inherited Create;
   FPrimaryThread := TThread.CurrentThread;
@@ -342,7 +343,7 @@ begin
 end;
 
 procedure TRESTClient.StartAsynchRequest(AHTTPMethod: THttpCommand;
-  AUrl: string; ABodyString: String);
+  AUrl: string; ABodyString: string);
 var
   th: TThread;
 begin
@@ -364,7 +365,6 @@ begin
               end)
           else
             FAsynchProc(R);
-          ClearAllParams;
         finally
           TMonitor.Exit(TObject(R));
         end;
@@ -392,6 +392,7 @@ begin
         else
           FAsynchProcAlways();
       end;
+      ClearAllParams;
     end);
   th.Start;
 end;
@@ -447,7 +448,7 @@ begin
   end;
 end;
 
-function TRESTClient.doPATCH(AResource: string; AResourceParams: array of string; ABodyString: String): IRESTResponse;
+function TRESTClient.doPATCH(AResource: string; AResourceParams: array of string; ABodyString: string): IRESTResponse;
 var
   URL: string;
 begin
@@ -482,7 +483,7 @@ begin
 end;
 
 function TRESTClient.doPOST(AResource: string; AResourceParams: array of string;
-ABodyString: String): IRESTResponse;
+ABodyString: string): IRESTResponse;
 var
   URL: string;
 begin
@@ -504,7 +505,7 @@ begin
 end;
 
 function TRESTClient.doPUT(AResource: string; AResourceParams: array of string;
-ABodyString: String): IRESTResponse;
+ABodyString: string): IRESTResponse;
 var
   URL: string;
 begin
@@ -526,17 +527,17 @@ begin
 
 end;
 
-function TRESTClient.DSDelete(const URL, KeyValue: String): IRESTResponse;
+function TRESTClient.DSDelete(const URL, KeyValue: string): IRESTResponse;
 begin
   Result := doDELETE(URL, [KeyValue]);
 end;
 
-function TRESTClient.DSInsert(const URL: String; DataSet: TDataSet): IRESTResponse;
+function TRESTClient.DSInsert(const URL: string; DataSet: TDataSet): IRESTResponse;
 begin
   Result := doPOST(URL, [], DataSet.AsJSONObjectString);
 end;
 
-function TRESTClient.DSUpdate(const URL: String; DataSet: TDataSet; const KeyValue: String): IRESTResponse;
+function TRESTClient.DSUpdate(const URL: string; DataSet: TDataSet; const KeyValue: string): IRESTResponse;
 begin
   Result := doPUT(URL, [KeyValue], DataSet.AsJSONObjectString);
 end;
@@ -769,7 +770,7 @@ begin
 end;
 
 function TRESTClient.SendHTTPCommandWithBody(const ACommand: THttpCommand;
-const AAccept, AContentType, AUrl: string; ABodyString: String): IRESTResponse;
+const AAccept, AContentType, AUrl: string; ABodyString: string): IRESTResponse;
 begin
   Result := TRESTResponse.Create;
   FHTTP.Request.RawHeaders.Clear;
@@ -940,19 +941,19 @@ begin
   inherited;
 end;
 
-function TRESTResponse.GetContentEncoding: String;
+function TRESTResponse.GetContentEncoding: string;
 begin
   Result := FContentEncoding;
 end;
 
-function TRESTResponse.GetContentType: String;
+function TRESTResponse.GetContentType: string;
 begin
   Result := FContentType;
 end;
 
-function TRESTResponse.GetHeader(const Value: String): String;
+function TRESTResponse.GetHeader(const Value: string): string;
 var
-  s: String;
+  s: string;
 begin
   if Assigned(FHeaders) and (FHeaders.Count > 0) then
   begin
@@ -1005,7 +1006,7 @@ end;
 procedure TRESTResponse.SetHeaders(AHeaders: TStrings);
 var
   CT: TArray<string>;
-  C: String;
+  C: string;
 begin
   FHeaders.Assign(AHeaders);
 

sources/MVCFramework.Router.pas

@@ -21,6 +21,7 @@ type
       AAttributes: TArray<TCustomAttribute>): Boolean;
     function IsHTTPAcceptCompatible(AWebRequestMethodType: TMVCHTTPMethodType; AAccept: AnsiString;
       AAttributes: TArray<TCustomAttribute>): Boolean;
+    function GetFirstMimeType(const AContentType: string): string;
   protected
     function IsHTTPMethodCompatible(AMethodType: TMVCHTTPMethodType;
       AAttributes: TArray<TCustomAttribute>): Boolean; virtual;
@@ -33,21 +34,16 @@ type
     class function StringMethodToHTTPMetod(const Value: AnsiString)
       : TMVCHTTPMethodType;
     constructor Create(AMVCConfig: TMVCConfig);
-    function ExecuteRouting(AWebRequest: TWebRequest;
-      AMVCControllers: TList<TMVCControllerClass>;
-      ADefaultContentType, ADefaultContentCharset: String;
-      var AMVCRequestParams: TMVCRequestParamsTable;
-      out AResponseContentType, AResponseContentEncoding: string)
-      : Boolean; overload;
     function ExecuteRouting(AWebRequestPathInfo: AnsiString;
       AWebRequestMethodType: TMVCHTTPMethodType;
       AWebRequestContentType: AnsiString;
       AWebRequestAccept: AnsiString;
       AMVCControllers: TList<TMVCControllerClass>;
-      ADefaultContentType: String;
-      ADefaultContentCharset: String;
+      ADefaultContentType: string;
+      ADefaultContentCharset: string;
       var AMVCRequestParams: TMVCRequestParamsTable;
-      out AResponseContentType, AResponseContentEncoding: string)
+      out AResponseContentType: string;
+      out AResponseContentEncoding: string)
       : Boolean; overload;
     property MethodToCall: TRTTIMethod read FMethodToCall;
     property MVCControllerClass: TMVCControllerClass read FMVCControllerClass;
@@ -63,23 +59,6 @@ uses
 
 { TMVCRouter }
 
-function TMVCRouter.ExecuteRouting(AWebRequest: TWebRequest;
-  AMVCControllers: TList<TMVCControllerClass>;
-  ADefaultContentType, ADefaultContentCharset: String;
-  var AMVCRequestParams: TMVCRequestParamsTable;
-  out AResponseContentType, AResponseContentEncoding: string): Boolean;
-var
-  HTTPMethodType: TMVCHTTPMethodType;
-begin
-  HTTPMethodType := StringMethodToHTTPMetod(AWebRequest.Method);
-  Result := ExecuteRouting(AWebRequest.PathInfo, HTTPMethodType,
-    AWebRequest.ContentType, AWebRequest.Accept, AMVCControllers,
-    ADefaultContentType,
-    ADefaultContentCharset,
-    AMVCRequestParams,
-    AResponseContentType, AResponseContentEncoding);
-end;
-
 constructor TMVCRouter.Create(AMVCConfig: TMVCConfig);
 begin
   inherited Create;
@@ -89,9 +68,10 @@ end;
 function TMVCRouter.ExecuteRouting(AWebRequestPathInfo: AnsiString;
   AWebRequestMethodType: TMVCHTTPMethodType; AWebRequestContentType: AnsiString; AWebRequestAccept: AnsiString;
   AMVCControllers: TList<TMVCControllerClass>;
-  ADefaultContentType, ADefaultContentCharset: String;
+  ADefaultContentType, ADefaultContentCharset: string;
   var AMVCRequestParams: TMVCRequestParamsTable;
-  out AResponseContentType, AResponseContentEncoding: string): Boolean;
+  out AResponseContentType: string;
+  out AResponseContentEncoding: string): Boolean;
 var
   controllerClass: TMVCControllerClass;
   _type: TRttiType;
@@ -121,7 +101,7 @@ begin
   { ISAPI CHANGE THE REQUEST PATH INFO START }
   if IsLibrary then
   begin
-    AWebRequestPathInfo := String(AWebRequestPathInfo).Remove(0, FMVCConfig.Value['isapi_path'].Length);
+    AWebRequestPathInfo := string(AWebRequestPathInfo).Remove(0, FMVCConfig.Value[TMVCConfigKey.ISAPIPath].Length);
     if Length(AWebRequestPathInfo) = 0 then
       AWebRequestPathInfo := '/';
   end;
@@ -211,6 +191,16 @@ begin
       Exit(T(a));
 end;
 
+function TMVCRouter.GetFirstMimeType(
+  const AContentType: string): string;
+begin
+  Result := AContentType;
+  while Pos(',', Result) > 0 do
+    Result := Copy(Result, 1, Pos(',', Result) - 1);
+  while Pos(';', Result) > 0 do
+    Result := Copy(Result, 1, Pos(';', Result) - 1); // application/json;charset=UTF-8 {daniele}
+end;
+
 function TMVCRouter.IsCompatiblePath(AMVCPath: string; APath: string;
   var AParams: TMVCRequestParamsTable): Boolean;
   function ToPattern(const V: string; Names: TList<string>): string;
@@ -287,8 +277,10 @@ begin
     begin
       FoundOneAttribProduces := true;
       MethodAccept := MVCProducesAttribute(AAttributes[i]).Value;
-      while Pos(',', AAccept) > 0 do
-        AAccept := Copy(AAccept, 1, Pos(',', AAccept) - 1);
+      AAccept := GetFirstMimeType(AAccept);
+//      while Pos(',', AAccept) > 0 do
+//        AAccept := Copy(AAccept, 1, Pos(',', AAccept) - 1);
+
       Result := SameText(AAccept, MethodAccept, loInvariantLocale);
       if Result then
         Break;
@@ -316,8 +308,7 @@ begin
     begin
       FoundOneAttribConsumes := true;
       MethodContentType := MVCConsumesAttribute(AAttributes[i]).Value;
-      while Pos(',', AContentType) > 0 do
-        AContentType := Copy(AContentType, 1, Pos(',', AContentType) - 1);
+      AContentType := GetFirstMimeType(AContentType);
       Result := SameText(AContentType, MethodContentType, loInvariantLocale);
       if Result then
         Break;

sources/MVCFramework.pas

@@ -95,7 +95,7 @@ type
     FParamsTable: TMVCRequestParamsTable;
     FContentType: string;
     FCharset: string;
-    FContentEncoding: string;
+    FContentCharset: string;
     function GetHeader(const Name: string): string;
     function GetHeaderValue(const Name: string): string;
     function GetPathInfo: string;
@@ -140,7 +140,7 @@ type
     property ClientPreferHTML: boolean read GetClientPreferHTML;
     property Files: TAbstractWebRequestFiles read GetFiles;
     property ContentType: string read FContentType;
-    property ContentEncoding: string read FContentEncoding;
+    property ContentCharset: string read FContentCharset;
     property Charset: string read FCharset;
   end;
 
@@ -268,14 +268,14 @@ type
     FContext: TWebContext;
     FWebSession: TWebSession;
     FResponseStream: TStringBuilder;
-    FContentEncoding: string;
+    FContentCharset: string;
     procedure SetContext(const Value: TWebContext);
     procedure SetWebSession(const Value: TWebSession);
     procedure SetContentType(const Value: string);
     function GetContentType: string;
     function GetWebSession: TWebSession;
-    function GetContentEncoding: string;
-    procedure SetContentEncoding(const Value: string);
+    function GetContentCharset: string;
+    procedure SetContentCharset(const Value: string);
 
   protected
     procedure RaiseSessionExpired; virtual;
@@ -289,7 +289,7 @@ type
     procedure MVCControllerAfterCreate; virtual;
     procedure MVCControllerBeforeDestroy; virtual;
     property ContentType: string read GetContentType write SetContentType;
-    property ContentEncoding: string read GetContentEncoding write SetContentEncoding;
+    property ContentCharset: string read GetContentCharset write SetContentCharset;
     // Session
     procedure SessionStart; virtual;
     procedure SessionStop(ARaiseExceptionIfExpired: boolean = true); virtual;
@@ -560,7 +560,7 @@ var
   StaticFileName: string;
   ContentType: string;
   Handled: boolean;
-  ResponseContentType, ResponseContentEncoding: string;
+  ResponseContentType, ResponseContentCharset: string;
 begin
   LogEnterMethod(Request.PathInfo);
   try
@@ -592,10 +592,17 @@ begin
             ExecuteBeforeRoutingMiddleware(Context, Handled);
             if not Handled then
             begin
-              if Router.ExecuteRouting(Request, FControllers, FMVCConfig[TMVCConfigKey.DefaultContentType],
+              if Router.ExecuteRouting(
+                Request.PathInfo,
+                TMVCRouter.StringMethodToHTTPMetod(Request.Method),
+                Request.ContentType,
+                Request.Accept,
+                FControllers,
+                FMVCConfig[TMVCConfigKey.DefaultContentType],
                 FMVCConfig[TMVCConfigKey.DefaultContentCharset],
-
-                ParamsTable, ResponseContentType, ResponseContentEncoding) then
+                ParamsTable,
+                ResponseContentType,
+                ResponseContentCharset) then
               begin
                 SelectedController := Router.MVCControllerClass.Create;
                 try
@@ -615,7 +622,7 @@ begin
                       Handled := false;
                       // gets response contentype from MVCProduces attribute
                       SelectedController.ContentType := ResponseContentType;
-                      SelectedController.ContentEncoding := ResponseContentEncoding;
+                      SelectedController.ContentCharset := ResponseContentCharset;
                       SelectedController.OnBeforeAction(Context, Router.MethodToCall.Name, Handled);
                       if not Handled then
                       begin
@@ -1306,7 +1313,7 @@ begin
   begin
     CT := c.Split([';']);
     FContentType := trim(CT[0]);
-    FCharset := 'utf-8'; // default encoding
+    FCharset := TMVCConstants.DEFAULT_CONTENT_CHARSET; // default charset
     if Length(CT) > 1 then
     begin
       if CT[1].trim.StartsWith('charset', true) then
@@ -1316,9 +1323,9 @@ begin
     end;
   end;
 
-  c := GetHeaderValue('content-encoding');
-  if c.IsEmpty then
-    FContentEncoding := c;
+  // c := GetHeaderValue('content-encoding');
+  // if c.IsEmpty then
+  // FContentEncoding := c;
 end;
 
 destructor TMVCWebRequest.Destroy;
@@ -1349,7 +1356,7 @@ begin
   inherited Create;
   IsSessionStarted := false;
   SessionMustBeClose := false;
-  FContentEncoding := TMVCConstants.DEFAULT_CONTENT_CHARSET;
+  FContentCharset := TMVCConstants.DEFAULT_CONTENT_CHARSET;
 end;
 
 destructor TMVCController.Destroy;
@@ -1396,9 +1403,9 @@ begin
   end;
 end;
 
-function TMVCController.GetContentEncoding: string;
+function TMVCController.GetContentCharset: string;
 begin
-  Result := FContentEncoding;
+  Result := FContentCharset;
 end;
 
 function TMVCController.GetContentType: string;
@@ -1578,7 +1585,7 @@ end;
 
 procedure TMVCController.Render(const Content: string);
 begin
-  InternalRender(Content, ContentType, ContentEncoding, Context);
+  InternalRender(Content, ContentType, ContentCharset, Context);
 end;
 
 procedure TMVCController.Render(AObject: TObject; AInstanceOwner: boolean);
@@ -1680,9 +1687,9 @@ begin
   SessionMustBeClose := true;
 end;
 
-procedure TMVCController.SetContentEncoding(const Value: string);
+procedure TMVCController.SetContentCharset(const Value: string);
 begin
-  FContentEncoding := Value;
+  FContentCharset := Value;
 end;
 
 procedure TMVCController.SetContentType(const Value: string);
@@ -2147,7 +2154,7 @@ begin
   if (not Context.Request.IsAjax) and (Context.Request.ClientPreferHTML) then
   begin
     ContentType := TMVCMimeType.TEXT_HTML;
-    ContentEncoding := 'UTF-8';
+    ContentCharset := TMVCConstants.DEFAULT_CONTENT_CHARSET;
     ResponseStream.Clear;
 
     ResponseStream.Append
@@ -2275,7 +2282,7 @@ end;
 
 procedure TMVCController.Render(AJSONValue: TJSONValue; AInstanceOwner: boolean);
 begin
-  InternalRender(AJSONValue, ContentType, ContentEncoding, Context, AInstanceOwner);
+  InternalRender(AJSONValue, ContentType, ContentCharset, Context, AInstanceOwner);
 end;
 
 procedure TMVCController.ResponseStatusCode(const ErrorCode: UInt16);

sources/ObjectsMappers.pas

@@ -1535,6 +1535,8 @@ begin
           end
           else if _field.PropertyType.QualifiedName = 'System.TTime' then
             _field.SetValue(TObject(AObject), ISOStrToTime(jvalue.Value))
+          else if _field.PropertyType.QualifiedName = 'System.Currency' then
+            _field.SetValue(TObject(AObject), (jvalue as TJSONNumber).AsDouble)
           else
             _field.SetValue(TObject(AObject), (jvalue as TJSONNumber).AsDouble)
         end;

unittests/DMVCFrameworkTests/DMVCFrameworkTests.dproj

@@ -175,8 +175,6 @@
                     <Source Name="MainSource">DMVCFrameworkTests.dpr</Source>
                 </Source>
                 <Excluded_Packages>
-                    <Excluded_Packages Name="$(BDSBIN)\bcboffice2k200.bpl">Embarcadero C++Builder Office 2000 Servers Package</Excluded_Packages>
-                    <Excluded_Packages Name="$(BDSBIN)\bcbofficexp200.bpl">Embarcadero C++Builder Office XP Servers Package</Excluded_Packages>
                     <Excluded_Packages Name="$(BDSBIN)\dcloffice2k200.bpl">Microsoft Office 2000 Sample Automation Server Wrapper Components</Excluded_Packages>
                     <Excluded_Packages Name="$(BDSBIN)\dclofficexp200.bpl">Microsoft Office XP Sample Automation Server Wrapper Components</Excluded_Packages>
                 </Excluded_Packages>

unittests/DMVCFrameworkTests/FrameworkTestsU.pas

@@ -26,6 +26,8 @@ type
     procedure TestPathWithParameters;
     procedure TestWithMethodTypes;
     procedure TestComplexRoutings;
+    procedure TestProduceRoutings;
+    procedure TestProduceRoutingsWithExplicitCharset;
 
     procedure TestObjectToJSONObject;
     procedure TestObjectListToJSONArray;
@@ -362,6 +364,60 @@ begin
 
 end;
 
+procedure TTestRouting.TestProduceRoutings;
+var
+  Params: TMVCRequestParamsTable;
+  ResponseContentType: string;
+  ResponseContentCharset: string;
+begin
+  Params := TMVCRequestParamsTable.Create;
+  try
+    // a GET request with a ACCEPT: application/json
+    CheckTrue(Router.ExecuteRouting('/orders', httpGET,
+      '',
+      'application/json',
+      Controllers,
+      TMVCConstants.DEFAULT_CONTENT_TYPE,
+      TMVCConstants.DEFAULT_CONTENT_CHARSET,
+      Params,
+      ResponseContentType,
+      ResponseContentCharset));
+    CheckEquals(0, Params.Count);
+    CheckEquals('TSimpleController', Router.MVCControllerClass.ClassName);
+    CheckEquals('OrdersProduceJSON', Router.MethodToCall.Name);
+    CheckEquals(TMVCConstants.DEFAULT_CONTENT_CHARSET, ResponseContentCharset);
+  finally
+    Params.Free;
+  end;
+end;
+
+procedure TTestRouting.TestProduceRoutingsWithExplicitCharset;
+var
+  Params: TMVCRequestParamsTable;
+  ResponseContentType: string;
+  ResponseContentCharset: string;
+begin
+  Params := TMVCRequestParamsTable.Create;
+  try
+    // a GET request with a ACCEPT: application/json
+    CheckTrue(Router.ExecuteRouting('/orders', httpGET,
+      '',
+      'application/json; charset=UTF-8',
+      Controllers,
+      TMVCConstants.DEFAULT_CONTENT_TYPE,
+      TMVCConstants.DEFAULT_CONTENT_CHARSET,
+      Params,
+      ResponseContentType,
+      ResponseContentCharset));
+    CheckEquals(0, Params.Count);
+    CheckEquals('TSimpleController', Router.MVCControllerClass.ClassName);
+    CheckEquals('OrdersProduceJSON', Router.MethodToCall.Name);
+    CheckEquals(TMVCConstants.DEFAULT_CONTENT_CHARSET, ResponseContentCharset);
+  finally
+    Params.Free;
+  end;
+end;
+
 procedure TTestRouting.TestWithMethodTypes;
 var
   Params: TMVCRequestParamsTable;

unittests/DMVCFrameworkTests/LiveServerTestU.pas

@@ -261,7 +261,6 @@ end;
 procedure TServerTest.TestMiddlewareHandler;
 var
   r: IRESTResponse;
-  JSON: TJSONObject;
   P: TPerson;
 begin
   r := RESTClient
@@ -274,7 +273,6 @@ end;
 procedure TServerTest.TestMiddlewareSpeedMiddleware;
 var
   r: IRESTResponse;
-  JSON: TJSONObject;
   P: TPerson;
 begin
   P := TPerson.Create;
@@ -307,7 +305,6 @@ end;
 procedure TServerTest.TestPOSTWithObjectJSONBody;
 var
   r: IRESTResponse;
-  JSON: TJSONObject;
   P: TPerson;
 begin
   P := TPerson.Create;

unittests/DMVCFrameworkTests/TestControllersU.pas

@@ -22,6 +22,11 @@ type
   public
     [MVCPath('/')]
     procedure Index(Context: TWebContext);
+
+    [MVCPath('/orders')]
+    [MVCProduces('application/json')]
+    procedure OrdersProduceJSON(Context: TWebContext);
+
     [MVCPath('/orders')]
     procedure Orders(Context: TWebContext);
 
@@ -77,6 +82,11 @@ begin
 
 end;
 
+procedure TSimpleController.OrdersProduceJSON(Context: TWebContext);
+begin
+
+end;
+
 procedure TSimpleController.PatchOrder(Context: TWebContext);
 begin
 

unittests/TestServer/TestServerControllerU.pas

@@ -205,7 +205,7 @@ procedure TTestServerController.TestEncoding(ctx: TWebContext);
 var
   Obj: TJSONObject;
 begin
-  ContentEncoding := 'utf-8';
+  ContentCharset := TMVCConstants.DEFAULT_CONTENT_CHARSET;
   Obj := TJSONObject.Create;
   Obj.AddPair('name1', 'jørn');
   Obj.AddPair('name2', 'Što je Unicode?');