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

Merge branch 'master' of https://github.com/danieleteti/delphimvcframework

Browse Source
This commit is contained in:
Pedro 2019-02-25 08:51:35 -03:00
commit 506a187418
12 changed files with 493 additions and 289 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
README.md
View File

@ -76,8 +76,11 @@ Congratulations to Daniele Teti and all the staff for the excellent work!" -- Ma
- New! `TMVCActiveRecord.DeleteRQL` deletes records using an `RQL` expression as `where` clause.
- New! Microsoft SQLServer Support in ActiveRecord and RQL (thanks to one of the biggest Delphi based company in Italy which heavily uses DMVCFramework)
- Improved! `ActiveRecordShowCase` sample is much better now.
- Improved! In case of unhandled exception `TMVCEngine` is compliant with the default response content-type (usually it did would reply using `text/plain`).
- Fix! [issue184](https://github.com/danieleteti/delphimvcframework/issues/184).
- New Installation procedure! Just open the project group, build all and install the design-time package (which is `dmvcframeworkDT`)
|Delphi Version|Project Group|
|---|---|
|Delphi 10.3 Rio| `packages\d103\dmvcframework_group.groupproj`|

3
samples/CustomAuth/AuthHandlerU.pas
View File

@ -51,6 +51,9 @@ type
implementation
uses
System.SysUtils;
{ TCustomAuth }
procedure TCustomAuth.OnAuthentication(const AContext: TWebContext; const UserName: string; const Password: string;

2
samples/CustomAuth/CustomAuthClient.dproj
View File

@ -1,7 +1,7 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{B42B1969-7408-4E0A-8624-A48DADE46556}</ProjectGuid>
<ProjectVersion>18.5</ProjectVersion>
<ProjectVersion>18.6</ProjectVersion>
<FrameworkType>VCL</FrameworkType>
<MainSource>CustomAuthClient.dpr</MainSource>
<Base>True</Base>

2
samples/CustomAuth/CustomAuthServer.dproj
View File

@ -1,7 +1,7 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{0293A1B2-2793-41CE-9099-8B24A46AA8CF}</ProjectGuid>
<ProjectVersion>18.5</ProjectVersion>
<ProjectVersion>18.6</ProjectVersion>
<FrameworkType>VCL</FrameworkType>
<MainSource>CustomAuthServer.dpr</MainSource>
<Base>True</Base>

15
sources/MVCFramework.Serializer.JsonDataObjects.pas
View File

@ -611,12 +611,17 @@ begin
ChildObject := AValue.AsObject;
if Assigned(ChildObject) then
begin
ChildList := TDuckTypedList.Wrap(ChildObject);
if TMVCSerializerHelper.AttributeExists<MVCListOfAttribute>(ACustomAttributes, ChildListOfAtt) then
JsonArrayToList(AJsonObject.A[AName], ChildList, ChildListOfAtt.Value, AType, AIgnored)
if ChildObject is TDataSet then
JsonArrayToDataSet(AJsonObject.A[AName], ChildObject as TDataSet, AIgnored, ncLowerCase)
else
raise EMVCDeserializationException.CreateFmt
('You can not deserialize a list %s without the attribute MVCListClassTypeAttribute.', [AName]);
begin
ChildList := TDuckTypedList.Wrap(ChildObject);
if TMVCSerializerHelper.AttributeExists<MVCListOfAttribute>(ACustomAttributes, ChildListOfAtt) then
JsonArrayToList(AJsonObject.A[AName], ChildList, ChildListOfAtt.Value, AType, AIgnored)
else
raise EMVCDeserializationException.CreateFmt
('You can not deserialize a list %s without the attribute MVCListClassTypeAttribute.', [AName]);
end;
end;
end;
end;

530
sources/MVCFramework.pas
View File

@ -57,7 +57,8 @@ uses
// MVCFramework.Serializer.JSON,
{$IFDEF WEBAPACHEHTTP}
Web.ApacheHTTP, // Apache Support since XE6 http://docwiki.embarcadero.com/Libraries/XE6/de/Web.ApacheHTTP
Web.ApacheHTTP,
// Apache Support since XE6 http://docwiki.embarcadero.com/Libraries/XE6/de/Web.ApacheHTTP
{$ENDIF}
@ -340,7 +341,8 @@ type
procedure Flush; virtual;
procedure BindToSession(const ASessionId: string);
function SendSessionCookie(const AContext: TWebContext): string;
function AddSessionToTheSessionList(const ASessionType, ASessionId: string; const ASessionTimeout: Integer): TWebSession;
function AddSessionToTheSessionList(const ASessionType, ASessionId: string; const ASessionTimeout: Integer)
: TWebSession;
public
constructor Create(const ARequest: TWebRequest; const AResponse: TWebResponse; const AConfig: TMVCConfig;
const ASerializers: TDictionary<string, IMVCSerializer>);
@ -388,8 +390,7 @@ type
IMVCRenderer = interface
['{2FF6DAC8-2F19-4C78-B9EC-A86296847D39}']
procedure Render(const AContent: string);
overload;
procedure Render(const AContent: string); overload;
procedure Render(const AObject: TObject); overload;
procedure Render(const AObject: TObject; const AOwns: Boolean); overload;
procedure Render(const AObject: TObject; const AOwns: Boolean; const AType: TMVCSerializationType); overload;
@ -397,15 +398,18 @@ type
procedure Render(const ACollection: IMVCList; const AType: TMVCSerializationType); overload;
procedure Render(const ADataSet: TDataSet); overload;
procedure Render(const ADataSet: TDataSet; const AOwns: Boolean); overload;
procedure Render(const ADataSet: TDataSet; const AOwns: Boolean; const ASerializationType: TMVCDatasetSerializationType); overload;
procedure Render(const ADataSet: TDataSet; const AOwns: Boolean;
const ASerializationType: TMVCDatasetSerializationType); overload;
procedure Render(const ADataSet: TDataSet; const AOwns: Boolean; const AIgnoredFields: TMVCIgnoredList;
const ASerializationType: TMVCDatasetSerializationType); overload;
procedure Render(const ADataSet: TDataSet; const AOwns: Boolean; const AIgnoredFields: TMVCIgnoredList; const ANameCase: TMVCNameCase;
const ASerializationType: TMVCDatasetSerializationType); overload;
procedure Render(const ADataSet: TDataSet; const AOwns: Boolean; const AIgnoredFields: TMVCIgnoredList;
const ANameCase: TMVCNameCase; const ASerializationType: TMVCDatasetSerializationType); overload;
procedure Render(const ATextWriter: TTextWriter; const AOwns: Boolean = True); overload;
procedure Render(const AStream: TStream; const AOwns: Boolean = True); overload;
procedure Render(const AErrorCode: Integer; const AErrorMessage: string; const AErrorClassName: string = ''); overload;
procedure Render(const AException: Exception; AExceptionItems: TList<string> = nil; const AOwns: Boolean = True); overload;
procedure Render(const AErrorCode: Integer; const AErrorMessage: string;
const AErrorClassName: string = ''); overload;
procedure Render(const AException: Exception; AExceptionItems: TList<string> = nil;
const AOwns: Boolean = True); overload;
procedure Render(const AResponse: TMVCResponse; const AOwns: Boolean = True); overload;
// SSE Support
procedure RenderSSE(const EventID: string; const EventData: string; EventName: string = '';
@ -424,11 +428,12 @@ type
IMVCAuthenticationHandler = interface
['{19B580EA-8A47-4364-A302-EEF3C6207A9F}']
procedure OnRequest(const AContext: TWebContext; const AControllerQualifiedClassName, AActionName: string; var AAuthenticationRequired: Boolean);
procedure OnAuthentication(const AContext: TWebContext; const AUserName, APassword: string; AUserRoles: TList<string>; var AIsValid: Boolean;
const ASessionData: TDictionary<string, string>);
procedure OnAuthorization(const AContext: TWebContext; AUserRoles: TList<string>; const AControllerQualifiedClassName: string; const AActionName: string;
var AIsAuthorized: Boolean);
procedure OnRequest(const AContext: TWebContext; const AControllerQualifiedClassName, AActionName: string;
var AAuthenticationRequired: Boolean);
procedure OnAuthentication(const AContext: TWebContext; const AUserName, APassword: string;
AUserRoles: TList<string>; var AIsValid: Boolean; const ASessionData: TDictionary<string, string>);
procedure OnAuthorization(const AContext: TWebContext; AUserRoles: TList<string>;
const AControllerQualifiedClassName: string; const AActionName: string; var AIsAuthorized: Boolean);
end;
TMVCRenderer = class(TMVCBase)
@ -456,21 +461,24 @@ type
procedure Render(const AObject: TObject; const AOwns: Boolean; const AType: TMVCSerializationType); overload;
procedure Render<T: class>(const ACollection: TObjectList<T>); overload;
procedure Render<T: class>(const ACollection: TObjectList<T>; const AOwns: Boolean); overload;
procedure Render<T: class>(const ACollection: TObjectList<T>; const AOwns: Boolean; const AType: TMVCSerializationType); overload;
procedure Render<T: class>(const ACollection: TObjectList<T>; const AOwns: Boolean;
const AType: TMVCSerializationType); overload;
procedure Render(const ACollection: IMVCList); overload;
procedure Render(const ACollection: IMVCList; const AType: TMVCSerializationType); overload;
procedure Render(const ADataSet: TDataSet); overload;
procedure Render(const ADataSet: TDataSet; const AOwns: Boolean); overload;
procedure Render(const ADataSet: TDataSet; const AOwns: Boolean; const ASerializationType: TMVCDatasetSerializationType); overload;
procedure Render(const ADataSet: TDataSet; const AOwns: Boolean;
const ASerializationType: TMVCDatasetSerializationType); overload;
procedure Render(const ADataSet: TDataSet; const AOwns: Boolean; const AIgnoredFields: TMVCIgnoredList;
const ASerializationType: TMVCDatasetSerializationType); overload;
procedure Render(const ADataSet: TDataSet; const AOwns: Boolean; const AIgnoredFields: TMVCIgnoredList; const ANameCase: TMVCNameCase;
const ASerializationType: TMVCDatasetSerializationType); overload;
procedure Render(const ADataSet: TDataSet; const AOwns: Boolean; const AIgnoredFields: TMVCIgnoredList;
const ANameCase: TMVCNameCase; const ASerializationType: TMVCDatasetSerializationType); overload;
procedure Render(const ATextWriter: TTextWriter; const AOwns: Boolean = True); overload;
procedure Render(const AStream: TStream; const AOwns: Boolean = True); overload;
procedure Render(const AErrorCode: Integer; const AErrorMessage: string; const AErrorClassName: string = '';
const ADataObject: TObject = nil); overload;
procedure Render(const AException: Exception; AExceptionItems: TList<string> = nil; const AOwns: Boolean = True); overload;
procedure Render(const AException: Exception; AExceptionItems: TList<string> = nil;
const AOwns: Boolean = True); overload;
procedure Render(const AResponse: TMVCResponse; const AOwns: Boolean = True); overload;
// SSE Support
procedure RenderSSE(const EventID: string; const EventData: string; EventName: string = '';
@ -551,7 +559,8 @@ type
protected
{ protected declarations }
public
constructor Create(const AClazz: TMVCControllerClazz; const ACreateAction: TMVCControllerCreateAction; const AURLSegment: string = '');
constructor Create(const AClazz: TMVCControllerClazz; const ACreateAction: TMVCControllerCreateAction;
const AURLSegment: string = '');
property Clazz: TMVCControllerClazz read FClazz;
property CreateAction: TMVCControllerCreateAction read FCreateAction;
property URLSegment: string read FURLSegment;
@ -586,8 +595,8 @@ type
/// <param name="AControllerQualifiedClassName">Qualified classname of the matching controller.</param>
/// <param name="AActionName">Method name of the matching controller method.</param>
/// <param name="AHandled">If set to True the Request would finished. Response must be set by the implementor. Default value is False.</param>
procedure OnBeforeControllerAction(AContext: TWebContext; const AControllerQualifiedClassName: string; const AActionName: string;
var AHandled: Boolean);
procedure OnBeforeControllerAction(AContext: TWebContext; const AControllerQualifiedClassName: string;
const AActionName: string; var AHandled: Boolean);
/// <summary>
/// Procedure is called after the specific controller method was called.
/// It is still possible to cancel or to completly modifiy the request.
@ -600,7 +609,8 @@ type
TMVCEngine = class(TComponent)
private const
ALLOWED_TYPED_ACTION_PARAMETERS_TYPES = 'Integer, Int64, Single, Double, Extended, Boolean, TDate, TTime, TDateTime and String';
ALLOWED_TYPED_ACTION_PARAMETERS_TYPES =
'Integer, Int64, Single, Double, Extended, Boolean, TDate, TTime, TDateTime and String';
private
FViewEngineClass: TMVCViewEngineClass;
FWebModule: TWebModule;
@ -624,14 +634,18 @@ type
procedure LoadSystemControllers; virtual;
procedure FixUpWebModule;
procedure ExecuteBeforeRoutingMiddleware(const AContext: TWebContext; var AHandled: Boolean);
procedure ExecuteBeforeControllerActionMiddleware(const AContext: TWebContext; const AControllerQualifiedClassName: string;
const AActionName: string; var AHandled: Boolean);
procedure ExecuteAfterControllerActionMiddleware(const AContext: TWebContext; const AActionName: string; const AHandled: Boolean);
procedure ExecuteBeforeControllerActionMiddleware(const AContext: TWebContext;
const AControllerQualifiedClassName: string; const AActionName: string; var AHandled: Boolean);
procedure ExecuteAfterControllerActionMiddleware(const AContext: TWebContext; const AActionName: string;
const AHandled: Boolean);
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;
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;
public
class function GetCurrentSession(const ASessionTimeout: Integer; const ASessionId: string;
const ARaiseExceptionIfExpired: Boolean = True): TWebSession; static;
@ -640,23 +654,27 @@ type
class function SendSessionCookie(const AContext: TWebContext; const ASessionId: string): string; overload; static;
class procedure ClearSessionCookiesAlreadySet(const ACookies: TCookieCollection); static;
public
constructor Create(const AWebModule: TWebModule; const AConfigAction: TProc<TMVCConfig> = nil; const ACustomLogger: ILogWriter = nil);
reintroduce;
constructor Create(const AWebModule: TWebModule; const AConfigAction: TProc<TMVCConfig> = nil;
const ACustomLogger: ILogWriter = nil); reintroduce;
destructor Destroy; override;
function GetSessionBySessionId(const ASessionId: string): TWebSession;
function AddSerializer(const AContentType: string; const ASerializer: IMVCSerializer): TMVCEngine;
function AddMiddleware(const AMiddleware: IMVCMiddleware): TMVCEngine;
function AddController(const AControllerClazz: TMVCControllerClazz; const AURLSegment: string = ''): TMVCEngine; overload;
function AddController(const AControllerClazz: TMVCControllerClazz; const AURLSegment: string = '')
: TMVCEngine; overload;
function AddController(const AControllerClazz: TMVCControllerClazz; const ACreateAction: TMVCControllerCreateAction;
const AURLSegment: string = ''): TMVCEngine; overload;
function PublishObject(const AObjectCreatorDelegate: TMVCObjectCreatorDelegate; const AURLSegment: string): TMVCEngine;
function PublishObject(const AObjectCreatorDelegate: TMVCObjectCreatorDelegate; const AURLSegment: string)
: TMVCEngine;
function SetViewEngine(const AViewEngineClass: TMVCViewEngineClass): TMVCEngine;
function GetServerSignature(const AContext: TWebContext): string;
procedure HTTP404(const AContext: TWebContext);
procedure HTTP500(const AContext: TWebContext; const AReasonString: string = '');
procedure SendRawHTTPStatus(const AContext: TWebContext; const HTTPStatusCode: Integer;
const AReasonString: string);
property ViewEngineClass: TMVCViewEngineClass read GetViewEngineClass;
property WebModule: TWebModule read FWebModule;
@ -989,7 +1007,8 @@ begin
Result := FWebRequest.CookieFields.Values[AName];
end;
constructor TMVCWebRequest.Create(const AWebRequest: TWebRequest; const ASerializers: TDictionary<string, IMVCSerializer>);
constructor TMVCWebRequest.Create(const AWebRequest: TWebRequest;
const ASerializers: TDictionary<string, IMVCSerializer>);
begin
inherited Create;
FBody := EmptyStr;
@ -1313,8 +1332,8 @@ begin
LRoles := string.Join('$$', FRoles.ToArray)
else
LRoles := '';
AWebSession[TMVCConstants.CURRENT_USER_SESSION_KEY] := FUserName + '$$' + DateTimeToISOTimeStamp(FLoggedSince) + '$$' + FRealm +
'$$' + LRoles;
AWebSession[TMVCConstants.CURRENT_USER_SESSION_KEY] := FUserName + '$$' + DateTimeToISOTimeStamp(FLoggedSince) + '$$'
+ FRealm + '$$' + LRoles;
end;
procedure TUser.SetCustomData(const Value: TMVCCustomData);
@ -1332,7 +1351,8 @@ end;
{ TWebContext }
function TWebContext.AddSessionToTheSessionList(const ASessionType, ASessionId: string; const ASessionTimeout: Integer): TWebSession;
function TWebContext.AddSessionToTheSessionList(const ASessionType, ASessionId: string; const ASessionTimeout: Integer)
: TWebSession;
var
Session: TWebSession;
begin
@ -1473,7 +1493,8 @@ begin
if not Assigned(FWebSession) then
begin
Id := TMVCEngine.SendSessionCookie(Self);
FWebSession := AddSessionToTheSessionList(Config[TMVCConfigKey.SessionType], Id, StrToInt64(Config[TMVCConfigKey.SessionTimeout]));
FWebSession := AddSessionToTheSessionList(Config[TMVCConfigKey.SessionType], Id,
StrToInt64(Config[TMVCConfigKey.SessionTimeout]));
FIsSessionStarted := True;
FSessionMustBeClose := False;
end;
@ -1532,8 +1553,8 @@ begin
Result := AddController(AControllerClazz, nil, AURLSegment);
end;
function TMVCEngine.AddController(const AControllerClazz: TMVCControllerClazz; const ACreateAction: TMVCControllerCreateAction;
const AURLSegment: string): TMVCEngine;
function TMVCEngine.AddController(const AControllerClazz: TMVCControllerClazz;
const ACreateAction: TMVCControllerCreateAction; const AURLSegment: string): TMVCEngine;
begin
FControllers.Add(TMVCControllerDelegate.Create(AControllerClazz, ACreateAction, AURLSegment));
Result := Self;
@ -1604,7 +1625,8 @@ begin
Log.Info('EXIT: Config default values', LOGGERPRO_TAG);
end;
constructor TMVCEngine.Create(const AWebModule: TWebModule; const AConfigAction: TProc<TMVCConfig>; const ACustomLogger: ILogWriter);
constructor TMVCEngine.Create(const AWebModule: TWebModule; const AConfigAction: TProc<TMVCConfig>;
const ACustomLogger: ILogWriter);
begin
inherited Create(AWebModule);
FWebModule := AWebModule;
@ -1651,7 +1673,8 @@ begin
inherited Destroy;
end;
function TMVCEngine.ExecuteAction(const ASender: TObject; const ARequest: TWebRequest; const AResponse: TWebResponse): Boolean;
function TMVCEngine.ExecuteAction(const ASender: TObject; const ARequest: TWebRequest;
const AResponse: TWebResponse): Boolean;
var
LParamsTable: TMVCRequestParamsTable;
LContext: TWebContext;
@ -1667,9 +1690,10 @@ begin
Result := False;
ARequest.ReadTotalContent;
if ARequest.ContentLength > fConfigCache_MaxRequestSize then
if ARequest.ContentLength > FConfigCache_MaxRequestSize then
begin
raise EMVCException.CreateFmt('Request size exceeded the max allowed size [%d KiB]', [(FConfigCache_MaxRequestSize div 1024)]);
raise EMVCException.CreateFmt('Request size exceeded the max allowed size [%d KiB]',
[(FConfigCache_MaxRequestSize div 1024)]);
end;
LParamsTable := TMVCRequestParamsTable.Create;
@ -1677,140 +1701,197 @@ begin
LContext := TWebContext.Create(ARequest, AResponse, FConfig, FSerializers);
try
DefineDefaultResponseHeaders(LContext);
if IsStaticFileRequest(ARequest, LFileName) then
Result := SendStaticFileIfPresent(LContext, LFileName)
else
begin
LHandled := False;
LRouter := TMVCRouter.Create(FConfig, _MVCGlobalActionParamsCache);
try
ExecuteBeforeRoutingMiddleware(LContext, LHandled);
if not LHandled then
begin
if LRouter.ExecuteRouting(ARequest.PathInfo, TMVCRouter.StringMethodToHTTPMetod(ARequest.Method), ARequest.ContentType,
ARequest.Accept, FControllers, FConfig[TMVCConfigKey.DefaultContentType], FConfig[TMVCConfigKey.DefaultContentCharset],
LParamsTable, LResponseContentMediaType, LResponseContentCharset) then
LHandled := False;
LRouter := TMVCRouter.Create(FConfig, _MVCGlobalActionParamsCache);
try // finally
LSelectedController := nil;
try // only for lselectedcontroller
try // global exception handler
ExecuteBeforeRoutingMiddleware(LContext, LHandled);
if not LHandled then
begin
try
if Assigned(LRouter.ControllerCreateAction) then
LSelectedController := LRouter.ControllerCreateAction()
else
LSelectedController := LRouter.ControllerClazz.Create;
except
on Ex: Exception do
begin
Log.ErrorFmt('[%s] %s (Custom message: "%s")', [Ex.Classname, Ex.Message, 'Cannot create controller'],
LOGGERPRO_TAG);
HTTP500(LContext, 'Cannot create controller');
Result := False;
Exit;
if LRouter.ExecuteRouting(ARequest.PathInfo, TMVCRouter.StringMethodToHTTPMetod(ARequest.Method),
ARequest.ContentType, ARequest.Accept, FControllers, FConfig[TMVCConfigKey.DefaultContentType],
FConfig[TMVCConfigKey.DefaultContentCharset], LParamsTable, LResponseContentMediaType,
LResponseContentCharset) then
begin
try
if Assigned(LRouter.ControllerCreateAction) then
LSelectedController := LRouter.ControllerCreateAction()
else
LSelectedController := LRouter.ControllerClazz.Create;
except
on Ex: Exception do
begin
Log.ErrorFmt('[%s] %s (Custom message: "%s")',
[Ex.Classname, Ex.Message, 'Cannot create controller'], LOGGERPRO_TAG);
raise EMVCException.Create(HTTP_STATUS.InternalServerError, 'Cannot create controller');
// HTTP500(LContext, 'Cannot create controller');
// Result := False;
// Exit;
end;
end;
end;
try
LSelectedController.Engine := Self;
LSelectedController.Context := LContext;
LSelectedController.ApplicationSession := FApplicationSession;
LContext.ParamsTable := LParamsTable;
ExecuteBeforeControllerActionMiddleware(LContext, LRouter.ControllerClazz.QualifiedClassName,
LRouter.MethodToCall.Name, LHandled);
if LHandled then
Exit(True);
LSelectedController.MVCControllerAfterCreate;
try
ExecuteBeforeControllerActionMiddleware(LContext, LRouter.ControllerClazz.QualifiedClassName, LRouter.MethodToCall.Name,
LHandled);
if LHandled then
Exit(True);
LHandled := False;
LSelectedController.ContentType := BuildContentType(LResponseContentMediaType,
LResponseContentCharset);
// LSelectedController.ContentCharset := LResponseContentCharset;
LActionFormalParams := LRouter.MethodToCall.GetParameters;
if (Length(LActionFormalParams) = 0) then
SetLength(LActualParams, 0)
else if (Length(LActionFormalParams) = 1) and
(SameText(LActionFormalParams[0].ParamType.QualifiedName, 'MVCFramework.TWebContext')) then
begin
SetLength(LActualParams, 1);
LActualParams[0] := LContext;
end
else
FillActualParamsForAction(LContext, LActionFormalParams, LRouter.MethodToCall.Name, LActualParams);
LSelectedController.MVCControllerAfterCreate;
try
LHandled := False;
LSelectedController.ContentType := BuildContentType(LResponseContentMediaType, LResponseContentCharset);
// LSelectedController.ContentCharset := LResponseContentCharset;
LActionFormalParams := LRouter.MethodToCall.GetParameters;
if (Length(LActionFormalParams) = 0) then
SetLength(LActualParams, 0)
else if (Length(LActionFormalParams) = 1) and
(SameText(LActionFormalParams[0].ParamType.QualifiedName, 'MVCFramework.TWebContext')) then
begin
SetLength(LActualParams, 1);
LActualParams[0] := LContext;
end
else
FillActualParamsForAction(LContext, LActionFormalParams, LRouter.MethodToCall.Name, LActualParams);
LSelectedController.OnBeforeAction(LContext, LRouter.MethodToCall.Name, LHandled);
LSelectedController.OnBeforeAction(LContext, LRouter.MethodToCall.Name, LHandled);
if not LHandled then
begin
try
LRouter.MethodToCall.Invoke(LSelectedController, LActualParams);
finally
LSelectedController.OnAfterAction(LContext, LRouter.MethodToCall.Name);
end;
if not LHandled then
begin
try
LRouter.MethodToCall.Invoke(LSelectedController, LActualParams);
finally
LSelectedController.OnAfterAction(LContext, LRouter.MethodToCall.Name);
end;
finally
LSelectedController.MVCControllerBeforeDestroy;
end;
ExecuteAfterControllerActionMiddleware(LContext, LRouter.MethodToCall.Name, LHandled);
except
on E: EMVCSessionExpiredException do
begin
Log.ErrorFmt('[%s] %s (Custom message: "%s")', [E.Classname, E.Message, E.DetailedMessage], LOGGERPRO_TAG);
LContext.SessionStop(False);
LSelectedController.ResponseStatus(E.HTTPErrorCode);
LSelectedController.Render(E);
end;
on E: EMVCException do
begin
Log.ErrorFmt('[%s] %s (Custom message: "%s")', [E.Classname, E.Message, E.DetailedMessage], LOGGERPRO_TAG);
LSelectedController.ResponseStatus(E.HTTPErrorCode);
LSelectedController.Render(E);
end;
on E: EInvalidOp do
begin
Log.ErrorFmt('[%s] %s (Custom message: "%s")', [E.Classname, E.Message, 'Invalid Op'], LOGGERPRO_TAG);
LSelectedController.ResponseStatus(HTTP_STATUS.InternalServerError);
LSelectedController.Render(E);
end;
on Ex: Exception do
begin
Log.ErrorFmt('[%s] %s (Custom message: "%s")', [Ex.Classname, Ex.Message, 'Global Action Exception Handler'],
LOGGERPRO_TAG);
LSelectedController.ResponseStatus(HTTP_STATUS.InternalServerError);
LSelectedController.Render(Ex);
end;
finally
LSelectedController.MVCControllerBeforeDestroy;
end;
ExecuteAfterControllerActionMiddleware(LContext, LRouter.MethodToCall.Name, LHandled);
// except
// on E: EMVCSessionExpiredException do
// begin
// Log.ErrorFmt('[%s] %s (Custom message: "%s")', [E.Classname, E.Message, E.DetailedMessage], LOGGERPRO_TAG);
// LContext.SessionStop(False);
// LSelectedController.ResponseStatus(E.HTTPErrorCode);
// LSelectedController.Render(E);
// end;
// on E: EMVCException do
// begin
// Log.ErrorFmt('[%s] %s (Custom message: "%s")', [E.Classname, E.Message, E.DetailedMessage], LOGGERPRO_TAG);
// LSelectedController.ResponseStatus(E.HTTPErrorCode);
// LSelectedController.Render(E);
// end;
// on E: EInvalidOp do
// begin
// Log.ErrorFmt('[%s] %s (Custom message: "%s")', [E.Classname, E.Message, 'Invalid Op'], LOGGERPRO_TAG);
// LSelectedController.ResponseStatus(HTTP_STATUS.InternalServerError);
// LSelectedController.Render(E);
// end;
// on Ex: Exception do
// begin
// Log.ErrorFmt('[%s] %s (Custom message: "%s")', [Ex.Classname, Ex.Message, 'Global Action Exception Handler'],
// LOGGERPRO_TAG);
// LSelectedController.ResponseStatus(HTTP_STATUS.InternalServerError);
// LSelectedController.Render(Ex);
// end;
// end;
LContext.Response.ContentType := LSelectedController.ContentType;
Log(TLogLevel.levNormal, ARequest.Method + ':' + ARequest.RawPathInfo + ' -> ' + LRouter.ControllerClazz.QualifiedClassName
+ ' - ' + IntToStr(AResponse.StatusCode) + ' ' + AResponse.ReasonString)
finally
LSelectedController.Free;
end;
end
else
begin
if Config[TMVCConfigKey.AllowUnhandledAction] = 'false' then
Log(TLogLevel.levNormal, ARequest.Method + ':' + ARequest.RawPathInfo + ' -> ' +
LRouter.ControllerClazz.QualifiedClassName + ' - ' + IntToStr(AResponse.StatusCode) + ' ' +
AResponse.ReasonString)
end
else // execute-routing
begin
if not Config[TMVCConfigKey.FallbackResource].IsEmpty then
if Config[TMVCConfigKey.AllowUnhandledAction] = 'false' then
begin
if (LContext.Request.PathInfo = '/') or (LContext.Request.PathInfo = '') then // useful for SPA
Result := SendStaticFileIfPresent(LContext, TPath.Combine(Config[TMVCConfigKey.DocumentRoot],
Config[TMVCConfigKey.FallbackResource]));
end;
if not Result then
begin
HTTP404(LContext);
Log(TLogLevel.levNormal, ARequest.Method + ':' + ARequest.RawPathInfo + ' -> NO ACTION ' + ' - ' +
IntToStr(AResponse.StatusCode) + ' ' + AResponse.ReasonString);
end;
if not Config[TMVCConfigKey.FallbackResource].IsEmpty then
begin
if (LContext.Request.PathInfo = '/') or (LContext.Request.PathInfo = '') then // useful for SPA
Result := SendStaticFileIfPresent(LContext, TPath.Combine(Config[TMVCConfigKey.DocumentRoot],
Config[TMVCConfigKey.FallbackResource]));
end;
if (not Result) and (IsStaticFileRequest(ARequest, LFileName)) then
begin
Result := SendStaticFileIfPresent(LContext, LFileName);
end;
if not Result then
begin
// HTTP404(LContext);
Log(TLogLevel.levNormal, ARequest.Method + ':' + ARequest.RawPathInfo + ' -> NO ACTION ' + ' - ' +
IntToStr(AResponse.StatusCode) + ' ' + AResponse.ReasonString);
raise EMVCException.Create(HTTP_STATUS.NotFound, 'Not Found');
end;
end
else
LContext.Response.FlushOnDestroy := False;
end; // end-execute-routing
end; // if not handled by beforerouting
except
on E: EMVCSessionExpiredException do
begin
Log.ErrorFmt('[%s] %s (Custom message: "%s")', [E.Classname, E.Message, E.DetailedMessage],
LOGGERPRO_TAG);
LContext.SessionStop(False);
LSelectedController.ResponseStatus(E.HTTPErrorCode);
LSelectedController.Render(E);
end;
on E: EMVCException do
begin
Log.ErrorFmt('[%s] %s (Custom message: "%s")', [E.Classname, E.Message, E.DetailedMessage],
LOGGERPRO_TAG);
if Assigned(LSelectedController) then
begin
LSelectedController.ResponseStatus(E.HTTPErrorCode);
LSelectedController.Render(E);
end
else
LContext.Response.FlushOnDestroy := False;
begin
SendRawHTTPStatus(LContext, E.HTTPErrorCode, Format('[%s] %s', [E.Classname, E.Message]));
end;
end;
on E: EInvalidOp do
begin
Log.ErrorFmt('[%s] %s (Custom message: "%s")', [E.Classname, E.Message, 'Invalid Op'], LOGGERPRO_TAG);
if Assigned(LSelectedController) then
begin
LSelectedController.ResponseStatus(HTTP_STATUS.InternalServerError);
LSelectedController.Render(E);
end
else
begin
SendRawHTTPStatus(LContext, HTTP_STATUS.InternalServerError,
Format('[%s] %s', [E.Classname, E.Message]));
end;
end;
on E: Exception do
begin
Log.ErrorFmt('[%s] %s (Custom message: "%s")',
[E.Classname, E.Message, 'Global Action Exception Handler'], LOGGERPRO_TAG);
if Assigned(LSelectedController) then
begin
LSelectedController.ResponseStatus(HTTP_STATUS.InternalServerError);
LSelectedController.Render(E);
end
else
begin
SendRawHTTPStatus(LContext, HTTP_STATUS.InternalServerError,
Format('[%s] %s', [E.Classname, E.Message]));
end;
end;
end;
finally
LRouter.Free;
FreeAndNil(LSelectedController);
end;
finally
LRouter.Free;
end;
finally
LContext.Free;
@ -1829,8 +1910,8 @@ begin
FMiddlewares[I].OnAfterControllerAction(AContext, AActionName, AHandled);
end;
procedure TMVCEngine.ExecuteBeforeControllerActionMiddleware(const AContext: TWebContext; const AControllerQualifiedClassName: string;
const AActionName: string; var AHandled: Boolean);
procedure TMVCEngine.ExecuteBeforeControllerActionMiddleware(const AContext: TWebContext;
const AControllerQualifiedClassName: string; const AActionName: string; var AHandled: Boolean);
var
Middleware: IMVCMiddleware;
begin
@ -1863,8 +1944,8 @@ begin
Result := TIdURI.URLDecode(Result);
end;
procedure TMVCEngine.FillActualParamsForAction(const AContext: TWebContext; const AActionFormalParams: TArray<TRttiParameter>;
const AActionName: string; var AActualParams: TArray<TValue>);
procedure TMVCEngine.FillActualParamsForAction(const AContext: TWebContext;
const AActionFormalParams: TArray<TRttiParameter>; const AActionName: string; var AActualParams: TArray<TValue>);
var
ParamName: string;
I: Integer;
@ -1883,7 +1964,8 @@ begin
ParamName := AActionFormalParams[I].Name;
if not AContext.Request.SegmentParam(ParamName, StrValue) then
raise EMVCException.CreateFmt('Invalid parameter %s for action %s (Hint: Here parameters names are case-sensitive)',
raise EMVCException.CreateFmt
('Invalid parameter %s for action %s (Hint: Here parameters names are case-sensitive)',
[ParamName, AActionName]);
case AActionFormalParams[I].ParamType.TypeKind of
@ -1920,7 +2002,8 @@ begin
except
on E: Exception do
begin
raise EMVCException.CreateFmt('Invalid TDateTime value for param [%s][%s]', [AActionFormalParams[I].Name, E.Message]);
raise EMVCException.CreateFmt('Invalid TDateTime value for param [%s][%s]',
[AActionFormalParams[I].Name, E.Message]);
end;
end;
end
@ -1949,16 +2032,17 @@ begin
AActualParams[I] := False
else
raise EMVCException.CreateFmt
('Invalid boolean value for parameter %s. Boolean parameters accepts only "true"/"false" or "1"/"0".', [ParamName]);
('Invalid boolean value for parameter %s. Boolean parameters accepts only "true"/"false" or "1"/"0".',
[ParamName]);
end
else
raise EMVCException.CreateFmt('Invalid type for parameter %s. Allowed types are ' + ALLOWED_TYPED_ACTION_PARAMETERS_TYPES,
[ParamName]);
raise EMVCException.CreateFmt('Invalid type for parameter %s. Allowed types are ' +
ALLOWED_TYPED_ACTION_PARAMETERS_TYPES, [ParamName]);
end;
else
begin
raise EMVCException.CreateFmt('Invalid type for parameter %s. Allowed types are ' + ALLOWED_TYPED_ACTION_PARAMETERS_TYPES,
[ParamName]);
raise EMVCException.CreateFmt('Invalid type for parameter %s. Allowed types are ' +
ALLOWED_TYPED_ACTION_PARAMETERS_TYPES, [ParamName]);
end;
end;
end;
@ -2029,14 +2113,16 @@ end;
function TMVCEngine.GetViewEngineClass: TMVCViewEngineClass;
begin
if FViewEngineClass = nil then
raise EMVCConfigException.Create('No View Engine configured. [HINT: Use TMVCEngine.SetViewEngine() to set a valid view engine]');
raise EMVCConfigException.Create
('No View Engine configured. [HINT: Use TMVCEngine.SetViewEngine() to set a valid view engine]');
Result := FViewEngineClass;
end;
procedure TMVCEngine.HTTP404(const AContext: TWebContext);
begin
AContext.Response.SetStatusCode(HTTP_STATUS.NotFound);
AContext.Response.SetContentType(BuildContentType(TMVCMediaType.TEXT_PLAIN, AContext.Config[TMVCConfigKey.DefaultContentCharset]));
AContext.Response.SetContentType(BuildContentType(TMVCMediaType.TEXT_PLAIN,
AContext.Config[TMVCConfigKey.DefaultContentCharset]));
AContext.Response.SetReasonString('Not Found');
AContext.Response.SetContent('Not Found' + sLineBreak + GetServerSignature(AContext));
end;
@ -2044,9 +2130,42 @@ end;
procedure TMVCEngine.HTTP500(const AContext: TWebContext; const AReasonString: string);
begin
AContext.Response.SetStatusCode(HTTP_STATUS.InternalServerError);
AContext.Response.SetContentType(BuildContentType(TMVCMediaType.TEXT_PLAIN, AContext.Config[TMVCConfigKey.DefaultContentCharset]));
AContext.Response.SetContentType(BuildContentType(TMVCMediaType.TEXT_PLAIN,
AContext.Config[TMVCConfigKey.DefaultContentCharset]));
AContext.Response.SetReasonString('Internal server error');
AContext.Response.SetContent('Internal server error' + sLineBreak + GetServerSignature(AContext) + ': ' + AReasonString);
AContext.Response.SetContent('Internal server error' + sLineBreak + GetServerSignature(AContext) + ': ' +
AReasonString);
end;
procedure TMVCEngine.SendRawHTTPStatus(const AContext: TWebContext; const HTTPStatusCode: Integer;
const AReasonString: string);
var
lSer: IMVCSerializer;
lError: TMVCErrorResponse;
begin
AContext.Response.SetStatusCode(HTTPStatusCode);
AContext.Response.SetReasonString(AReasonString);
if Serializers.TryGetValue(AContext.Config[TMVCConfigKey.DefaultContentType], lSer) then
begin
lError := TMVCErrorResponse.Create;
try
lError.Classname := '';
lError.StatusCode := HTTPStatusCode;
lError.Message := AReasonString;
AContext.Response.SetContent(lSer.SerializeObject(lError));
finally
lError.Free;
end;
AContext.Response.SetContentType(AContext.Config[TMVCConfigKey.DefaultContentType]);
end
else
begin
AContext.Response.SetContentType(BuildContentType(TMVCMediaType.TEXT_PLAIN,
AContext.Config[TMVCConfigKey.DefaultContentCharset]));
AContext.Response.SetContent(GetServerSignature(AContext) + sLineBreak + 'HTTP ' + HTTPStatusCode.ToString + ': ' +
AReasonString);
end;
end;
function TMVCEngine.IsStaticFileRequest(const ARequest: TWebRequest; out AFileName: string): Boolean;
@ -2062,7 +2181,8 @@ begin
Log(TLogLevel.levNormal, 'EXIT: LoadSystemControllers');
end;
procedure TMVCEngine.OnBeforeDispatch(ASender: TObject; ARequest: TWebRequest; AResponse: TWebResponse; var AHandled: Boolean);
procedure TMVCEngine.OnBeforeDispatch(ASender: TObject; ARequest: TWebRequest; AResponse: TWebResponse;
var AHandled: Boolean);
begin
AHandled := False;
{ there is a bug in WebBroker Linux on 10.2.1 tokyo }
@ -2087,9 +2207,8 @@ begin
end;
end;
function TMVCEngine.PublishObject(
const AObjectCreatorDelegate: TMVCObjectCreatorDelegate;
const AURLSegment: string): TMVCEngine;
function TMVCEngine.PublishObject(const AObjectCreatorDelegate: TMVCObjectCreatorDelegate; const AURLSegment: string)
: TMVCEngine;
begin
Result := AddController(TMVCJSONRPCPublisher,
function: TMVCController
@ -2116,15 +2235,16 @@ begin
end;
end;
procedure TMVCEngine.ResponseErrorPage(const AException: Exception; const ARequest: TWebRequest; const AResponse: TWebResponse);
procedure TMVCEngine.ResponseErrorPage(const AException: Exception; const ARequest: TWebRequest;
const AResponse: TWebResponse);
begin
AResponse.SetCustomHeader('x-mvc-error', AException.Classname + ': ' + AException.Message);
AResponse.StatusCode := HTTP_STATUS.OK;
begin
AResponse.ContentType := TMVCMediaType.TEXT_PLAIN;
AResponse.Content := Config[TMVCConfigKey.ServerName] + ' ERROR:' + sLineBreak + 'Exception raised of class: ' + AException.Classname +
sLineBreak + '***********************************************' + sLineBreak + AException.Message + sLineBreak +
'***********************************************';
AResponse.Content := Config[TMVCConfigKey.ServerName] + ' ERROR:' + sLineBreak + 'Exception raised of class: ' +
AException.Classname + sLineBreak + '***********************************************' + sLineBreak +
AException.Message + sLineBreak + '***********************************************';
end;
end;
@ -2132,13 +2252,15 @@ class function TMVCEngine.SendSessionCookie(const AContext: TWebContext): string
var
SId: string;
begin
SId := StringReplace(StringReplace(StringReplace(GUIDToString(TGUID.NewGuid), '}', '', []), '{', '', []), '-', '', [rfReplaceAll]);
SId := StringReplace(StringReplace(StringReplace(GUIDToString(TGUID.NewGuid), '}', '', []), '{', '', []), '-', '',
[rfReplaceAll]);
Result := SendSessionCookie(AContext, SId);
end;
procedure TMVCEngine.SaveCacheConfigValues;
begin
FConfigCache_MaxRequestSize := StrToInt64Def(Config[TMVCConfigKey.MaxRequestSize], TMVCConstants.DEFAULT_MAX_REQUEST_SIZE);
FConfigCache_MaxRequestSize := StrToInt64Def(Config[TMVCConfigKey.MaxRequestSize],
TMVCConstants.DEFAULT_MAX_REQUEST_SIZE);
end;
class function TMVCEngine.SendSessionCookie(const AContext: TWebContext; const ASessionId: string): string;
@ -2240,8 +2362,8 @@ end;
{ TMVCControllerDelegate }
constructor TMVCControllerDelegate.Create(const AClazz: TMVCControllerClazz; const ACreateAction: TMVCControllerCreateAction;
const AURLSegment: string = '');
constructor TMVCControllerDelegate.Create(const AClazz: TMVCControllerClazz;
const ACreateAction: TMVCControllerCreateAction; const AURLSegment: string = '');
begin
inherited Create;
FClazz := AClazz;
@ -2256,7 +2378,8 @@ begin
Result := TPath.GetExtension(AStaticFileName).ToLower = '.' + AConfig[TMVCConfigKey.DefaultViewFileExtension].ToLower;
end;
class function TMVCStaticContents.IsStaticFile(const AViewPath, AWebRequestPath: string; out ARealFileName: string): Boolean;
class function TMVCStaticContents.IsStaticFile(const AViewPath, AWebRequestPath: string;
out ARealFileName: string): Boolean;
var
FileName: string;
begin
@ -2332,6 +2455,11 @@ end;
function TMVCRenderer.GetContentType: string;
begin
Result := GetContext.Response.ContentType;
if Result.Trim.IsEmpty then
begin
GetContext.Response.ContentType := FContext.FConfig[MVCFramework.Commons.TMVCConfigKey.DefaultContentType];
Result := GetContentType;
end;
end;
function TMVCRenderer.GetContext: TWebContext;
@ -2577,7 +2705,8 @@ begin
SendStream(AStream, AOwns);
end;
procedure TMVCRenderer.Render(const AErrorCode: Integer; const AErrorMessage, AErrorClassName: string; const ADataObject: TObject);
procedure TMVCRenderer.Render(const AErrorCode: Integer; const AErrorMessage, AErrorClassName: string;
const ADataObject: TObject);
var
R: TMVCErrorResponse;
begin
@ -2599,7 +2728,7 @@ begin
end;
procedure TMVCRenderer.Render(const ADataSet: TDataSet; const AOwns: Boolean; const AIgnoredFields: TMVCIgnoredList;
const ANameCase: TMVCNameCase; const ASerializationType: TMVCDatasetSerializationType);
const ANameCase: TMVCNameCase; const ASerializationType: TMVCDatasetSerializationType);
begin
if Assigned(ADataSet) then
begin
@ -2617,7 +2746,8 @@ begin
raise EMVCException.Create('Can not render an empty dataset.');
end;
procedure TMVCRenderer.Render<T>(const ACollection: TObjectList<T>; const AOwns: Boolean; const AType: TMVCSerializationType);
procedure TMVCRenderer.Render<T>(const ACollection: TObjectList<T>; const AOwns: Boolean;
const AType: TMVCSerializationType);
begin
if Assigned(ACollection) then
begin
@ -2745,10 +2875,12 @@ begin
begin
SetContentType(TMVCMediaType.TEXT_HTML);
ResponseStream.Clear;
ResponseStream.Append('<html><head><style>pre { color: #000000; background-color: #d0d0d0; }</style></head><body>')
.Append('<h1>' + Config[TMVCConfigKey.ServerName] + ': Error Raised</h1>').AppendFormat('<pre>HTTP Return Code: %d' + sLineBreak,
[GetContext.Response.StatusCode]).AppendFormat('HTTP Reason Text: "%s"</pre>', [GetContext.Response.ReasonString])
.Append('<h3><pre>').AppendFormat('Exception Class Name : %s' + sLineBreak, [AException.Classname])
ResponseStream.Append
('<html><head><style>pre { color: #000000; background-color: #d0d0d0; }</style></head><body>')
.Append('<h1>' + Config[TMVCConfigKey.ServerName] + ': Error Raised</h1>')
.AppendFormat('<pre>HTTP Return Code: %d' + sLineBreak, [GetContext.Response.StatusCode])
.AppendFormat('HTTP Reason Text: "%s"</pre>', [GetContext.Response.ReasonString]).Append('<h3><pre>')
.AppendFormat('Exception Class Name : %s' + sLineBreak, [AException.Classname])
.AppendFormat('Exception Message : %s' + sLineBreak, [AException.Message]).Append('</pre></h3>');
if Assigned(AExceptionItems) and (AExceptionItems.Count > 0) then
begin
@ -2758,7 +2890,7 @@ begin
ResponseStream.Append('</pre><h2>');
end
else
ResponseStream.AppendLine('<pre>No other informations available</pre>');
ResponseStream.AppendLine('<pre>No other information available</pre>');
ResponseStream.Append('</body></html>');
RenderResponseStream;
end
@ -2822,12 +2954,13 @@ begin
end;
procedure TMVCRenderer.Render(const ADataSet: TDataSet; const AOwns: Boolean; const AIgnoredFields: TMVCIgnoredList;
const ASerializationType: TMVCDatasetSerializationType);
const ASerializationType: TMVCDatasetSerializationType);
begin
Render(ADataSet, AOwns, AIgnoredFields, ncLowerCase, ASerializationType);
end;
procedure TMVCRenderer.Render(const ADataSet: TDataSet; const AOwns: Boolean; const ASerializationType: TMVCDatasetSerializationType);
procedure TMVCRenderer.Render(const ADataSet: TDataSet; const AOwns: Boolean;
const ASerializationType: TMVCDatasetSerializationType);
begin
Render(ADataSet, AOwns, [], ASerializationType);
end;
@ -2859,8 +2992,9 @@ end;
{ TMVCBaseView }
constructor TMVCBaseViewEngine.Create(const AEngine: TMVCEngine; const AWebContext: TWebContext; const AViewModel: TMVCViewDataObject;
const AViewDataSets: TObjectDictionary<string, TDataSet>; const AContentType: string);
constructor TMVCBaseViewEngine.Create(const AEngine: TMVCEngine; const AWebContext: TWebContext;
const AViewModel: TMVCViewDataObject; const AViewDataSets: TObjectDictionary<string, TDataSet>;
const AContentType: string);
begin
inherited Create;
Engine := AEngine;
@ -2893,11 +3027,12 @@ begin
if DirectoryExists(Config[TMVCConfigKey.ViewPath]) then
F := ExpandFileName(IncludeTrailingPathDelimiter(Config.Value[TMVCConfigKey.ViewPath]) + FileName)
else
F := ExpandFileName(IncludeTrailingPathDelimiter(GetApplicationFileNamePath + Config.Value[TMVCConfigKey.ViewPath]) + FileName);
F := ExpandFileName(IncludeTrailingPathDelimiter(GetApplicationFileNamePath + Config.Value[TMVCConfigKey.ViewPath])
+ FileName);
if not TFile.Exists(F) then
FileName := ExpandFileName(IncludeTrailingPathDelimiter(GetApplicationFileNamePath + Config.Value[TMVCConfigKey.DocumentRoot])
+ FileName)
FileName := ExpandFileName(IncludeTrailingPathDelimiter(GetApplicationFileNamePath +
Config.Value[TMVCConfigKey.DocumentRoot]) + FileName)
else
FileName := F;
@ -2918,4 +3053,3 @@ finalization
FreeAndNil(_MVCGlobalActionParamsCache);
end.

84
unittests/general/Several/DMVCFrameworkTests.dpr
View File

@ -1,16 +1,19 @@
program DMVCFrameworkTests;
{$IFNDEF TESTINSIGHT}
{$IFNDEF GUI_TESTRUNNER}
{$APPTYPE CONSOLE}
{$ENDIF}{$STRONGLINKTYPES ON}
{$ENDIF}{$ENDIF}{$STRONGLINKTYPES ON}
uses
System.SysUtils,
{$IFDEF TESTINSIGHT}
TestInsight.DUnitX,
{$ENDIF }
{$IFDEF GUI_TESTRUNNER}
Vcl.Forms,
DUnitX.Loggers.GUI.Vcl,
{$ENDIF}
{$IFDEF CONSOLE_TESTRUNNER}
DUnitX.Loggers.Console,
// DUnitX.Loggers.GUIX,
{$ENDIF}
DUnitX.Loggers.Xml.NUnit,
DUnitX.TestFramework,
FrameworkTestsU in 'FrameworkTestsU.pas',
@ -19,9 +22,10 @@ uses
BOs in 'BOs.pas',
TestServerControllerU in '..\TestServer\TestServerControllerU.pas',
RESTAdapterTestsU in 'RESTAdapterTestsU.pas',
MVCFramework.Tests.WebModule2 in '..\StandaloneServer\MVCFramework.Tests.WebModule2.pas' {TestWebModule2: TWebModule},
MVCFramework.Tests.WebModule2
in '..\StandaloneServer\MVCFramework.Tests.WebModule2.pas' {TestWebModule2: TWebModule} ,
MVCFramework.Tests.StandaloneServer in '..\StandaloneServer\MVCFramework.Tests.StandaloneServer.pas',
MVCFramework.Tests.WebModule1 in '..\RESTClient\MVCFramework.Tests.WebModule1.pas' {TestWebModule1: TWebModule},
MVCFramework.Tests.WebModule1 in '..\RESTClient\MVCFramework.Tests.WebModule1.pas' {TestWebModule1: TWebModule} ,
MVCFramework.Tests.RESTClient in '..\RESTClient\MVCFramework.Tests.RESTClient.pas',
MVCFramework.Tests.AppController in '..\RESTClient\MVCFramework.Tests.AppController.pas',
BusinessObjectsU in '..\..\..\samples\commons\BusinessObjectsU.pas',
@ -34,51 +38,67 @@ uses
MVCFramework.Serializer.JsonDataObjects in '..\..\..\sources\MVCFramework.Serializer.JsonDataObjects.pas';
{$R *.RES}
{$IFDEF CONSOLE_TESTRUNNER}
procedure MainConsole();
var
runner : ITestRunner;
results : IRunResults;
logger : ITestLogger;
nunitLogger : ITestLogger;
runner: ITestRunner;
results: IRunResults;
logger: ITestLogger;
nunitLogger: ITestLogger;
begin
ReportMemoryLeaksOnShutdown := True;
{$IFDEF TESTINSIGHT}
TestInsight.DUnitX.RunRegisteredTests;
exit;
{$ENDIF}
try
//Check command line options, will exit if invalid
// Check command line options, will exit if invalid
TDUnitX.CheckCommandLine;
//Create the test runner
// Create the test runner
runner := TDUnitX.CreateRunner;
//Tell the runner to use RTTI to find Fixtures
// Tell the runner to use RTTI to find Fixtures
runner.UseRTTI := True;
//tell the runner how we will log things
//Log to the console window
logger := TDUnitXConsoleLogger.Create(true);
// tell the runner how we will log things
// Log to the console window
logger := TDUnitXConsoleLogger.Create(True);
runner.AddLogger(logger);
//Generate an NUnit compatible XML File
nunitLogger := TDUnitXXMLNUnitFileLogger.Create(TDUnitX.Options.XMLOutputFile);
runner.AddLogger(nunitLogger);
runner.FailsOnNoAsserts := False; //When true, Assertions must be made during tests;
// Generate an NUnit compatible XML File
// nunitLogger := TDUnitXXMLNUnitFileLogger.Create(TDUnitX.Options.XMLOutputFile);
// runner.AddLogger(nunitLogger);
runner.FailsOnNoAsserts := False; // When true, Assertions must be made during tests;
//Run tests
// Run tests
results := runner.Execute;
if not results.AllPassed then
System.ExitCode := EXIT_ERRORS;
{$IFNDEF CI}
//We don't want this happening when running under CI.
{$IFNDEF CI}
// We don't want this happening when running under CI.
if TDUnitX.Options.ExitBehavior = TDUnitXExitBehavior.Pause then
begin
System.Write('Done.. press <Enter> key to quit.');
System.Readln;
end;
{$ENDIF}
{$ENDIF}
except
on E: Exception do
System.Writeln(E.ClassName, ': ', E.Message);
end;
end;
{$ENDIF}
{$IFDEF GUI_TESTRUNNER}
procedure MainGUI;
begin
Application.Initialize;
Application.CreateForm(TGUIVCLTestRunner, GUIVCLTestRunner);
Application.Run;
end;
{$ENDIF}
begin
ReportMemoryLeaksOnShutdown := True;
{$IFDEF CONSOLE_TESTRUNNER}
MainConsole();
{$ENDIF}
{$IFDEF GUI_TESTRUNNER}
MainGUI();
{$ENDIF}
end.

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

@ -1,10 +1,10 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{0582DE6A-D716-46D3-8CBD-84AD73A4B536}</ProjectGuid>
<ProjectVersion>18.5</ProjectVersion>
<ProjectVersion>18.6</ProjectVersion>
<FrameworkType>VCL</FrameworkType>
<Base>True</Base>
<Config Condition="'$(Config)'==''">Debug</Config>
<Config Condition="'$(Config)'==''">GUI</Config>
<Platform Condition="'$(Platform)'==''">Win32</Platform>
<TargetedPlatforms>1</TargetedPlatforms>
<AppType>Console</AppType>
@ -34,7 +34,35 @@
<Cfg_1>true</Cfg_1>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='USE_MESSAGING' or '$(Cfg_3)'!=''">
<PropertyGroup Condition="'$(Config)'=='CONSOLE' or '$(Cfg_4)'!=''">
<Cfg_4>true</Cfg_4>
<CfgParent>Cfg_1</CfgParent>
<Cfg_1>true</Cfg_1>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_4)'=='true') or '$(Cfg_4_Win32)'!=''">
<Cfg_4_Win32>true</Cfg_4_Win32>
<CfgParent>Cfg_4</CfgParent>
<Cfg_4>true</Cfg_4>
<Cfg_1>true</Cfg_1>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='CI' or '$(Cfg_5)'!=''">
<Cfg_5>true</Cfg_5>
<CfgParent>Cfg_4</CfgParent>
<Cfg_4>true</Cfg_4>
<Cfg_1>true</Cfg_1>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_5)'=='true') or '$(Cfg_5_Win32)'!=''">
<Cfg_5_Win32>true</Cfg_5_Win32>
<CfgParent>Cfg_5</CfgParent>
<Cfg_5>true</Cfg_5>
<Cfg_4>true</Cfg_4>
<Cfg_1>true</Cfg_1>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='GUI' or '$(Cfg_3)'!=''">
<Cfg_3>true</Cfg_3>
<CfgParent>Cfg_1</CfgParent>
<Cfg_1>true</Cfg_1>
@ -47,12 +75,6 @@
<Cfg_1>true</Cfg_1>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='SERVER_ON_LINUX' or '$(Cfg_4)'!=''">
<Cfg_4>true</Cfg_4>
<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>
@ -73,7 +95,6 @@
<Icns_MainIcns>$(BDS)\bin\delphi_PROJECTICNS.icns</Icns_MainIcns>
<SanitizedProjectName>DMVCFrameworkTests</SanitizedProjectName>
<DCC_Namespace>Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace)</DCC_Namespace>
<DCC_Define>_CONSOLE_TESTRUNNER;TESTINSIGHT;$(DCC_Define)</DCC_Define>
<DCC_UnitSearchPath>$(BDS)\Source\DUnit\src;..\..\..\sources;..\..\..\lib\delphistompclient;..\..\..\lib\dmustache;..\..\..\lib\loggerpro;$(DCC_UnitSearchPath)</DCC_UnitSearchPath>
<DCC_DcuOutput>.\$(Platform)\$(Config)\dcu</DCC_DcuOutput>
<DCC_ExeOutput>.\$(Platform)\$(Config)</DCC_ExeOutput>
@ -106,17 +127,26 @@
<VerInfo_Locale>1033</VerInfo_Locale>
<DCC_MapFile>3</DCC_MapFile>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_3)'!=''">
<VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
<VerInfo_Locale>1040</VerInfo_Locale>
<DCC_Define>USE_MESSAGING;$(DCC_Define)</DCC_Define>
<Manifest_File>$(BDS)\bin\default_app.manifest</Manifest_File>
<PropertyGroup Condition="'$(Cfg_4)'!=''">
<DCC_Define>CONSOLE_TESTRUNNER;$(DCC_Define)</DCC_Define>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_3_Win32)'!=''">
<PropertyGroup Condition="'$(Cfg_4_Win32)'!=''">
<VerInfo_Locale>1033</VerInfo_Locale>
<AppEnableRuntimeThemes>true</AppEnableRuntimeThemes>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_4)'!=''">
<DCC_Define>LINUX_SERVER;$(DCC_Define)</DCC_Define>
<PropertyGroup Condition="'$(Cfg_5_Win32)'!=''">
<DCC_Define>CI;$(DCC_Define)</DCC_Define>
<VerInfo_Locale>1033</VerInfo_Locale>
<AppEnableRuntimeThemes>true</AppEnableRuntimeThemes>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_3)'!=''">
<DCC_UnitSearchPath>$(BDS)\source\DunitX;$(DCC_UnitSearchPath)</DCC_UnitSearchPath>
<DCC_Define>_CONSOLE_TESTRUNNER;GUI_TESTRUNNER;$(DCC_Define)</DCC_Define>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_3_Win32)'!=''">
<DCC_Define>GUI_TESTRUNNER;$(DCC_Define)</DCC_Define>
<VerInfo_Locale>1033</VerInfo_Locale>
<AppEnableRuntimeThemes>true</AppEnableRuntimeThemes>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2)'!=''">
<VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
@ -141,13 +171,11 @@
<DCCReference Include="RESTAdapterTestsU.pas"/>
<DCCReference Include="..\StandaloneServer\MVCFramework.Tests.WebModule2.pas">
<Form>TestWebModule2</Form>
<FormType>dfm</FormType>
<DesignClass>TWebModule</DesignClass>
</DCCReference>
<DCCReference Include="..\StandaloneServer\MVCFramework.Tests.StandaloneServer.pas"/>
<DCCReference Include="..\RESTClient\MVCFramework.Tests.WebModule1.pas">
<Form>TestWebModule1</Form>
<FormType>dfm</FormType>
<DesignClass>TWebModule</DesignClass>
</DCCReference>
<DCCReference Include="..\RESTClient\MVCFramework.Tests.RESTClient.pas"/>
@ -160,10 +188,14 @@
<DCCReference Include="..\..\..\sources\MVCFramework.JSONRPC.pas"/>
<DCCReference Include="..\..\..\samples\commons\RandomUtilsU.pas"/>
<DCCReference Include="..\..\..\sources\MVCFramework.Serializer.JsonDataObjects.pas"/>
<BuildConfiguration Include="CI">
<Key>Cfg_5</Key>
<CfgParent>Cfg_4</CfgParent>
</BuildConfiguration>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
<BuildConfiguration Include="SERVER_ON_LINUX">
<BuildConfiguration Include="CONSOLE">
<Key>Cfg_4</Key>
<CfgParent>Cfg_1</CfgParent>
</BuildConfiguration>
@ -171,14 +203,14 @@
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
<BuildConfiguration Include="USE_MESSAGING">
<Key>Cfg_3</Key>
<CfgParent>Cfg_1</CfgParent>
</BuildConfiguration>
<BuildConfiguration Include="Debug">
<Key>Cfg_1</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
<BuildConfiguration Include="GUI">
<Key>Cfg_3</Key>
<CfgParent>Cfg_1</CfgParent>
</BuildConfiguration>
</ItemGroup>
<ProjectExtensions>
<Borland.Personality>Delphi.Personality.12</Borland.Personality>
@ -239,7 +271,8 @@
<Source Name="MainSource">DMVCFrameworkTests.dpr</Source>
</Source>
<Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\DataExplorerDBXPluginEnt260.bpl">DBExpress Enterprise Data Explorer Integration</Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\bcboffice2k260.bpl">Embarcadero C++Builder Office 2000 Servers Package</Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\bcbofficexp260.bpl">Embarcadero C++Builder Office XP Servers Package</Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\dcloffice2k260.bpl">Microsoft Office 2000 Sample Automation Server Wrapper Components</Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\dclofficexp260.bpl">Microsoft Office XP Sample Automation Server Wrapper Components</Excluded_Packages>
</Excluded_Packages>

38
unittests/general/Several/LiveServerTestU.pas
View File

@ -41,10 +41,8 @@ const
{$ENDIF}
type
[TestFixture]
TBaseServerTest = class(TObject)
protected
RESTClient: TRESTClient;
@ -59,11 +57,12 @@ type
end;
[TestFixture]
TServerTest = class(TBaseServerTest)
public
[Test]
[TestCase('/fault', '/fault')]
[TestCase('/fault2', '/fault2')]
[TestCase('request url /fault', '/fault')]
[TestCase('request url /fault2', '/fault2')]
procedure TestControllerWithExceptionInCreate(const URLSegment: string);
[Test]
@ -73,12 +72,12 @@ type
[Test]
[TestCase('1', ' à,è')]
[TestCase('2', 'é,ù,ò')]
[TestCase('2', 'ì,@,[')]
[TestCase('2', '],{,}')]
[TestCase('2', '(,),\')]
[TestCase('2', '=,;,&')]
[TestCase('2', '#,.,_')]
[TestCase('2', '%, , ')]
[TestCase('3', 'ì,@,[')]
[TestCase('4', '],{,}')]
[TestCase('5', '(,),\')]
[TestCase('6', '=,;,&')]
[TestCase('7', '#,.,_')]
[TestCase('8', '%, , ')]
procedure TestReqWithURLMappedParams(const par1, par2, par3: string);
[Test]
procedure TestPOSTWithParamsAndJSONBody;
@ -473,15 +472,16 @@ begin
Assert.areEqual('johndoe', LRes.BodyAsString);
end;
procedure TServerTest.TestControllerWithExceptionInCreate(
const URLSegment: string);
procedure TServerTest.TestControllerWithExceptionInCreate(const URLSegment: string);
var
res: IRESTResponse;
begin
res := RESTClient.doGET(URLSegment, []);
Assert.areEqual(HTTP_STATUS.InternalServerError, res.ResponseCode);
Assert.Contains(res.ContentType, 'text/plain', true, 'Is not a text/plain in case of error');
//Assert.Contains(res.ContentType, 'text/plain', true, 'Is not a text/plain in case of error');
Assert.Contains(res.ContentType, 'application/json', true, 'Is not a application/json in case of error');
Assert.Contains(res.BodyAsString, 'Cannot create controller', true, 'Exception message in body is not correct');
//Assert.Contains(res.BodyAsString, 'Cannot create controller', true, 'Exception message in body is not correct');
end;
procedure TServerTest.TestCookies;
@ -733,12 +733,10 @@ var
lCompType: string;
j: Integer;
const
CompressionTypes: array [1 .. 9] of string =
('deflate', 'gzip', 'deflate,gzip', 'gzip,deflate',
'gzip,invalid', 'deflate,notvalid', 'notvalid,gzip', 'invalid', '');
CompressionTypeResult: array [1 .. 9] of string =
('deflate', 'gzip', 'deflate', 'gzip',
'gzip', 'deflate', 'gzip', '', '');
CompressionTypes: array [1 .. 9] of string = ('deflate', 'gzip', 'deflate,gzip', 'gzip,deflate', 'gzip,invalid',
'deflate,notvalid', 'notvalid,gzip', 'invalid', '');
CompressionTypeResult: array [1 .. 9] of string = ('deflate', 'gzip', 'deflate', 'gzip', 'gzip', 'deflate',
'gzip', '', '');
begin
j := 1;
for lCompType in CompressionTypes do
@ -1330,7 +1328,7 @@ begin
lRPCResp := FExecutor2.ExecuteRequest(lReq);
LRes := lRPCResp.Result.AsType<TDateTime>();
DecodeDateTime(LRes, lYear, lMonth, lDay, lHour, lMinute, lSecond, lMillisecond);
Assert.AreEqual(2000, lYear);
Assert.areEqual(2000, lYear);
end;
procedure TJSONRPCServerTest.TestRequestWithoutParams;

2
unittests/general/TestServer/TestServer.dproj
View File

@ -1,7 +1,7 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{FAC8B4A9-B614-46ED-BF18-D718EC2E7F3E}</ProjectGuid>
<ProjectVersion>18.5</ProjectVersion>
<ProjectVersion>18.6</ProjectVersion>
<FrameworkType>None</FrameworkType>
<MainSource>TestServer.dpr</MainSource>
<Base>True</Base>

8
unittests/serializer/jsondataobjects/MVCFramework.Tests.Serializer.JsonDataObjects.pas
View File

@ -770,8 +770,16 @@ begin
Dm.EntityAsIsId.AsLargeInt := 2;
Dm.EntityAsIsName.AsString := 'Ezequiel Juliano Müller';
Dm.EntityAsIs.Post;
//serialize dataset
S := FSerializer.SerializeDataSet(Dm.EntityAsIs);
Assert.areEqual(JSON_LIST, S, 'json list');
//serialize dataset as object
S := FSerializer.SerializeObject(Dm.EntityAsIs);
Assert.areEqual(JSON_LIST, S, 'json list');
finally
Dm.Free;
end;

10
unittests/serializer/jsondataobjects/TestSerializerJsonDataObjects.dproj
View File

@ -1,10 +1,10 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{DE94B0A5-DA22-4941-9AE1-FB2BBDCD4F7E}</ProjectGuid>
<ProjectVersion>18.5</ProjectVersion>
<ProjectVersion>18.6</ProjectVersion>
<FrameworkType>None</FrameworkType>
<Base>True</Base>
<Config Condition="'$(Config)'==''">CI</Config>
<Config Condition="'$(Config)'==''">Debug</Config>
<Platform Condition="'$(Platform)'==''">Win32</Platform>
<TargetedPlatforms>1</TargetedPlatforms>
<AppType>Console</AppType>
@ -48,7 +48,7 @@
<PropertyGroup Condition="'$(Base)'!=''">
<SanitizedProjectName>TestSerializerJsonDataObjects</SanitizedProjectName>
<DCC_Namespace>System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace)</DCC_Namespace>
<DCC_Define>_CONSOLE_TESTRUNNER;TESTINSIGHT;$(DCC_Define)</DCC_Define>
<DCC_Define>CONSOLE_TESTRUNNER;_TESTINSIGHT;$(DCC_Define)</DCC_Define>
<VerInfo_Locale>1046</VerInfo_Locale>
<DCC_DcpOutput>.\$(Platform)\$(Config)\dcp</DCC_DcpOutput>
<DCC_UnitSearchPath>$(BDS)\Source\DUnit\src;..\..\..\sources;..\..\..\lib\loggerpro;..\..\..\lib\dmustache;..\..\..\lib\delphistompclient;..\..\..\lib\jsondataobjects\Source;$(DCC_UnitSearchPath)</DCC_UnitSearchPath>
@ -122,11 +122,11 @@
<BorlandProject>
<Delphi.Personality>
<Excluded_Packages>
<Excluded_Packages Name="C:\Users\Public\Documents\Embarcadero\Studio\20.0\Bpl\LockBoxFMXDD250.bpl">TurboPack LockBox Delphi FMX designtime package</Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\DataExplorerDBXPluginEnt260.bpl">DBExpress Enterprise Data Explorer Integration</Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\bcboffice2k260.bpl">Embarcadero C++Builder Office 2000 Servers Package</Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\bcbofficexp260.bpl">Embarcadero C++Builder Office XP Servers Package</Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\dcloffice2k260.bpl">Microsoft Office 2000 Sample Automation Server Wrapper Components</Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\dclofficexp260.bpl">Microsoft Office XP Sample Automation Server Wrapper Components</Excluded_Packages>
<Excluded_Packages Name="C:\Program Files (x86)\FastReports\LibD26\dclfrxtee26.bpl">FastReport 6.0 Tee Components</Excluded_Packages>
</Excluded_Packages>
<Source>
<Source Name="MainSource">TestSerializerJsonDataObjects.dpr</Source>