// *************************************************************************** // // Delphi MVC Framework // // Copyright (c) 2010-2024 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.Serializer.HTML; {$I dmvcframework.inc} {$WARN SYMBOL_DEPRECATED OFF} interface uses System.SysUtils, System.Classes, System.Rtti, System.TypInfo, System.Variants, System.Generics.Collections, Data.SqlTimSt, Data.FmtBcd, Data.DB, MVCFramework.Commons, MVCFramework.Serializer.Intf, MVCFramework.Serializer.Abstract, MVCFramework.DuckTyping, MVCFramework.Serializer.Commons; type TMVCHTMLSerializer = class(TMVCAbstractSerializer, IMVCSerializer) protected procedure RaiseNotImplemented; public procedure AfterConstruction; override; { IMVCSerializer } procedure RegisterTypeSerializer(const ATypeInfo: PTypeInfo; AInstance: IMVCTypeSerializer); function SerializeObject( const AObject: TObject; const AType: TMVCSerializationType = stDefault; const AIgnoredAttributes: TMVCIgnoredList = nil; const ASerializationAction: TMVCSerializationAction = nil ): string; overload; function SerializeObject( const AObject: IInterface; const AType: TMVCSerializationType = stDefault; const AIgnoredAttributes: TMVCIgnoredList = nil; const ASerializationAction: TMVCSerializationAction = nil ): string; overload; function SerializeRecord( const ARecord: Pointer; const ARecordTypeInfo: PTypeInfo; const AType: TMVCSerializationType = stDefault; const AIgnoredAttributes: TMVCIgnoredList = nil; const ASerializationAction: TMVCSerializationAction = nil ): string; overload; function SerializeCollection( const AList: TObject; const AType: TMVCSerializationType = stDefault; const AIgnoredAttributes: TMVCIgnoredList = nil; const ASerializationAction: TMVCSerializationAction = nil ): string; overload; function SerializeCollection( const AList: IInterface; const AType: TMVCSerializationType = stDefault; const AIgnoredAttributes: TMVCIgnoredList = nil; const ASerializationAction: TMVCSerializationAction = nil ): string; overload; function SerializeDataSet( const ADataSet: TDataSet; const AIgnoredFields: TMVCIgnoredList = []; const ANameCase: TMVCNameCase = ncAsIs; const ASerializationAction: TMVCDatasetSerializationAction = nil ): string; function SerializeDataSetRecord( const ADataSet: TDataSet; const AIgnoredFields: TMVCIgnoredList = []; const ANameCase: TMVCNameCase = ncAsIs; const ASerializationAction: TMVCDatasetSerializationAction = nil ): string; procedure DeserializeObject( const ASerializedObject: string; const AObject: TObject; const AType: TMVCSerializationType = stDefault; const AIgnoredAttributes: TMVCIgnoredList = nil; const ARootNode: string = '' ); overload; procedure DeserializeObject( const ASerializedObject: string; const AObject: IInterface; const AType: TMVCSerializationType = stDefault; const AIgnoredAttributes: TMVCIgnoredList = nil ); overload; procedure DeserializeCollection( const ASerializedList: string; const AList: TObject; const AClazz: TClass; const AType: TMVCSerializationType = stDefault; const AIgnoredAttributes: TMVCIgnoredList = nil; const ARootNode: string = '' ); overload; procedure DeserializeCollection( const ASerializedList: string; const AList: IInterface; const AClazz: TClass; const AType: TMVCSerializationType = stDefault; const AIgnoredAttributes: TMVCIgnoredList = nil ); overload; procedure DeserializeDataSet( const ASerializedDataSet: string; const ADataSet: TDataSet; const AIgnoredFields: TMVCIgnoredList = []; const ANameCase: TMVCNameCase = ncAsIs ); procedure DeserializeDataSetRecord( const ASerializedDataSetRecord: string; const ADataSet: TDataSet; const AIgnoredFields: TMVCIgnoredList = []; const ANameCase: TMVCNameCase = ncAsIs ); function SerializeArrayOfRecord( var ATValueContainingAnArray: TValue; const AType: TMVCSerializationType = stDefault; const AIgnoredAttributes: TMVCIgnoredList = nil; const ASerializationAction: TMVCSerializationAction = nil): string; end; implementation uses System.NetEncoding, MVCFramework, MVCFramework.Logger, MVCFramework.DataSet.Utils, MVCFramework.Nullables, System.StrUtils; const HTML_HEADER = '' + '' + '' + '' + '' + 'DMVCFramework' + ''+ '' + '' + '
'; HTML_FOOTER = '
'; function HTMLEntitiesEncode(const Text: string): String; begin Result := TNetEncoding.HTML.Encode(Text); end; { TMVCHTMLSerializer } procedure TMVCHTMLSerializer.AfterConstruction; begin inherited AfterConstruction; end; procedure TMVCHTMLSerializer.DeserializeCollection( const ASerializedList: string; const AList: IInterface; const AClazz: TClass; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList); begin RaiseNotImplemented; end; procedure TMVCHTMLSerializer.DeserializeCollection( const ASerializedList: string; const AList: TObject; const AClazz: TClass; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList; const ARootNode: string); begin RaiseNotImplemented; end; procedure TMVCHTMLSerializer.DeserializeDataSet( const ASerializedDataSet: string; const ADataSet: TDataSet; const AIgnoredFields: TMVCIgnoredList; const ANameCase: TMVCNameCase); begin RaiseNotImplemented; end; procedure TMVCHTMLSerializer.DeserializeDataSetRecord( const ASerializedDataSetRecord: string; const ADataSet: TDataSet; const AIgnoredFields: TMVCIgnoredList; const ANameCase: TMVCNameCase); begin RaiseNotImplemented; end; procedure TMVCHTMLSerializer.DeserializeObject(const ASerializedObject: string; const AObject: TObject; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList; const ARootNode: string); begin RaiseNotImplemented; end; procedure TMVCHTMLSerializer.DeserializeObject(const ASerializedObject: string; const AObject: IInterface; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList); begin RaiseNotImplemented; end; procedure TMVCHTMLSerializer.RaiseNotImplemented; begin raise EMVCException.Create('Not Implemented'); end; procedure TMVCHTMLSerializer.RegisterTypeSerializer(const ATypeInfo: PTypeInfo; AInstance: IMVCTypeSerializer); begin RaiseNotImplemented; end; function TMVCHTMLSerializer.SerializeCollection(const AList: TObject; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList; const ASerializationAction: TMVCSerializationAction): string; begin RaiseNotImplemented; end; function TMVCHTMLSerializer.SerializeArrayOfRecord( var ATValueContainingAnArray: TValue; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList; const ASerializationAction: TMVCSerializationAction): string; begin RaiseNotImplemented; end; function TMVCHTMLSerializer.SerializeCollection(const AList: IInterface; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList; const ASerializationAction: TMVCSerializationAction): string; begin RaiseNotImplemented; end; function TMVCHTMLSerializer.SerializeDataSet(const ADataSet: TDataSet; const AIgnoredFields: TMVCIgnoredList; const ANameCase: TMVCNameCase; const ASerializationAction: TMVCDatasetSerializationAction): string; begin RaiseNotImplemented; end; function TMVCHTMLSerializer.SerializeDataSetRecord(const ADataSet: TDataSet; const AIgnoredFields: TMVCIgnoredList; const ANameCase: TMVCNameCase; const ASerializationAction: TMVCDatasetSerializationAction): string; begin RaiseNotImplemented; end; function TMVCHTMLSerializer.SerializeObject(const AObject: TObject; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList; const ASerializationAction: TMVCSerializationAction): string; function EmitExceptionClass(const ClazzName, Message: string): string; begin Result := Result + '

' + IfThen(not ClazzName.IsEmpty, HTMLEntitiesEncode(ClazzName) + ': ') + Message + '

'; end; function EmitTitle(const HTTPStatusCode: Word): string; begin Result := '

' + HTTPStatusCode.ToString + ' ' + HTTP_STATUS.ReasonStringFor(HTTPStatusCode) + '

'; if Assigned(FConfig) then begin Result := Result + '

' + FConfig[TMVCConfigKey.ServerName] + '

'; end; end; function GetHTMLBody( const HTTPStatusCode: Integer; const Message: String; const DetailedMessage: String; const ClazzName: String; const AppErrorCode: Integer; const ErrorItems: TArray): String; var lErr: String; begin Result := EmitTitle(HTTPStatusCode) + sLineBreak + EmitExceptionClass(ClazzName, Message) + sLineBreak + '

' + HTMLEntitiesEncode(DetailedMessage) + '

' + sLineBreak; Result := Result + '
'; if AppErrorCode <> 0 then begin Result := Result + '

Application Error Code: ' + AppErrorCode.ToString + '

'; end; if Assigned(ErrorItems) and (Length(ErrorItems) > 0) then begin Result := Result + '

Error Items:

'; end; Result := Result + '
'; end; var lBody: string; lMVCException: EMVCException; lException: Exception; lErrResponse: TMVCErrorResponse; begin lBody := ''; if AObject is Exception then begin if AObject is EMVCException then begin lMVCException := EMVCException(AObject); lBody := GetHTMLBody( lMVCException.HTTPStatusCode, lMVCException.Message, lMVCException.DetailedMessage, lMVCException.ClassName, lMVCException.ApplicationErrorCode, lMVCException.ErrorItems); end else begin lException := Exception(AObject); lBody := EmitTitle(500) + sLineBreak + EmitExceptionClass(lException.ClassName, lException.Message) + sLineBreak; end; end; if AObject is TMVCErrorResponse then begin lErrResponse := TMVCErrorResponse(AObject); lBody := GetHTMLBody( lErrResponse.StatusCode, lErrResponse.Message, lErrResponse.DetailedMessage, lErrResponse.ClassName, lErrResponse.AppErrorCode, nil); end; if lBody.IsEmpty then begin RaiseNotImplemented end else begin Result := HTML_HEADER + lBody + HTML_FOOTER; end; end; function TMVCHTMLSerializer.SerializeObject(const AObject: IInterface; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList; const ASerializationAction: TMVCSerializationAction): string; begin RaiseNotImplemented; end; function TMVCHTMLSerializer.SerializeRecord(const ARecord: Pointer; const ARecordTypeInfo: PTypeInfo; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList; const ASerializationAction: TMVCSerializationAction): string; begin raise Exception.Create('Not implemented'); end; end.