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

Added features selection in dmvcframework.inc

Browse Source 
Added MVCFramework.Patches.pas which should try to uniform interfaces of the changed classes in different versions of Delphi
This commit is contained in:
Daniele Teti 2016-12-30 20:41:55 +01:00
parent 05fb9259ae
commit 32e7a8d325
12 changed files with 219 additions and 96 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
sources/MVCFramework.Commons.pas
View File

@ -28,10 +28,10 @@ interface
uses
System.SysUtils, Generics.Collections
{$IF CompilerVersion < 27 }
, Data.DBXJSON
{$ELSE}
{$IF CompilerVersion >= 27} // XE6
, System.JSON
{$ELSE}
, Data.DBXJSON
{$ENDIF}
, System.Generics.Collections, MVCFramework.Session, LoggerPro;

49
sources/MVCFramework.JWT.pas
View File

@ -28,12 +28,13 @@ interface
uses
System.Generics.Collections
{$IF CompilerVersion < 27 }
, Data.DBXJSON
{$ELSE}
{$IF CompilerVersion >= 27} // XE6
, System.JSON
{$ELSE}
, Data.DBXJSON
, MVCFramework.Patches
{$ENDIF}
;
;
type
{$SCOPEDENUMS ON}
@ -210,7 +211,11 @@ type
implementation
uses
System.SysUtils, MVCFramework.Commons, MVCFramework.HMAC, System.DateUtils;
System.SysUtils
, MVCFramework.Commons
, MVCFramework.HMAC
, System.DateUtils
, MVCFramework.Patches;
{ TJWTRegisteredClaims }
@ -347,20 +352,20 @@ begin
if not Assigned(lJValue) then
begin
Error := TJWTRegisteredClaimNames.ExpirationTime + ' not set';
Exit(false);
Exit(False);
end;
lValue := lJValue.Value;
if not TryStrToInt64(lValue, lIntValue) then
begin
Error := TJWTRegisteredClaimNames.ExpirationTime + ' is not an integer';
Exit(false);
Exit(False);
end;
if UnixToDateTime(lIntValue, False) <= Now - FLeewaySeconds * OneSecond then
begin
Error := 'Token expired';
Exit(false);
Exit(False);
end;
Result := True;
@ -376,20 +381,20 @@ begin
if not Assigned(lJValue) then
begin
Error := TJWTRegisteredClaimNames.IssuedAt + ' not set';
Exit(false);
Exit(False);
end;
lValue := lJValue.Value;
if not TryStrToInt64(lValue, lIntValue) then
begin
Error := TJWTRegisteredClaimNames.IssuedAt + ' is not an integer';
Exit(false);
Exit(False);
end;
if UnixToDateTime(lIntValue, False) >= Now + FLeewaySeconds * OneSecond then
begin
Error := 'Token is issued in the future';
Exit(false);
Exit(False);
end;
Result := True;
@ -405,20 +410,20 @@ begin
if not Assigned(lJValue) then
begin
Error := TJWTRegisteredClaimNames.NotBefore + ' not set';
Exit(false);
Exit(False);
end;
lValue := lJValue.Value;
if not TryStrToInt64(lValue, lIntValue) then
begin
Error := TJWTRegisteredClaimNames.NotBefore + ' is not an integer';
Exit(false);
Exit(False);
end;
if UnixToDateTime(lIntValue, False) >= Now + FLeewaySeconds * OneSecond then
begin
Error := 'Token still not valid';
Exit(false);
Exit(False);
end;
Result := True;
@ -502,7 +507,7 @@ begin
if Length(lPieces) <> 3 then
begin
Error := 'Invalid Token';
Exit(false);
Exit(False);
end;
lJHeader := TJSONObject.ParseJSONValue(B64Decode(lPieces[0])) as TJSONObject;
@ -510,7 +515,7 @@ begin
if not Assigned(lJHeader) then
begin
Error := 'Invalid Token';
Exit(false);
Exit(False);
end;
lJPayload := TJSONObject.ParseJSONValue(B64Decode(lPieces[1])) as TJSONObject;
@ -518,13 +523,13 @@ begin
if not Assigned(lJPayload) then
begin
Error := 'Invalid Token';
Exit(false);
Exit(False);
end;
if not lJHeader.TryGetValue<TJSONString>('alg', lJAlg) then
begin
Error := 'Invalid Token';
Exit(false);
Exit(False);
end;
lAlgName := lJAlg.Value;
@ -542,7 +547,7 @@ begin
begin
if not CheckExpirationTime(lJPayload, Error) then
begin
Exit(false);
Exit(False);
end;
end;
@ -551,7 +556,7 @@ begin
begin
if not CheckNotBefore(lJPayload, Error) then
begin
Exit(false);
Exit(False);
end;
end;
@ -559,7 +564,7 @@ begin
begin
if not CheckIssuedAt(lJPayload, Error) then
begin
Exit(false);
Exit(False);
end;
end;
end;
@ -602,7 +607,7 @@ begin
FCustomClaims.FClaims.Clear;
for i := 0 to lJPayload.Count - 1 do
begin
lIsRegistered := false;
lIsRegistered := False;
lJPair := lJPayload.Pairs[i];
lName := lJPair.JsonString.Value;
lValue := lJPair.JsonValue.Value;

44
sources/MVCFramework.MessagingController.pas
View File

@ -77,16 +77,16 @@ implementation
{ TMVCBUSController }
uses
System.SysUtils,
MVCFramework.Commons,
System.DateUtils,
{$IF CompilerVersion < 27}
Data.DBXJSON,
System.SysUtils
, MVCFramework.Commons
, System.DateUtils
{$IF CompilerVersion >= 27} // XE6
, System.JSON
{$ELSE}
System.JSON,
{$IFEND}
MVCFramework.Logger,
System.SyncObjs;
, Data.DBXJSON
{$ENDIF}
, MVCFramework.Logger
, System.SyncObjs;
procedure TMVCBUSController.AddTopicToUserSubscriptions(const ATopic: string);
var
@ -313,21 +313,21 @@ end;
procedure TMVCBUSController.InternalSubscribeUserToTopic(clientid, topicname: string;
StompClient: IStompClient);
//var
// LDurSubHeader: string;
// LHeaders: IStompHeaders;
// var
// LDurSubHeader: string;
// LHeaders: IStompHeaders;
begin
raise EMVCException.Create('Not implemented');
// LHeaders := TStompHeaders.Create;
// LDurSubHeader := GetUniqueDurableHeader(clientid, topicname);
// LHeaders.Add(TStompHeaders.NewDurableSubscriptionHeader(LDurSubHeader));
//
// if topicname.StartsWith('/topic') then
// LHeaders.Add('id', clientid); //https://www.rabbitmq.com/stomp.html
//
// StompClient.Subscribe(topicname, amClient, LHeaders);
// LogE('SUBSCRIBE TO ' + clientid + '@' + topicname + ' dursubheader:' + LDurSubHeader);
// AddTopicToUserSubscriptions(topicname);
// LHeaders := TStompHeaders.Create;
// LDurSubHeader := GetUniqueDurableHeader(clientid, topicname);
// LHeaders.Add(TStompHeaders.NewDurableSubscriptionHeader(LDurSubHeader));
//
// if topicname.StartsWith('/topic') then
// LHeaders.Add('id', clientid); //https://www.rabbitmq.com/stomp.html
//
// StompClient.Subscribe(topicname, amClient, LHeaders);
// LogE('SUBSCRIBE TO ' + clientid + '@' + topicname + ' dursubheader:' + LDurSubHeader);
// AddTopicToUserSubscriptions(topicname);
end;
procedure TMVCBUSController.UnSubscribeFromTopic(CTX: TWebContext);

21
sources/MVCFramework.Middleware.Authentication.pas
View File

@ -26,6 +26,9 @@ unit MVCFramework.Middleware.Authentication;
interface
{$I dmvcframework.inc}
uses
MVCFramework, MVCFramework.Logger,
System.Generics.Collections, MVCFramework.Commons;
@ -73,12 +76,18 @@ type
implementation
uses
System.SysUtils, MVCFramework.Session, ObjectsMappers, System.StrUtils
{$IF CompilerVersion > 24}
, System.NetEncoding, System.JSON, System.Classes
System.SysUtils, MVCFramework.Session, ObjectsMappers, System.StrUtils, System.Classes
{$IFDEF SYSTEMNETENCODING}
, System.NetEncoding
{$ELSE}
, Soap.EncdDecd, Data.DBXJSON
{$ENDIF};
, Soap.EncdDecd
{$ENDIF}
{$IFDEF SYSTEMJSON}
, System.JSON
{$ELSE}
, Data.DBXJSON
{$ENDIF}
;
{
@ -95,7 +104,7 @@ const
function Base64DecodeString(const Value: string): string; inline;
begin
{$IF CompilerVersion > 24}
{$IFDEF SYSTEMNETENCODING}
Result := TNetEncoding.Base64.Decode(Value);
{$ELSE}
Result := DecodeString(Value);

14
sources/MVCFramework.Middleware.JWT.pas
View File

@ -26,6 +26,9 @@ unit MVCFramework.Middleware.JWT;
interface
{$I dmvcframework.inc}
uses
MVCFramework,
MVCFramework.Commons,
@ -70,12 +73,15 @@ implementation
uses
MVCFramework.Session
{$IF CompilerVersion < 27}
, Data.DBXJSON
{$IFDEF SYSTEMJSON}
, System.JSON
{$ELSE}
, System.JSON, Web.ApacheHTTP
, Data.DBXJSON
{$ENDIF}
{$IF CompilerVersion >= 21}
{$IFDEF WEBAPACHEHTTP}
, Web.ApacheHTTP
{$ENDIF}
{$IFDEF SYSTEMNETENCODING}
, System.NetEncoding
{$ELSE}
, Soap.EncdDecd

62
sources/MVCFramework.Patches.pas Normal file
View File

@ -0,0 +1,62 @@
// ***************************************************************************
//
// Delphi MVC Framework
//
// Copyright (c) 2010-2016 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.Patches;
interface
{$I dmvcframework.inc}
uses
System.Classes, System.JSON
{$IFNDEF SYSTEMJSON} // XE6
, Data.DBXJSON
{$ENDIF}
;
{$IFNDEF SYSTEMJSON}
type
TJSONValueHelper = class helper for TJSONValue
public
function ToJSON: String;
end;
{$ENDIF}
implementation
{ TJSONValueHelper }
{$IFNDEF SYSTEMJSON}
function TJSONValueHelper.ToJSON: String;
begin
Result := Self.ToString;
end;
{$ENDIF}
end.

17
sources/MVCFramework.SysControllers.pas
View File

@ -57,13 +57,18 @@ type
implementation
uses
{$IF CompilerVErsion < 27}
Data.DBXJSON,
System.SysUtils
, System.Rtti
, MVCFramework.Commons
, System.Classes
, Winapi.Windows
, System.TypInfo
{$IF CompilerVersion >= 27} // XE6
, System.JSON
{$ELSE}
System.JSON,
{$IFEND}
System.SysUtils, System.Rtti, MVCFramework.Commons, System.Classes,
Winapi.Windows, System.TypInfo;
, Data.DBXJSON
{$ENDIF}
;
function MSecToTime(mSec: Int64): string;
const

18
sources/MVCFramework.View.pas
View File

@ -35,7 +35,9 @@ uses
Data.DB,
MVCFramework.View.Cache,
System.SysUtils,
SynMustache, SynCommons;
SynMustache,
SynCommons,
MVCFramework.Patches;
type
TMVCBaseView = class(TMVCBase)
@ -82,12 +84,12 @@ type
implementation
uses
System.ioutils,
System.Classes
{$IF CompilerVersion < 27}
, Data.DBXJSON
{$ELSE}
System.IOUtils
, System.Classes
{$IF CompilerVersion >= 27} // XE6
, System.JSON
{$ELSE}
, Data.DBXJSON
{$ENDIF};
{ TMVCBaseView }
@ -192,11 +194,7 @@ begin
raise;
end;
{$IF CompilerVersion >= 28}
FOutput := UTF8ToString(LMEngine.RenderJSON(LJContext.ToJSON));
{$ELSE}
FOutput := UTF8ToString(LMEngine.RenderJSON(LJContext.ToString));
{$ENDIF}
end;
end.

20
sources/MVCFramework.pas
View File

@ -47,17 +47,19 @@ uses
MVCFramework.Session,
StompTypes,
ObjectsMappers
{$IF CompilerVersion < 27}
, Data.DBXJSON
{$ELSE}
{$IF CompilerVersion >= 27} // XE6
, System.JSON
{$ELSE}
, Data.DBXJSON
{$ENDIF}
{$IF CompilerVersion >= 27}
, Web.ApacheHTTP
// Apache Support since XE6 http://docwiki.embarcadero.com/Libraries/XE6/de/Web.ApacheHTTP
{$ENDIF}
, ReqMulti {Delphi XE4 (all update) and XE5 (with no update) dont contains this unit. Look for the bug in QC}
, LoggerPro, MVCFramework.DuckTyping;
, LoggerPro
, MVCFramework.DuckTyping
, MVCFramework.Patches;
type
TMVCHTTPMethodType = (httpGET, httpPOST, httpPUT, httpDELETE, httpHEAD,
@ -1889,11 +1891,7 @@ begin
Stomp := GetNewStompClient(GetClientID);
H := StompUtils.NewHeaders.Add(TStompHeaders.NewPersistentHeader(true));
{$IF CompilerVersion >= 28}
Stomp.Send(ATopic, msg.ToJSON);
{$ELSE}
Stomp.Send(ATopic, msg.ToString);
{$ENDIF}
TThread.Sleep(100);
// single user cannot enqueue more than 10 message in noe second...
// it is noot too much elegant, but it works as DoS protection
@ -2103,11 +2101,7 @@ var
OutEncoding: TEncoding;
lContentType, lJString: string;
begin
{$IF CompilerVersion <= 27}
lJString := aJSONValue.ToString; // requires the patch
{$ELSE}
lJString := aJSONValue.ToJSON; // since XE7 is available ToJSON
{$ENDIF}
lJString := aJSONValue.ToJSON;
// first set the ContentType; because of this bug:
// http://qc.embarcadero.com/wc/qcmain.aspx?d=67350
Context.Response.RawWebResponse.ContentType := ContentType + '; charset=' +

35
sources/dmvcframework.inc Normal file
View File

@ -0,0 +1,35 @@
// ***************************************************************************
//
// Delphi MVC Framework
//
// Copyright (c) 2010-2016 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.
//
// *************************************************************************** }
{
http://delphi.wikia.com/wiki/CompilerVersion_Constant
}
{$IF CompilerVersion >= 27} // XE6
{$DEFINE SYSTEMJSON}
{$DEFINE WEBAPACHEHTTP}
{$ENDIF}
{$IF CompilerVersion >= 28} // XE7
{$DEFINE SYSTEMNETENCODING}
{$ENDIF}

3
unittests/TestServer/TestServer.dpr
View File

@ -34,7 +34,8 @@ uses
MVCFramework.View in '..\..\sources\MVCFramework.View.pas',
MVCFramework.RTTIUtils in '..\..\sources\MVCFramework.RTTIUtils.pas',
TestServerControllerPrivateU in 'TestServerControllerPrivateU.pas',
AuthHandlersU in 'AuthHandlersU.pas';
AuthHandlersU in 'AuthHandlersU.pas',
MVCFramework.Patches in '..\..\sources\MVCFramework.Patches.pas';
{$R *.res}

26
unittests/TestServer/TestServer.dproj
View File

@ -130,6 +130,8 @@
<DCCReference Include="..\..\sources\MVCFramework.RTTIUtils.pas"/>
<DCCReference Include="TestServerControllerPrivateU.pas"/>
<DCCReference Include="AuthHandlersU.pas"/>
<DCCReference Include="..\..\sources\MVCFramework.Patches.pas"/>
<None Include="..\..\sources\dmvcframework.inc"/>
<BuildConfiguration Include="Release">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>
@ -199,16 +201,13 @@
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployClass Name="DependencyModule">
<DeployFile LocalName="New1.inc" Configuration="Debug" Class="ProjectFile">
<Platform Name="Win32">
<Operation>0</Operation>
<Extensions>.dll;.bpl</Extensions>
<RemoteDir>.\</RemoteDir>
<Overwrite>true</Overwrite>
</Platform>
<Platform Name="OSX32">
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
</DeployClass>
</DeployFile>
<DeployClass Name="ProjectiOSDeviceResourceRules"/>
<DeployClass Name="ProjectOSXResource">
<Platform Name="OSX32">
<RemoteDir>Contents\Resources</RemoteDir>
@ -548,7 +547,16 @@
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectiOSDeviceResourceRules"/>
<DeployClass Name="DependencyModule">
<Platform Name="Win32">
<Operation>0</Operation>
<Extensions>.dll;.bpl</Extensions>
</Platform>
<Platform Name="OSX32">
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
</DeployClass>
<ProjectRoot Platform="iOSDevice64" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="Win64" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="iOSDevice32" Name="$(PROJECTNAME).app"/>