From dc2328c89accd8746e8ceda03c3d5a1ad692b804 Mon Sep 17 00:00:00 2001 From: Daniele Teti Date: Sat, 16 Mar 2019 17:20:28 +0100 Subject: [PATCH] Added Dict function to easily return a dictionary of strings. Improved exceptions rendering. --- samples/articles_crud_server/MainDM.dfm | 3 +- .../jsonrpcclientwithobjects.dproj | 2 +- .../jsonrpcserverwithobjects.dproj | 2 +- samples/renders/RenderSampleControllerU.pas | 96 ++++++++++++++-- samples/renders/renders.dproj | 28 ++--- sources/MVCFramework.ActiveRecord.pas | 2 +- sources/MVCFramework.Commons.pas | 105 +++++++++++++----- sources/MVCFramework.pas | 44 +++++--- tools/entitygenerator/MainFormU.pas | 83 ++++++++++---- 9 files changed, 276 insertions(+), 89 deletions(-) diff --git a/samples/articles_crud_server/MainDM.dfm b/samples/articles_crud_server/MainDM.dfm index 770bfde2..f9602b68 100644 --- a/samples/articles_crud_server/MainDM.dfm +++ b/samples/articles_crud_server/MainDM.dfm @@ -9,9 +9,10 @@ object dmMain: TdmMain 'B' 'User_Name=sysdba' 'Password=masterkey' + 'Protocol=TCPIP' + 'Server=localhost' 'DriverID=FB') ConnectedStoredUsage = [] - Connected = True LoginPrompt = False BeforeConnect = ConnectionBeforeConnect Left = 64 diff --git a/samples/jsonrpc_with_published_objects/jsonrpcclientwithobjects.dproj b/samples/jsonrpc_with_published_objects/jsonrpcclientwithobjects.dproj index 8783996c..7b0da38c 100644 --- a/samples/jsonrpc_with_published_objects/jsonrpcclientwithobjects.dproj +++ b/samples/jsonrpc_with_published_objects/jsonrpcclientwithobjects.dproj @@ -1,7 +1,7 @@  {300F83FF-8F7B-43FD-B740-A3DFDF7238ED} - 18.5 + 18.6 VCL jsonrpcclientwithobjects.dpr True diff --git a/samples/jsonrpc_with_published_objects/jsonrpcserverwithobjects.dproj b/samples/jsonrpc_with_published_objects/jsonrpcserverwithobjects.dproj index 73673027..2ddbbeda 100644 --- a/samples/jsonrpc_with_published_objects/jsonrpcserverwithobjects.dproj +++ b/samples/jsonrpc_with_published_objects/jsonrpcserverwithobjects.dproj @@ -1,7 +1,7 @@  {AF5FBC36-0D1D-4C07-B2E3-C2A2E688AC6F} - 18.5 + 18.6 VCL jsonrpcserverwithobjects.dpr True diff --git a/samples/renders/RenderSampleControllerU.pas b/samples/renders/RenderSampleControllerU.pas index 05daf0f7..c359d855 100644 --- a/samples/renders/RenderSampleControllerU.pas +++ b/samples/renders/RenderSampleControllerU.pas @@ -105,7 +105,7 @@ type [MVCHTTPMethod([httpGET])] [MVCPath('/customers/($id).html')] [MVCProduces('text/html')] - procedure GetPerson_AsHTML(CTX: TWebContext); + procedure GetPerson_AsHTML; [MVCHTTPMethod([httpGET])] [MVCPath('/customers.csv')] @@ -114,7 +114,7 @@ type [MVCHTTPMethod([httpGET])] [MVCPath('/customers/unicode/($id).html')] [MVCProduces('text/html', 'UTF-8')] - procedure GetUnicodeText_AsHTML(CTX: TWebContext); + procedure GetUnicodeText_AsHTML; [MVCHTTPMethod([httpGET])] [MVCPath('/customers/($id)')] @@ -133,7 +133,16 @@ type [MVCHTTPMethod([httpGET])] [MVCPath('/images/customers/($id)')] - procedure GetPersonPhotoAsStream(CTX: TWebContext); + procedure GetPersonPhotoAsStream; + + [MVCHTTPMethod([httpPOST])] + [MVCConsumes(TMVCMediaType.MULTIPART_FORM_DATA)] + [MVCPath('/files')] + procedure UploadBinaryData; + + [MVCHTTPMethod([httpGET])] + [MVCPath('/files/($filename)')] + procedure GetBinaryData(const filename: string); [MVCHTTPMethod([httpGET])] [MVCPath('/exception')] @@ -153,7 +162,9 @@ uses MVCFramework.DataSet.Utils, MVCFramework.Serializer.Commons, MVCFramework.Serializer.Defaults, + MVCFramework.Logger, MyDataModuleU, + System.IOUtils, System.Classes, System.SysUtils, WebModuleU, @@ -161,11 +172,12 @@ uses InMemoryDataU, JsonDataObjects, MVCFramework.Serializer.JsonDataObjects, - Data.DB; + Data.DB, + Web.HTTPApp; { TRoutingSampleController } -procedure TRenderSampleController.GetUnicodeText_AsHTML(CTX: TWebContext); +procedure TRenderSampleController.GetUnicodeText_AsHTML; var s: string; begin @@ -192,6 +204,76 @@ begin Render(IntToStr(10 div a)); end; +procedure TRenderSampleController.UploadBinaryData; +var + lFile: TAbstractWebRequestFile; + lFileExt: string; + lOutputFileName: string; + lOutputFullPath: string; + lOutFile: TFileStream; + lOutputFolder: string; +begin + if Context.Request.Files.Count <> 1 then + begin + raise EMVCException.Create(HTTP_STATUS.BadRequest, 'Expected exactly 1 file'); + end; + lFile := Context.Request.Files[0]; + + LogI(Format('Upload: [FieldName: %s] [FileName: %s] [ContentType: %s] [Size: %d bytes]', + [lFile.FieldName, lFile.filename, lFile.ContentType, lFile.Stream.Size])); + + { Be sure that our data directory always exists. We could also do it in the server startup. } + lOutputFolder := TPath.Combine(AppPath, 'uploadedfiles'); + if not TDirectory.Exists(lOutputFolder) then + begin + TDirectory.CreateDirectory(lOutputFolder); + end; + + lFileExt := TPath.GetExtension(lFile.filename); + { + Here we could check for allowed extensions or check the file contents looking for + accepted file headers (e.g. Zip, PNG, BMP, TIFF etc). + In this case we just use the extension of the filename sent by the client. + } + + { Find a valid random filename to store the stream on disk. } + repeat + lOutputFileName := TPath.ChangeExtension(TPath.GetRandomFileName, lFileExt); + lOutputFullPath := TPath.Combine(lOutputFolder, lOutputFileName); + until not TFile.Exists(lOutputFullPath); + + lOutFile := TFileStream.Create(lOutputFullPath, fmCreate); + try + lOutFile.CopyFrom(lFile.Stream, 0); + finally + lOutFile.Free; + end; + + { Inform the client about the name assigned to the file + on disk and how to retrieve it. } + Context.Response.ContentType := TMVCMediaType.APPLICATION_JSON; + Context.Response.StatusCode := HTTP_STATUS.OK; + Render(Dict(['filename', 'ref'], [lOutputFileName, '/files/' + lOutputFileName])); +end; + +procedure TRenderSampleController.GetBinaryData(const filename: string); +var + lFilesFolder: string; + lFullFilePath: string; +begin + lFilesFolder := TPath.Combine(AppPath, 'uploadedfiles'); + lFullFilePath := TPath.Combine(lFilesFolder, filename); + if not TFile.Exists(lFullFilePath) then + begin + raise EMVCException.Create('File not found'); + end; + Context.Response.ContentType := TMVCMediaType.APPLICATION_OCTET_STREAM; + Context.Response.StatusCode := HTTP_STATUS.OK; + Context.Response.CustomHeaders.Values['Content-Disposition'] := 'attachment; filename=' + + filename + ';'; + Render(TFileStream.Create(lFullFilePath, fmOpenRead or fmShareDenyNone)); +end; + procedure TRenderSampleController.GetCustomerByID_AsTObject(const id: Integer); var Cust: TCustomer; @@ -302,7 +384,7 @@ begin Render(GetPeopleList, False); end; -procedure TRenderSampleController.GetPerson_AsHTML(CTX: TWebContext); +procedure TRenderSampleController.GetPerson_AsHTML; begin ResponseStream.Append('
    ').Append('
  • FirstName: Daniele
    • ') .Append('
  • LastName: Teti') @@ -537,7 +619,7 @@ begin SendFile('..\..\_\customer.png'); end; -procedure TRenderSampleController.GetPersonPhotoAsStream(CTX: TWebContext); +procedure TRenderSampleController.GetPersonPhotoAsStream; var LPhoto: TFileStream; begin diff --git a/samples/renders/renders.dproj b/samples/renders/renders.dproj index f12fb457..46f356f0 100644 --- a/samples/renders/renders.dproj +++ b/samples/renders/renders.dproj @@ -315,31 +315,31 @@ true + + + .\ + true + + + + + .\ + true + + .\ true - - - .\ - true - - - - - .\ - true - - .\ true - + .\ true @@ -357,7 +357,7 @@ true - + .\ true diff --git a/sources/MVCFramework.ActiveRecord.pas b/sources/MVCFramework.ActiveRecord.pas index 627db75c..d464374c 100644 --- a/sources/MVCFramework.ActiveRecord.pas +++ b/sources/MVCFramework.ActiveRecord.pas @@ -717,7 +717,7 @@ var begin lQry := TFDQuery.Create(nil); try - lQry.FetchOptions.Unidirectional := True; + lQry.FetchOptions.Unidirectional := False; //True; if Connection = nil then begin lQry.Connection := ActiveRecordConnectionsRegistry.GetCurrent; diff --git a/sources/MVCFramework.Commons.pas b/sources/MVCFramework.Commons.pas index a34d41d5..e0ec1f22 100644 --- a/sources/MVCFramework.Commons.pas +++ b/sources/MVCFramework.Commons.pas @@ -43,16 +43,17 @@ uses {$I dmvcframeworkbuildconsts.inc} + type - TMVCHTTPMethodType = (httpGET, httpPOST, httpPUT, httpDELETE, httpHEAD, httpOPTIONS, httpPATCH, httpTRACE); + TMVCHTTPMethodType = (httpGET, httpPOST, httpPUT, httpDELETE, httpHEAD, httpOPTIONS, httpPATCH, + httpTRACE); TMVCHTTPMethods = set of TMVCHTTPMethodType; TMVCMediaType = record public const APPLICATION_ATOM_XML = 'application/atom+xml'; - APPLICATION_FORM_URLENCODED = 'application/x-www-form-urlencoded'; APPLICATION_JSON = 'application/json'; APPLICATION_OCTET_STREAM = 'application/octet-stream'; APPLICATION_SVG_XML = 'application/svg+xml'; @@ -61,6 +62,7 @@ type APPLICATION_OCTETSTREAM = 'application/octet-stream'; MEDIA_TYPE_WILDCARD = '*'; MULTIPART_FORM_DATA = 'multipart/form-data'; + APPLICATION_FORM_URLENCODED = 'application/x-www-form-urlencoded'; TEXT_HTML = 'text/html'; TEXT_PLAIN = 'text/plain'; TEXT_XML = 'text/xml'; @@ -288,7 +290,8 @@ type { protected declarations } public constructor Create(const AMsg: string); overload; virtual; - constructor Create(const AMsg: string; const ADetailedMessage: string; const AAppErrorCode: UInt16; + 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; @@ -354,7 +357,8 @@ type protected FDict: TDictionary; public - constructor Create; virtual; + constructor Create; overload; virtual; + constructor Create(const aKey, aValue: String); overload; virtual; destructor Destroy; override; procedure Clear; function Add(const Name, Value: string): TMVCStringDictionary; @@ -416,7 +420,7 @@ type function GetValue(const AIndex: string): string; function GetValueAsInt64(const AIndex: string): Int64; - procedure SetValue(const AIndex: string; const AValue: string); + procedure SetValue(const AIndex: string; const aValue: string); protected { protected declarations } public @@ -451,9 +455,9 @@ function AppPath: string; function IsReservedOrPrivateIP(const AIP: string): Boolean; inline; function IP2Long(const AIP: string): UInt32; inline; -function B64Encode(const AValue: string): string; overload; -function B64Encode(const AValue: TBytes): string; overload; -function B64Decode(const AValue: string): string; +function B64Encode(const aValue: string): string; overload; +function B64Encode(const aValue: TBytes): string; overload; +function B64Decode(const aValue: string): string; function URLSafeB64encode(const Value: string; IncludePadding: Boolean): string; overload; function URLSafeB64encode(const Value: TBytes; IncludePadding: Boolean): string; overload; @@ -466,12 +470,17 @@ procedure SplitContentMediaTypeAndCharset(const aContentType: string; var aConte var aContentCharSet: string); function BuildContentType(const aContentMediaType: string; const aContentCharSet: string): string; +function Dict: TMVCStringDictionary; overload; +function Dict(const aKeys: array of string; const aValues: array of string) + : TMVCStringDictionary; overload; + const MVC_HTTP_METHODS_WITHOUT_CONTENT: TMVCHTTPMethods = [httpGET, httpDELETE, httpHEAD, httpOPTIONS]; MVC_HTTP_METHODS_WITH_CONTENT: TMVCHTTPMethods = [httpPOST, httpPUT, httpPATCH]; const - MVC_COMPRESSION_TYPE_AS_STRING: array [TMVCCompressionType] of string = ('none', 'deflate', 'gzip'); + MVC_COMPRESSION_TYPE_AS_STRING: array [TMVCCompressionType] of string = ('none', + 'deflate', 'gzip'); MVC_COMPRESSION_ZLIB_WINDOW_BITS: array [TMVCCompressionType] of Integer = (0, -15, 31); // WindowBits: http://zlib.net/manual.html#Advanced @@ -480,15 +489,19 @@ var 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'), + ('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'), + ('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 uses - IdCoder3to4, JsonDataObjects, MVCFramework.Serializer.JsonDataObjects; + IdCoder3to4, + JsonDataObjects, + MVCFramework.Serializer.JsonDataObjects; var GlobalAppName, GlobalAppPath, GlobalAppExe: string; @@ -517,7 +530,8 @@ begin if AIP.IsEmpty then Exit(0); lPieces := AIP.Split(['.']); - Result := (StrToInt(lPieces[0]) * 16777216) + (StrToInt(lPieces[1]) * 65536) + (StrToInt(lPieces[2]) * 256) + + Result := (StrToInt(lPieces[0]) * 16777216) + (StrToInt(lPieces[1]) * 65536) + + (StrToInt(lPieces[2]) * 256) + StrToInt(lPieces[3]); end; @@ -526,22 +540,22 @@ end; // Result := IdGlobal.IPv4ToUInt32(AIP); // end; -function B64Encode(const AValue: string): string; overload; +function B64Encode(const aValue: string): string; overload; begin // Do not use TNetEncoding - Result := TIdEncoderMIME.EncodeString(AValue); + Result := TIdEncoderMIME.EncodeString(aValue); end; -function B64Encode(const AValue: TBytes): string; overload; +function B64Encode(const aValue: TBytes): string; overload; begin // Do not use TNetEncoding - Result := TIdEncoderMIME.EncodeBytes(TIdBytes(AValue)); + Result := TIdEncoderMIME.EncodeBytes(TIdBytes(aValue)); end; -function B64Decode(const AValue: string): string; +function B64Decode(const aValue: string): string; begin // Do not use TNetEncoding - Result := TIdDecoderMIME.DecodeString(AValue); + Result := TIdDecoderMIME.DecodeString(aValue); end; function ByteToHex(AInByte: Byte): string; @@ -576,7 +590,8 @@ begin begin Result := lContentMediaType; end - else if lContentMediaType.StartsWith('text/') or lContentMediaType.StartsWith('application/') then + else if lContentMediaType.StartsWith('text/') or lContentMediaType.StartsWith('application/') + then begin Result := lContentMediaType + ';charset=' + aContentCharSet.ToLower; end @@ -596,7 +611,8 @@ begin begin lContentTypeValues := aContentType.Split([';']); aContentMediaType := Trim(lContentTypeValues[0]); - if (Length(lContentTypeValues) > 1) and (lContentTypeValues[1].Trim.StartsWith('charset', True)) then + if (Length(lContentTypeValues) > 1) and (lContentTypeValues[1].Trim.StartsWith('charset', True)) + then begin aContentCharSet := lContentTypeValues[1].Trim.Split(['='])[1].Trim; end @@ -622,7 +638,8 @@ begin FAppErrorCode := 0; end; -constructor EMVCException.Create(const AMsg, ADetailedMessage: string; const AAppErrorCode, AHttpErrorCode: UInt16); +constructor EMVCException.Create(const AMsg, ADetailedMessage: string; + const AAppErrorCode, AHttpErrorCode: UInt16); begin Create(AMsg); FHttpErrorCode := AHttpErrorCode; @@ -667,7 +684,8 @@ begin end; end; -function TMVCCriticalSectionHelper.DoWithLockTimeout(const AAction: TProc; const ATimeOut: UInt32): TWaitResult; +function TMVCCriticalSectionHelper.DoWithLockTimeout(const AAction: TProc; const ATimeOut: UInt32) + : TWaitResult; begin Result := Self.WaitFor(ATimeOut); if (Result = TWaitResult.wrSignaled) then @@ -716,7 +734,8 @@ var lStreamReader: TStreamReader; lSer: TMVCJsonDataObjectsSerializer; begin - lStreamReader := TStreamReader.Create(TFileStream.Create(AFileName, fmOpenRead or fmShareDenyWrite), TEncoding.ASCII); + lStreamReader := TStreamReader.Create(TFileStream.Create(AFileName, + fmOpenRead or fmShareDenyWrite), TEncoding.ASCII); try lStreamReader.OwnStream; lConfigString := lStreamReader.ReadToEnd; @@ -738,9 +757,9 @@ begin TFile.WriteAllText(AFileName, ToString, TEncoding.ASCII); end; -procedure TMVCConfig.SetValue(const AIndex, AValue: string); +procedure TMVCConfig.SetValue(const AIndex, aValue: string); begin - FConfig.Add(AIndex, AValue); + FConfig.Add(AIndex, aValue); end; function TMVCConfig.ToString: string; @@ -778,6 +797,12 @@ begin Result := FDict.Count; end; +constructor TMVCStringDictionary.Create(const aKey, aValue: String); +begin + Create; + Add(aKey, aValue); +end; + constructor TMVCStringDictionary.Create; begin inherited; @@ -877,7 +902,8 @@ type end; const - GURLSafeBase64CodeTable: string = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_'; + GURLSafeBase64CodeTable + : string = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_'; { Do not Localize } procedure TURLSafeEncode.InitComponent; @@ -984,12 +1010,35 @@ begin Self.WriteBuffer(UFTStr[Low(UFTStr)], Length(UFTStr)); end; +function Dict: TMVCStringDictionary; overload; +begin + Result := TMVCStringDictionary.Create; +end; + +function Dict(const aKeys: array of string; const aValues: array of string) + : TMVCStringDictionary; overload; +var + I: Integer; +begin + if Length(aKeys) <> Length(aValues) then + begin + raise EMVCException.CreateFmt('Dict error. Got %d keys but %d values', + [Length(aKeys), Length(aValues)]); + end; + Result := Dict(); + for I := Low(aKeys) to High(aKeys) do + begin + Result.Add(aKeys[i], aValues[i]); + end; +end; + initialization Lock := TObject.Create; // SGR 2017-07-03 : Initialize decoding table for URLSafe Gb64 encoding -TURLSafeDecode.ConstructDecodeTable(GURLSafeBase64CodeTable, TURLSafeDecode.GSafeBaseBase64DecodeTable); +TURLSafeDecode.ConstructDecodeTable(GURLSafeBase64CodeTable, + TURLSafeDecode.GSafeBaseBase64DecodeTable); GlobalAppExe := ExtractFileName(GetModuleName(HInstance)); GlobalAppName := ChangeFileExt(GlobalAppExe, EmptyStr); diff --git a/sources/MVCFramework.pas b/sources/MVCFramework.pas index d7adfb60..29b8ce31 100644 --- a/sources/MVCFramework.pas +++ b/sources/MVCFramework.pas @@ -79,8 +79,7 @@ uses LoggerPro, IdGlobal, IdGlobalProtocols, - IdURI, - MVCFramework.Commons; + IdURI, MVCFramework.Commons; type @@ -438,7 +437,7 @@ type procedure ResponseStatus(const AStatusCode: Integer; const AReasonString: string = ''); // Serializer access function Serializer: IMVCSerializer; overload; - function Serializer(const AContentType: string): IMVCSerializer; overload; + function Serializer(const AContentType: string; const ARaiseExcpIfNotExists: Boolean = True): IMVCSerializer; overload; end; IMVCAuthenticationHandler = interface @@ -465,7 +464,7 @@ type procedure Redirect(const AUrl: string); virtual; procedure ResponseStatus(const AStatusCode: Integer; const AReasonString: string = ''); virtual; function Serializer: IMVCSerializer; overload; - function Serializer(const AContentType: string): IMVCSerializer; overload; + function Serializer(const AContentType: string; const ARaiseExceptionIfNotExists: Boolean = True): IMVCSerializer; overload; procedure SendStream(const AStream: TStream; const AOwns: Boolean = True; const ARewind: Boolean = False); virtual; procedure SendFile(const AFileName: string); virtual; procedure RenderResponseStream; virtual; @@ -712,7 +711,7 @@ type procedure HTTP404(const AContext: TWebContext); procedure HTTP500(const AContext: TWebContext; const AReasonString: string = ''); procedure SendRawHTTPStatus(const AContext: TWebContext; const HTTPStatusCode: Integer; - const AReasonString: string); + const AReasonString: string; const AClassName: String = ''); property ViewEngineClass: TMVCViewEngineClass read GetViewEngineClass; property WebModule: TWebModule read FWebModule; @@ -1893,7 +1892,7 @@ begin end else begin - SendRawHTTPStatus(LContext, E.HTTPErrorCode, Format('[%s] %s', [E.Classname, E.Message])); + SendRawHTTPStatus(LContext, E.HTTPErrorCode, Format('[%s] %s', [E.Classname, E.Message]), E.ClassName); end; end; on E: EInvalidOp do @@ -1907,7 +1906,7 @@ begin else begin SendRawHTTPStatus(LContext, HTTP_STATUS.InternalServerError, - Format('[%s] %s', [E.Classname, E.Message])); + Format('[%s] %s', [E.Classname, E.Message]), E.Classname); end; end; on E: Exception do @@ -1922,7 +1921,7 @@ begin else begin SendRawHTTPStatus(LContext, HTTP_STATUS.InternalServerError, - Format('[%s] %s', [E.Classname, E.Message])); + Format('[%s] %s', [E.Classname, E.Message]), E.Classname); end; end; end; @@ -2177,7 +2176,7 @@ begin end; procedure TMVCEngine.SendRawHTTPStatus(const AContext: TWebContext; const HTTPStatusCode: Integer; - const AReasonString: string); + const AReasonString: string; const AClassName: String); var lSer: IMVCSerializer; lError: TMVCErrorResponse; @@ -2188,7 +2187,7 @@ begin begin lError := TMVCErrorResponse.Create; try - lError.Classname := ''; + lError.Classname := AClassName; lError.StatusCode := HTTPStatusCode; lError.Message := AReasonString; AContext.Response.SetContent(lSer.SerializeObject(lError)); @@ -2201,7 +2200,6 @@ begin begin AContext.Response.SetContentType(BuildContentType(TMVCMediaType.TEXT_PLAIN, AContext.Config[TMVCConfigKey.DefaultContentCharset])); - AContext.Response.SetContent(GetServerSignature(AContext) + sLineBreak + 'HTTP ' + HTTPStatusCode.ToString + ': ' + AReasonString); end; @@ -2702,15 +2700,27 @@ begin GetContext.Response.RawWebResponse.FreeContentStream := True; end; -function TMVCRenderer.Serializer(const AContentType: string): IMVCSerializer; +function TMVCRenderer.Serializer(const AContentType: string; const ARaiseExceptionIfNotExists: Boolean): IMVCSerializer; var lContentMediaType: string; lContentCharSet: string; begin SplitContentMediaTypeAndCharset(AContentType.ToLower, lContentMediaType, lContentCharSet); - if not Engine.Serializers.ContainsKey(lContentMediaType) then - raise EMVCException.CreateFmt('The serializer for %s could not be found.', [lContentMediaType]); - Result := Engine.Serializers.Items[lContentMediaType]; + if Engine.Serializers.ContainsKey(lContentMediaType) then + begin + Result := Engine.Serializers.Items[lContentMediaType]; + end + else + begin + if ARaiseExceptionIfNotExists then + begin + raise EMVCException.CreateFmt('The serializer for %s could not be found.', [lContentMediaType]); + end + else + begin + Result := nil; + end; + end; end; function TMVCController.SessionAs: T; @@ -2973,6 +2983,10 @@ begin R.Items.Add(I); end; end; + if Serializer(GetContentType, False) = nil then + begin + GetContext.Response.ContentType := GetConfig[TMVCConfigKey.DefaultContentType]; + end; Render(R, False); finally R.Free; diff --git a/tools/entitygenerator/MainFormU.pas b/tools/entitygenerator/MainFormU.pas index 496f6330..5263c6bd 100644 --- a/tools/entitygenerator/MainFormU.pas +++ b/tools/entitygenerator/MainFormU.pas @@ -42,8 +42,13 @@ uses Vcl.Grids, Vcl.ValEdit, FireDAC.Phys.MySQLDef, - FireDAC.Phys.MySQL, FireDAC.Phys.PGDef, FireDAC.Phys.PG, FireDAC.Phys.IBDef, - FireDAC.Phys.IB, FireDAC.Stan.ExprFuncs, FireDAC.Phys.SQLiteDef, + FireDAC.Phys.MySQL, + FireDAC.Phys.PGDef, + FireDAC.Phys.PG, + FireDAC.Phys.IBDef, + FireDAC.Phys.IB, + FireDAC.Stan.ExprFuncs, + FireDAC.Phys.SQLiteDef, FireDAC.Phys.SQLite; type @@ -153,7 +158,8 @@ begin fImplBuff.WriteString(' inherited Create;' + sLineBreak); for F := low(lFieldsName) to high(lFieldsName) do begin - fImplBuff.WriteString(' ' + lFieldsName[F] + ' := ' + lTypesName[F] + '.Create;' + sLineBreak); + fImplBuff.WriteString(' ' + lFieldsName[F] + ' := ' + lTypesName[F] + '.Create;' + + sLineBreak); end; fImplBuff.WriteString('end;' + sLineBreak + sLineBreak); @@ -237,46 +243,81 @@ begin end; procedure TMainForm.EmitField(F: TField); +var + lAttrib, lField: String; begin - fIntfBuff.WriteString(Format(' [MVCTableField(''%s'')]', [F.FieldName]) + sLineBreak + ' ' + GetFieldName(F.FieldName) + ': ' + - GetDelphiType(F.DataType) + ';' + sLineBreak); + lAttrib := Format(' [MVCTableField(''%s'')]', [F.FieldName]); + lField := GetFieldName(F.FieldName) + ': ' + GetDelphiType(F.DataType) + ';' + sLineBreak; + + if GetDelphiType(F.DataType).ToUpper.Contains('UNSUPPORTED TYPE') then + begin + lAttrib := ' //' + lAttrib; + lField := ' //' + lField; + end + else + begin + lField := ' ' + lField; + lAttrib := ' ' + lAttrib; + end; + fIntfBuff.WriteString(lAttrib + sLineBreak + lField); end; procedure TMainForm.EmitHeaderComments; begin - fIntfBuff.WriteString('// *************************************************************************** }' + sLineBreak); + fIntfBuff.WriteString + ('// *************************************************************************** }' + + sLineBreak); fIntfBuff.WriteString('//' + sLineBreak); fIntfBuff.WriteString('// Delphi MVC Framework' + sLineBreak); fIntfBuff.WriteString('//' + sLineBreak); - fIntfBuff.WriteString('// Copyright (c) 2010-2019 Daniele Teti and the DMVCFramework Team' + sLineBreak); + fIntfBuff.WriteString('// Copyright (c) 2010-2019 Daniele Teti and the DMVCFramework Team' + + sLineBreak); fIntfBuff.WriteString('//' + sLineBreak); fIntfBuff.WriteString('// https://github.com/danieleteti/delphimvcframework' + sLineBreak); fIntfBuff.WriteString('//' + sLineBreak); - fIntfBuff.WriteString('// ***************************************************************************' + sLineBreak); + fIntfBuff.WriteString + ('// ***************************************************************************' + sLineBreak); fIntfBuff.WriteString('//' + sLineBreak); - fIntfBuff.WriteString('// Licensed under the Apache License, Version 2.0 (the "License");' + sLineBreak); - fIntfBuff.WriteString('// you may not use this file except in compliance with the License.' + sLineBreak); + fIntfBuff.WriteString('// Licensed under the Apache License, Version 2.0 (the "License");' + + sLineBreak); + fIntfBuff.WriteString('// you may not use this file except in compliance with the License.' + + sLineBreak); fIntfBuff.WriteString('// You may obtain a copy of the License at' + sLineBreak); fIntfBuff.WriteString('//' + sLineBreak); fIntfBuff.WriteString('// http://www.apache.org/licenses/LICENSE-2.0' + sLineBreak); fIntfBuff.WriteString('//' + sLineBreak); - fIntfBuff.WriteString('// Unless required by applicable law or agreed to in writing, software' + sLineBreak); - fIntfBuff.WriteString('// distributed under the License is distributed on an "AS IS" BASIS,' + sLineBreak); - fIntfBuff.WriteString('// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.' + sLineBreak); - fIntfBuff.WriteString('// See the License for the specific language governing permissions and' + sLineBreak); + fIntfBuff.WriteString('// Unless required by applicable law or agreed to in writing, software' + + sLineBreak); + fIntfBuff.WriteString('// distributed under the License is distributed on an "AS IS" BASIS,' + + sLineBreak); + fIntfBuff.WriteString + ('// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.' + sLineBreak); + fIntfBuff.WriteString('// See the License for the specific language governing permissions and' + + sLineBreak); fIntfBuff.WriteString('// limitations under the License.' + sLineBreak); fIntfBuff.WriteString('//' + sLineBreak); - fIntfBuff.WriteString('// ***************************************************************************' + sLineBreak); + fIntfBuff.WriteString + ('// ***************************************************************************' + sLineBreak); fIntfBuff.WriteString(sLineBreak); end; procedure TMainForm.EmitProperty(F: TField); +var + lProp: String; begin - // Buff.WriteString(Format(' [TableField(''%s'')]', [F.FieldName]) + sLineBreak + ' property ' + GetProperCase(F.FieldName) + ': ' + - // GetDelphiType(F.DataType) + ';' + sLineBreak); - fIntfBuff.WriteString(' property ' + GetFieldName(F.FieldName).Substring(1) { remove f } + ': ' + GetDelphiType(F.DataType)); - fIntfBuff.WriteString(' read ' + GetFieldName(F.FieldName) + ' write ' + GetFieldName(F.FieldName)); - fIntfBuff.WriteString(';' + sLineBreak); + lProp := 'property ' + GetFieldName(F.FieldName).Substring(1) { remove f } + ': ' + + GetDelphiType(F.DataType) + + ' read ' + GetFieldName(F.FieldName) + ' write ' + GetFieldName(F.FieldName) + ';' + sLineBreak; + + if GetDelphiType(F.DataType).ToUpper.Contains('UNSUPPORTED TYPE') then + begin + lProp := ' //' + lProp + end + else + begin + lProp := ' ' + lProp; + end; + fIntfBuff.WriteString(lProp) end; procedure TMainForm.EmitUnit; @@ -359,7 +400,7 @@ begin Result := 'Boolean'; ftFloat, ftSingle, ftExtended: Result := 'Double'; - ftCurrency, ftBCD: + ftCurrency, ftBCD, ftFMTBcd: Result := 'Currency'; ftDate: Result := 'TDate';