delphimvcframework/samples/renders/RenderSampleControllerU.pas

800 lines
23 KiB
ObjectPascal
Raw Normal View History

// ***************************************************************************
//
// Delphi MVC Framework
//
2019-01-08 12:48:27 +01:00
// Copyright (c) 2010-2019 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;
2013-11-10 01:03:53 +01:00
interface
uses
MVCFramework,
MVCFramework.Commons,
MVCFramework.Serializer.Intf,
System.Rtti;
2013-11-10 01:03:53 +01:00
type
[MVCPath('/')]
TRenderSampleController = class(TMVCController)
protected
procedure OnBeforeAction(AContext: TWebContext; const AActionName: string; var AHandled: Boolean); override;
2013-11-10 01:03:53 +01:00
public
2016-11-27 23:17:20 +01:00
[MVCHTTPMethod([httpGET])]
2019-05-08 20:20:14 +02:00
[MVCPath('/customers/($ID)')]
2016-11-27 23:17:20 +01:00
[MVCProduces('text/plain')]
2019-05-08 20:20:14 +02:00
procedure GetPerson_AsText(const ID: Integer);
2016-11-27 23:17:20 +01:00
[MVCHTTPMethod([httpGET])]
2019-05-09 20:53:52 +02:00
[MVCPath('/customers/simple')]
procedure GetCustomers_AsDataSet;
2019-03-10 16:29:18 +01:00
[MVCHTTPMethod([httpGET])]
[MVCPath('/customers')]
2019-05-09 20:53:52 +02:00
procedure GetCustomersAsDataSetWithRefLinks;
[MVCHTTPMethod([httpGET])]
[MVCPath('/customers/withcallback')]
procedure GetCustomersWithCallback;
2019-05-09 20:53:52 +02:00
[MVCHTTPMethod([httpGET])]
[MVCPath('/customers/($ID)/asdataset')]
2019-05-09 20:53:52 +02:00
procedure GetCustomer_AsDataSetRecord(const ID: Integer);
2013-11-10 01:03:53 +01:00
[MVCHTTPMethod([httpGET])]
[MVCPath('/customers/($ID)')]
[MVCProduces('application/json')]
procedure GetCustomerByID_AsTObject(const ID: Integer);
[MVCHTTPMethod([httpGET])]
[MVCPath('/customers/metadata')]
[MVCProduces('application/json')]
procedure GetDataSetWithMetadata;
2016-11-27 23:17:20 +01:00
[MVCHTTPMethod([httpGET])]
[MVCPath('/multi')]
[MVCProduces('application/json')]
procedure GetCustomersAndCountry_AsDataSet;
[MVCHTTPMethod([httpGET])]
2014-04-01 00:02:31 +02:00
[MVCPath('/people')]
[MVCProduces('application/json')]
2016-11-27 23:17:20 +01:00
procedure GetPeople_AsObjectList;
2014-04-01 00:02:31 +02:00
[MVCHTTPMethod([httpGET])]
[MVCPath('/interfacedpeople')]
[MVCProduces('application/json')]
procedure GetInterfacedPeople;
[MVCHTTPMethod([httpGET])]
2019-03-10 16:29:18 +01:00
[MVCPath('/people/hateoas')]
[MVCProduces('application/json')]
2019-03-10 16:29:18 +01:00
procedure GetPeople_AsObjectList_HATEOAS;
[MVCHTTPMethod([httpGET])]
[MVCPath('/people/withtiming')]
[MVCProduces('application/json')]
procedure GetPeopleWithTiming;
2019-03-10 16:29:18 +01:00
[MVCHTTPMethod([httpGET])]
2019-05-08 20:20:14 +02:00
[MVCPath('/people/($ID)')]
2019-03-10 16:29:18 +01:00
[MVCProduces('application/json')]
2019-05-08 20:20:14 +02:00
procedure GetPersonById(const ID: Integer);
2019-03-10 16:29:18 +01:00
[MVCHTTPMethod([httpGET])]
[MVCPath('/lotofobjects')]
procedure GetLotOfPeople;
// this action is polymorphic
2016-11-27 23:17:20 +01:00
[MVCHTTPMethod([httpGET])]
2014-05-30 11:29:58 +02:00
[MVCPath('/skilledpeople')]
2015-06-29 14:36:54 +02:00
[MVCProduces('application/json')]
2016-11-27 23:17:20 +01:00
procedure GetProgrammersAndPhilosophersAsObjectList;
2014-05-30 11:29:58 +02:00
2016-11-27 23:17:20 +01:00
[MVCHTTPMethod([httpGET])]
2019-05-08 20:20:14 +02:00
[MVCPath('/customers/view/($ID).html')]
2016-02-26 19:21:57 +01:00
[MVCProduces('text/html', 'UTF-8')]
2016-11-27 23:17:20 +01:00
procedure GetPerson_AsHTMLView;
2016-02-26 19:21:57 +01:00
2016-11-27 23:17:20 +01:00
[MVCHTTPMethod([httpGET])]
2019-05-08 20:20:14 +02:00
[MVCPath('/customers/($ID).html')]
[MVCProduces('text/html')]
procedure GetPerson_AsHTML;
2014-04-01 00:02:31 +02:00
[MVCHTTPMethod([httpGET])]
[MVCPath('/customers.csv')]
procedure GetPeopleAsCSV;
2016-11-27 23:17:20 +01:00
[MVCHTTPMethod([httpGET])]
2019-05-08 20:20:14 +02:00
[MVCPath('/customers/unicode/($ID).html')]
2014-07-04 17:52:17 +02:00
[MVCProduces('text/html', 'UTF-8')]
procedure GetUnicodeText_AsHTML;
2014-07-04 17:52:17 +02:00
2016-11-27 23:17:20 +01:00
[MVCHTTPMethod([httpGET])]
2014-03-06 14:20:57 +01:00
[MVCPath('/files/customers.json')]
2013-11-11 19:32:20 +01:00
[MVCProduces('application/json')]
2016-11-27 23:17:20 +01:00
procedure GetPersonJSON;
2014-04-01 00:02:31 +02:00
2016-11-27 23:17:20 +01:00
[MVCHTTPMethod([httpGET])]
2014-04-01 00:02:31 +02:00
[MVCPath('/files/customers.png')]
[MVCProduces('image/png')]
2016-11-27 23:17:20 +01:00
procedure GetPersonPhoto;
2014-04-01 00:02:31 +02:00
2016-11-27 23:17:20 +01:00
[MVCHTTPMethod([httpGET])]
2019-05-08 20:20:14 +02:00
[MVCPath('/images/customers/($ID)')]
procedure GetPersonPhotoAsStream;
[MVCHTTPMethod([httpPOST])]
[MVCConsumes(TMVCMediaType.MULTIPART_FORM_DATA)]
[MVCPath('/files')]
procedure UploadBinaryData;
[MVCHTTPMethod([httpGET])]
[MVCPath('/files/($filename)')]
procedure GetBinaryData(const filename: string);
2015-06-29 14:36:54 +02:00
2016-11-27 23:17:20 +01:00
[MVCHTTPMethod([httpGET])]
[MVCPath('/exception')]
procedure RaiseException;
[MVCHTTPMethod([httpGET])]
[MVCPath('/customserializationtype')]
procedure GetCustomSerializationType;
2019-11-03 16:16:35 +01:00
[MVCHTTPMethod([httpGET])]
[MVCPath('/simplearray')]
procedure GetSimpleArrays;
[MVCHTTPMethod([httpGET])]
[MVCPath('/objectwithjson')]
procedure GetObjectWithJSONProperty;
2013-11-10 01:03:53 +01:00
end;
implementation
uses
BusinessObjectsU,
2016-02-26 19:21:57 +01:00
Generics.Collections,
MVCFramework.DataSet.Utils,
MVCFramework.Serializer.Commons,
MVCFramework.Serializer.Defaults,
MVCFramework.Logger,
MyDataModuleU,
System.IOUtils,
System.Classes,
System.SysUtils,
WebModuleU,
CustomTypesU,
InMemoryDataU,
JsonDataObjects,
2019-03-10 16:29:18 +01:00
MVCFramework.Serializer.JsonDataObjects,
Data.DB,
Web.HTTPApp,
Graphics,
System.Types;
2013-11-10 01:03:53 +01:00
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;
2013-11-10 01:03:53 +01:00
{ TRoutingSampleController }
procedure TRenderSampleController.GetUnicodeText_AsHTML;
2014-07-04 17:52:17 +02:00
var
s: string;
begin
s := '<html><body>';
s := s + '什么是Unicode(统一码)? in Simplified Chinese <br>';
s := s + 'Što je Unicode? in Croatian <br>';
s := s + 'Co je Unicode? in Czech';
s := s + '</body></html>';
Render(s);
end;
procedure TRenderSampleController.OnBeforeAction(AContext: TWebContext; const AActionName: string;
var AHandled: Boolean);
begin
inherited;
end;
2016-11-27 23:17:20 +01:00
procedure TRenderSampleController.RaiseException;
var
a: Integer;
begin
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;
2019-05-09 20:53:52 +02:00
Render(StrDict(['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;
2019-05-08 20:20:14 +02:00
procedure TRenderSampleController.GetCustomerByID_AsTObject(const ID: Integer);
2013-11-10 01:03:53 +01:00
var
2013-11-11 01:11:09 +01:00
Cust: TCustomer;
2013-11-10 01:03:53 +01:00
begin
2019-05-08 20:20:14 +02:00
if ID = 7 then // just a sample
2016-11-27 23:17:20 +01:00
Render(HTTP_STATUS.NotFound, 'Customer Not Found')
2013-11-11 01:11:09 +01:00
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);
2013-11-11 01:11:09 +01:00
Render(Cust);
end;
2013-11-10 01:03:53 +01:00
end;
2016-11-27 23:17:20 +01:00
procedure TRenderSampleController.GetCustomersAndCountry_AsDataSet;
var
lDM: TMyDataModule;
lJObj: TJSONObject;
lSer: TMVCJsonDataObjectsSerializer;
2016-11-27 23:17:20 +01:00
begin
lDM := TMyDataModule.Create(nil);
try
lDM.qryCustomers.Open;
lDM.qryCountry.Open;
2016-11-27 23:17:20 +01:00
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, []);
finally
lSer.Free;
end;
2016-11-27 23:17:20 +01:00
Render(lJObj);
except // avoid memory leaks in case of exceptions
2016-11-27 23:17:20 +01:00
lJObj.Free;
raise;
end;
finally
lDM.Free;
end;
end;
procedure TRenderSampleController.GetCustomers_AsDataSet;
2013-11-10 01:03:53 +01:00
var
2016-11-27 23:17:20 +01:00
lDM: TMyDataModule;
2013-11-10 01:03:53 +01:00
begin
2016-11-27 23:17:20 +01:00
lDM := TMyDataModule.Create(nil);
try
lDM.qryCustomers.Open;
Render(lDM.qryCustomers, False);
2016-11-27 23:17:20 +01:00
finally
lDM.Free;
end;
2013-11-10 01:03:53 +01:00
end;
2019-05-09 20:53:52 +02:00
procedure TRenderSampleController.GetCustomersAsDataSetWithRefLinks;
2019-03-10 16:29:18 +01:00
var
lDM: TMyDataModule;
begin
lDM := TMyDataModule.Create(nil);
try
lDM.qryCustomers.Open;
Render(lDM.qryCustomers, False,
2019-05-09 20:53:52 +02:00
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');
2019-05-09 20:53:52 +02:00
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<String>;
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.GetCustomer_AsDataSetRecord(const ID: Integer);
2019-05-09 20:53:52 +02:00
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)
2019-03-10 16:29:18 +01:00
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')
2019-05-09 20:53:52 +02:00
.Add(HATEOAS._TYPE, TMVCMediaType.APPLICATION_JSON);
2019-03-10 16:29:18 +01:00
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;
lHolder: TDataSetHolder;
begin
lDM := TMyDataModule.Create(nil);
try
lDM.qryCustomers.Open;
lHolder := TDataSetHolder.Create(lDM.qryCustomers);
lHolder.Metadata.Add('page', '1');
lHolder.Metadata.Add('count', lDM.qryCustomers.RecordCount.ToString);
Render(lHolder);
finally
lDM.Free;
end;
end;
procedure TRenderSampleController.GetInterfacedPeople;
begin
Render(ToMVCList(GetInterfacedPeopleList, True));
end;
procedure TRenderSampleController.GetLotOfPeople;
begin
Render<TPerson>(GetPeopleList, False);
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.GetPerson_AsHTML;
2013-11-11 19:32:20 +01:00
begin
ResponseStream.Append('<html><body><ul>').Append('<li>FirstName: Daniele</li>').Append('<li>LastName: Teti')
.AppendFormat('<li>DOB: %s</li>', [DateToISODate(EncodeDate(1975, 5, 2))]).Append('<li>Married: yes</li>')
2016-11-27 23:17:20 +01:00
.Append('</ul></body></html>');
2016-11-18 14:09:54 +01:00
RenderResponseStream;
2016-02-26 19:21:57 +01:00
end;
2016-11-27 23:17:20 +01:00
procedure TRenderSampleController.GetPerson_AsHTMLView;
2016-02-26 19:21:57 +01:00
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;
2016-02-27 09:58:54 +01:00
LoadView(['header', 'customer', 'footer']);
2016-11-18 14:09:54 +01:00
RenderResponseStream;
2016-02-27 09:58:54 +01:00
{ 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']));
}
2013-11-11 19:32:20 +01:00
end;
2019-05-08 20:20:14 +02:00
procedure TRenderSampleController.GetPerson_AsText(const ID: Integer);
2014-04-01 00:02:31 +02:00
begin
ResponseStream.AppendLine('ID : ' + ID.ToString).AppendLine('FirstName : Daniele')
.AppendLine('LastName : Teti').AppendLine('DOB : ' + DateToStr(EncodeDate(1979, 5, 2)))
2016-11-27 23:17:20 +01:00
.AppendLine('Married : yes');
2016-11-18 14:09:54 +01:00
RenderResponseStream;
2014-04-01 00:02:31 +02:00
end;
procedure TRenderSampleController.GetProgrammersAndPhilosophersAsObjectList;
2014-05-30 11:29:58 +02:00
var
List: TObjectList<TPerson>;
p: TProgrammer;
ph: TPhilosopher;
begin
List := TObjectList<TPerson>.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<TPerson>(List);
end;
2019-11-03 16:16:35 +01:00
procedure TRenderSampleController.GetSimpleArrays;
begin
Render(TArrayTest.Create);
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;
2016-11-27 23:17:20 +01:00
procedure TRenderSampleController.GetPeople_AsObjectList;
2014-04-01 00:02:31 +02:00
var
2014-05-30 11:29:58 +02:00
p: TPerson;
2014-04-01 00:02:31 +02:00
People: TObjectList<TPerson>;
begin
People := TObjectList<TPerson>.Create(True);
{$REGION 'Fake data'}
2014-05-30 11:29:58 +02:00
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}
2014-04-01 00:02:31 +02:00
Render<TPerson>(People);
end;
2019-03-10 16:29:18 +01:00
procedure TRenderSampleController.GetPeople_AsObjectList_HATEOAS;
var
p: TPerson;
People: TObjectList<TPerson>;
begin
People := TObjectList<TPerson>.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}
Render<TPerson>(People, True,
2019-05-09 20:53:52 +02:00
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);
end;
2019-05-08 20:20:14 +02:00
procedure TRenderSampleController.GetPersonById(const ID: Integer);
2019-03-10 16:29:18 +01:00
var
lPerson: TPerson;
begin
lPerson := TPerson.Create;
try
2019-05-08 20:20:14 +02:00
lPerson.ID := ID;
2019-03-10 16:29:18 +01:00
lPerson.FirstName := 'Daniele';
2019-05-08 20:20:14 +02:00
lPerson.LastName := 'Teti';
2019-03-10 16:29:18 +01:00
lPerson.DOB := EncodeDate(1979, 11, 4);
lPerson.Married := True;
Render(lPerson, False,
2019-05-09 20:53:52 +02:00
procedure(const AObject: TObject; const Links: IMVCLinks)
2019-03-10 16:29:18 +01:00
begin
Links.AddRefLink.Add(HATEOAS.HREF, '/people/' + TPerson(AObject).ID.ToString).Add(HATEOAS.REL, 'self')
2019-05-09 20:53:52 +02:00
.Add(HATEOAS._TYPE, TMVCMediaType.APPLICATION_JSON);
Links.AddRefLink.Add(HATEOAS.HREF, '/people').Add(HATEOAS.REL, 'people').Add(HATEOAS._TYPE,
TMVCMediaType.APPLICATION_JSON);
2019-03-10 16:29:18 +01:00
end);
finally
lPerson.Free;
end;
end;
2016-11-27 23:17:20 +01:00
procedure TRenderSampleController.GetPersonJSON;
2013-11-11 19:32:20 +01:00
var
2019-03-10 16:29:18 +01:00
lJSONPerson: TJSONObject;
2013-11-11 19:32:20 +01:00
begin
2019-03-10 16:29:18 +01:00
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);
2013-11-11 19:32:20 +01:00
end;
2016-11-27 23:17:20 +01:00
procedure TRenderSampleController.GetPersonPhoto;
2014-04-01 00:02:31 +02:00
begin
2014-04-01 19:36:05 +02:00
// ContentType := 'image/jpeg';
2016-11-27 23:17:20 +01:00
SendFile('..\..\_\customer.png');
2014-04-01 00:02:31 +02:00
end;
procedure TRenderSampleController.GetPersonPhotoAsStream;
2015-06-29 14:36:54 +02:00
var
LPhoto: TFileStream;
begin
LPhoto := TFileStream.Create('..\..\_\customer.png', fmOpenRead or fmShareDenyWrite);
2015-06-29 14:36:54 +02:00
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;
2013-11-10 01:03:53 +01:00
end.