mirror of
https://github.com/danieleteti/delphimvcframework.git
synced 2024-11-15 07:45:54 +01:00
MVCActiveRecord Framework, Sample for MVCActiveRecord Framework
This commit is contained in:
Daniele Teti
parent
d235c88dce
commit
e4cd5894ae
@ -46,6 +46,7 @@
|
||||
## What's New
|
||||
|
||||
### 3.1.0 lithium (currently in beta)
|
||||
- ActiveRecord support (check sample `activerecord_crud`)
|
||||
- `Config[TMVCConfigKey.FallbackResource]` is served only if request path is empty or `/`.
|
||||
- Now the JSON-RPC executor provides methods to handle HTTP headers for JSON-RPC requests and notifications.
|
||||
- FIX for [issue #141](https://github.com/danieleteti/delphimvcframework/issues/141)
|
||||
|
||||
@ -2,7 +2,7 @@
|
||||
//
|
||||
// Delphi MVC Framework
|
||||
//
|
||||
// Copyright (c) 2010-2017 Daniele Teti and the DMVCFramework Team
|
||||
// Copyright (c) 2010-2018 Daniele Teti and the DMVCFramework Team
|
||||
//
|
||||
// https://github.com/danieleteti/delphimvcframework
|
||||
//
|
||||
|
||||
@ -2,7 +2,7 @@
|
||||
//
|
||||
// Delphi MVC Framework
|
||||
//
|
||||
// Copyright (c) 2010-2017 Daniele Teti and the DMVCFramework Team
|
||||
// Copyright (c) 2010-2018 Daniele Teti and the DMVCFramework Team
|
||||
//
|
||||
// https://github.com/danieleteti/delphimvcframework
|
||||
//
|
||||
|
||||
@ -2,7 +2,7 @@
|
||||
//
|
||||
// Delphi MVC Framework
|
||||
//
|
||||
// Copyright (c) 2010-2017 Daniele Teti and the DMVCFramework Team
|
||||
// Copyright (c) 2010-2018 Daniele Teti and the DMVCFramework Team
|
||||
//
|
||||
// https://github.com/danieleteti/delphimvcframework
|
||||
//
|
||||
|
||||
@ -2,7 +2,7 @@
|
||||
//
|
||||
// Delphi MVC Framework
|
||||
//
|
||||
// Copyright (c) 2010-2017 Daniele Teti and the DMVCFramework Team
|
||||
// Copyright (c) 2010-2018 Daniele Teti and the DMVCFramework Team
|
||||
//
|
||||
// https://github.com/danieleteti/delphimvcframework
|
||||
//
|
||||
|
||||
150
samples/activerecord_crud/Entities.pas
Normal file
150
samples/activerecord_crud/Entities.pas
Normal file
@ -0,0 +1,150 @@
|
||||
unit Entities;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
MVCFramework.Serializer.Commons,
|
||||
MVCFramework.ActiveRecord,
|
||||
System.Classes;
|
||||
|
||||
type
|
||||
|
||||
[MVCNameCase(ncLowerCase)]
|
||||
[Table('PEOPLE')]
|
||||
TPerson = class(TMVCActiveRecord)
|
||||
private
|
||||
[PrimaryKey('ID', [foAutoGenerated])]
|
||||
fID: Int64;
|
||||
[TableField('LAST_NAME')]
|
||||
fLastName: string;
|
||||
[TableField('FIRST_NAME')]
|
||||
fFirstName: string;
|
||||
[TableField('DOB')]
|
||||
fDOB: TDate;
|
||||
[TableField('FULL_NAME')]
|
||||
fFullName: string;
|
||||
[TableField('IS_MALE')]
|
||||
fIsMale: Boolean;
|
||||
[TableField('NOTE')]
|
||||
fNote: string;
|
||||
[TableField('PHOTO')]
|
||||
fPhoto: TStream;
|
||||
|
||||
// transient fields
|
||||
fAge: Integer;
|
||||
|
||||
procedure SetLastName(const Value: string);
|
||||
procedure SetID(const Value: Int64);
|
||||
procedure SetFirstName(const Value: string);
|
||||
procedure SetDOB(const Value: TDate);
|
||||
function GetFullName: string;
|
||||
procedure SetIsMale(const Value: Boolean);
|
||||
procedure SetNote(const Value: string);
|
||||
protected
|
||||
procedure OnAfterLoad; override;
|
||||
procedure OnBeforeInsertOrUpdate; override;
|
||||
procedure OnValidation; override;
|
||||
procedure OnBeforeInsert; override;
|
||||
public
|
||||
constructor Create; override;
|
||||
destructor Destroy; override;
|
||||
property ID: Int64 read fID write SetID;
|
||||
property LastName: string read fLastName write SetLastName;
|
||||
property FirstName: string read fFirstName write SetFirstName;
|
||||
property Age: Integer read fAge;
|
||||
property DOB: TDate read fDOB write SetDOB;
|
||||
property FullName: string read GetFullName;
|
||||
property IsMale: Boolean read fIsMale write SetIsMale;
|
||||
property Note: string read fNote write SetNote;
|
||||
property Photo: TStream read fPhoto;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
System.DateUtils,
|
||||
System.SysUtils;
|
||||
|
||||
{ TPersona }
|
||||
|
||||
constructor TPerson.Create;
|
||||
begin
|
||||
inherited;
|
||||
fPhoto := TMemoryStream.Create;
|
||||
end;
|
||||
|
||||
destructor TPerson.Destroy;
|
||||
begin
|
||||
fPhoto.Free;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TPerson.GetFullName: string;
|
||||
begin
|
||||
Result := fFullName;
|
||||
end;
|
||||
|
||||
procedure TPerson.OnAfterLoad;
|
||||
begin
|
||||
inherited;
|
||||
fAge := Yearsbetween(fDOB, now);
|
||||
end;
|
||||
|
||||
procedure TPerson.OnBeforeInsert;
|
||||
begin
|
||||
inherited;
|
||||
TMemoryStream(fPhoto).LoadFromFile('C:\DEV\dmvcframework\samples\_\customer.png');
|
||||
end;
|
||||
|
||||
procedure TPerson.OnBeforeInsertOrUpdate;
|
||||
begin
|
||||
inherited;
|
||||
fLastName := fLastName.ToUpper;
|
||||
fFirstName := fFirstName.ToUpper;
|
||||
fFullName := fFirstName + ' ' + fLastName;
|
||||
end;
|
||||
|
||||
procedure TPerson.OnValidation;
|
||||
begin
|
||||
inherited;
|
||||
if fLastName.Trim.IsEmpty or fFirstName.Trim.IsEmpty then
|
||||
raise EMVCActiveRecord.Create('Validation error. FirstName and LastName are required');
|
||||
end;
|
||||
|
||||
procedure TPerson.SetLastName(const Value: string);
|
||||
begin
|
||||
fLastName := Value;
|
||||
end;
|
||||
|
||||
procedure TPerson.SetNote(const Value: string);
|
||||
begin
|
||||
fNote := Value;
|
||||
end;
|
||||
|
||||
procedure TPerson.SetDOB(const Value: TDate);
|
||||
begin
|
||||
fDOB := Value;
|
||||
end;
|
||||
|
||||
procedure TPerson.SetID(const Value: Int64);
|
||||
begin
|
||||
fID := Value;
|
||||
end;
|
||||
|
||||
procedure TPerson.SetIsMale(const Value: Boolean);
|
||||
begin
|
||||
fIsMale := Value;
|
||||
end;
|
||||
|
||||
procedure TPerson.SetFirstName(const Value: string);
|
||||
begin
|
||||
fFirstName := Value;
|
||||
end;
|
||||
|
||||
initialization
|
||||
|
||||
ActiveRecordMappingRegistry.AddEntity('people', TPerson);
|
||||
|
||||
finalization
|
||||
|
||||
end.
|
||||
43
samples/activerecord_crud/FDConnectionConfigU.pas
Normal file
43
samples/activerecord_crud/FDConnectionConfigU.pas
Normal file
@ -0,0 +1,43 @@
|
||||
unit FDConnectionConfigU;
|
||||
|
||||
interface
|
||||
|
||||
const
|
||||
CON_DEF_NAME = 'MyPrivConn';
|
||||
|
||||
function CreatePrivateConnDef(AIsPooled: boolean = True): string;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
System.Classes,
|
||||
FireDAC.Comp.Client;
|
||||
|
||||
function CreatePrivateConnDef(AIsPooled: boolean): string;
|
||||
var
|
||||
LParams: TStringList;
|
||||
LConnName: string;
|
||||
begin
|
||||
LParams := TStringList.Create;
|
||||
try
|
||||
LParams.Add('Database=C:\DEV\dmvcframework\samples\data\ACTIVERECORDDB.FDB');
|
||||
LParams.Add('Protocol=TCPIP');
|
||||
LParams.Add('Server=localhost');
|
||||
LParams.Add('User_Name=sysdba');
|
||||
LParams.Add('Password=masterkey');
|
||||
if AIsPooled then
|
||||
begin
|
||||
LParams.Add('Pooled=True');
|
||||
end
|
||||
else
|
||||
begin
|
||||
LParams.Add('Pooled=False');
|
||||
end;
|
||||
FDManager.AddConnectionDef(CON_DEF_NAME, 'FB', LParams);
|
||||
finally
|
||||
LParams.Free;
|
||||
end;
|
||||
Result := LConnName;
|
||||
end;
|
||||
|
||||
end.
|
||||
8
samples/activerecord_crud/WebModuleU.dfm
Normal file
8
samples/activerecord_crud/WebModuleU.dfm
Normal file
@ -0,0 +1,8 @@
|
||||
object MyWebModule: TMyWebModule
|
||||
OldCreateOrder = False
|
||||
OnCreate = WebModuleCreate
|
||||
OnDestroy = WebModuleDestroy
|
||||
Actions = <>
|
||||
Height = 230
|
||||
Width = 415
|
||||
end
|
||||
89
samples/activerecord_crud/WebModuleU.pas
Normal file
89
samples/activerecord_crud/WebModuleU.pas
Normal file
@ -0,0 +1,89 @@
|
||||
unit WebModuleU;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
System.SysUtils,
|
||||
System.Classes,
|
||||
Web.HTTPApp,
|
||||
MVCFramework;
|
||||
|
||||
type
|
||||
TMyWebModule = class(TWebModule)
|
||||
procedure WebModuleCreate(Sender: TObject);
|
||||
procedure WebModuleDestroy(Sender: TObject);
|
||||
private
|
||||
FMVC: TMVCEngine;
|
||||
public
|
||||
{ Public declarations }
|
||||
end;
|
||||
|
||||
var
|
||||
WebModuleClass: TComponentClass = TMyWebModule;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.dfm}
|
||||
|
||||
uses
|
||||
System.IOUtils,
|
||||
MVCFramework.Commons,
|
||||
MVCFramework.ActiveRecordController,
|
||||
MVCFramework.ActiveRecord,
|
||||
FireDAC.Comp.Client,
|
||||
FDConnectionConfigU;
|
||||
|
||||
procedure TMyWebModule.WebModuleCreate(Sender: TObject);
|
||||
begin
|
||||
FMVC := TMVCEngine.Create(Self,
|
||||
procedure(Config: TMVCConfig)
|
||||
begin
|
||||
// enable static files
|
||||
Config[TMVCConfigKey.DocumentRoot] := TPath.Combine(ExtractFilePath(GetModuleName(HInstance)), 'www');
|
||||
// session timeout (0 means session cookie)
|
||||
Config[TMVCConfigKey.SessionTimeout] := '0';
|
||||
// default content-type
|
||||
Config[TMVCConfigKey.DefaultContentType] := TMVCConstants.DEFAULT_CONTENT_TYPE;
|
||||
// default content charset
|
||||
Config[TMVCConfigKey.DefaultContentCharset] := TMVCConstants.DEFAULT_CONTENT_CHARSET;
|
||||
// unhandled actions are permitted?
|
||||
Config[TMVCConfigKey.AllowUnhandledAction] := 'false';
|
||||
// default view file extension
|
||||
Config[TMVCConfigKey.DefaultViewFileExtension] := 'html';
|
||||
// view path
|
||||
Config[TMVCConfigKey.ViewPath] := 'templates';
|
||||
// Enable Server Signature in response
|
||||
Config[TMVCConfigKey.ExposeServerSignature] := 'true';
|
||||
// Define a default URL for requests that don't map to a route or a file (useful for client side web app)
|
||||
Config[TMVCConfigKey.FallbackResource] := 'index.html';
|
||||
end);
|
||||
FMVC.AddController(TMVCActiveRecordController,
|
||||
function: TMVCController
|
||||
begin
|
||||
Result := TMVCActiveRecordController.Create(
|
||||
function: TFDConnection
|
||||
begin
|
||||
Result := TFDConnection.Create(nil);
|
||||
Result.ConnectionDefName := CON_DEF_NAME;
|
||||
Result.Open;
|
||||
end,
|
||||
function(aContext: TWebContext; aClass: TMVCActiveRecordClass; aAction: TMVCActiveRecordAction): Boolean
|
||||
begin
|
||||
if aContext.LoggedUser.IsValid then
|
||||
begin
|
||||
Result := True;
|
||||
end
|
||||
else
|
||||
begin
|
||||
Result := not(aAction in [TMVCActiveRecordAction.Delete]);
|
||||
end;
|
||||
end);
|
||||
end, '/api/entities');
|
||||
end;
|
||||
|
||||
procedure TMyWebModule.WebModuleDestroy(Sender: TObject);
|
||||
begin
|
||||
FMVC.Free;
|
||||
end;
|
||||
|
||||
end.
|
||||
113
samples/activerecord_crud/activerecord_crud.dpr
Normal file
113
samples/activerecord_crud/activerecord_crud.dpr
Normal file
@ -0,0 +1,113 @@
|
||||
program activerecord_crud;
|
||||
|
||||
{$APPTYPE CONSOLE}
|
||||
|
||||
uses
|
||||
FireDAC.Phys.FB, {required by FireDAC to access Firebird}
|
||||
System.SysUtils,
|
||||
MVCFramework.Logger,
|
||||
MVCFramework.Commons,
|
||||
MVCFramework.REPLCommandsHandlerU,
|
||||
Web.ReqMulti,
|
||||
Web.WebReq,
|
||||
Web.WebBroker,
|
||||
IdHTTPWebBrokerBridge,
|
||||
WebModuleU in 'WebModuleU.pas' {MyWebModule: TWebModule} ,
|
||||
Entities in 'Entities.pas',
|
||||
FDConnectionConfigU in 'FDConnectionConfigU.pas';
|
||||
|
||||
{$R *.res}
|
||||
|
||||
procedure RunServer(APort: Integer);
|
||||
var
|
||||
lServer: TIdHTTPWebBrokerBridge;
|
||||
lCustomHandler: TMVCCustomREPLCommandsHandler;
|
||||
lCmd: string;
|
||||
begin
|
||||
Writeln('** DMVCFramework Server ** build ' + DMVCFRAMEWORK_VERSION);
|
||||
if ParamCount >= 1 then
|
||||
lCmd := ParamStr(1)
|
||||
else
|
||||
lCmd := 'start';
|
||||
|
||||
lCustomHandler := function(const Value: string; const Server: TIdHTTPWebBrokerBridge; out Handled: Boolean): THandleCommandResult
|
||||
begin
|
||||
Handled := False;
|
||||
Result := THandleCommandResult.Unknown;
|
||||
|
||||
// Write here your custom command for the REPL using the following form...
|
||||
// ***
|
||||
// Handled := False;
|
||||
// if (Value = 'apiversion') then
|
||||
// begin
|
||||
// REPLEmit('Print my API version number');
|
||||
// Result := THandleCommandResult.Continue;
|
||||
// Handled := True;
|
||||
// end
|
||||
// else if (Value = 'datetime') then
|
||||
// begin
|
||||
// REPLEmit(DateTimeToStr(Now));
|
||||
// Result := THandleCommandResult.Continue;
|
||||
// Handled := True;
|
||||
// end;
|
||||
end;
|
||||
|
||||
lServer := TIdHTTPWebBrokerBridge.Create(nil);
|
||||
try
|
||||
lServer.DefaultPort := APort;
|
||||
|
||||
{ more info about MaxConnections
|
||||
http://www.indyproject.org/docsite/html/frames.html?frmname=topic&frmfile=TIdCustomTCPServer_MaxConnections.html }
|
||||
lServer.MaxConnections := 0;
|
||||
|
||||
{ more info about ListenQueue
|
||||
http://www.indyproject.org/docsite/html/frames.html?frmname=topic&frmfile=TIdCustomTCPServer_ListenQueue.html }
|
||||
lServer.ListenQueue := 200;
|
||||
|
||||
Writeln('Write "quit" or "exit" to shutdown the server');
|
||||
repeat
|
||||
if lCmd.IsEmpty then
|
||||
begin
|
||||
write('-> ');
|
||||
ReadLn(lCmd)
|
||||
end;
|
||||
try
|
||||
case HandleCommand(lCmd.ToLower, lServer, lCustomHandler) of
|
||||
THandleCommandResult.Continue:
|
||||
begin
|
||||
Continue;
|
||||
end;
|
||||
THandleCommandResult.Break:
|
||||
begin
|
||||
Break;
|
||||
end;
|
||||
THandleCommandResult.Unknown:
|
||||
begin
|
||||
REPLEmit('Unknown command: ' + lCmd);
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
lCmd := '';
|
||||
end;
|
||||
until False;
|
||||
|
||||
finally
|
||||
lServer.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
ReportMemoryLeaksOnShutdown := True;
|
||||
IsMultiThread := True;
|
||||
try
|
||||
CreatePrivateConnDef;
|
||||
if WebRequestHandler <> nil then
|
||||
WebRequestHandler.WebModuleClass := WebModuleClass;
|
||||
WebRequestHandlerProc.MaxConnections := 1024;
|
||||
RunServer(8080);
|
||||
except
|
||||
on E: Exception do
|
||||
Writeln(E.ClassName, ': ', E.Message);
|
||||
end;
|
||||
|
||||
end.
|
||||
567
samples/activerecord_crud/activerecord_crud.dproj
Normal file
567
samples/activerecord_crud/activerecord_crud.dproj
Normal file
@ -0,0 +1,567 @@
|
||||
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
|
||||
<PropertyGroup>
|
||||
<ProjectGuid>{AA03EFF9-BE4C-4D2B-A76F-61F472553AE2}</ProjectGuid>
|
||||
<ProjectVersion>18.4</ProjectVersion>
|
||||
<FrameworkType>VCL</FrameworkType>
|
||||
<MainSource>activerecord_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)'=='Android' and '$(Base)'=='true') or '$(Base_Android)'!=''">
|
||||
<Base_Android>true</Base_Android>
|
||||
<CfgParent>Base</CfgParent>
|
||||
<Base>true</Base>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="('$(Platform)'=='iOSDevice32' and '$(Base)'=='true') or '$(Base_iOSDevice32)'!=''">
|
||||
<Base_iOSDevice32>true</Base_iOSDevice32>
|
||||
<CfgParent>Base</CfgParent>
|
||||
<Base>true</Base>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="('$(Platform)'=='iOSDevice64' and '$(Base)'=='true') or '$(Base_iOSDevice64)'!=''">
|
||||
<Base_iOSDevice64>true</Base_iOSDevice64>
|
||||
<CfgParent>Base</CfgParent>
|
||||
<Base>true</Base>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="('$(Platform)'=='iOSSimulator' and '$(Base)'=='true') or '$(Base_iOSSimulator)'!=''">
|
||||
<Base_iOSSimulator>true</Base_iOSSimulator>
|
||||
<CfgParent>Base</CfgParent>
|
||||
<Base>true</Base>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="('$(Platform)'=='Linux64' and '$(Base)'=='true') or '$(Base_Linux64)'!=''">
|
||||
<Base_Linux64>true</Base_Linux64>
|
||||
<CfgParent>Base</CfgParent>
|
||||
<Base>true</Base>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="('$(Platform)'=='OSX32' and '$(Base)'=='true') or '$(Base_OSX32)'!=''">
|
||||
<Base_OSX32>true</Base_OSX32>
|
||||
<CfgParent>Base</CfgParent>
|
||||
<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)'!=''">
|
||||
<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>
|
||||
<DCC_UsePackage>RESTComponents;emsclientfiredac;DataSnapFireDAC;FireDACIBDriver;emsclient;FireDACCommon;RESTBackendComponents;soapserver;CloudService;FireDACCommonDriver;inet;FireDAC;FireDACSqliteDriver;soaprtl;soapmidas;$(DCC_UsePackage)</DCC_UsePackage>
|
||||
<DCC_Namespace>System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace)</DCC_Namespace>
|
||||
<UsingDelphiRTL>true</UsingDelphiRTL>
|
||||
<Icon_MainIcon>$(BDS)\bin\delphi_PROJECTICON.ico</Icon_MainIcon>
|
||||
<Icns_MainIcns>$(BDS)\bin\delphi_PROJECTICNS.icns</Icns_MainIcns>
|
||||
<DCC_UnitSearchPath>$(DMVC);$(DCC_UnitSearchPath)</DCC_UnitSearchPath>
|
||||
<DCC_Framework>VCL;$(DCC_Framework)</DCC_Framework>
|
||||
<SanitizedProjectName>activerecord_crud</SanitizedProjectName>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="'$(Base_Android)'!=''">
|
||||
<DCC_UsePackage>DBXSqliteDriver;DBXInterBaseDriver;tethering;bindcompfmx;fmx;FireDACDBXDriver;dbexpress;IndyCore;dsnap;DataSnapCommon;bindengine;DataSnapClient;IndyIPCommon;bindcompdbx;IndyIPServer;IndySystem;fmxFireDAC;DbxCommonDriver;xmlrtl;DataSnapNativeClient;FireDACDSDriver;rtl;DbxClientDriver;CustomIPTransport;bindcomp;IndyIPClient;dbxcds;dsnapxml;DataSnapProviderClient;dbrtl;IndyProtocols;$(DCC_UsePackage)</DCC_UsePackage>
|
||||
<EnabledSysJars>android-support-v4.dex.jar;cloud-messaging.dex.jar;fmx.dex.jar;google-analytics-v2.dex.jar;google-play-billing.dex.jar;google-play-licensing.dex.jar;google-play-services-ads-7.0.0.dex.jar;google-play-services-analytics-7.0.0.dex.jar;google-play-services-base-7.0.0.dex.jar;google-play-services-identity-7.0.0.dex.jar;google-play-services-maps-7.0.0.dex.jar;google-play-services-panorama-7.0.0.dex.jar;google-play-services-plus-7.0.0.dex.jar;google-play-services-wallet-7.0.0.dex.jar</EnabledSysJars>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="'$(Base_iOSDevice32)'!=''">
|
||||
<DCC_UsePackage>DBXSqliteDriver;fmxase;DBXInterBaseDriver;tethering;bindcompfmx;fmx;FireDACDBXDriver;dbexpress;IndyCore;dsnap;DataSnapCommon;bindengine;DataSnapClient;IndyIPCommon;bindcompdbx;IndyIPServer;IndySystem;fmxFireDAC;DbxCommonDriver;xmlrtl;DataSnapNativeClient;FireDACDSDriver;rtl;DbxClientDriver;CustomIPTransport;bindcomp;IndyIPClient;dbxcds;dsnapxml;DataSnapProviderClient;dbrtl;IndyProtocols;$(DCC_UsePackage)</DCC_UsePackage>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="'$(Base_iOSDevice64)'!=''">
|
||||
<DCC_UsePackage>DBXSqliteDriver;fmxase;DBXInterBaseDriver;tethering;rtcSDK;PythonVCL_D;bindcompfmx;fmx;FireDACDBXDriver;dbexpress;IndyCore;dsnap;DataSnapCommon;bindengine;DataSnapClient;rtcSDK_DBA;IndyIPCommon;bindcompdbx;IndyIPServer;IndySystem;fmxFireDAC;DbxCommonDriver;xmlrtl;DataSnapNativeClient;FireDACDSDriver;rtl;DbxClientDriver;CustomIPTransport;bindcomp;IndyIPClient;dbxcds;dsnapxml;DataSnapProviderClient;dbrtl;IndyProtocols;$(DCC_UsePackage)</DCC_UsePackage>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="'$(Base_iOSSimulator)'!=''">
|
||||
<DCC_UsePackage>DBXSqliteDriver;fmxase;DBXInterBaseDriver;tethering;bindcompfmx;fmx;FireDACDBXDriver;dbexpress;IndyCore;dsnap;DataSnapCommon;bindengine;DataSnapClient;IndyIPCommon;bindcompdbx;IndyIPServer;IndySystem;fmxFireDAC;DbxCommonDriver;xmlrtl;DataSnapNativeClient;FireDACDSDriver;rtl;DbxClientDriver;CustomIPTransport;bindcomp;IndyIPClient;dbxcds;dsnapxml;DataSnapProviderClient;dbrtl;IndyProtocols;$(DCC_UsePackage)</DCC_UsePackage>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="'$(Base_Linux64)'!=''">
|
||||
<DCC_UsePackage>FireDACADSDriver;rtcSDK;DatasnapConnectorsFreePascal;FireDACMSSQLDriver;PythonVCL_D;inetdb;emsedge;dbexpress;IndyCore;dsnap;DataSnapCommon;DataSnapConnectors;bindengine;FireDACOracleDriver;FireDACMySQLDriver;FireDACCommonODBC;DataSnapClient;rtcSDK_DBA;IndySystem;FireDACDb2Driver;FireDACInfxDriver;emshosting;FireDACPgDriver;FireDACASADriver;FireDACTDataDriver;DbxCommonDriver;DataSnapServer;xmlrtl;DataSnapNativeClient;rtl;DbxClientDriver;CustomIPTransport;bindcomp;dbxcds;FireDACODBCDriver;DataSnapIndy10ServerTransport;dsnapxml;dbrtl;IndyProtocols;FireDACMongoDBDriver;DataSnapServerMidas;$(DCC_UsePackage)</DCC_UsePackage>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="'$(Base_OSX32)'!=''">
|
||||
<DCC_UsePackage>DBXSqliteDriver;fmxase;DBXInterBaseDriver;tethering;FireDACMSSQLDriver;bindcompfmx;DBXOracleDriver;inetdb;emsedge;fmx;fmxdae;FireDACDBXDriver;dbexpress;IndyCore;dsnap;DataSnapCommon;bindengine;DBXMySQLDriver;FireDACOracleDriver;FireDACMySQLDriver;DBXFirebirdDriver;FireDACCommonODBC;DataSnapClient;IndyIPCommon;bindcompdbx;IndyIPServer;IndySystem;fmxFireDAC;emshosting;FireDACPgDriver;FireDACASADriver;FireDACTDataDriver;DbxCommonDriver;DataSnapServer;xmlrtl;DataSnapNativeClient;fmxobj;FireDACDSDriver;rtl;DbxClientDriver;DBXSybaseASADriver;CustomIPTransport;bindcomp;DBXInformixDriver;IndyIPClient;dbxcds;FireDACODBCDriver;DataSnapIndy10ServerTransport;dsnapxml;DataSnapProviderClient;dbrtl;IndyProtocols;inetdbxpress;FireDACMongoDBDriver;DataSnapServerMidas;$(DCC_UsePackage)</DCC_UsePackage>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="'$(Base_Win32)'!=''">
|
||||
<DCC_UsePackage>DBXSqliteDriver;fmxase;DBXDb2Driver;DBXInterBaseDriver;OverbyteIcsD102Run;vclactnband;vclFireDAC;tethering;svnui;FireDACADSDriver;rtcSDK;DBXMSSQLDriver;DatasnapConnectorsFreePascal;FireDACMSSQLDriver;vcltouch;PythonVCL_D;vcldb;bindcompfmx;svn;DBXOracleDriver;inetdb;MQTTComponents;VirtualTreesDR;RaizeComponentsVcl;emsedge;RaizeComponentsVclDb;fmx;fmxdae;FireDACDBXDriver;dbexpress;IndyCore;vclx;Python_D;dsnap;DataSnapCommon;Package1;DataSnapConnectors;VCLRESTComponents;JclDeveloperTools;vclie;bindengine;DBXMySQLDriver;FireDACOracleDriver;FireDACMySQLDriver;DBXFirebirdDriver;pasdoc_package_XE8;FireDACCommonODBC;DataSnapClient;rtcSDK_DBA;IndyIPCommon;bindcompdbx;vcl;IndyIPServer;DBXSybaseASEDriver;IndySystem;FireDACDb2Driver;dsnapcon;DMVC_IDE_Expert_D102Tokyo;FireDACMSAccDriver;fmxFireDAC;FireDACInfxDriver;vclimg;Jcl;emshosting;FireDACPgDriver;FireDACASADriver;DBXOdbcDriver;FireDACTDataDriver;DbxCommonDriver;DataSnapServer;xmlrtl;DataSnapNativeClient;fmxobj;vclwinx;FireDACDSDriver;rtl;RFindUnit;DbxClientDriver;DBXSybaseASADriver;CustomIPTransport;vcldsnap;SynEditDR;bindcomp;appanalytics;DBXInformixDriver;IndyIPClient;bindcompvcl;dbxcds;VclSmp;adortl;FireDACODBCDriver;JclVcl;DataSnapIndy10ServerTransport;dsnapxml;DataSnapProviderClient;dbrtl;IndyProtocols;inetdbxpress;FireDACMongoDBDriver;JclContainers;DataSnapServerMidas;$(DCC_UsePackage)</DCC_UsePackage>
|
||||
<DCC_Namespace>Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)</DCC_Namespace>
|
||||
<BT_BuildType>Debug</BT_BuildType>
|
||||
<VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
|
||||
<VerInfo_Locale>1033</VerInfo_Locale>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="'$(Base_Win64)'!=''">
|
||||
<DCC_UsePackage>DBXSqliteDriver;fmxase;DBXDb2Driver;DBXInterBaseDriver;OverbyteIcsD102Run;vclactnband;vclFireDAC;tethering;FireDACADSDriver;DBXMSSQLDriver;DatasnapConnectorsFreePascal;FireDACMSSQLDriver;vcltouch;vcldb;bindcompfmx;DBXOracleDriver;inetdb;VirtualTreesDR;RaizeComponentsVcl;emsedge;RaizeComponentsVclDb;fmx;fmxdae;FireDACDBXDriver;dbexpress;IndyCore;vclx;dsnap;DataSnapCommon;DataSnapConnectors;VCLRESTComponents;vclie;bindengine;DBXMySQLDriver;FireDACOracleDriver;FireDACMySQLDriver;DBXFirebirdDriver;FireDACCommonODBC;DataSnapClient;IndyIPCommon;bindcompdbx;vcl;IndyIPServer;DBXSybaseASEDriver;IndySystem;FireDACDb2Driver;dsnapcon;FireDACMSAccDriver;fmxFireDAC;FireDACInfxDriver;vclimg;emshosting;FireDACPgDriver;FireDACASADriver;DBXOdbcDriver;FireDACTDataDriver;DbxCommonDriver;DataSnapServer;xmlrtl;DataSnapNativeClient;fmxobj;vclwinx;FireDACDSDriver;rtl;DbxClientDriver;DBXSybaseASADriver;CustomIPTransport;vcldsnap;SynEditDR;bindcomp;appanalytics;DBXInformixDriver;IndyIPClient;bindcompvcl;dbxcds;VclSmp;adortl;FireDACODBCDriver;DataSnapIndy10ServerTransport;dsnapxml;DataSnapProviderClient;dbrtl;IndyProtocols;inetdbxpress;FireDACMongoDBDriver;DataSnapServerMidas;$(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)'!=''">
|
||||
<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="WebModuleU.pas">
|
||||
<Form>MyWebModule</Form>
|
||||
<DesignClass>TWebModule</DesignClass>
|
||||
</DCCReference>
|
||||
<DCCReference Include="Entities.pas"/>
|
||||
<DCCReference Include="FDConnectionConfigU.pas"/>
|
||||
<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>Console</Borland.ProjectType>
|
||||
<BorlandProject>
|
||||
<Delphi.Personality>
|
||||
<Source>
|
||||
<Source Name="MainSource">activerecord_crud.dpr</Source>
|
||||
</Source>
|
||||
</Delphi.Personality>
|
||||
<Deployment Version="3">
|
||||
<DeployFile LocalName="$(BDS)\Redist\osx32\libcgunwind.1.0.dylib" Class="DependencyModule">
|
||||
<Platform Name="OSX32">
|
||||
<Overwrite>true</Overwrite>
|
||||
</Platform>
|
||||
</DeployFile>
|
||||
<DeployFile LocalName="$(BDS)\Redist\iossimulator\libcgunwind.1.0.dylib" Class="DependencyModule">
|
||||
<Platform Name="iOSSimulator">
|
||||
<Overwrite>true</Overwrite>
|
||||
</Platform>
|
||||
</DeployFile>
|
||||
<DeployFile LocalName="$(BDS)\Redist\iossimulator\libPCRE.dylib" Class="DependencyModule">
|
||||
<Platform Name="iOSSimulator">
|
||||
<Overwrite>true</Overwrite>
|
||||
</Platform>
|
||||
</DeployFile>
|
||||
<DeployFile LocalName="$(BDS)\Redist\osx32\libcgsqlite3.dylib" Class="DependencyModule">
|
||||
<Platform Name="OSX32">
|
||||
<Overwrite>true</Overwrite>
|
||||
</Platform>
|
||||
</DeployFile>
|
||||
<DeployFile LocalName="Win32\Debug\activerecord_crud.exe" Configuration="Debug" Class="ProjectOutput">
|
||||
<Platform Name="Win32">
|
||||
<RemoteName>activerecord_crud.exe</RemoteName>
|
||||
<Overwrite>true</Overwrite>
|
||||
</Platform>
|
||||
</DeployFile>
|
||||
<DeployClass Name="AdditionalDebugSymbols">
|
||||
<Platform Name="OSX32">
|
||||
<Operation>1</Operation>
|
||||
</Platform>
|
||||
<Platform Name="Win32">
|
||||
<RemoteDir>Contents\MacOS</RemoteDir>
|
||||
<Operation>0</Operation>
|
||||
</Platform>
|
||||
</DeployClass>
|
||||
<DeployClass Name="AndroidClassesDexFile">
|
||||
<Platform Name="Android">
|
||||
<RemoteDir>classes</RemoteDir>
|
||||
<Operation>1</Operation>
|
||||
</Platform>
|
||||
</DeployClass>
|
||||
<DeployClass Name="AndroidGDBServer">
|
||||
<Platform Name="Android">
|
||||
<RemoteDir>library\lib\armeabi-v7a</RemoteDir>
|
||||
<Operation>1</Operation>
|
||||
</Platform>
|
||||
</DeployClass>
|
||||
<DeployClass Name="AndroidLibnativeArmeabiFile">
|
||||
<Platform Name="Android">
|
||||
<RemoteDir>library\lib\armeabi</RemoteDir>
|
||||
<Operation>1</Operation>
|
||||
</Platform>
|
||||
</DeployClass>
|
||||
<DeployClass Name="AndroidLibnativeMipsFile">
|
||||
<Platform Name="Android">
|
||||
<RemoteDir>library\lib\mips</RemoteDir>
|
||||
<Operation>1</Operation>
|
||||
</Platform>
|
||||
</DeployClass>
|
||||
<DeployClass Name="AndroidServiceOutput">
|
||||
<Platform Name="Android">
|
||||
<RemoteDir>library\lib\armeabi-v7a</RemoteDir>
|
||||
<Operation>1</Operation>
|
||||
</Platform>
|
||||
</DeployClass>
|
||||
<DeployClass Name="AndroidSplashImageDef">
|
||||
<Platform Name="Android">
|
||||
<RemoteDir>res\drawable</RemoteDir>
|
||||
<Operation>1</Operation>
|
||||
</Platform>
|
||||
</DeployClass>
|
||||
<DeployClass Name="AndroidSplashStyles">
|
||||
<Platform Name="Android">
|
||||
<RemoteDir>res\values</RemoteDir>
|
||||
<Operation>1</Operation>
|
||||
</Platform>
|
||||
</DeployClass>
|
||||
<DeployClass Name="Android_DefaultAppIcon">
|
||||
<Platform Name="Android">
|
||||
<RemoteDir>res\drawable</RemoteDir>
|
||||
<Operation>1</Operation>
|
||||
</Platform>
|
||||
</DeployClass>
|
||||
<DeployClass Name="Android_LauncherIcon144">
|
||||
<Platform Name="Android">
|
||||
<RemoteDir>res\drawable-xxhdpi</RemoteDir>
|
||||
<Operation>1</Operation>
|
||||
</Platform>
|
||||
</DeployClass>
|
||||
<DeployClass Name="Android_LauncherIcon36">
|
||||
<Platform Name="Android">
|
||||
<RemoteDir>res\drawable-ldpi</RemoteDir>
|
||||
<Operation>1</Operation>
|
||||
</Platform>
|
||||
</DeployClass>
|
||||
<DeployClass Name="Android_LauncherIcon48">
|
||||
<Platform Name="Android">
|
||||
<RemoteDir>res\drawable-mdpi</RemoteDir>
|
||||
<Operation>1</Operation>
|
||||
</Platform>
|
||||
</DeployClass>
|
||||
<DeployClass Name="Android_LauncherIcon72">
|
||||
<Platform Name="Android">
|
||||
<RemoteDir>res\drawable-hdpi</RemoteDir>
|
||||
<Operation>1</Operation>
|
||||
</Platform>
|
||||
</DeployClass>
|
||||
<DeployClass Name="Android_LauncherIcon96">
|
||||
<Platform Name="Android">
|
||||
<RemoteDir>res\drawable-xhdpi</RemoteDir>
|
||||
<Operation>1</Operation>
|
||||
</Platform>
|
||||
</DeployClass>
|
||||
<DeployClass Name="Android_SplashImage426">
|
||||
<Platform Name="Android">
|
||||
<RemoteDir>res\drawable-small</RemoteDir>
|
||||
<Operation>1</Operation>
|
||||
</Platform>
|
||||
</DeployClass>
|
||||
<DeployClass Name="Android_SplashImage470">
|
||||
<Platform Name="Android">
|
||||
<RemoteDir>res\drawable-normal</RemoteDir>
|
||||
<Operation>1</Operation>
|
||||
</Platform>
|
||||
</DeployClass>
|
||||
<DeployClass Name="Android_SplashImage640">
|
||||
<Platform Name="Android">
|
||||
<RemoteDir>res\drawable-large</RemoteDir>
|
||||
<Operation>1</Operation>
|
||||
</Platform>
|
||||
</DeployClass>
|
||||
<DeployClass Name="Android_SplashImage960">
|
||||
<Platform Name="Android">
|
||||
<RemoteDir>res\drawable-xlarge</RemoteDir>
|
||||
<Operation>1</Operation>
|
||||
</Platform>
|
||||
</DeployClass>
|
||||
<DeployClass Name="DebugSymbols">
|
||||
<Platform Name="iOSSimulator">
|
||||
<Operation>1</Operation>
|
||||
</Platform>
|
||||
<Platform Name="OSX32">
|
||||
<Operation>1</Operation>
|
||||
</Platform>
|
||||
<Platform Name="Win32">
|
||||
<Operation>0</Operation>
|
||||
</Platform>
|
||||
</DeployClass>
|
||||
<DeployClass Name="DependencyFramework">
|
||||
<Platform Name="OSX32">
|
||||
<Operation>1</Operation>
|
||||
<Extensions>.framework</Extensions>
|
||||
</Platform>
|
||||
<Platform Name="Win32">
|
||||
<Operation>0</Operation>
|
||||
</Platform>
|
||||
</DeployClass>
|
||||
<DeployClass Name="DependencyModule">
|
||||
<Platform Name="OSX32">
|
||||
<Operation>1</Operation>
|
||||
<Extensions>.dylib</Extensions>
|
||||
</Platform>
|
||||
<Platform Name="Win32">
|
||||
<Operation>0</Operation>
|
||||
<Extensions>.dll;.bpl</Extensions>
|
||||
</Platform>
|
||||
</DeployClass>
|
||||
<DeployClass Required="true" Name="DependencyPackage">
|
||||
<Platform Name="iOSDevice32">
|
||||
<Operation>1</Operation>
|
||||
<Extensions>.dylib</Extensions>
|
||||
</Platform>
|
||||
<Platform Name="iOSDevice64">
|
||||
<Operation>1</Operation>
|
||||
<Extensions>.dylib</Extensions>
|
||||
</Platform>
|
||||
<Platform Name="iOSSimulator">
|
||||
<Operation>1</Operation>
|
||||
<Extensions>.dylib</Extensions>
|
||||
</Platform>
|
||||
<Platform Name="OSX32">
|
||||
<Operation>1</Operation>
|
||||
<Extensions>.dylib</Extensions>
|
||||
</Platform>
|
||||
<Platform Name="Win32">
|
||||
<Operation>0</Operation>
|
||||
<Extensions>.bpl</Extensions>
|
||||
</Platform>
|
||||
</DeployClass>
|
||||
<DeployClass Name="File">
|
||||
<Platform Name="Android">
|
||||
<Operation>0</Operation>
|
||||
</Platform>
|
||||
<Platform Name="iOSDevice32">
|
||||
<Operation>0</Operation>
|
||||
</Platform>
|
||||
<Platform Name="iOSDevice64">
|
||||
<Operation>0</Operation>
|
||||
</Platform>
|
||||
<Platform Name="iOSSimulator">
|
||||
<Operation>0</Operation>
|
||||
</Platform>
|
||||
<Platform Name="OSX32">
|
||||
<Operation>0</Operation>
|
||||
</Platform>
|
||||
<Platform Name="Win32">
|
||||
<Operation>0</Operation>
|
||||
</Platform>
|
||||
</DeployClass>
|
||||
<DeployClass Name="iPad_Launch1024">
|
||||
<Platform Name="iOSDevice32">
|
||||
<Operation>1</Operation>
|
||||
</Platform>
|
||||
<Platform Name="iOSDevice64">
|
||||
<Operation>1</Operation>
|
||||
</Platform>
|
||||
<Platform Name="iOSSimulator">
|
||||
<Operation>1</Operation>
|
||||
</Platform>
|
||||
</DeployClass>
|
||||
<DeployClass Name="iPad_Launch1536">
|
||||
<Platform Name="iOSDevice32">
|
||||
<Operation>1</Operation>
|
||||
</Platform>
|
||||
<Platform Name="iOSDevice64">
|
||||
<Operation>1</Operation>
|
||||
</Platform>
|
||||
<Platform Name="iOSSimulator">
|
||||
<Operation>1</Operation>
|
||||
</Platform>
|
||||
</DeployClass>
|
||||
<DeployClass Name="iPad_Launch2048">
|
||||
<Platform Name="iOSDevice32">
|
||||
<Operation>1</Operation>
|
||||
</Platform>
|
||||
<Platform Name="iOSDevice64">
|
||||
<Operation>1</Operation>
|
||||
</Platform>
|
||||
<Platform Name="iOSSimulator">
|
||||
<Operation>1</Operation>
|
||||
</Platform>
|
||||
</DeployClass>
|
||||
<DeployClass Name="iPad_Launch768">
|
||||
<Platform Name="iOSDevice32">
|
||||
<Operation>1</Operation>
|
||||
</Platform>
|
||||
<Platform Name="iOSDevice64">
|
||||
<Operation>1</Operation>
|
||||
</Platform>
|
||||
<Platform Name="iOSSimulator">
|
||||
<Operation>1</Operation>
|
||||
</Platform>
|
||||
</DeployClass>
|
||||
<DeployClass Name="iPhone_Launch320">
|
||||
<Platform Name="iOSDevice32">
|
||||
<Operation>1</Operation>
|
||||
</Platform>
|
||||
<Platform Name="iOSDevice64">
|
||||
<Operation>1</Operation>
|
||||
</Platform>
|
||||
<Platform Name="iOSSimulator">
|
||||
<Operation>1</Operation>
|
||||
</Platform>
|
||||
</DeployClass>
|
||||
<DeployClass Name="iPhone_Launch640">
|
||||
<Platform Name="iOSDevice32">
|
||||
<Operation>1</Operation>
|
||||
</Platform>
|
||||
<Platform Name="iOSDevice64">
|
||||
<Operation>1</Operation>
|
||||
</Platform>
|
||||
<Platform Name="iOSSimulator">
|
||||
<Operation>1</Operation>
|
||||
</Platform>
|
||||
</DeployClass>
|
||||
<DeployClass Name="iPhone_Launch640x1136">
|
||||
<Platform Name="iOSDevice32">
|
||||
<Operation>1</Operation>
|
||||
</Platform>
|
||||
<Platform Name="iOSDevice64">
|
||||
<Operation>1</Operation>
|
||||
</Platform>
|
||||
<Platform Name="iOSSimulator">
|
||||
<Operation>1</Operation>
|
||||
</Platform>
|
||||
</DeployClass>
|
||||
<DeployClass Name="ProjectAndroidManifest">
|
||||
<Platform Name="Android">
|
||||
<Operation>1</Operation>
|
||||
</Platform>
|
||||
</DeployClass>
|
||||
<DeployClass Name="ProjectiOSDeviceDebug">
|
||||
<Platform Name="iOSDevice32">
|
||||
<RemoteDir>..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF</RemoteDir>
|
||||
<Operation>1</Operation>
|
||||
</Platform>
|
||||
<Platform Name="iOSDevice64">
|
||||
<RemoteDir>..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF</RemoteDir>
|
||||
<Operation>1</Operation>
|
||||
</Platform>
|
||||
</DeployClass>
|
||||
<DeployClass Name="ProjectiOSDeviceResourceRules"/>
|
||||
<DeployClass Name="ProjectiOSEntitlements"/>
|
||||
<DeployClass Name="ProjectiOSInfoPList"/>
|
||||
<DeployClass Name="ProjectiOSResource">
|
||||
<Platform Name="iOSDevice32">
|
||||
<Operation>1</Operation>
|
||||
</Platform>
|
||||
<Platform Name="iOSDevice64">
|
||||
<Operation>1</Operation>
|
||||
</Platform>
|
||||
<Platform Name="iOSSimulator">
|
||||
<Operation>1</Operation>
|
||||
</Platform>
|
||||
</DeployClass>
|
||||
<DeployClass Name="ProjectOSXEntitlements"/>
|
||||
<DeployClass Name="ProjectOSXInfoPList"/>
|
||||
<DeployClass Name="ProjectOSXResource">
|
||||
<Platform Name="OSX32">
|
||||
<RemoteDir>Contents\Resources</RemoteDir>
|
||||
<Operation>1</Operation>
|
||||
</Platform>
|
||||
</DeployClass>
|
||||
<DeployClass Required="true" Name="ProjectOutput">
|
||||
<Platform Name="Android">
|
||||
<RemoteDir>library\lib\armeabi-v7a</RemoteDir>
|
||||
<Operation>1</Operation>
|
||||
</Platform>
|
||||
<Platform Name="iOSDevice32">
|
||||
<Operation>1</Operation>
|
||||
</Platform>
|
||||
<Platform Name="iOSDevice64">
|
||||
<Operation>1</Operation>
|
||||
</Platform>
|
||||
<Platform Name="iOSSimulator">
|
||||
<Operation>1</Operation>
|
||||
</Platform>
|
||||
<Platform Name="Linux64">
|
||||
<Operation>1</Operation>
|
||||
</Platform>
|
||||
<Platform Name="OSX32">
|
||||
<Operation>1</Operation>
|
||||
</Platform>
|
||||
<Platform Name="Win32">
|
||||
<Operation>0</Operation>
|
||||
</Platform>
|
||||
</DeployClass>
|
||||
<DeployClass Name="ProjectUWPManifest">
|
||||
<Platform Name="Win32">
|
||||
<Operation>1</Operation>
|
||||
</Platform>
|
||||
<Platform Name="Win64">
|
||||
<Operation>1</Operation>
|
||||
</Platform>
|
||||
</DeployClass>
|
||||
<DeployClass Name="UWP_DelphiLogo150">
|
||||
<Platform Name="Win32">
|
||||
<RemoteDir>Assets</RemoteDir>
|
||||
<Operation>1</Operation>
|
||||
</Platform>
|
||||
<Platform Name="Win64">
|
||||
<RemoteDir>Assets</RemoteDir>
|
||||
<Operation>1</Operation>
|
||||
</Platform>
|
||||
</DeployClass>
|
||||
<DeployClass Name="UWP_DelphiLogo44">
|
||||
<Platform Name="Win32">
|
||||
<RemoteDir>Assets</RemoteDir>
|
||||
<Operation>1</Operation>
|
||||
</Platform>
|
||||
<Platform Name="Win64">
|
||||
<RemoteDir>Assets</RemoteDir>
|
||||
<Operation>1</Operation>
|
||||
</Platform>
|
||||
</DeployClass>
|
||||
<ProjectRoot Platform="iOSDevice64" Name="$(PROJECTNAME).app"/>
|
||||
<ProjectRoot Platform="Win64" Name="$(PROJECTNAME)"/>
|
||||
<ProjectRoot Platform="iOSDevice32" Name="$(PROJECTNAME).app"/>
|
||||
<ProjectRoot Platform="Linux64" Name="$(PROJECTNAME)"/>
|
||||
<ProjectRoot Platform="Win32" Name="$(PROJECTNAME)"/>
|
||||
<ProjectRoot Platform="OSX32" Name="$(PROJECTNAME)"/>
|
||||
<ProjectRoot Platform="Android" Name="$(PROJECTNAME)"/>
|
||||
<ProjectRoot Platform="iOSSimulator" Name="$(PROJECTNAME).app"/>
|
||||
</Deployment>
|
||||
<Platforms>
|
||||
<Platform value="Android">False</Platform>
|
||||
<Platform value="iOSDevice32">False</Platform>
|
||||
<Platform value="iOSDevice64">False</Platform>
|
||||
<Platform value="iOSSimulator">False</Platform>
|
||||
<Platform value="Linux64">False</Platform>
|
||||
<Platform value="OSX32">False</Platform>
|
||||
<Platform value="Win32">True</Platform>
|
||||
<Platform value="Win64">False</Platform>
|
||||
</Platforms>
|
||||
</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')"/>
|
||||
<Import Project="$(MSBuildProjectName).deployproj" Condition="Exists('$(MSBuildProjectName).deployproj')"/>
|
||||
</Project>
|
||||
@ -3,7 +3,7 @@ object MainForm: TMainForm
|
||||
Top = 0
|
||||
Caption = 'Articles CRUD SAMPLE'
|
||||
ClientHeight = 391
|
||||
ClientWidth = 669
|
||||
ClientWidth = 876
|
||||
Color = clBtnFace
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clWindowText
|
||||
@ -18,19 +18,21 @@ object MainForm: TMainForm
|
||||
object Panel1: TPanel
|
||||
Left = 0
|
||||
Top = 0
|
||||
Width = 669
|
||||
Width = 876
|
||||
Height = 39
|
||||
Align = alTop
|
||||
TabOrder = 0
|
||||
ExplicitWidth = 669
|
||||
object DBNavigator1: TDBNavigator
|
||||
AlignWithMargins = True
|
||||
Left = 378
|
||||
Left = 585
|
||||
Top = 4
|
||||
Width = 287
|
||||
Height = 31
|
||||
DataSource = dsrcArticles
|
||||
Align = alRight
|
||||
TabOrder = 0
|
||||
ExplicitLeft = 378
|
||||
end
|
||||
object btnOpen: TButton
|
||||
AlignWithMargins = True
|
||||
@ -69,7 +71,7 @@ object MainForm: TMainForm
|
||||
object DBGrid1: TDBGrid
|
||||
Left = 0
|
||||
Top = 39
|
||||
Width = 669
|
||||
Width = 876
|
||||
Height = 352
|
||||
Align = alClient
|
||||
DataSource = dsrcArticles
|
||||
|
||||
BIN
samples/data/ACTIVERECORDDB.FDB
Normal file
BIN
samples/data/ACTIVERECORDDB.FDB
Normal file
Binary file not shown.
987
sources/MVCFramework.ActiveRecord.pas
Normal file
987
sources/MVCFramework.ActiveRecord.pas
Normal file
@ -0,0 +1,987 @@
|
||||
// *************************************************************************** }
|
||||
//
|
||||
// Delphi MVC Framework
|
||||
//
|
||||
// Copyright (c) 2010-2018 Daniele Teti and the DMVCFramework Team
|
||||
//
|
||||
// https://github.com/danieleteti/delphimvcframework
|
||||
//
|
||||
// ***************************************************************************
|
||||
//
|
||||
// Licensed under the Apache License, Version 2.0 (the "License");
|
||||
// you may not use this file except in compliance with the License.
|
||||
// You may obtain a copy of the License at
|
||||
//
|
||||
// http://www.apache.org/licenses/LICENSE-2.0
|
||||
//
|
||||
// Unless required by applicable law or agreed to in writing, software
|
||||
// distributed under the License is distributed on an "AS IS" BASIS,
|
||||
// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
// See the License for the specific language governing permissions and
|
||||
// limitations under the License.
|
||||
//
|
||||
// ***************************************************************************
|
||||
|
||||
unit MVCFramework.ActiveRecord;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
System.Generics.Defaults,
|
||||
System.Generics.Collections,
|
||||
System.RTTI,
|
||||
FireDAC.Comp.Client,
|
||||
FireDAC.DApt,
|
||||
Data.DB,
|
||||
MVCFramework.Commons,
|
||||
FireDAC.Stan.Param;
|
||||
|
||||
type
|
||||
EMVCActiveRecord = class(EMVCException)
|
||||
public
|
||||
constructor Create(const AMsg: string); reintroduce; { do not override!! }
|
||||
end;
|
||||
|
||||
TMVCActiveRecordClass = class of TMVCActiveRecord;
|
||||
TDelphiARFieldOption = (foAutoGenerated);
|
||||
TDelphiARFieldOptions = set of TDelphiARFieldOption;
|
||||
|
||||
DelphiARBaseAttribute = class(TCustomAttribute)
|
||||
|
||||
end;
|
||||
|
||||
TableAttribute = class(DelphiARBaseAttribute)
|
||||
Name: string;
|
||||
constructor Create(AName: string);
|
||||
end;
|
||||
|
||||
TableFieldAttribute = class(DelphiARBaseAttribute)
|
||||
public
|
||||
FieldName: string;
|
||||
constructor Create(aFieldName: string);
|
||||
end;
|
||||
|
||||
PrimaryKeyAttribute = class(DelphiARBaseAttribute)
|
||||
public
|
||||
FieldName: string;
|
||||
FieldOptions: TDelphiARFieldOptions;
|
||||
constructor Create(const aFieldName: string; const aFieldOptions: TDelphiARFieldOptions); overload;
|
||||
constructor Create(const aFieldName: string); overload;
|
||||
end;
|
||||
|
||||
TMVCActiveRecord = class
|
||||
private
|
||||
fConn: TFDConnection;
|
||||
fPrimaryKeyFieldName: string;
|
||||
fPrimaryKeyOptions: TDelphiARFieldOptions;
|
||||
function TableFieldsDelimited(const Delimiter: string = ','): string;
|
||||
function MapColumnToTValue(const aFieldName: string; const aField: TField): TValue;
|
||||
procedure MapTValueToParam(const aValue: TValue; const aParam: TFDParam);
|
||||
protected
|
||||
fRTTIType: TRttiType;
|
||||
fProps: TArray<TRttiField>;
|
||||
fObjAttributes: TArray<TCustomAttribute>;
|
||||
fPropsAttributes: TArray<TCustomAttribute>;
|
||||
fTableName: string;
|
||||
fMap: TDictionary<TRttiField, string>;
|
||||
fPrimaryKey: TRttiField;
|
||||
procedure InitTableInfo;
|
||||
function CreateInsertSQL: string; virtual;
|
||||
function CreateSelectByPKSQL(aPrimaryKey: int64): string; virtual;
|
||||
function CreateSelectSQL: string; virtual;
|
||||
function CreateUpdateSQL: string; virtual;
|
||||
function CreateDeleteSQL: string; virtual;
|
||||
function GetWhereByPrimaryKey: string; virtual;
|
||||
class function ExecQuery(const SQL: string): TDataSet; overload;
|
||||
class function ExecQuery(const SQL: string; const Values: array of Variant): TDataSet; overload;
|
||||
function ExecNonQuery(const SQL: string; RefreshAutoGenerated: boolean = false): int64;
|
||||
// load events
|
||||
/// <summary>
|
||||
/// Called everywhere before persist object into database
|
||||
/// </summary>
|
||||
procedure OnValidation; virtual;
|
||||
|
||||
/// <summary>
|
||||
/// Called just after load the object state from database
|
||||
/// </summary>
|
||||
procedure OnAfterLoad; virtual;
|
||||
|
||||
/// <summary>
|
||||
/// Called before load the object state from database
|
||||
/// </summary>
|
||||
procedure OnBeforeLoad; virtual;
|
||||
|
||||
/// <summary>
|
||||
/// Called before insert the object state to database
|
||||
/// </summary>
|
||||
|
||||
procedure OnBeforeInsert; virtual;
|
||||
/// <summary>
|
||||
/// Called before update the object state to database
|
||||
/// </summary>
|
||||
|
||||
procedure OnBeforeUpdate; virtual;
|
||||
|
||||
/// <summary>
|
||||
/// Called before delete object from database
|
||||
/// </summary>
|
||||
procedure OnBeforeDelete; virtual;
|
||||
|
||||
/// <summary>
|
||||
/// Called before insert or update the object to the database
|
||||
/// </summary>
|
||||
procedure OnBeforeInsertOrUpdate; virtual;
|
||||
|
||||
public
|
||||
constructor Create; virtual;
|
||||
destructor Destroy; override;
|
||||
procedure Insert;
|
||||
function LoadByPK(ID: int64): boolean;
|
||||
procedure Update;
|
||||
procedure Delete;
|
||||
function TableInfo: string;
|
||||
procedure LoadByDataset(const aDataSet: TDataSet);
|
||||
procedure SetPK(const aValue: TValue);
|
||||
function GetPK: TValue;
|
||||
class function GetByPrimaryKey<T: TMVCActiveRecord>(const aValue: int64): T; overload;
|
||||
class function GetByPrimaryKey(const aClass: TMVCActiveRecordClass; const aValue: int64): TMVCActiveRecord; overload;
|
||||
class function Select<T: TMVCActiveRecord>(const SQL: string; const Params: array of Variant): TObjectList<T>; overload;
|
||||
class function Select(const aClass: TMVCActiveRecordClass; const SQL: string; const Params: array of Variant)
|
||||
: TObjectList<TMVCActiveRecord>; overload;
|
||||
class function Where<T: TMVCActiveRecord>(const SQLWhere: string; const Params: array of Variant): TObjectList<T>;
|
||||
class function All<T: TMVCActiveRecord>: TObjectList<T>; overload;
|
||||
class function All(const aClass: TMVCActiveRecordClass): TObjectList<TMVCActiveRecord>; overload;
|
||||
class function SelectDataSet(const SQL: string; const Params: array of Variant): TDataSet;
|
||||
end;
|
||||
|
||||
IMVCEntitiesRegistry = interface
|
||||
['{BB227BEB-A74A-4637-8897-B13BA938C07B}']
|
||||
procedure AddEntity(const aURLSegment: string; const aActiveRecordClass: TMVCActiveRecordClass);
|
||||
function GetByURLSegment(const aURLSegment: string): TMVCActiveRecordClass;
|
||||
end;
|
||||
|
||||
TMVCEntitiesRegistry = class(TInterfacedObject, IMVCEntitiesRegistry)
|
||||
private
|
||||
fEntitiesDict: TDictionary<string, TMVCActiveRecordClass>;
|
||||
public
|
||||
constructor Create; virtual;
|
||||
destructor Destroy; override;
|
||||
protected
|
||||
procedure AddEntity(const aURLSegment: string; const aActiveRecordClass: TMVCActiveRecordClass);
|
||||
function GetByURLSegment(const aURLSegment: string): TMVCActiveRecordClass;
|
||||
end;
|
||||
|
||||
IARConnections = interface
|
||||
['{7B87473C-1784-489F-A838-925E7DDD0DE2}']
|
||||
procedure AddConnection(const AName: string; const aConnection: TFDConnection);
|
||||
procedure RemoveConnection(const AName: string);
|
||||
procedure SetCurrent(const AName: string);
|
||||
function GetCurrent: TFDConnection;
|
||||
end;
|
||||
|
||||
TMVCConnectionsRepository = class(TInterfacedObject, IARConnections)
|
||||
private
|
||||
fConnectionsDict: TDictionary<string, TFDConnection>;
|
||||
fCurrent: TFDConnection;
|
||||
fCurrentName: string;
|
||||
public
|
||||
constructor Create; virtual;
|
||||
destructor Destroy; override;
|
||||
procedure AddConnection(const AName: string; const aConnection: TFDConnection);
|
||||
procedure RemoveConnection(const AName: string);
|
||||
procedure SetCurrent(const AName: string);
|
||||
function GetCurrent: TFDConnection;
|
||||
function GetByName(const AName: string): TFDConnection;
|
||||
end;
|
||||
|
||||
function ActiveRecordConnectionsRegistry: IARConnections;
|
||||
|
||||
function ActiveRecordMappingRegistry: IMVCEntitiesRegistry;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
SysUtils,
|
||||
TypInfo,
|
||||
MVCFramework.DataSet.Utils,
|
||||
MVCFramework.Logger,
|
||||
|
||||
FireDAC.Stan.Option,
|
||||
System.IOUtils,
|
||||
System.Classes;
|
||||
|
||||
threadvar gCtx: TRttiContext;
|
||||
threadvar gCtxInitialized: boolean;
|
||||
threadvar gConnections: IARConnections;
|
||||
|
||||
var
|
||||
gEntitiesRegistry: IMVCEntitiesRegistry;
|
||||
gLock: TObject;
|
||||
|
||||
function ActiveRecordConnectionsRegistry: IARConnections;
|
||||
begin
|
||||
if not Assigned(gConnections) then
|
||||
begin
|
||||
gConnections := TMVCConnectionsRepository.Create;
|
||||
end;
|
||||
Result := gConnections;
|
||||
end;
|
||||
|
||||
{ TConnectionsRepository }
|
||||
|
||||
{ TConnectionsRepository }
|
||||
|
||||
procedure TMVCConnectionsRepository.AddConnection(const AName: string; const aConnection: TFDConnection);
|
||||
var
|
||||
lName: string;
|
||||
begin
|
||||
lName := AName.ToLower;
|
||||
fConnectionsDict.AddOrSetValue(lName, aConnection);
|
||||
if (lName = 'default') and ((fCurrentName = 'default') or (fCurrentName.IsEmpty)) then
|
||||
begin
|
||||
fCurrentName := lName;
|
||||
fCurrent := aConnection;
|
||||
end;
|
||||
end;
|
||||
|
||||
constructor TMVCConnectionsRepository.Create;
|
||||
begin
|
||||
inherited;
|
||||
fConnectionsDict := TDictionary<string, TFDConnection>.Create;
|
||||
end;
|
||||
|
||||
destructor TMVCConnectionsRepository.Destroy;
|
||||
begin
|
||||
fConnectionsDict.Free;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TMVCConnectionsRepository.GetByName(const AName: string): TFDConnection;
|
||||
begin
|
||||
if not fConnectionsDict.TryGetValue(AName.ToLower, Result) then
|
||||
raise Exception.CreateFmt('Unknown connection %s', [AName]);
|
||||
end;
|
||||
|
||||
function TMVCConnectionsRepository.GetCurrent: TFDConnection;
|
||||
begin
|
||||
Assert(Assigned(fCurrent), 'Current connection not set');
|
||||
Result := fCurrent;
|
||||
end;
|
||||
|
||||
procedure TMVCConnectionsRepository.RemoveConnection(const AName: string);
|
||||
var
|
||||
lName: string;
|
||||
lConn: TFDConnection;
|
||||
begin
|
||||
lName := AName.ToLower;
|
||||
if not fConnectionsDict.TryGetValue(lName, lConn) then
|
||||
raise Exception.CreateFmt('Unknown connection %s', [AName]);
|
||||
fConnectionsDict.Remove(lName);
|
||||
try
|
||||
FreeAndNil(lConn);
|
||||
except
|
||||
on E: Exception do
|
||||
begin
|
||||
LogE('ActiveRecord: ' + E.ClassName + ' > ' + E.Message);
|
||||
raise;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMVCConnectionsRepository.SetCurrent(const AName: string);
|
||||
var
|
||||
lName: string;
|
||||
begin
|
||||
lName := AName.ToLower;
|
||||
if not fConnectionsDict.TryGetValue(lName, fCurrent) then
|
||||
raise Exception.CreateFmt('Unknown connection %s', [AName]);
|
||||
fCurrentName := lName;
|
||||
end;
|
||||
|
||||
function ActiveRecordMappingRegistry: IMVCEntitiesRegistry;
|
||||
begin
|
||||
if gEntitiesRegistry = nil then
|
||||
begin
|
||||
TMonitor.Enter(gLock);
|
||||
try
|
||||
if gEntitiesRegistry = nil then
|
||||
begin
|
||||
gEntitiesRegistry := TMVCEntitiesRegistry.Create;
|
||||
end;
|
||||
finally
|
||||
TMonitor.Exit(gLock);
|
||||
end;
|
||||
end;
|
||||
Result := gEntitiesRegistry;
|
||||
end;
|
||||
|
||||
function GetRTTIContext: TRttiContext; inline;
|
||||
begin
|
||||
if not gCtxInitialized then
|
||||
begin
|
||||
gCtx := TRttiContext.Create;
|
||||
end;
|
||||
Result := gCtx;
|
||||
end;
|
||||
|
||||
{ TableFieldAttribute }
|
||||
|
||||
constructor TableFieldAttribute.Create(aFieldName: string);
|
||||
begin
|
||||
inherited Create;
|
||||
FieldName := aFieldName;
|
||||
end;
|
||||
|
||||
{ TableAttribute }
|
||||
|
||||
constructor TableAttribute.Create(AName: string);
|
||||
begin
|
||||
inherited Create;
|
||||
name := AName;
|
||||
end;
|
||||
|
||||
{ TActiveRecord }
|
||||
|
||||
destructor TMVCActiveRecord.Destroy;
|
||||
begin
|
||||
fMap.Free;
|
||||
fConn := nil;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TMVCActiveRecord.ExecNonQuery(const SQL: string; RefreshAutoGenerated: boolean = false): int64;
|
||||
var
|
||||
lQry: TFDQuery;
|
||||
lPar: TFDParam;
|
||||
lPair: TPair<TRttiField, string>;
|
||||
lValue: TValue;
|
||||
begin
|
||||
lQry := TFDQuery.Create(nil);
|
||||
try
|
||||
lQry.Connection := fConn;
|
||||
lQry.SQL.Text := SQL;
|
||||
lQry.Prepare;
|
||||
for lPair in fMap do
|
||||
begin
|
||||
lPar := lQry.FindParam(lPair.value);
|
||||
if lPar <> nil then
|
||||
begin
|
||||
lValue := lPair.Key.GetValue(Self);
|
||||
MapTValueToParam(lValue, lPar);
|
||||
end
|
||||
else
|
||||
begin
|
||||
// check if it's the primary key
|
||||
lPar := lQry.FindParam(fPrimaryKeyFieldName);
|
||||
if lPar <> nil then
|
||||
begin
|
||||
MapTValueToParam(fPrimaryKey.GetValue(Self), lPar);
|
||||
end
|
||||
end;
|
||||
end;
|
||||
|
||||
if RefreshAutoGenerated and (foAutoGenerated in fPrimaryKeyOptions) then
|
||||
begin
|
||||
lQry.Open;
|
||||
fPrimaryKey.SetValue(Self, lQry.FieldByName(fPrimaryKeyFieldName).AsInteger);
|
||||
OnAfterLoad;
|
||||
end
|
||||
else
|
||||
begin
|
||||
lQry.ExecSQL(SQL);
|
||||
end;
|
||||
|
||||
Result := lQry.RowsAffected;
|
||||
except
|
||||
lQry.Free;
|
||||
raise;
|
||||
end;
|
||||
end;
|
||||
|
||||
class function TMVCActiveRecord.ExecQuery(const SQL: string; const Values: array of Variant): TDataSet;
|
||||
var
|
||||
lQry: TFDQuery;
|
||||
begin
|
||||
lQry := TFDQuery.Create(nil);
|
||||
try
|
||||
lQry.FetchOptions.Unidirectional := True;
|
||||
lQry.Connection := ActiveRecordConnectionsRegistry.GetCurrent;
|
||||
lQry.SQL.Text := SQL;
|
||||
lQry.Prepare;
|
||||
lQry.Open(SQL, Values);
|
||||
Result := lQry;
|
||||
except
|
||||
lQry.Free;
|
||||
raise;
|
||||
end;
|
||||
end;
|
||||
|
||||
class function TMVCActiveRecord.ExecQuery(const SQL: string): TDataSet;
|
||||
begin
|
||||
Result := ExecQuery(SQL, []);
|
||||
end;
|
||||
|
||||
function TMVCActiveRecord.GetWhereByPrimaryKey: string;
|
||||
begin
|
||||
Result := ' ' + fPrimaryKeyFieldName + '= :' + fPrimaryKeyFieldName;
|
||||
end;
|
||||
|
||||
procedure TMVCActiveRecord.InitTableInfo;
|
||||
var
|
||||
obj_attr: TCustomAttribute;
|
||||
prop: TRttiField;
|
||||
prop_attr: TCustomAttribute;
|
||||
begin
|
||||
fTableName := '';
|
||||
fRTTIType := GetRTTIContext.GetType(Self.ClassInfo);
|
||||
fObjAttributes := fRTTIType.GetAttributes;
|
||||
for obj_attr in fObjAttributes do
|
||||
if obj_attr is TableAttribute then
|
||||
begin
|
||||
fTableName := TableAttribute(obj_attr).Name;
|
||||
Break;
|
||||
end;
|
||||
|
||||
if fTableName = '' then
|
||||
raise Exception.Create('Cannot find TableNameAttribute');
|
||||
|
||||
fProps := fRTTIType.GetFields;
|
||||
for prop in fProps do
|
||||
begin
|
||||
fPropsAttributes := prop.GetAttributes;
|
||||
if Length(fPropsAttributes) = 0 then
|
||||
Continue;
|
||||
for prop_attr in fPropsAttributes do
|
||||
begin
|
||||
if prop_attr is TableFieldAttribute then
|
||||
begin
|
||||
fMap.Add(prop, { fTableName + '.' + } TableFieldAttribute(prop_attr).FieldName);
|
||||
end
|
||||
else if prop_attr is PrimaryKeyAttribute then
|
||||
begin
|
||||
fPrimaryKey := prop;
|
||||
fPrimaryKeyFieldName := PrimaryKeyAttribute(prop_attr).FieldName;
|
||||
fPrimaryKeyOptions := PrimaryKeyAttribute(prop_attr).FieldOptions;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMVCActiveRecord.Insert;
|
||||
var
|
||||
SQL: string;
|
||||
begin
|
||||
OnValidation;
|
||||
OnBeforeInsert;
|
||||
OnBeforeInsertOrUpdate;
|
||||
SQL := CreateInsertSQL;
|
||||
ExecNonQuery(SQL, True);
|
||||
end;
|
||||
|
||||
constructor TMVCActiveRecord.Create;
|
||||
begin
|
||||
inherited;
|
||||
fConn := ActiveRecordConnectionsRegistry.GetCurrent;
|
||||
fMap := TDictionary<TRttiField, string>.Create;
|
||||
InitTableInfo;
|
||||
end;
|
||||
|
||||
function TMVCActiveRecord.CreateUpdateSQL: string;
|
||||
var
|
||||
keyvalue: TPair<TRttiField, string>;
|
||||
begin
|
||||
Result := 'UPDATE ' + fTableName + ' SET ';
|
||||
for keyvalue in fMap do
|
||||
begin
|
||||
Result := Result + keyvalue.value + ' = :' + keyvalue.value + ',';
|
||||
end;
|
||||
Result[Length(Result)] := ' ';
|
||||
if Assigned(fPrimaryKey) then
|
||||
begin
|
||||
Result := Result + ' where ' + GetWhereByPrimaryKey;
|
||||
end;
|
||||
end;
|
||||
|
||||
class function TMVCActiveRecord.GetByPrimaryKey(const aClass: TMVCActiveRecordClass; const aValue: int64): TMVCActiveRecord;
|
||||
begin
|
||||
Result := aClass.Create;
|
||||
Result.LoadByPK(aValue);
|
||||
end;
|
||||
|
||||
class function TMVCActiveRecord.GetByPrimaryKey<T>(const aValue: int64): T;
|
||||
var
|
||||
lActiveRecord: TMVCActiveRecord;
|
||||
begin
|
||||
Result := T.Create;
|
||||
lActiveRecord := TMVCActiveRecord(Result);
|
||||
lActiveRecord.LoadByPK(aValue);
|
||||
end;
|
||||
|
||||
function TMVCActiveRecord.GetPK: TValue;
|
||||
begin
|
||||
if fPrimaryKeyFieldName.IsEmpty then
|
||||
raise Exception.Create('No primary key defined');
|
||||
Result := fPrimaryKey.GetValue(Self);
|
||||
end;
|
||||
|
||||
function TMVCActiveRecord.CreateDeleteSQL: string;
|
||||
begin
|
||||
Result := 'DELETE FROM ' + fTableName + ' WHERE ' + GetWhereByPrimaryKey;
|
||||
end;
|
||||
|
||||
function TMVCActiveRecord.CreateInsertSQL: string;
|
||||
var
|
||||
keyvalue: TPair<TRttiField, string>;
|
||||
lSB: TStringBuilder;
|
||||
begin
|
||||
lSB := TStringBuilder.Create;
|
||||
try
|
||||
lSB.Append('INSERT INTO ' + fTableName + '(');
|
||||
for keyvalue in fMap do
|
||||
lSB.Append(keyvalue.value + ',');
|
||||
lSB.Remove(lSB.Length - 1, 1);
|
||||
lSB.Append(') values (');
|
||||
for keyvalue in fMap do
|
||||
begin
|
||||
lSB.Append(':' + keyvalue.value + ',');
|
||||
end;
|
||||
lSB.Remove(lSB.Length - 1, 1);
|
||||
lSB.Append(')');
|
||||
|
||||
if foAutoGenerated in fPrimaryKeyOptions then
|
||||
begin
|
||||
lSB.Append(' RETURNING ' + fPrimaryKeyFieldName);
|
||||
end;
|
||||
Result := lSB.ToString;
|
||||
finally
|
||||
lSB.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TMVCActiveRecord.CreateSelectByPKSQL(aPrimaryKey: int64): string;
|
||||
begin
|
||||
Result := CreateSelectSQL + ' WHERE ' + fPrimaryKeyFieldName + ' = :' + fPrimaryKeyFieldName;
|
||||
end;
|
||||
|
||||
function TMVCActiveRecord.CreateSelectSQL: string;
|
||||
begin
|
||||
Result := 'SELECT ' + TableFieldsDelimited + ' FROM ' + fTableName;
|
||||
end;
|
||||
|
||||
procedure TMVCActiveRecord.Delete;
|
||||
var
|
||||
SQL: string;
|
||||
begin
|
||||
if not Assigned(fPrimaryKey) then
|
||||
raise Exception.CreateFmt('Cannot delete %s without a primary key', [ClassName]);
|
||||
SQL := CreateDeleteSQL;
|
||||
ExecNonQuery(SQL, false);
|
||||
end;
|
||||
|
||||
function TMVCActiveRecord.MapColumnToTValue(const aFieldName: string; const aField: TField): TValue;
|
||||
var
|
||||
lMS: TMemoryStream;
|
||||
begin
|
||||
case aField.DataType of
|
||||
ftString, ftWideString:
|
||||
begin
|
||||
Result := aField.AsString;
|
||||
end;
|
||||
ftLargeint:
|
||||
begin
|
||||
Result := aField.AsLargeInt;
|
||||
end;
|
||||
ftInteger, ftSmallint:
|
||||
begin
|
||||
Result := aField.AsInteger;
|
||||
end;
|
||||
ftLongWord, ftWord:
|
||||
begin
|
||||
Result := aField.AsLongWord;
|
||||
end;
|
||||
ftDate:
|
||||
begin
|
||||
Result := Trunc(aField.AsDateTime);
|
||||
end;
|
||||
ftDateTime:
|
||||
begin
|
||||
Result := aField.AsDateTime;
|
||||
end;
|
||||
ftBoolean:
|
||||
begin
|
||||
Result := aField.AsBoolean;
|
||||
end;
|
||||
ftMemo, ftWideMemo:
|
||||
begin
|
||||
Result := aField.AsString;
|
||||
end;
|
||||
ftBlob:
|
||||
begin
|
||||
lMS := TMemoryStream.Create;
|
||||
try
|
||||
TBlobField(aField).SaveToStream(lMS);
|
||||
lMS.Position := 0;
|
||||
Result := lMS;
|
||||
except
|
||||
lMS.Free;
|
||||
raise;
|
||||
end;
|
||||
end;
|
||||
else
|
||||
raise Exception.CreateFmt('Unsupported FieldType (%d) for field %s', [Ord(aField.DataType), aFieldName]);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMVCActiveRecord.MapTValueToParam(const aValue: TValue; const aParam: TFDParam);
|
||||
var
|
||||
lStream: TStream;
|
||||
begin
|
||||
case aParam.DataType of
|
||||
ftString:
|
||||
begin
|
||||
aParam.AsString := aValue.AsString;
|
||||
end;
|
||||
ftWideString:
|
||||
begin
|
||||
aParam.AsWideString := aValue.AsString;
|
||||
end;
|
||||
ftLargeint:
|
||||
begin
|
||||
aParam.AsLargeInt := aValue.AsInt64;
|
||||
end;
|
||||
ftSmallint:
|
||||
begin
|
||||
aParam.AsSmallInt := aValue.AsInteger;
|
||||
end;
|
||||
ftInteger:
|
||||
begin
|
||||
aParam.AsInteger := aValue.AsInteger;
|
||||
end;
|
||||
ftLongWord:
|
||||
begin
|
||||
aParam.AsLongWord := aValue.AsInteger;
|
||||
end;
|
||||
ftWord:
|
||||
begin
|
||||
aParam.AsWord := aValue.AsInteger;
|
||||
end;
|
||||
ftDate:
|
||||
begin
|
||||
aParam.AsDate := Trunc(aValue.AsExtended);
|
||||
end;
|
||||
ftDateTime:
|
||||
begin
|
||||
aParam.AsDateTime := aValue.AsExtended;
|
||||
end;
|
||||
ftBoolean:
|
||||
begin
|
||||
aParam.AsBoolean := aValue.AsBoolean;
|
||||
end;
|
||||
ftMemo:
|
||||
begin
|
||||
aParam.AsMemo := AnsiString(aValue.AsString);
|
||||
end;
|
||||
ftWideMemo:
|
||||
begin
|
||||
aParam.AsWideMemo := aValue.AsString;
|
||||
end;
|
||||
ftBlob:
|
||||
begin
|
||||
lStream := aValue.AsType<TStream>(false);
|
||||
if Assigned(lStream) then
|
||||
begin
|
||||
lStream.Position := 0;
|
||||
aParam.LoadFromStream(lStream, ftBlob);
|
||||
end
|
||||
else
|
||||
begin
|
||||
aParam.Clear;
|
||||
end;
|
||||
end;
|
||||
else
|
||||
raise Exception.CreateFmt('Unsupported FieldType (%d) for param %s', [Ord(aValue.Kind), aParam.Name]);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMVCActiveRecord.LoadByDataset(const aDataSet: TDataSet);
|
||||
var
|
||||
lItem: TPair<TRttiField, string>;
|
||||
lValue: TValue;
|
||||
lDestField: TValue;
|
||||
lStream: TStream;
|
||||
begin
|
||||
OnBeforeLoad;
|
||||
for lItem in fMap do
|
||||
begin
|
||||
lValue := MapColumnToTValue(lItem.value, aDataSet.FieldByName(lItem.value));
|
||||
if not lValue.IsObject then
|
||||
begin
|
||||
lItem.Key.SetValue(Self, lValue);
|
||||
end
|
||||
else
|
||||
begin
|
||||
lDestField := lItem.Key.GetValue(Self);
|
||||
if lDestField.IsEmpty then
|
||||
raise EMVCActiveRecord.CreateFmt('Target field (%s) is nil', [lItem.value]);
|
||||
if lDestField.IsObject and lDestField.IsType<TStream> then
|
||||
begin
|
||||
lStream := lDestField.AsType<TStream>;
|
||||
lStream.Position := 0;
|
||||
lStream.CopyFrom(lValue.AsType<TStream>, 0);
|
||||
lStream.Position := 0;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
if not fPrimaryKeyFieldName.IsEmpty then
|
||||
begin
|
||||
lValue := MapColumnToTValue(fPrimaryKeyFieldName, aDataSet.FieldByName(fPrimaryKeyFieldName));
|
||||
fPrimaryKey.SetValue(Self, lValue);
|
||||
end;
|
||||
OnAfterLoad;
|
||||
end;
|
||||
|
||||
function TMVCActiveRecord.LoadByPK(ID: int64): boolean;
|
||||
var
|
||||
SQL: string;
|
||||
lDataSet: TDataSet;
|
||||
begin
|
||||
SQL := CreateSelectByPKSQL(ID);
|
||||
lDataSet := ExecQuery(SQL, [ID]);
|
||||
try
|
||||
Result := not lDataSet.Eof;
|
||||
if Result then
|
||||
begin
|
||||
LoadByDataset(lDataSet);
|
||||
end;
|
||||
finally
|
||||
lDataSet.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMVCActiveRecord.OnAfterLoad;
|
||||
begin
|
||||
// do nothing
|
||||
end;
|
||||
|
||||
procedure TMVCActiveRecord.OnBeforeDelete;
|
||||
begin
|
||||
// do nothing
|
||||
end;
|
||||
|
||||
procedure TMVCActiveRecord.OnBeforeInsert;
|
||||
begin
|
||||
// do nothing
|
||||
end;
|
||||
|
||||
procedure TMVCActiveRecord.OnBeforeInsertOrUpdate;
|
||||
begin
|
||||
// do nothing
|
||||
end;
|
||||
|
||||
procedure TMVCActiveRecord.OnBeforeLoad;
|
||||
begin
|
||||
// do nothing
|
||||
end;
|
||||
|
||||
procedure TMVCActiveRecord.OnBeforeUpdate;
|
||||
begin
|
||||
// do nothing
|
||||
end;
|
||||
|
||||
procedure TMVCActiveRecord.OnValidation;
|
||||
begin
|
||||
// do nothing
|
||||
end;
|
||||
|
||||
class function TMVCActiveRecord.Select(const aClass: TMVCActiveRecordClass; const SQL: string; const Params: array of Variant)
|
||||
: TObjectList<TMVCActiveRecord>;
|
||||
var
|
||||
lDataSet: TDataSet;
|
||||
lAR: TMVCActiveRecord;
|
||||
begin
|
||||
Result := TObjectList<TMVCActiveRecord>.Create(True);
|
||||
try
|
||||
lDataSet := ExecQuery(SQL, Params);
|
||||
try
|
||||
while not lDataSet.Eof do
|
||||
begin
|
||||
lAR := aClass.Create;
|
||||
Result.Add(lAR);
|
||||
lAR.LoadByDataset(lDataSet);
|
||||
lDataSet.Next;
|
||||
end;
|
||||
// lDataSet.First;
|
||||
// TFile.WriteAllText('output.json', lDataSet.AsJSONArray);
|
||||
finally
|
||||
lDataSet.Free;
|
||||
end;
|
||||
except
|
||||
Result.Free;
|
||||
raise;
|
||||
end;
|
||||
end;
|
||||
|
||||
class function TMVCActiveRecord.Select<T>(const SQL: string; const Params: array of Variant): TObjectList<T>;
|
||||
var
|
||||
lDataSet: TDataSet;
|
||||
lAR: TMVCActiveRecord;
|
||||
begin
|
||||
Result := TObjectList<T>.Create(True);
|
||||
try
|
||||
lDataSet := ExecQuery(SQL, Params);
|
||||
try
|
||||
while not lDataSet.Eof do
|
||||
begin
|
||||
lAR := T.Create;
|
||||
Result.Add(lAR);
|
||||
lAR.LoadByDataset(lDataSet);
|
||||
lDataSet.Next;
|
||||
end;
|
||||
finally
|
||||
lDataSet.Free;
|
||||
end;
|
||||
except
|
||||
Result.Free;
|
||||
raise;
|
||||
end;
|
||||
end;
|
||||
|
||||
class function TMVCActiveRecord.SelectDataSet(const SQL: string; const Params: array of Variant): TDataSet;
|
||||
begin
|
||||
Result := TMVCActiveRecord.ExecQuery(SQL, Params);
|
||||
end;
|
||||
|
||||
procedure TMVCActiveRecord.SetPK(const aValue: TValue);
|
||||
begin
|
||||
if fPrimaryKeyFieldName.IsEmpty then
|
||||
raise Exception.Create('No primary key defined');
|
||||
fPrimaryKey.SetValue(Self, aValue);
|
||||
end;
|
||||
|
||||
function TMVCActiveRecord.TableFieldsDelimited(const Delimiter: string): string;
|
||||
var
|
||||
lPair: TPair<TRttiField, string>;
|
||||
begin
|
||||
for lPair in fMap do
|
||||
begin
|
||||
Result := Result + lPair.value + Delimiter;
|
||||
end;
|
||||
Result := Copy(Result, 1, Length(Result) - Length(Delimiter));
|
||||
if not fPrimaryKeyFieldName.IsEmpty then
|
||||
begin
|
||||
Result := fPrimaryKeyFieldName + ',' + Result;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TMVCActiveRecord.TableInfo: string;
|
||||
var
|
||||
keyvalue: TPair<TRttiField, string>;
|
||||
begin
|
||||
Result := 'Table Name: ' + fTableName;
|
||||
for keyvalue in fMap do
|
||||
Result := Result + sLineBreak + #9 + keyvalue.Key.Name + ' = ' + keyvalue.value;
|
||||
end;
|
||||
|
||||
procedure TMVCActiveRecord.Update;
|
||||
var
|
||||
SQL: string;
|
||||
begin
|
||||
OnValidation;
|
||||
OnBeforeUpdate;
|
||||
OnBeforeInsertOrUpdate;
|
||||
SQL := CreateUpdateSQL;
|
||||
ExecNonQuery(SQL, false);
|
||||
end;
|
||||
|
||||
class function TMVCActiveRecord.All(const aClass: TMVCActiveRecordClass): TObjectList<TMVCActiveRecord>;
|
||||
var
|
||||
lAR: TMVCActiveRecord;
|
||||
begin
|
||||
lAR := aClass.Create;
|
||||
try
|
||||
Result := Select(aClass, lAR.CreateSelectSQL, []);
|
||||
finally
|
||||
lAR.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
class function TMVCActiveRecord.All<T>: TObjectList<T>;
|
||||
var
|
||||
lAR: TMVCActiveRecord;
|
||||
begin
|
||||
lAR := T.Create;
|
||||
try
|
||||
Result := Select<T>(lAR.CreateSelectSQL, []);
|
||||
finally
|
||||
lAR.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
class function TMVCActiveRecord.Where<T>(const SQLWhere: string; const Params: array of Variant): TObjectList<T>;
|
||||
var
|
||||
lAR: TMVCActiveRecord;
|
||||
begin
|
||||
lAR := T.Create;
|
||||
try
|
||||
Result := Select<T>(lAR.CreateSelectSQL + ' WHERE ' + SQLWhere, Params);
|
||||
finally
|
||||
lAR.Free;
|
||||
end;
|
||||
end;
|
||||
{ PrimaryKeyAttribute }
|
||||
|
||||
constructor PrimaryKeyAttribute.Create(const aFieldName: string);
|
||||
begin
|
||||
Create(aFieldName, []);
|
||||
end;
|
||||
|
||||
constructor PrimaryKeyAttribute.Create(const aFieldName: string; const aFieldOptions: TDelphiARFieldOptions);
|
||||
begin
|
||||
inherited Create;
|
||||
FieldName := aFieldName;
|
||||
FieldOptions := aFieldOptions;
|
||||
end;
|
||||
|
||||
{ TMVCEntitiesRegistry }
|
||||
|
||||
procedure TMVCEntitiesRegistry.AddEntity(const aURLSegment: string; const aActiveRecordClass: TMVCActiveRecordClass);
|
||||
begin
|
||||
fEntitiesDict.AddOrSetValue(aURLSegment.ToLower, aActiveRecordClass);
|
||||
end;
|
||||
|
||||
constructor TMVCEntitiesRegistry.Create;
|
||||
begin
|
||||
inherited;
|
||||
fEntitiesDict := TDictionary<string, TMVCActiveRecordClass>.Create;
|
||||
end;
|
||||
|
||||
destructor TMVCEntitiesRegistry.Destroy;
|
||||
begin
|
||||
fEntitiesDict.Free;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TMVCEntitiesRegistry.GetByURLSegment(const aURLSegment: string): TMVCActiveRecordClass;
|
||||
begin
|
||||
if not fEntitiesDict.TryGetValue(aURLSegment.ToLower, Result) then
|
||||
begin
|
||||
raise Exception.CreateFmt('Cannot find URLSegment %s', [aURLSegment]);
|
||||
end;
|
||||
end;
|
||||
|
||||
{ EMVCActiveRecord }
|
||||
|
||||
constructor EMVCActiveRecord.Create(const AMsg: string);
|
||||
begin
|
||||
inherited Create(http_status.BadRequest, AMsg);
|
||||
end;
|
||||
|
||||
initialization
|
||||
|
||||
gLock := TObject.Create;
|
||||
|
||||
finalization
|
||||
|
||||
gLock.Free;
|
||||
|
||||
end.
|
||||
221
sources/MVCFramework.ActiveRecordController.pas
Normal file
221
sources/MVCFramework.ActiveRecordController.pas
Normal file
@ -0,0 +1,221 @@
|
||||
// *************************************************************************** }
|
||||
//
|
||||
// Delphi MVC Framework
|
||||
//
|
||||
// Copyright (c) 2010-2018 Daniele Teti and the DMVCFramework Team
|
||||
//
|
||||
// https://github.com/danieleteti/delphimvcframework
|
||||
//
|
||||
// ***************************************************************************
|
||||
//
|
||||
// Licensed under the Apache License, Version 2.0 (the "License");
|
||||
// you may not use this file except in compliance with the License.
|
||||
// You may obtain a copy of the License at
|
||||
//
|
||||
// http://www.apache.org/licenses/LICENSE-2.0
|
||||
//
|
||||
// Unless required by applicable law or agreed to in writing, software
|
||||
// distributed under the License is distributed on an "AS IS" BASIS,
|
||||
// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
// See the License for the specific language governing permissions and
|
||||
// limitations under the License.
|
||||
//
|
||||
// ***************************************************************************
|
||||
|
||||
unit MVCFramework.ActiveRecordController;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
System.SysUtils,
|
||||
MVCFramework,
|
||||
MVCFramework.Commons,
|
||||
MVCFramework.ActiveRecord,
|
||||
FireDAC.Stan.Def,
|
||||
FireDAC.Stan.Pool,
|
||||
FireDAC.Stan.Async,
|
||||
FireDAC.Comp.Client;
|
||||
|
||||
type
|
||||
{$SCOPEDENUMS ON}
|
||||
TMVCActiveRecordAction = (Create, Retrieve, Update, Delete);
|
||||
TMVCActiveRecordAuthFunc = TFunc<TWebContext, TMVCActiveRecordClass, TMVCActiveRecordAction, Boolean>;
|
||||
|
||||
TMVCActiveRecordController = class(TMVCController)
|
||||
private
|
||||
fAuthorization: TMVCActiveRecordAuthFunc;
|
||||
protected
|
||||
function CheckAuthorization(aClass: TMVCActiveRecordClass; aAction: TMVCActiveRecordAction): Boolean; virtual;
|
||||
public
|
||||
constructor Create(const aConnectionFactory: TFunc<TFDConnection>; const aAuthorization: TMVCActiveRecordAuthFunc = nil); reintroduce;
|
||||
destructor Destroy; override;
|
||||
|
||||
[MVCPath('/($entityname)')]
|
||||
[MVCHTTPMethod([httpGET])]
|
||||
procedure GetEntities(const entityname: string); virtual;
|
||||
|
||||
[MVCPath('/($entityname)/($id)')]
|
||||
[MVCHTTPMethod([httpGET])]
|
||||
procedure GetEntity(const entityname: string; const id: Integer); virtual;
|
||||
|
||||
[MVCPath('/($entityname)')]
|
||||
[MVCHTTPMethod([httpPOST])]
|
||||
procedure CreateEntity(const entityname: string); virtual;
|
||||
|
||||
[MVCPath('/($entityname)/($id)')]
|
||||
[MVCHTTPMethod([httpPUT])]
|
||||
procedure UpdateEntity(const entityname: string; const id: Integer); virtual;
|
||||
|
||||
[MVCPath('/($entityname)/($id)')]
|
||||
[MVCHTTPMethod([httpDELETE])]
|
||||
procedure DeleteEntity(const entityname: string; const id: Integer); virtual;
|
||||
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
MVCFramework.Logger;
|
||||
|
||||
procedure TMVCActiveRecordController.GetEntities(const entityname: string);
|
||||
var
|
||||
lARClassRef: TMVCActiveRecordClass;
|
||||
begin
|
||||
lARClassRef := ActiveRecordMappingRegistry.GetByURLSegment(entityname);
|
||||
if not CheckAuthorization(lARClassRef, TMVCActiveRecordAction.Retrieve) then
|
||||
begin
|
||||
Render(TMVCErrorResponse.Create(http_status.Forbidden, 'Cannot read ' + entityname, ''));
|
||||
Exit;
|
||||
end;
|
||||
Render<TMVCActiveRecord>(TMVCActiveRecord.All(lARClassRef), True);
|
||||
end;
|
||||
|
||||
procedure TMVCActiveRecordController.GetEntity(const entityname: string; const id: Integer);
|
||||
var
|
||||
lAR: TMVCActiveRecord;
|
||||
begin
|
||||
lAR := ActiveRecordMappingRegistry.GetByURLSegment(entityname).Create;
|
||||
try
|
||||
if not CheckAuthorization(TMVCActiveRecordClass(lAR.ClassType), TMVCActiveRecordAction.Retrieve) then
|
||||
begin
|
||||
Render(TMVCErrorResponse.Create(http_status.Forbidden, 'Cannot read ' + entityname, ''));
|
||||
Exit;
|
||||
end;
|
||||
|
||||
if lAR.LoadByPK(id) then
|
||||
begin
|
||||
Render(lAR, False);
|
||||
end
|
||||
else
|
||||
begin
|
||||
Render(TMVCErrorResponse.Create(http_status.NotFound, 'Not found', entityname.ToLower + ' not found'));
|
||||
end;
|
||||
finally
|
||||
lAR.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TMVCActiveRecordController.CheckAuthorization(aClass: TMVCActiveRecordClass; aAction: TMVCActiveRecordAction): Boolean;
|
||||
begin
|
||||
if Assigned(fAuthorization) then
|
||||
begin
|
||||
Result := fAuthorization(Context, aClass, aAction);
|
||||
end
|
||||
else
|
||||
begin
|
||||
Result := True;
|
||||
end;
|
||||
end;
|
||||
|
||||
constructor TMVCActiveRecordController.Create(const aConnectionFactory: TFunc<TFDConnection>;
|
||||
const aAuthorization: TMVCActiveRecordAuthFunc = nil);
|
||||
begin
|
||||
inherited Create;
|
||||
ActiveRecordConnectionsRegistry.AddConnection('default', aConnectionFactory());
|
||||
fAuthorization := aAuthorization;
|
||||
end;
|
||||
|
||||
procedure TMVCActiveRecordController.CreateEntity(const entityname: string);
|
||||
var
|
||||
lAR: TMVCActiveRecord;
|
||||
begin
|
||||
lAR := ActiveRecordMappingRegistry.GetByURLSegment(entityname).Create;
|
||||
try
|
||||
if not CheckAuthorization(TMVCActiveRecordClass(lAR.ClassType), TMVCActiveRecordAction.Create) then
|
||||
begin
|
||||
Render(TMVCErrorResponse.Create(http_status.Forbidden, 'Cannot create ' + entityname, ''));
|
||||
Exit;
|
||||
end;
|
||||
|
||||
Context.Request.BodyFor<TMVCActiveRecord>(lAR);
|
||||
lAR.Insert;
|
||||
StatusCode := http_status.Created;
|
||||
Context.Response.CustomHeaders.AddPair('X-REF', Context.Request.PathInfo + '/' + lAR.GetPK.AsInt64.ToString);
|
||||
if Context.Request.QueryStringParam('refresh').ToLower = 'true' then
|
||||
begin
|
||||
Render(lAR, False);
|
||||
end;
|
||||
finally
|
||||
lAR.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMVCActiveRecordController.UpdateEntity(const entityname: string; const id: Integer);
|
||||
var
|
||||
lAR: TMVCActiveRecord;
|
||||
begin
|
||||
lAR := ActiveRecordMappingRegistry.GetByURLSegment(entityname).Create;
|
||||
try
|
||||
if not CheckAuthorization(TMVCActiveRecordClass(lAR.ClassType), TMVCActiveRecordAction.Update) then
|
||||
begin
|
||||
Render(TMVCErrorResponse.Create(http_status.Forbidden, 'Cannot update ' + entityname, ''));
|
||||
Exit;
|
||||
end;
|
||||
if not lAR.LoadByPK(id) then
|
||||
raise EMVCException.Create('Cannot find entity');
|
||||
Context.Request.BodyFor<TMVCActiveRecord>(lAR);
|
||||
lAR.SetPK(id);
|
||||
lAR.Update;
|
||||
Context.Response.CustomHeaders.AddPair('X-REF', Context.Request.PathInfo);
|
||||
if Context.Request.QueryStringParam('refresh').ToLower = 'true' then
|
||||
begin
|
||||
Render(lAR, False);
|
||||
end
|
||||
else
|
||||
begin
|
||||
Render(http_status.OK, entityname.ToLower + ' updated');
|
||||
end;
|
||||
finally
|
||||
lAR.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMVCActiveRecordController.DeleteEntity(const entityname: string; const id: Integer);
|
||||
var
|
||||
lAR: TMVCActiveRecord;
|
||||
begin
|
||||
lAR := ActiveRecordMappingRegistry.GetByURLSegment(entityname).Create;
|
||||
try
|
||||
if not CheckAuthorization(TMVCActiveRecordClass(lAR), TMVCActiveRecordAction.Delete) then
|
||||
begin
|
||||
Render(TMVCErrorResponse.Create(http_status.Forbidden, 'Cannot delete ' + entityname, ''));
|
||||
Exit;
|
||||
end;
|
||||
if not lAR.LoadByPK(id) then
|
||||
raise EMVCException.Create('Cannot find entity');
|
||||
Context.Request.BodyFor<TMVCActiveRecord>(lAR);
|
||||
lAR.SetPK(id);
|
||||
lAR.Delete;
|
||||
Render(http_status.OK, entityname.ToLower + ' deleted');
|
||||
finally
|
||||
lAR.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
destructor TMVCActiveRecordController.Destroy;
|
||||
begin
|
||||
ActiveRecordConnectionsRegistry.RemoveConnection('default');
|
||||
inherited;
|
||||
end;
|
||||
|
||||
end.
|
||||
@ -277,7 +277,8 @@ type
|
||||
{ protected declarations }
|
||||
public
|
||||
constructor Create(const AMsg: string); overload; virtual;
|
||||
constructor Create(const AMsg: string; const ADetailedMessage: string; const AAppErrorCode: UInt16; const AHttpErrorCode: UInt16 = HTTP_STATUS.InternalServerError); overload; virtual;
|
||||
constructor Create(const AMsg: string; const ADetailedMessage: string; const AAppErrorCode: UInt16;
|
||||
const AHttpErrorCode: UInt16 = HTTP_STATUS.InternalServerError); overload; virtual;
|
||||
constructor Create(const AHttpErrorCode: UInt16; const AMsg: string); overload; virtual;
|
||||
constructor CreateFmt(const AMsg: string; const AArgs: array of const); reintroduce;
|
||||
|
||||
@ -385,8 +386,7 @@ type
|
||||
function DoWithLockTimeout(const AAction: TProc; const ATimeOut: UInt32): TWaitResult;
|
||||
end;
|
||||
|
||||
TMultiReadExclusiveWriteSynchronizerHelper = class helper
|
||||
for TMultiReadExclusiveWriteSynchronizer
|
||||
TMultiReadExclusiveWriteSynchronizerHelper = class helper for TMultiReadExclusiveWriteSynchronizer
|
||||
public
|
||||
procedure DoWithWriteLock(const AAction: TProc);
|
||||
procedure DoWithReadLock(const AAction: TProc);
|
||||
@ -417,11 +417,13 @@ type
|
||||
IMVCAuthenticationHandler = interface
|
||||
['{19B580EA-8A47-4364-A302-EEF3C6207A9F}']
|
||||
procedure OnRequest(const AControllerQualifiedClassName, AActionName: string; var AAuthenticationRequired: Boolean);
|
||||
procedure OnAuthentication(const AUserName, APassword: string; AUserRoles: TList<string>; var AIsValid: Boolean; const ASessionData: TDictionary<string, string>);
|
||||
procedure OnAuthorization(AUserRoles: TList<string>; const AControllerQualifiedClassName: string; const AActionName: string; var AIsAuthorized: Boolean);
|
||||
procedure OnAuthentication(const AUserName, APassword: string; AUserRoles: TList<string>; var AIsValid: Boolean;
|
||||
const ASessionData: TDictionary<string, string>);
|
||||
procedure OnAuthorization(AUserRoles: TList<string>; const AControllerQualifiedClassName: string; const AActionName: string;
|
||||
var AIsAuthorized: Boolean);
|
||||
end;
|
||||
|
||||
{$SCOPEDENUMS ON}
|
||||
{$SCOPEDENUMS ON}
|
||||
|
||||
function AppPath: string;
|
||||
function IsReservedOrPrivateIP(const AIP: string): Boolean; inline;
|
||||
@ -449,13 +451,10 @@ var
|
||||
Lock: TObject;
|
||||
|
||||
const
|
||||
RESERVED_IPS: array [1 .. 11] of array [1 .. 2] of string =
|
||||
(('0.0.0.0', '0.255.255.255'), ('10.0.0.0', '10.255.255.255'),
|
||||
('127.0.0.0', '127.255.255.255'), ('169.254.0.0', '169.254.255.255'),
|
||||
('172.16.0.0', '172.31.255.255'), ('192.0.2.0', '192.0.2.255'),
|
||||
('192.88.99.0', '192.88.99.255'), ('192.168.0.0', '192.168.255.255'),
|
||||
('198.18.0.0', '198.19.255.255'), ('224.0.0.0', '239.255.255.255'),
|
||||
('240.0.0.0', '255.255.255.255'));
|
||||
RESERVED_IPS: array [1 .. 11] of array [1 .. 2] of string = (('0.0.0.0', '0.255.255.255'), ('10.0.0.0', '10.255.255.255'),
|
||||
('127.0.0.0', '127.255.255.255'), ('169.254.0.0', '169.254.255.255'), ('172.16.0.0', '172.31.255.255'), ('192.0.2.0', '192.0.2.255'),
|
||||
('192.88.99.0', '192.88.99.255'), ('192.168.0.0', '192.168.255.255'), ('198.18.0.0', '198.19.255.255'),
|
||||
('224.0.0.0', '239.255.255.255'), ('240.0.0.0', '255.255.255.255'));
|
||||
|
||||
implementation
|
||||
|
||||
@ -489,10 +488,7 @@ begin
|
||||
if AIP.IsEmpty then
|
||||
Exit(0);
|
||||
lPieces := AIP.Split(['.']);
|
||||
Result := (StrToInt(lPieces[0]) * 16777216) +
|
||||
(StrToInt(lPieces[1]) * 65536) +
|
||||
(StrToInt(lPieces[2]) * 256) +
|
||||
StrToInt(lPieces[3]);
|
||||
Result := (StrToInt(lPieces[0]) * 16777216) + (StrToInt(lPieces[1]) * 65536) + (StrToInt(lPieces[2]) * 256) + StrToInt(lPieces[3]);
|
||||
end;
|
||||
|
||||
// function IP2Long(const AIP: string): UInt32;
|
||||
@ -591,6 +587,10 @@ end;
|
||||
|
||||
constructor EMVCException.Create(const AHttpErrorCode: UInt16; const AMsg: string);
|
||||
begin
|
||||
if (AHttpErrorCode div 100 = 0) or (AHttpErrorCode div 100 > 5) then
|
||||
begin
|
||||
raise EMVCException.CreateFmt('Invalid HTTP_STATUS [%d]', [AHttpErrorCode]);
|
||||
end;
|
||||
Create(AMsg);
|
||||
FHttpErrorCode := AHttpErrorCode;
|
||||
end;
|
||||
@ -719,16 +719,13 @@ begin
|
||||
for S in FConfig.Keys do
|
||||
Jo.AddPair(S, FConfig[S]);
|
||||
|
||||
{$IFDEF SYSTEMJSON}
|
||||
|
||||
{$IFDEF SYSTEMJSON}
|
||||
Result := Jo.ToJSON;
|
||||
|
||||
{$ELSE}
|
||||
|
||||
{$ELSE}
|
||||
Result := Jo.ToString;
|
||||
|
||||
{$ENDIF}
|
||||
|
||||
{$ENDIF}
|
||||
finally
|
||||
Jo.Free;
|
||||
end;
|
||||
@ -736,8 +733,7 @@ end;
|
||||
|
||||
{ TMVCStringDictionary }
|
||||
|
||||
function TMVCStringDictionary.AddProperty(const Name,
|
||||
Value: string): TMVCStringDictionary;
|
||||
function TMVCStringDictionary.AddProperty(const Name, Value: string): TMVCStringDictionary;
|
||||
begin
|
||||
FDict.AddOrSetValue(name, Value);
|
||||
Result := Self;
|
||||
@ -770,8 +766,7 @@ begin
|
||||
Result := FDict.GetEnumerator;
|
||||
end;
|
||||
|
||||
function TMVCStringDictionary.TryGetValue(const Name: string;
|
||||
out Value: string): Boolean;
|
||||
function TMVCStringDictionary.TryGetValue(const Name: string; out Value: string): Boolean;
|
||||
begin
|
||||
Result := FDict.TryGetValue(name, Value);
|
||||
end;
|
||||
@ -830,8 +825,7 @@ type
|
||||
end;
|
||||
|
||||
const
|
||||
GURLSafeBase64CodeTable: string =
|
||||
'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_'; { Do not Localize }
|
||||
GURLSafeBase64CodeTable: string = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_'; { Do not Localize }
|
||||
|
||||
procedure TURLSafeEncode.InitComponent;
|
||||
begin
|
||||
@ -862,14 +856,14 @@ end;
|
||||
/// <param name="Value">Original string</param>
|
||||
/// <param name="TrimmedChar">Character to remove</param>
|
||||
/// <returns>Resulting string</returns>
|
||||
function RTrim(const Value: string; TrimmedChar: char): string;
|
||||
function RTrim(const Value: string; TrimmedChar: Char): string;
|
||||
var
|
||||
Strlen: Integer;
|
||||
begin
|
||||
Strlen := Length(Value);
|
||||
while (Strlen > 0) and (Value[Strlen] = TrimmedChar) do
|
||||
dec(StrLen);
|
||||
result := copy(value, 1, StrLen)
|
||||
dec(Strlen);
|
||||
Result := copy(Value, 1, Strlen)
|
||||
end;
|
||||
|
||||
function URLSafeB64encode(const Value: TBytes; IncludePadding: Boolean): string; overload;
|
||||
@ -884,7 +878,7 @@ end;
|
||||
function URLSafeB64Decode(const Value: string): string;
|
||||
begin
|
||||
// SGR 2017-07-03 : b64url might not include padding. Need to add it before decoding
|
||||
case Length(value) mod 4 of
|
||||
case Length(Value) mod 4 of
|
||||
0:
|
||||
begin
|
||||
Result := TURLSafeDecode.DecodeString(Value);
|
||||
@ -900,8 +894,7 @@ end;
|
||||
|
||||
{ TMultiReadExclusiveWriteSynchronizerHelper }
|
||||
|
||||
procedure TMultiReadExclusiveWriteSynchronizerHelper.DoWithReadLock(
|
||||
const AAction: TProc);
|
||||
procedure TMultiReadExclusiveWriteSynchronizerHelper.DoWithReadLock(const AAction: TProc);
|
||||
begin
|
||||
Self.BeginRead;
|
||||
try
|
||||
@ -911,8 +904,7 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMultiReadExclusiveWriteSynchronizerHelper.DoWithWriteLock(
|
||||
const AAction: TProc);
|
||||
procedure TMultiReadExclusiveWriteSynchronizerHelper.DoWithWriteLock(const AAction: TProc);
|
||||
begin
|
||||
Self.BeginWrite;
|
||||
try
|
||||
|
||||
@ -577,7 +577,7 @@ type
|
||||
const AActionName: string; var AHandled: Boolean);
|
||||
procedure ExecuteAfterControllerActionMiddleware(const AContext: TWebContext; const AActionName: string; const AHandled: Boolean);
|
||||
|
||||
procedure DefineDefaultReponseHeaders(const AContext: TWebContext);
|
||||
procedure DefineDefaultResponseHeaders(const AContext: TWebContext);
|
||||
procedure OnBeforeDispatch(ASender: TObject; ARequest: TWebRequest; AResponse: TWebResponse; var AHandled: Boolean); virtual;
|
||||
procedure ResponseErrorPage(const AException: Exception; const ARequest: TWebRequest; const AResponse: TWebResponse); virtual;
|
||||
function ExecuteAction(const ASender: TObject; const ARequest: TWebRequest; const AResponse: TWebResponse): Boolean; virtual;
|
||||
@ -817,7 +817,7 @@ begin
|
||||
end;
|
||||
end
|
||||
else
|
||||
raise EMVCDeserializationException.CreateFmt('Body ContentType %s not supported', [ContentType]);
|
||||
raise EMVCDeserializationException.CreateFmt('Body ContentType "%s" not supported', [ContentType]);
|
||||
end;
|
||||
|
||||
function TMVCWebRequest.BodyAsListOf<T>: TObjectList<T>;
|
||||
@ -838,7 +838,7 @@ begin
|
||||
end;
|
||||
end
|
||||
else
|
||||
raise EMVCException.CreateFmt('Body ContentType %s not supported', [ContentType]);
|
||||
raise EMVCException.CreateFmt('Body ContentType "%s" not supported', [ContentType]);
|
||||
end;
|
||||
|
||||
procedure TMVCWebRequest.BodyFor<T>(const AObject: T);
|
||||
@ -849,7 +849,7 @@ begin
|
||||
if FSerializers.TryGetValue(ContentType, lSerializer) then
|
||||
lSerializer.DeserializeObject(Body, AObject)
|
||||
else
|
||||
raise EMVCException.CreateFmt('Body ContentType %s not supported', [ContentType]);
|
||||
raise EMVCException.CreateFmt('Body ContentType "%s" not supported', [ContentType]);
|
||||
end;
|
||||
|
||||
procedure TMVCWebRequest.BodyForListOf<T>(const AObjectList: TObjectList<T>);
|
||||
@ -860,7 +860,7 @@ begin
|
||||
if FSerializers.TryGetValue(ContentType, lSerializer) then
|
||||
lSerializer.DeserializeCollection(Body, AObjectList, T)
|
||||
else
|
||||
raise EMVCException.CreateFmt('Body ContentType %s not supported', [ContentType]);
|
||||
raise EMVCException.CreateFmt('Body ContentType "%s" not supported', [ContentType]);
|
||||
end;
|
||||
|
||||
function TMVCWebRequest.ClientIp: string;
|
||||
@ -1573,7 +1573,7 @@ begin
|
||||
LoadSystemControllers;
|
||||
end;
|
||||
|
||||
procedure TMVCEngine.DefineDefaultReponseHeaders(const AContext: TWebContext);
|
||||
procedure TMVCEngine.DefineDefaultResponseHeaders(const AContext: TWebContext);
|
||||
begin
|
||||
if Config[TMVCConfigKey.ExposeServerSignature] = 'true' then
|
||||
AContext.Response.CustomHeaders.Values['Server'] := GetServerSignature(AContext);
|
||||
@ -1609,7 +1609,7 @@ begin
|
||||
try
|
||||
LContext := TWebContext.Create(ARequest, AResponse, FConfig, FSerializers);
|
||||
try
|
||||
DefineDefaultReponseHeaders(LContext);
|
||||
DefineDefaultResponseHeaders(LContext);
|
||||
if IsStaticFileRequest(ARequest, LFileName) then
|
||||
Result := SendStaticFileIfPresent(LContext, LFileName)
|
||||
else
|
||||
@ -2710,6 +2710,7 @@ begin
|
||||
if Assigned(AError) then
|
||||
begin
|
||||
try
|
||||
Context.Response.StatusCode := AError.StatusCode;
|
||||
Render(AError, False, stProperties);
|
||||
finally
|
||||
if AOwns then
|
||||
|
||||
Loading…
Reference in New Issue
Block a user