TRESTRequest [TRESTRequest] Лучшая практика, когда нужно отправить несколько запросов через RESTRequest

[aleksandrguru]

RESTRequest непонятно можно настроить визуально только под один запрос??

 

Нельзя было сделать чтобы параметры привязывались к поля resourse , 

 

resourse1-параметры 

resourse2-параметры

 

и непонятно что делать когда rest не разбирает автоматом JSON визуально как делать тогда

[ruslan]

просто прими за правило делать все "ручками", без всяких там дизайнеров. и будет тебе счастье. поверь )

[aleksandrguru]

Да руками долго, а так за две минуты все сделал , вот только запрос к api всего один , а дальше не понятно как нужно , все равно все руками 

[DirtyBorov]

Да руками долго, а так за две минуты все сделал , вот только запрос к api всего один , а дальше не понятно как нужно , все равно все руками 

У вас какая то надуманная проблема. На самом деле "руками" все делается намного проще чем кажется. При этом код будет минимизировать ошибки, потому что он будет типовой, шаблонный. Вот я приведу кусочек код из одной моей программы:

unit Rest.API;

interface


uses
  CodeSiteLogging,
  System.JSON, REST.JsonReflect, Rest.Classes,
  System.SysUtils, System.Classes, IPPeerClient, REST.Client, REST.Types, Data.Bind.Components, Data.Bind.ObjectScope;


type
  TApiObject = class abstract
  end;


  TApiLogin = class(TApiObject)
  public
    Login: string;
    Password: string;
  end;


  TRestAPI = class(TDataModule)
    RESTClient: TRESTClient;
    RESTRequest: TRESTRequest;
    RESTResponse: TRESTResponse;
  private
     const BaseURL = 'http://bla-bla.com/index.php';
  private
    // Выполняет запрос
    function Request(ABody: TApiObject): TJSONValue;
    function SendLogin(ABody: TApiLogin): TJSONValue;
    function SendRegistry(ABody: TApiUser): TJSONValue;
    function GetUserInfo(ABody: TApiInfo): TJSONValue;
    function SetBalance(ABody: TApiBalance): TJSONValue;
  public
    function SendRequest(AObject: TApiObject; AOwn: Boolean = true): TJSONValue;
  end;


var
  RestAPI: TRestAPI;


implementation


{%CLASSGROUP 'FMX.Controls.TControl'}


{$R *.dfm}


{ TDataHTTP }


/// Основная функция отправки json-объекта. она принимает обычный объект и сериализует его в json
function TRestAPI.Request(ABody: TApiObject): TJSONValue;
var
  i: integer;
begin
  RESTRequest.ClearBody;
  RESTRequest.AddBody(ABody);
  RESTRequest.Execute;


/// проверяем ответ сервера
  if (RESTResponse.StatusCode <> 200) then
    raise Exception.CreateFmt('Оштбка сервера %d "%s"',[RESTResponse.StatusCode, RESTResponse.StatusText]);


/// проверяем, содержит ли ответ json
  if not Assigned(RESTResponse.JSONValue) then
     raise Exception.Create('Ответ сервера не содержит подходящих данных');


/// Проверяем, не содержится ли в ответе ошибок
  Result := RESTResponse.JSONValue.GetValue<TJSONValue>('content');
  if not RESTResponse.JSONValue.GetValue<string>('status').Equals('success') then
     raise Exception.Create(RESTResponse.JSONValue.GetValue<string>('error'));
end;


/// Так делаем отправку на конкретный URL


/// Запрос логина (проверка существования пользователя)
function TRestAPI.SendLogin(ABody: TApiLogin): TJSONValue;
begin
  RESTClient.BaseURL := BaseURL + '?act=users&area=login&response=js';
  Result := Request(ABody);
end;


/// регистрация нового пользователя
function TRestAPI.SendRegistry(ABody: TApiUser): TJSONValue;
begin
  RESTClient.BaseURL := BaseURL + '?act=terminal&area=create&registerType=2&response=js';
  Result := Request(ABody);
end;


/// Информация о пользователе
function TRestAPI.GetUserInfo(ABody: TApiInfo): TJSONValue;
begin
  RESTClient.BaseURL := BaseURL + '?act=terminal&area=info&infoType=2&response=js';
  Result := Request(ABody);
end;


/// Изменить баланс пользователя
function TRestAPI.SetBalance(ABody: TApiBalance): TJSONValue;
begin
  RESTClient.BaseURL := BaseURL + '?act=terminal&area=cash&response=js';
  Result := Request(ABody);
end;


/// Это не обязательная функция, она просто упрощает работу. По сути просто вызывает нужную функцию,
/// в зависимости от переданного объекта. после отправки запроса, удаляет объект из памяти.
function TRestAPI.SendRequest(AObject: TApiObject; AOwn: Boolean): TJSONValue;
begin
  try
    if (AObject is TApiLogin) then
       Result := SendLogin(AObject as TApiLogin)
    else
    if (AObject is TApiUser) then
       Result := SendRegistry(AObject as TApiUser)
    else
    if (AObject is TApiInfo) then
       Result := GetUserInfo(AObject as TApiInfo)
    else
    if (AObject is TApiBalance) then
       Result := SetBalance(AObject as TApiBalance)
  finally
    if AOwn and Assigned(AObject) then
       FreeAndNil(AObject);
  end;
end;


end.

А работать с этим так:

procedure DoLogin(const AUser, APassw: string);
var
  Usr:  TApiLogin;
  Jsn:  TJsonObject;
begin
  Usr := TApiLogin.Create;
  Usr.Login    := AUser;
  Usr.Password := APassw;
  Jsn := RestAPI.SendRequest(Usr, True);
end;

Следует заметить, что все запросы возвращают json. Просто потому что мне так было нужно. Однако можно немного изменить функцию Request, что бы возвращался объект конкретного типа. 

[aleksandrguru]

Спасибо за ответ , визуально я имел ввиду LiveBindings Designer очень удобная штука в связке с Rest Debugger

[aleksandrguru]

Спасибо в любом случае отличный пример.

[ruslan]

запросы всегда шлите в другом потоке: либо через ExecuteAsynch, либо в своем потоке наследнике, либо через ITask.

не обязательно везде писать if ..GetValue() then

напишите классы под структуру json-ответа и используйте TJson.JsonToObject из Rest.JSON

[DirtyBorov]

запросы всегда шлите в другом потоке: либо через ExecuteAsynch, либо в своем потоке наследнике, либо через ITask.

не обязательно везде писать if ..GetValue() then

напишите классы под структуру json-ответа и используйте TJson.JsonToObject из Rest.JSON

Логично. Но тема не раскрыта.

Во первых, я написал, о том что мне было НУЖЕН json, потому ответы не десереализуются в объекты. Во вторых нет необходимости использовать TJson.JsonToObject. Все гораздо проще. Как я уже писал, нужно изменить функцию Request. Например так:

function Request<T: class>(ABody: TApiObject): T;
...
function TRestAPI.Request<T>(ABody: TApiObject): T;
var
  i: integer;
begin
  RESTRequest.ClearBody;
  RESTRequest.AddBody(ABody);
  RESTRequest.Execute;

  if (RESTResponse.StatusCode <> 200) then
    raise Exception.CreateFmt('Оштбка сервера %d "%s"',[RESTResponse.StatusCode, RESTResponse.StatusText]);

  if not Assigned(RESTResponse.JSONValue) then
     raise Exception.Create('Ответ сервера не содержит подходящих данных');

  Result := RESTResponse.JSONValue.GetValue<T>('content');
end;

Теперь по поводу потоков. Все верно, но не совсем.  Поскольку TRestAPI это наследник TDataModule, то я подразумевал использование в программе единственного его экземпляра. А значит код на подобии такого - полный отстой:

function TRestAPI.GetUserInfo(ABody: TApiInfo): TJSONValue;
begin
  TThread.CreateAnonymousThread(procedure
  begin
    RESTClient.BaseURL := BaseURL + '?act=terminal&area=info&infoType=2&response=js';
    Result := Request(ABody);
  end).Start;
end;

Почему? Потому что если из главного модуля выполнить подряд сразу два запроса - то мы получим exception. Так как потоки раздерутся из-за единственных экземпляров:

RESTClient: TRESTClient;

RESTRequest: TRESTRequest;

RESTResponse: TRESTResponse;

 

Первое что приходит на ум:

1. Создавать динамически TRestAPI для каждого запроса

2. Создавать TRESTClient, TRESTRequest, TRESTResponse для каждого запроса.

 

Логично? Нет. Это вообще полное гамно плохая идея. Потому что будет много лишнего кода, а мы стремимся все сделать красиво. 

 

Что же, мы к этому подошли, покажу как же я использовал данный код. А использовал я его конечно же в потоках.

Идея очень простая и весьма удобная. Взял я ее с сайта fmxexpress.com (к сожалению не помню автора, но вы можете найти). Мне она настолько понравилась, что я теперь использую ее повсеместно. Конечно код я модернизировал под себя и адаптировал для использования на desktop.

Код позволяет отправить в поток любую функцию. При этом при завершении или ошибке будет вызваны соответсвующие функции. Но весь код будет находится в одном месте (используются анонимные методы). При выполнении запроса будет выведено окно с анимацией и надписью "Ждите..."

Вот пример вызова запроса:

procedure TFormCashbox.RequestCardInfo(const ACardNum: string);
var
  Json: TJSONValue;
  Body: TApiInfo;
begin
  lblStatus.Text := 'Запрос информации...';
  Wait.Run(
    procedure(AWait: TWaitControl)
    begin
      Body := TApiInfo.Create;
      Body.Card_num := ACardNum;
      Body.Hall_id := '1600';
      Json := RestAPI.SendRequest(Body);
    end,
    procedure(AWait: TWaitControl)
    begin
      CurrentCard.SetState(TCardState.Used, ACardNum, Json);
      lblStatus.Text := 'Готов';
    end,
    procedure (AWait: TWaitControl; AException: Exception)
    begin
      OnException(Self, AException);
    end
    );
end;

Весь секрет кроется в Wait. Метод Run принимает три метода: 

1.основной код

2.код завершения потока

3.код при возникновении ошибки в потоке.

 

Сам же Wait: TWaitControl - это наследник от TRectangle. Когда выполняется метод Run, он появляется на экране и показывает надпись. Дополнительно он поверх всей формы выводит полупрозрачный фон, что создает эффект как на многих сайтах.

Я не буду объяснять как работает TWaitControl, там все тривиально. Просто приложу готовый модуль - пользуйтесь. С помощью него вы можете сильно упростить жизнь при работе с потоками. 

[DirtyBorov]

По каким то причинам мне не удается прикрепить файл содержащий TWaitControl. Потому просто выложу его код полностью. Благо он совсем короткий. 

Модуль универсальный. Его можно использовать не только для REST но и вообще для любых длительных операций которые нужно выполнять в потоках.

 

Обратите внимание, что в конструктор передается TForm. Это экземпляр ГЛАВНОЙ формы приложения.  Это нужно потому что TWaitControl , будет перекрывать главную форму полупрозрачным квадратом, создавая эффект затемнения и заодно делая недоступным разные кнопки на форме.  Рекомендую создавать TWaitControl в событии OnCreate главной формы:

TMainForm = class(TForm)
private
  Wait: TWaitControl;
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
  Application.OnException := OnException;
  Wait := TWaitControl.Create(Self);
  Wait.Title.Text := 'Ждите пожалуйста...';
end;

unit Wait.Control;

interface

uses
   FMX.Forms, FMX.Objects, FMX.Types, FMX.Effects, FMX.StdCtrls, System.SysUtils, System.Classes, System.UITypes;

type
  TWaitControl = class(TRectangle)
  private
    FWindow: TRectangle;
    FTitle: TLabel;
    FHadErrors: Boolean;
    FWaiting: Boolean;
    procedure DoErrorHandling(E: Exception; AOnError: TProc<TWaitControl, Exception>);
    procedure DoOnCompleted(AOnComplete: TProc<TWaitControl>);
  public
    constructor Create(MainForm: TForm); reintroduce;
    procedure Run(ATask: TProc<TWaitControl>; AOnComplete: TProc<TWaitControl> = nil;
                  AOnError: TProc<TWaitControl, Exception> = nil); virtual;

    property Waiting: Boolean read FWaiting;
    property HadErrors: Boolean read FHadErrors;
    property Window: TRectangle read FWindow;
    property Title: TLabel read FTitle;
  end;

implementation

{ TWaitControl }

constructor TWaitControl.Create(MainForm: TForm);
begin
  inherited Create(MainForm);
  Parent := MainForm;
  Align  := TAlignLayout.Contents;
  Visible := False;
  Fill.Color := $4B000000;

  FWindow := TRectangle.Create(Self);
  FWindow.Parent := Self;
  FWindow.Fill.Color := $96000000;
  FWindow.Align := TAlignLayout.Center;
  FWindow.Width := 250;
  FWindow.Height := 65;

  FTitle := TLabel.Create(FWindow);
  FTitle.Parent := FWindow;
  FTitle.Align := TAlignLayout.Client;
  FTitle.StyledSettings := FTitle.StyledSettings - [TStyledSetting.Size, TStyledSetting.Style];
  FTitle.TextSettings.Font.Size := 16;
//  FTitle.TextSettings.Font.Style := [TFontStyle.fsBold];

  with TAniIndicator.Create(FWindow) do
   begin
     Parent := FWindow;
     Style := TAniIndicatorStyle.Circular;
     Align := TAlignLayout.Left;
     Margins.Left   := 15;
     Margins.Top    := 15;
     Margins.Right  := 15;
     Margins.Bottom := 15;
     Width := Height;
     Enabled := True;
   end;

  with TShadowEffect.Create(FWindow) do
    Parent := FWindow;
end;

procedure TWaitControl.DoErrorHandling(E: Exception; AOnError: TProc<TWaitControl, Exception>);
begin
  TThread.Synchronize(TThread.CurrentThread,
  procedure
  begin
    FWaiting := False;
    FHadErrors := True;
    Visible := False;
    if Assigned(AOnError) then
      AOnError(Self, E);
  end);
end;

procedure TWaitControl.DoOnCompleted(AOnComplete: TProc<TWaitControl>);
begin
   TThread.Synchronize(nil,
    procedure
    begin
      FWaiting := False;
      Visible := False;
      if Assigned(AOnComplete) then
        AOnComplete(Self);
    end);
end;

procedure TWaitControl.Run;
begin
  Visible := True;
  FWaiting := True;
  TThread.CreateAnonymousThread(
    procedure
    begin
      try
        FHadErrors := False;
        ATask(Self);
        DoOnCompleted(AOnComplete);
      except
        on E:Exception do
          DoErrorHandling(E, AOnError);
      end;
//      DoOnCompleted(AOnComplete);
    end).Start;
end;

end.