delphimvcframework/samples/jsonrpc_with_published_objects/MainClientFormU.pas

unit MainClientFormU;

interface

uses
  Winapi.Windows,
  Winapi.Messages,
  System.SysUtils,
  System.Variants,
  System.Classes,
  Vcl.Graphics,
  Vcl.Controls,
  Vcl.Forms,
  Vcl.Dialogs,
  System.Net.HttpClientComponent,
  Vcl.StdCtrls,
  System.Net.URLClient,
  System.Net.HttpClient,
  Data.DB,
  Vcl.Grids,
  Vcl.DBGrids,
  FireDAC.Stan.Intf,
  FireDAC.Stan.Option,
  FireDAC.Stan.Param,
  FireDAC.Stan.Error,
  FireDAC.DatS,
  FireDAC.Phys.Intf,
  FireDAC.DApt.Intf,
  FireDAC.Comp.DataSet,
  FireDAC.Comp.Client,
  Vcl.ComCtrls,
  Vcl.ExtCtrls,
  MVCFramework.JSONRPC.Client;

type
  TMainForm = class(TForm)
    DataSource1: TDataSource;
    FDMemTable1: TFDMemTable;
    FDMemTable1Code: TIntegerField;
    FDMemTable1Name: TStringField;
    GroupBox1: TGroupBox;
    edtValue1: TEdit;
    edtValue2: TEdit;
    btnSubstract: TButton;
    edtResult: TEdit;
    edtReverseString: TEdit;
    btnReverseString: TButton;
    edtReversedString: TEdit;
    GroupBox2: TGroupBox;
    edtUserName: TEdit;
    btnGetUser: TButton;
    lbPerson: TListBox;
    GroupBox3: TGroupBox;
    edtFilter: TEdit;
    edtGetCustomers: TButton;
    DBGrid1: TDBGrid;
    GroupBox4: TGroupBox;
    edtFirstName: TLabeledEdit;
    edtLastName: TLabeledEdit;
    chkMarried: TCheckBox;
    dtDOB: TDateTimePicker;
    btnSave: TButton;
    dtNextMonday: TDateTimePicker;
    btnAddDay: TButton;
    btnInvalid1: TButton;
    btnInvalid2: TButton;
    btnNotification: TButton;
    btnInvalidMethod: TButton;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    GroupBox5: TGroupBox;
    edtSearchText: TEdit;
    btnSearch: TButton;
    ListBox1: TListBox;
    CheckBox1: TCheckBox;
    btnDates: TButton;
    btnFloatsTests: TButton;
    btnWithJSON: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    btnSubtractWithNamedParams: TButton;
    Edit3: TEdit;
    TabSheet3: TTabSheet;
    btnDoNothing: TButton;
    btnDoNothingError: TButton;
    btnNotExistent: TButton;
    procedure btnSubstractClick(Sender: TObject);
    procedure btnReverseStringClick(Sender: TObject);
    procedure edtGetCustomersClick(Sender: TObject);
    procedure btnGetUserClick(Sender: TObject);
    procedure btnSaveClick(Sender: TObject);
    procedure btnAddDayClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure btnInvalid1Click(Sender: TObject);
    procedure btnInvalid2Click(Sender: TObject);
    procedure btnNotificationClick(Sender: TObject);
    procedure btnInvalidMethodClick(Sender: TObject);
    procedure btnSearchClick(Sender: TObject);
    procedure btnDatesClick(Sender: TObject);
    procedure btnFloatsTestsClick(Sender: TObject);
    procedure btnWithJSONClick(Sender: TObject);
    procedure btnSubtractWithNamedParamsClick(Sender: TObject);
    procedure btnDoNothingClick(Sender: TObject);
    procedure btnNotExistentClick(Sender: TObject);
    procedure btnDoNothingErrorClick(Sender: TObject);
  private
    FExecutor: IMVCJSONRPCExecutor;
    FExecutor2: IMVCJSONRPCExecutor;
    FExecutor3: IMVCJSONRPCExecutor;
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

uses
  MVCFramework.JSONRPC,
  MVCFramework.Serializer.JsonDataObjects,
  JsonDataObjects,
  MVCFramework.Serializer.Commons,
  MVCFramework.DataSet.Utils,
  BusinessObjectsU,
  System.Math,
  System.Rtti;

{$R *.dfm}


procedure TMainForm.btnAddDayClick(Sender: TObject);
var
  lReq: IJSONRPCRequest;
  lResp: IJSONRPCResponse;
begin
  lReq := TJSONRPCRequest.Create;
  lReq.Method := 'getnextmonday';
  lReq.RequestID := Random(1000);
  lReq.Params.Add(dtNextMonday.Date);
  lResp := FExecutor.ExecuteRequest(lReq);
  dtNextMonday.Date := ISOTimeStampToDateTime(lResp.Result.AsString);
end;

procedure TMainForm.btnDatesClick(Sender: TObject);
var
  lReq: IJSONRPCRequest;
  lResp: IJSONRPCResponse;
begin
  lReq := TJSONRPCRequest.Create(1234, 'playwithdatesandtimes');
  lReq.Params.Add(1234.5678, pdtFloat);
  lReq.Params.Add(Time(), pdtTime);
  lReq.Params.Add(Date(), pdtDate);
  lReq.Params.Add(Now(), pdtDateTime);
  lResp := FExecutor.ExecuteRequest(lReq);
  ShowMessage('Using Positional Parameters: ' +
    DateTimeToStr(ISOTimeStampToDateTime(lResp.Result.AsString)));

  // (const aJustAFloat: Double; const aTime: TTime; const aDate: TDate; const aDateAndTime: TDateTime)
  lReq := TJSONRPCRequest.Create(1234, 'playwithdatesandtimes');
  lReq.Params.AddByName('aJustAFloat', 1234.5678, pdtFloat);
  lReq.Params.AddByName('ATIME', Time(), pdtTime);
  lReq.Params.AddByName('adate', Date(), pdtDate);
  lReq.Params.AddByName('adateAndTime', Now(), pdtDateTime);
  lResp := FExecutor.ExecuteRequest(lReq);
  ShowMessage('Using Named Parameters: ' +
    DateTimeToStr(ISOTimeStampToDateTime(lResp.Result.AsString)));

end;

procedure TMainForm.btnDoNothingClick(Sender: TObject);
var
  lReq: IJSONRPCNotification;
begin
  lReq := TJSONRPCNotification.Create('DoSomething');
  FExecutor3.ExecuteNotification(lReq);
end;

procedure TMainForm.btnDoNothingErrorClick(Sender: TObject);
var
  lReq: IJSONRPCNotification;
begin
  lReq := TJSONRPCNotification.Create('DoSomethingWithError');
  FExecutor3.ExecuteNotification(lReq);
end;

procedure TMainForm.btnFloatsTestsClick(Sender: TObject);
var
  lReq: IJSONRPCRequest;
  lResp: IJSONRPCResponse;
  lRes: Extended;
begin
  lReq := TJSONRPCRequest.Create(1234, 'floatstest');
  lReq.Params.Add(1234.5678, pdtFloat);
  lReq.Params.Add(2345.6789, pdtFloat);
  lResp := FExecutor.ExecuteRequest(lReq);
  lRes := lResp.Result.AsType<Extended>;
  lRes := RoundTo(lRes, -4);
  Assert(SameValue(lRes, 3580.2467), 'Wrong result: ' + FloatToStrF(lRes, ffGeneral, 18, 9));

  lReq := TJSONRPCRequest.Create(1234, 'floatstest');
  lReq.Params.Add(123);
  lReq.Params.Add(234);
  lResp := FExecutor.ExecuteRequest(lReq);
  lRes := lResp.Result.AsType<Extended>;
  lRes := RoundTo(lRes, -4);
  Assert(SameValue(lRes, 357), 'Wrong result: ' + FloatToStrF(lRes, ffGeneral, 18, 9));
end;

procedure TMainForm.btnGetUserClick(Sender: TObject);
var
  lReq: IJSONRPCRequest;
  lResp: IJSONRPCResponse;
  lJSON: TJsonObject;
begin
  lbPerson.Clear;
  lReq := TJSONRPCRequest.Create;
  lReq.Method := 'getuser';
  lReq.RequestID := Random(1000);
  lReq.Params.Add(edtUserName.Text);
  lResp := FExecutor.ExecuteRequest(lReq);
  if Assigned(lResp.Error) then
    raise Exception.Create(lResp.Error.ErrMessage);

  // Remember that TObject descendants (but TDataset, TJDOJSONObject and TJDOJSONArray)
  // are serialized as JSON objects
  lJSON := lResp.Result.AsObject as TJsonObject;
  lbPerson.Items.Add('First Name:'.PadRight(15) + lJSON.S['firstname']);
  lbPerson.Items.Add('Last Name:'.PadRight(15) + lJSON.S['lastname']);
  lbPerson.Items.Add('Married:'.PadRight(15) + lJSON.B['married'].ToString(TUseBoolStrs.True));
  lbPerson.Items.Add('DOB:'.PadRight(15) + DateToStr(lJSON.D['dob']));
end;

procedure TMainForm.btnInvalid1Click(Sender: TObject);
var
  lReq: IJSONRPCRequest;
  lResp: IJSONRPCResponse;
begin
  lReq := TJSONRPCRequest.Create;
  lReq.Method := 'invalidmethod1';
  lReq.Params.Add(1);
  lResp := FExecutor.ExecuteRequest(lReq);
  ShowMessage(lResp.Error.ErrMessage);
end;

procedure TMainForm.btnInvalid2Click(Sender: TObject);
var
  lReq: IJSONRPCRequest;
  lResp: IJSONRPCResponse;
begin
  lReq := TJSONRPCRequest.Create;
  lReq.Method := 'invalidmethod2';
  lReq.Params.Add(1);
  lResp := FExecutor.ExecuteRequest(lReq);
  ShowMessage(lResp.Error.ErrMessage);
end;

procedure TMainForm.btnInvalidMethodClick(Sender: TObject);
var
  lNotification: IJSONRPCNotification;
begin
  lNotification := TJSONRPCNotification.Create;
  lNotification.Method := 'notexists';
  FExecutor.ExecuteNotification(lNotification);
end;

procedure TMainForm.btnNotificationClick(Sender: TObject);
var
  lNotification: IJSONRPCNotification;
begin
  lNotification := TJSONRPCNotification.Create;
  lNotification.Method := 'dosomething';
  FExecutor.ExecuteNotification(lNotification);
end;

procedure TMainForm.btnReverseStringClick(Sender: TObject);
var
  lReq: IJSONRPCRequest;
  lResp: IJSONRPCResponse;
begin
  lReq := TJSONRPCRequest.Create;
  lReq.Method := 'reversestring';
  lReq.RequestID := Random(1000);
  lReq.Params.AddByName('aString', edtReverseString.Text);
  lReq.Params.AddByName('aUpperCase', CheckBox1.Checked);
  lResp := FExecutor.ExecuteRequest(lReq);
  edtReversedString.Text := lResp.Result.AsString;
end;

procedure TMainForm.btnSaveClick(Sender: TObject);
var
  lPerson: TPerson;
  lReq: IJSONRPCRequest;
  lResp: IJSONRPCResponse;
begin
  lReq := TJSONRPCRequest.Create;
  lReq.Method := 'saveperson';
  lReq.RequestID := Random(1000);
  lPerson := TPerson.Create;
  lReq.Params.AddByName('Person', lPerson, pdtObject);
  lPerson.FirstName := edtFirstName.Text;
  lPerson.LastName := edtLastName.Text;
  lPerson.Married := chkMarried.Checked;
  lPerson.DOB := dtDOB.Date;
  lResp := FExecutor.ExecuteRequest(lReq);
  ShowMessage('Person saved with ID = ' + lResp.Result.AsInteger.ToString);
end;

procedure TMainForm.btnSearchClick(Sender: TObject);
var
  lReq: IJSONRPCRequest;
  lResp: IJSONRPCResponse;
  lJSON: TJsonArray;
  I: Integer;
  lJObj: TJsonObject;
begin
  ListBox1.Clear;
  lReq := TJSONRPCRequest.Create;
  lReq.Method := 'searchproducts';
  lReq.RequestID := 1234;
  lReq.Params.Add(edtSearchText.Text);
  lResp := FExecutor2.ExecuteRequest(lReq);
  if Assigned(lResp.Error) then
    raise Exception.Create(lResp.Error.ErrMessage);

  // Remember that TObject descendants (but TDataset, TJDOJSONObject and TJDOJSONArray)
  // are serialized as JSON objects
  lJSON := lResp.Result.AsObject as TJsonArray;
  for I := 0 to lJSON.Count - 1 do
  begin
    lJObj := lJSON[I].ObjectValue;
    ListBox1.Items.Add(Format('%6s: %-34s <20> %5.2f', [lJObj.S['codice'], lJObj.S['descrizione'],
      lJObj.F['prezzo']]));
  end;
  // lbPerson.Items.Add('First Name:'.PadRight(15) + lJSON.S['firstname']);
  // lbPerson.Items.Add('Last Name:'.PadRight(15) + lJSON.S['lastname']);
  // lbPerson.Items.Add('Married:'.PadRight(15) + lJSON.B['married'].ToString(TUseBoolStrs.True));
  // lbPerson.Items.Add('DOB:'.PadRight(15) + DateToStr(lJSON.D['dob']));
end;

procedure TMainForm.btnSubstractClick(Sender: TObject);
var
  lReq: IJSONRPCRequest;
  lResp: IJSONRPCResponse;
begin
  lReq := TJSONRPCRequest.Create;
  lReq.Method := 'subtract';
  lReq.RequestID := Random(1000);
  lReq.Params.Add(StrToInt(edtValue1.Text));
  lReq.Params.Add(StrToInt(edtValue2.Text));
  lResp := FExecutor.ExecuteRequest(lReq);
  edtResult.Text := lResp.Result.AsInteger.ToString;
end;

procedure TMainForm.btnSubtractWithNamedParamsClick(Sender: TObject);
var
  lReq: IJSONRPCRequest;
  lResp: IJSONRPCResponse;
begin
  lReq := TJSONRPCRequest.Create;
  lReq.Method := 'subtract';
  lReq.RequestID := Random(1000);
  lReq.Params.AddByName('Value1', StrToInt(Edit1.Text));
  lReq.Params.AddByName('Value2', StrToInt(Edit2.Text));
  lResp := FExecutor.ExecuteRequest(lReq);
  Edit3.Text := lResp.Result.AsInteger.ToString;
end;

procedure TMainForm.btnWithJSONClick(Sender: TObject);
var
  lPerson: TJsonObject;
  lReq: IJSONRPCRequest;
  lResp: IJSONRPCResponse;
begin
  lReq := TJSONRPCRequest.Create;
  lReq.Method := 'SaveObjectWithJSON';
  lReq.RequestID := 1234;
  lPerson := TJsonObject.Create;
  lReq.Params.Add(lPerson, pdTJDOJsonObject);
  lPerson.S['StringProp'] := 'Hello World';
  lPerson.O['JSONObject'] := TJsonObject.Parse('{"name":"Daniele"}') as TJsonObject;
  lResp := FExecutor.ExecuteRequest(lReq);

  lPerson := lResp.Result.AsObject as TJsonObject;
  ShowMessage(lPerson.ToJSON(False));
end;

procedure TMainForm.btnNotExistentClick(Sender: TObject);
var
  lReq: IJSONRPCNotification;
begin
  lReq := TJSONRPCNotification.Create('blablabla');
  FExecutor3.ExecuteNotification(lReq);
end;

procedure TMainForm.edtGetCustomersClick(Sender: TObject);
var
  lReq: IJSONRPCRequest;
  lResp: IJSONRPCResponse;
begin
  FDMemTable1.Active := False;
  lReq := TJSONRPCRequest.Create(Random(1000), 'getcustomers');
  lReq.Params.AddByName('FilterString', edtFilter.Text);
  lResp := FExecutor.ExecuteRequest(lReq);
  FDMemTable1.Active := True;
  FDMemTable1.LoadFromTValue(lResp.Result);
  FDMemTable1.First;
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
  FExecutor := TMVCJSONRPCExecutor.Create('http://localhost:8080/jsonrpc');
  FExecutor2 := TMVCJSONRPCExecutor.Create('http://localhost:8080/rpcdatamodule');
  FExecutor3 := TMVCJSONRPCExecutor.Create('http://localhost:8080/jsonrpchooks');

  dtNextMonday.Date := Date;

  // these are the methods to handle http headers in JSONRPC
  // the following line and the check on the server is just for demo
  Assert(FExecutor.HTTPHeadersCount = 0);
  FExecutor.AddHTTPHeader(TNetHeader.Create('x-token', TGUID.NewGuid.ToString));
  Assert(FExecutor.HTTPHeadersCount = 1);
  FExecutor.ClearHTTPHeaders;
  Assert(FExecutor.HTTPHeadersCount = 0);
  FExecutor.AddHTTPHeader(TNetHeader.Create('x-token', TGUID.NewGuid.ToString));
end;

end.