// *************************************************************************** // // Delphi MVC Framework // // Copyright (c) 2010-2023 Daniele Teti and the DMVCFramework Team // // https://github.com/danieleteti/delphimvcframework // // Collaborators with this file: Ezequiel Juliano Müller (ezequieljuliano@gmail.com) // // *************************************************************************** // // 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 RenderSampleControllerU; interface uses MVCFramework, MVCFramework.Commons, MVCFramework.Serializer.Intf, System.Rtti, BusinessObjectsU; type [MVCPath('/')] TRenderSampleController = class(TMVCController) protected procedure OnBeforeAction(AContext: TWebContext; const AActionName: string; var AHandled: Boolean); override; public [MVCHTTPMethod([httpGET])] [MVCPath('/customers/simple')] procedure GetCustomers_AsDataSet; [MVCHTTPMethod([httpGET])] [MVCPath('/people')] [MVCProduces('application/json')] procedure GetPeople_AsObjectList; [MVCHTTPMethod([httpGET])] [MVCPath('/customers')] procedure GetCustomersAsDataSetWithRefLinks; [MVCHTTPMethod([httpGET])] [MVCPath('/customers/withcallback')] procedure GetCustomersWithCallback; [MVCHTTPMethod([httpGET])] [MVCPath('/customers/($ID)')] [MVCProduces('text/plain')] procedure GetPerson_AsText(const ID: Integer); [MVCHTTPMethod([httpGET])] [MVCPath('/dateandtimes/showcase')] procedure GetDateAndTimeShowcase; [MVCHTTPMethod([httpGET])] [MVCPath('/customers2')] procedure GetCustomersWithObjectDictionary; [MVCHTTPMethod([httpGET])] [MVCPath('/customers/($ID)/asdataset')] procedure GetCustomer_AsDataSetRecord(const ID: Integer); [MVCHTTPMethod([httpGET])] [MVCPath('/customers/metadata/all')] [MVCProduces('application/json')] procedure GetDataSetWithMetadata; [MVCHTTPMethod([httpGET])] [MVCPath('/customers2/($ID)')] [MVCProduces('application/json')] procedure GetCustomerByID_AsTObject(const ID: Integer); [MVCHTTPMethod([httpGET])] [MVCPath('/multi')] [MVCProduces('application/json')] procedure GetCustomersAndCountry_AsDataSet; [MVCHTTPMethod([httpGET])] [MVCPath('/people/alias')] [MVCProduces('application/json')] procedure GetPeople_AsObjectList_With_Alias; [MVCHTTPMethod([httpGET])] [MVCPath('/objectdict/nil')] [MVCProduces('application/json')] procedure GetNil; [MVCHTTPMethod([httpGET])] [MVCPath('/interfacedpeople')] [MVCProduces('application/json')] procedure GetInterfacedPeople; [MVCHTTPMethod([httpGET])] [MVCPath('/people/hateoas')] [MVCProduces('application/json')] procedure GetPeople_AsObjectList_HATEOAS; [MVCHTTPMethod([httpGET])] [MVCPath('/people/withtiming')] [MVCProduces('application/json')] procedure GetPeopleWithTiming; [MVCHTTPMethod([httpGET])] [MVCPath('/people/($ID)')] [MVCProduces('application/json')] procedure GetPersonById(const ID: Integer); [MVCHTTPMethod([httpGET])] [MVCPath('/lotofobjects')] procedure GetLotOfPeople; // this action is polymorphic [MVCHTTPMethod([httpGET])] [MVCPath('/skilledpeople')] [MVCProduces('application/json')] procedure GetProgrammersAndPhilosophersAsObjectList; [MVCHTTPMethod([httpGET])] [MVCPath('/customers/view/($ID).html')] [MVCProduces('text/html', 'UTF-8')] procedure GetPerson_AsHTMLView; [MVCHTTPMethod([httpGET])] [MVCPath('/customers/($ID).html')] [MVCProduces('text/html')] procedure GetPerson_AsHTML; [MVCHTTPMethod([httpGET])] [MVCPath('/customers.csv')] procedure GetPeopleAsCSV; [MVCHTTPMethod([httpGET])] [MVCPath('/customers/unicode/($ID).html')] [MVCProduces('text/html', 'UTF-8')] procedure GetUnicodeText_AsHTML; [MVCHTTPMethod([httpGET])] [MVCPath('/files/customers.json')] [MVCProduces('application/json')] procedure GetPersonJSON; [MVCHTTPMethod([httpGET])] [MVCPath('/files/customers.png')] [MVCProduces('image/png')] procedure GetPersonPhoto; [MVCHTTPMethod([httpGET])] [MVCPath('/images/customers/($ID)')] procedure GetPersonPhotoAsStream; [MVCHTTPMethod([httpPOST])] [MVCConsumes(TMVCMediaType.MULTIPART_FORM_DATA)] [MVCPath('/files')] procedure UploadBinaryData; [MVCHTTPMethod([httpPOST])] [MVCPath('/people/mvcfrombody')] procedure CreatePerson( const [MVCFromBody] Person: TPerson ); [MVCHTTPMethod([httpPOST])] [MVCPath('/people/mvcfromquerystring')] procedure CreatePersonEx( const [MVCFromBody] Person: TPerson; const [MVCFromQueryString('par1')] Par1: Boolean ); [MVCHTTPMethod([httpPOST])] [MVCPath('/people/mvcfromheader')] procedure CreatePersonEx2( const [MVCFromBody] Person: TPerson; const [MVCFromQueryString('par1')] Par1: Boolean; const [MVCFromHeader('X-MY-HEADER')] XMyHeader: TDateTime ); [MVCHTTPMethod([httpGET])] [MVCPath('/files/($filename)')] procedure GetBinaryData(const filename: string); [MVCHTTPMethod([httpGET])] [MVCPath('/exception')] procedure RaiseException; [MVCHTTPMethod([httpGET])] [MVCPath('/exception/ashtml')] procedure RaiseExceptionHTML; [MVCHTTPMethod([httpGET])] [MVCPath('/customserializationtype')] procedure GetCustomSerializationType; [MVCHTTPMethod([httpGET])] [MVCPath('/simplearray')] procedure GetSimpleArrays; [MVCHTTPMethod([httpGET])] [MVCPath('/simplelists')] procedure GetSimpleLists; [MVCHTTPMethod([httpGET])] [MVCPath('/objectwithjson')] procedure GetObjectWithJSONProperty; // Nullables [MVCHTTPMethod([httpGET])] [MVCPath('/nullables/single')] procedure GetOneNullableObject; // Nullables [MVCHTTPMethod([httpGET])] [MVCPath('/nullables/many')] procedure GetManyNullableObjects; // Arrays [MVCHTTPMethod([httpGET])] [MVCPath('/arrays')] procedure GetClassWithArrays; //Records [MVCHTTPMethod([httpGET])] [MVCPath('/record')] procedure GetSingleRecord; // Enums [MVCHTTPMethod([httpGET])] [MVCPath('/enums')] procedure GetClassWithEnums; [MVCHTTPMethod([httpPOST])] [MVCPath('/enums')] procedure EchoClassWithEnums; end; implementation uses Generics.Collections, MVCFramework.DataSet.Utils, MVCFramework.Serializer.Commons, MVCFramework.Serializer.Defaults, MVCFramework.Logger, MyDataModuleU, System.IOUtils, System.Classes, System.SysUtils, WebModuleU, CustomTypesU, InMemoryDataU, JsonDataObjects, MVCFramework.Serializer.JsonDataObjects, Data.DB, Web.HTTPApp, Graphics, System.Types; procedure DrawLogo(const Logo: TBitmap); var lRect: TRect; lText: string; begin lRect := Rect(0, 0, 300, 200); lText := 'DMVCFramework'; Logo.SetSize(lRect.Width, lRect.Height); Logo.Canvas.Brush.Color := clRed; Logo.Canvas.FillRect(lRect); Logo.Canvas.Font.Size := 24; Logo.Canvas.Font.Name := 'Tahoma'; Logo.Canvas.Font.Color := clWhite; lRect.Inflate(-20, -60); Logo.Canvas.TextRect(lRect, lText, [TTextFormats.tfCenter]); end; { TRoutingSampleController } procedure TRenderSampleController.GetUnicodeText_AsHTML; var s: string; begin s := ''; s := s + '什么是Unicode(统一码)? in Simplified Chinese
'; s := s + 'Što je Unicode? in Croatian
'; s := s + 'Co je Unicode? in Czech'; s := s + ''; Render(s); end; procedure TRenderSampleController.OnBeforeAction(AContext: TWebContext; const AActionName: string; var AHandled: Boolean); begin inherited; end; procedure TRenderSampleController.RaiseException; var a: Integer; begin a := 0; Render(IntToStr(10 div a)); end; procedure TRenderSampleController.RaiseExceptionHTML; var a: Integer; begin ContentType := TMVCMediaType.TEXT_HTML; a := 0; 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(StrDict(['filename', 'ref'], [lOutputFileName, '/files/' + lOutputFileName])); end; procedure TRenderSampleController.CreatePerson(const Person: TPerson); begin Render(Person, False); end; procedure TRenderSampleController.CreatePersonEx(const Person: TPerson; const Par1: Boolean); begin Person.Married := Par1; Render(Person, False); end; procedure TRenderSampleController.CreatePersonEx2(const Person: TPerson; const Par1: Boolean; const XMyHeader: TDateTime); begin Person.Married := Par1; Person.DOB := XMyHeader; Render(Person, False); end; procedure TRenderSampleController.EchoClassWithEnums; var lObj: TClassWithEnums; begin lObj := Context.Request.BodyAs; lObj.RGBSet := [ctBlue, ctGreen, ctRed]; lObj.EnumWithName := ctBlue; Render(lObj, True); 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.GetClassWithArrays; var lClass: TClassWithArrays; begin lClass := TClassWithArrays.Create; lClass.ArrayOfString := ['one', 'two', 'three']; lClass.ArrayOfInt := [1, 2, 3]; lClass.ArrayOfInt64 := [high(Int64), high(Int64) - 1, high(Int64) - 2]; lClass.ArrayOfDouble := [1234.5678, 2345.6789, 3456.78901]; Render(lClass); end; procedure TRenderSampleController.GetClassWithEnums; var lObj: TClassWithEnums; begin lObj := TClassWithEnums.Create; lObj.RGBSet := [ctGreen, ctBlue]; lObj.EnumDefaultSerialization := ctGreen; lObj.EnumWithName := ctGreen; lObj.EnumWithOrdValue := ctGreen; lObj.EnumWithMappedValues := ctGreen; Render(lObj); end; procedure TRenderSampleController.GetCustomerByID_AsTObject(const ID: Integer); var Cust: TCustomer; begin if ID = 7 then // just a sample Render(HTTP_STATUS.NotFound, 'Customer Not Found') else begin Cust := TCustomer.Create; Cust.Name := 'Daniele Teti Inc.'; Cust.ContactFirst := 'Daniele'; Cust.ContactLast := 'Teti'; Cust.AddressLine1 := 'Rome Street 12'; Cust.AddressLine2 := '00100'; Cust.City := 'ROME'; DrawLogo(Cust.Logo); Render(Cust); end; end; procedure TRenderSampleController.GetCustomersAndCountry_AsDataSet; var lDM: TMyDataModule; lJObj: TJSONObject; lSer: TMVCJsonDataObjectsSerializer; begin lDM := TMyDataModule.Create(nil); try lDM.qryCustomers.Open; lDM.qryCountry.Open; lJObj := TJSONObject.Create; try // We need a non standard representation, let's create a specific serializer. lSer := TMVCJsonDataObjectsSerializer.Create; try lSer.DataSetToJsonArray(lDM.qryCustomers, lJObj.a['customers'], TMVCNameCase.ncLowerCase, []); lSer.DataSetToJsonArray(lDM.qryCountry, lJObj.a['countries'], TMVCNameCase.ncLowerCase, []); lJObj.O['info'].s['timestamp'] := DateTimeToISOTimeStamp(Now); finally lSer.Free; end; Render(lJObj); except // avoid memory leaks in case of exceptions lJObj.Free; raise; end; finally lDM.Free; end; end; procedure TRenderSampleController.GetCustomers_AsDataSet; var lDM: TMyDataModule; begin lDM := TMyDataModule.Create(nil); try lDM.qryCustomers.Open; Render(lDM.qryCustomers, False); finally lDM.Free; end; end; procedure TRenderSampleController.GetCustomersAsDataSetWithRefLinks; var lDM: TMyDataModule; begin lDM := TMyDataModule.Create(nil); try lDM.qryCustomers.Open; Render(lDM.qryCustomers, False, procedure(const DS: TDataset; const Links: IMVCLinks) begin Links .AddRefLink .Add(HATEOAS.HREF, '/customers/' + DS.FieldByName('cust_no').AsString) .Add(HATEOAS.REL, 'self') .Add(HATEOAS._TYPE, 'application/json'); Links .AddRefLink .Add(HATEOAS.HREF, '/customers/' + DS.FieldByName('cust_no').AsString + '/orders') .Add(HATEOAS.REL, 'orders') .Add(HATEOAS._TYPE, 'application/json'); end); finally lDM.Free; end; end; procedure TRenderSampleController.GetCustomersWithCallback; var lDM: TMyDataModule; lSer: TMVCJsonDataObjectsSerializer; lJArray: TJsonArray; lJObj: TJSONObject; begin lDM := TMyDataModule.Create(nil); try lDM.qryCustomers.Open('SELECT * FROM CUSTOMER ORDER BY CUST_NO'); lSer := TMVCJsonDataObjectsSerializer.Create; try lJObj := TJSONObject.Create; lJArray := lJObj.a['customers']; lSer.DataSetToJsonArray(lDM.qryCustomers, lJArray, TMVCNameCase.ncLowerCase, [], procedure(const aField: TField; const aJsonObject: TJSONObject; var Handled: Boolean) var lTmp: string; lPieces: TArray; begin // ignore one attribute if SameText(aField.FieldName, 'contact_last') then begin Handled := True; end; // change the attribute value if SameText(aField.FieldName, 'on_hold') then begin aJsonObject.B['on_hold'] := not aField.IsNull; Handled := True; end; // change the attribute type! if SameText(aField.FieldName, 'phone_no') then begin lTmp := aField.AsString.Replace('(', '').Replace(')', '').Replace('-', ' ') .Replace(' ', ' ', [rfReplaceAll]).Trim; if lTmp.IsEmpty then begin Handled := True; Exit; end; lPieces := lTmp.Split([' ']); aJsonObject.O['phone'].s['intl_prefix'] := lPieces[0]; Delete(lPieces, 0, 1); aJsonObject.O['phone'].s['number'] := string.Join('-', lPieces); Handled := True; end; // add an attribute if SameText(aField.FieldName, 'country') then begin aJsonObject.B['is_usa_customer'] := SameText(aField.AsString, 'usa'); end; // merge 2 or more attributes if SameText(aField.FieldName, 'contact_first') then begin aJsonObject.s['contact_full_name'] := aField.DataSet.FieldByName('contact_first') .AsString + ', ' + aField.DataSet.FieldByName('contact_last').AsString; Handled := True; end; end); finally lSer.Free; end; Render(lJObj); finally lDM.Free; end; end; procedure TRenderSampleController.GetCustomersWithObjectDictionary; var lDM: TMyDataModule; lDict: IMVCObjectDictionary; begin lDM := TMyDataModule.Create(nil); try lDM.qryCustomers.Open; lDict := ObjectDict(False { data are not freed after ObjectDict if freed } ) .Add('customers', lDM.qryCustomers, procedure(const DS: TDataset; const Links: IMVCLinks) begin Links.AddRefLink.Add(HATEOAS.HREF, '/customers/' + DS.FieldByName('cust_no').AsString) .Add(HATEOAS.REL, 'self').Add(HATEOAS._TYPE, 'application/json'); Links.AddRefLink.Add(HATEOAS.HREF, '/customers/' + DS.FieldByName('cust_no').AsString + '/orders').Add(HATEOAS.REL, 'orders').Add(HATEOAS._TYPE, 'application/json'); end) .Add('singleCustomer', lDM.qryCustomers, procedure(const DS: TDataset; const Links: IMVCLinks) begin Links.AddRefLink.Add(HATEOAS.HREF, '/customers/' + DS.FieldByName('cust_no').AsString) .Add(HATEOAS.REL, 'self').Add(HATEOAS._TYPE, 'application/json'); Links.AddRefLink.Add(HATEOAS.HREF, '/customers/' + DS.FieldByName('cust_no').AsString + '/orders').Add(HATEOAS.REL, 'orders').Add(HATEOAS._TYPE, 'application/json'); end, dstSingleRecord, ncPascalCase); Render(lDict); finally lDM.Free; end; end; procedure TRenderSampleController.GetCustomer_AsDataSetRecord(const ID: Integer); var lDM: TMyDataModule; begin lDM := TMyDataModule.Create(nil); try lDM.qryCustomers.Open('SELECT * FROM CUSTOMER WHERE CUST_NO = ?', [ID]); Render(lDM.qryCustomers, False, [], dstSingleRecord, procedure(const DS: TDataset; const Links: IMVCLinks) begin Links.AddRefLink.Add(HATEOAS.HREF, '/customers').Add(HATEOAS.REL, 'customers') .Add(HATEOAS._TYPE, TMVCMediaType.APPLICATION_JSON); Links.AddRefLink.Add(HATEOAS.HREF, '/customers/' + DS.FieldByName('cust_no').AsString) .Add(HATEOAS.REL, 'self').Add(HATEOAS._TYPE, TMVCMediaType.APPLICATION_JSON); end); finally lDM.Free; end; end; procedure TRenderSampleController.GetCustomSerializationType; begin // TSysUser contains a type with a custom serializer Render(TSysUser.Create('daniele', ['poweruser', 'role1', 'role2']), True); end; procedure TRenderSampleController.GetDataSetWithMetadata; var lDM: TMyDataModule; lDict: IMVCObjectDictionary; begin lDM := TMyDataModule.Create(nil); try lDM.qryCustomers.Open; lDict := ObjectDict(False) .Add('ncUpperCaseList', lDM.qryCustomers, nil, dstAllRecords, ncUpperCase) .Add('ncLowerCaseList', lDM.qryCustomers, nil, dstAllRecords, ncLowerCase) .Add('ncCamelCaseList', lDM.qryCustomers, nil, dstAllRecords, ncCamelCase) .Add('ncPascalCaseList', lDM.qryCustomers, nil, dstAllRecords, ncPascalCase) .Add('ncUpperCaseSingle', lDM.qryCustomers, nil, dstSingleRecord, ncUpperCase) .Add('ncLowerCaseSingle', lDM.qryCustomers, nil, dstSingleRecord, ncLowerCase) .Add('ncCamelCaseSingle', lDM.qryCustomers, nil, dstSingleRecord, ncCamelCase) .Add('ncPascalCaseSingle', lDM.qryCustomers, nil, dstSingleRecord, ncPascalCase) .Add('meta', StrDict(['page', 'count'], ['1', lDM.qryCustomers.RecordCount.ToString])); Render(lDict); finally lDM.Free; end; end; procedure TRenderSampleController.GetDateAndTimeShowcase; begin Render(GetDataSet); end; procedure TRenderSampleController.GetInterfacedPeople; begin Render(ToMVCList(GetInterfacedPeopleList, True)); end; procedure TRenderSampleController.GetLotOfPeople; begin { classic approach } // Render(GetPeopleList, False); { new approach with ObjectDict } Render(ObjectDict(False).Add('data', GetPeopleList)); end; procedure TRenderSampleController.GetManyNullableObjects; var lList: TObjectList; I: Integer; begin lList := TObjectList.Create(True); for I := 1 to 10 do begin lList.Add(TNullablesTest.Create); lList.Last.LoadSomeData; end; Render(lList); end; procedure TRenderSampleController.GetNil; begin Render(ObjectDict().Add('data', nil)); end; procedure TRenderSampleController.GetObjectWithJSONProperty; var lObj: TObjectWithJSONObject; begin lObj := TObjectWithJSONObject.Create; lObj.StringProp := 'Daniele Teti'; lObj.JSONObject.s['stringprop'] := 'String Prop'; lObj.JSONObject.O['innerobj'].s['innerstringprop'] := 'Inner String Prop'; Render(lObj); end; procedure TRenderSampleController.GetOneNullableObject; begin Render(TNullablesTest.Create); end; procedure TRenderSampleController.GetPerson_AsHTML; begin ResponseStream.Append('
    ').Append('
  • FirstName: Daniele
  • ') .Append('
  • LastName: Teti').AppendFormat('
  • DOB: %s
  • ', [DateToISODate(EncodeDate(1975, 5, 2))]).Append('
  • Married: yes
  • ') .Append('
'); RenderResponseStream; end; procedure TRenderSampleController.GetPerson_AsHTMLView; var Cust: TCustomer; begin Cust := TCustomer.Create; Cust.Name := 'Daniele Teti Inc.'; Cust.ContactFirst := 'Daniele'; Cust.ContactLast := 'Teti'; Cust.AddressLine1 := 'Rome Street 12'; Cust.AddressLine2 := '00100'; Cust.City := 'ROME'; ViewData['customer'] := Cust; LoadView(['header', 'customer', 'footer']); RenderResponseStream; { If you need more flexibility, you can use GetRenderedView to compose your output using small views. Here's an example: ContentType := TMVCMediaType.TEXT_HTML; Render(GetRenderedView(['header', 'customer','footer'])); } end; procedure TRenderSampleController.GetPerson_AsText(const ID: Integer); begin ResponseStream .AppendLine('ID : ' + ID.ToString) .AppendLine('FirstName : Daniele') .AppendLine('LastName : Teti') .AppendLine('DOB : ' + DateToStr(EncodeDate(1979, 5, 2))) .AppendLine('Married : yes'); RenderResponseStream; end; procedure TRenderSampleController.GetProgrammersAndPhilosophersAsObjectList; var List: TObjectList; p: TProgrammer; ph: TPhilosopher; begin List := TObjectList.Create(True); p := TProgrammer.Create; p.Married := True; p.FirstName := 'Peter'; p.LastName := 'Parker'; p.Skills := 'Delphi, JavaScript, Python, C++'; List.Add(p); ph := TPhilosopher.Create; p.Married := False; ph.FirstName := 'Bruce'; ph.LastName := 'Banner'; ph.Mentors := 'Abbagnano, Algarotti, Cavalieri, Pareyson'; List.Add(ph); p := TProgrammer.Create; p.Married := False; p.FirstName := 'Sue'; p.LastName := 'Storm'; p.Skills := 'Delphi, JavaScript'; List.Add(p); Render(List); end; procedure TRenderSampleController.GetSimpleArrays; begin Render(TArrayTest.Create); end; procedure TRenderSampleController.GetSimpleLists; begin Render(TSimpleListTest.Create); end; procedure TRenderSampleController.GetSingleRecord; var lSR: TSimpleRecord; begin lSR := TSimpleRecord.Create; Render(200, lSR); end; procedure TRenderSampleController.GetPeopleAsCSV; begin ResponseStream.AppendLine('first_name;last_name;age'); ResponseStream.AppendLine('Daniele;Teti;38'); ResponseStream.AppendLine('Peter;Parker;22'); ResponseStream.AppendLine('Bruce;Banner;60'); ContentType := TMVCMediaType.TEXT_CSV; RenderResponseStream; end; procedure TRenderSampleController.GetPeopleWithTiming; var p: TPerson; People: TPeopleWithMetadata; begin People := TPeopleWithMetadata.Create; try People.Metadata.StartProcessing := Now; {$REGION 'Fake data'} Sleep(1000); // processing... p := TPerson.Create; p.FirstName := 'Daniele'; p.LastName := 'Teti'; p.DOB := EncodeDate(1979, 11, 4); p.Married := True; People.Items.Add(p); p := TPerson.Create; p.FirstName := 'John'; p.LastName := 'Doe'; p.DOB := EncodeDate(1879, 10, 2); p.Married := False; People.Items.Add(p); p := TPerson.Create; p.FirstName := 'Jane'; p.LastName := 'Doe'; p.DOB := EncodeDate(1883, 1, 5); p.Married := True; People.Items.Add(p); {$ENDREGION} People.Metadata.CustomData := Format('There are %d people in the list', [People.Items.Count]); People.Metadata.StopProcessing := Now; Render(People, False); finally People.Free; end; end; procedure TRenderSampleController.GetPeople_AsObjectList; var People: TObjectList; begin People := TObjectList.Create(True); People.Add(TPerson.GetNew('Daniele','Teti', EncodeDate(1979, 11, 4), True)); People.Add(TPerson.GetNew('John','Doe', EncodeDate(1879, 10, 2), False)); People.Add(TPerson.GetNew('Jane','Doe', EncodeDate(1883, 1, 5), True)); { classic approach } //Render(HTTP_STATUS.OK, People, True); { new approach with ObjectDict } Render(HTTP_STATUS.OK, ObjectDict().Add('data', People)); end; procedure TRenderSampleController.GetPeople_AsObjectList_HATEOAS; var p: TPerson; People: TObjectList; begin People := TObjectList.Create(True); {$REGION 'Fake data'} p := TPerson.Create; p.FirstName := 'Daniele'; p.LastName := 'Teti'; p.DOB := EncodeDate(1979, 11, 4); p.Married := True; People.Add(p); p := TPerson.Create; p.FirstName := 'John'; p.LastName := 'Doe'; p.DOB := EncodeDate(1879, 10, 2); p.Married := False; People.Add(p); p := TPerson.Create; p.FirstName := 'Jane'; p.LastName := 'Doe'; p.DOB := EncodeDate(1883, 1, 5); p.Married := True; People.Add(p); {$ENDREGION} { classic approach } { Render(People, True, procedure(const APerson: TPerson; const Links: IMVCLinks) begin Links .AddRefLink .Add(HATEOAS.HREF, '/people/' + APerson.ID.ToString) .Add(HATEOAS.REL, 'self') .Add(HATEOAS._TYPE, 'application/json') .Add('title', 'Details for ' + APerson.FullName); Links .AddRefLink .Add(HATEOAS.HREF, '/people') .Add(HATEOAS.REL, 'people') .Add(HATEOAS._TYPE, 'application/json'); end); } { new approach with ObjectDict } Render(ObjectDict().Add('data', People, procedure(const APerson: TObject; const Links: IMVCLinks) begin Links.AddRefLink.Add(HATEOAS.HREF, '/people/' + TPerson(APerson).ID.ToString).Add(HATEOAS.REL, 'self').Add(HATEOAS._TYPE, 'application/json').Add('title', 'Details for ' + TPerson(APerson).FullName); Links.AddRefLink.Add(HATEOAS.HREF, '/people').Add(HATEOAS.REL, 'people').Add(HATEOAS._TYPE, 'application/json'); end)); end; procedure TRenderSampleController.GetPeople_AsObjectList_With_Alias; var p: TPerson; People: TPeople; begin People := TPeople.Create(True); {$REGION 'Fake data'} p := TPerson.Create; p.FirstName := 'Daniele'; p.LastName := 'Teti'; p.DOB := EncodeDate(1979, 11, 4); p.Married := True; People.Add(p); p := TPerson.Create; p.FirstName := 'John'; p.LastName := 'Doe'; p.DOB := EncodeDate(1879, 10, 2); p.Married := False; People.Add(p); p := TPerson.Create; p.FirstName := 'Jane'; p.LastName := 'Doe'; p.DOB := EncodeDate(1883, 1, 5); p.Married := True; People.Add(p); People.Add(nil); {$ENDREGION} { classic approach } // Render(People, True); // Render(People, True); // Render(HTTP_STATUS.OK, People, True); { new approach with ObjectDict } Render(HTTP_STATUS.OK, ObjectDict().Add('data', People)); end; procedure TRenderSampleController.GetPersonById(const ID: Integer); var lPerson: TPerson; begin lPerson := TPerson.Create; try lPerson.ID := ID; lPerson.FirstName := 'Daniele'; lPerson.LastName := 'Teti'; lPerson.DOB := EncodeDate(1979, 11, 4); lPerson.Married := True; Render(lPerson, False, procedure(const AObject: TObject; const Links: IMVCLinks) begin Links.AddRefLink.Add(HATEOAS.HREF, '/people/' + TPerson(AObject).ID.ToString) .Add(HATEOAS.REL, 'self').Add(HATEOAS._TYPE, TMVCMediaType.APPLICATION_JSON); Links.AddRefLink.Add(HATEOAS.HREF, '/people').Add(HATEOAS.REL, 'people').Add(HATEOAS._TYPE, TMVCMediaType.APPLICATION_JSON); end); finally lPerson.Free; end; end; procedure TRenderSampleController.GetPersonJSON; var lJSONPerson: TJSONObject; begin lJSONPerson := TJSONObject.Create; lJSONPerson.s['FirstName'] := 'Daniele'; lJSONPerson.s['LastName'] := 'Teti'; lJSONPerson.s['DOB'] := DateToISODate(EncodeDate(1975, 5, 2)); lJSONPerson.B['Married'] := True; Render(lJSONPerson); end; procedure TRenderSampleController.GetPersonPhoto; begin // ContentType := 'image/jpeg'; SendFile('..\..\_\customer.png'); end; procedure TRenderSampleController.GetPersonPhotoAsStream; var LPhoto: TFileStream; begin LPhoto := TFileStream.Create('..\..\_\customer.png', fmOpenRead or fmShareDenyWrite); ContentType := 'image/png'; // you can also use MVCProduces attribute // LPhoto is a plain TStream descendant, so it can be rendered as usual Render(LPhoto, True); end; end.