mORMot Open Source

procedure TSQLRestServerURIContext.ExecuteORMGet;
...
                // use the first static table (poorman's JOIN)
                Static := Server.InternalAdaptSQL(TableIndexes[0],SQL); //--> always executed
              end;
            end;
            if Static<>nil then  begin
              TableEngine := Static;
              Call.OutBody := TableEngine.EngineList(SQL); //--> always executed after first time
            end else
              Call.OutBody := Server.MainEngineList(SQL,false,nil); //--> executed ONLY the firs time
            // security note: only first statement is run by EngineList()
            if Call.OutBody<>'' then begin // got JSON list '[{...}]' ?
...
end;

procedure TSQLRestServerDB.PrepareStatement(Cached: boolean);
var wasPrepared: boolean;
    timer: PPPrecisionTimer;
begin
  fStaticStatementTimer.Start;
  if not Cached then begin
    fStaticStatement.Prepare(DB.DB,fStatementGenericSQL); //--> executed the first time (called from PrepareStatement->GetAndPrepareStatement->MainEngineList)
    fStatementGenericSQL := '';			          //    then this call to TSQLRequest.Prepare->mORMotSQLite3.vt_create->TSQLVirtualTable.Create
  ...
end;

  for I := Low(fModel.Tables) to High(fModel.Tables) do begin
    if (fModel.Props[fModel.Tables[I]].Kind in [rCustomForcedID, rCustomAutoID]) then begin // only external tables
      lMappingVersion := fModel.Props[fModel.Tables[I]].ExternalDB.MappingVersion;
      if lMappingVersion>1 then // only with mapped fields
        fServerRest.TableHasRows(fModel.Tables[I]);
    end;
  end;

...
TARISClient = class(TObject)
protected
  ...
  fWebSocketClient: TSQLHttpClientWebsockets; // for websocket callbacks
  fCallbackService: IARISCallbackService; // callback interface
  fClient: TSQLRestClientURI; // mORMot client
  fLastErrorMessage: RawUTF8;
  ...
public
  ...
  CallbackClient: IARISCallbackClient;

  constructor Create;
  ...
  function CallbackCreate(const aHost, aPort: string; out aCallback: IARISCallbackClient): Boolean;
  ...
  /// Cliente websocket
  property WSClient: TSQLHttpClientWebsockets read fWebSocketClient;
  ...
end;

constructor TARISClient.Create;
  ...
  fClient := TSQLHttpClient.Create(...);
  ...
end;
...
function TARISClient.CallbackCreate(const aHost, aPort: string; out aCallback: IARISCallbackClient): Boolean;
begin
  // se crea el websocket cliente
  fWebSocketClient := TSQLHttpClientWebsockets.Create(...));
  fWebSocketClient.Model.Owner := fWebSocketClient;
  // se usa el websocket con protocolo binario
  fWebSocketClient.WebSocketsUpgrade(ARIS_WS_TRANSMISSION_KEY);
  if not fWebSocketClient.ServerTimeStampSynchronize then
  begin
    fLastErrorMessage := FormatUTF8(SErrorConnectingToTheServer, [lHost, lPort])  + ' / ' + fWebSocketClient.LastErrorMessage;;
    Exit;
  end;
  // se cargan los servicios definidos para los websockets
  fWebSocketClient.ServiceDefine([IARISCallbackService], sicShared);
  if not fWebSocketClient.Services.Resolve(IARISCallbackService, fCallbackService) then
  begin
    fLastErrorMessage := SServiceIARISCallbackServiceUnava + ' / ' + fWebSocketClient.LastErrorMessage;;
    Exit;
  end;
  // se crea el callback cliente que será invocado cuando se reciba una notificación websocket desde el servidor
  aCallback := TARISCallbackClient.Create(fWebSocketClient, IARISCallbackClient);
  // si está asignado el evento para cuando se recibe un callback se lo asigna al callback cliente creado para que
  // luego propague la notificación
  if Assigned(fOnCallback) then
    TARISCallbackClient(ObjectFromInterface(aCallback)).OnCallback := fOnCallback; // allow it callback propagation when used in a TForm
  Result := True;
end;
...

const
  WM_SERVICENOTIFICATION = WM_USER+123;
type
...
TfrmARISClient = class(TForm)
protected
  ...
  fARISClient: TARISClient;
  fCallback: IARISCallbackClient;
  ...
  procedure ServiceNotification(var Msg: TMessage); message WM_SERVICENOTIFICATION;
  procedure DoOnCallback(const aJSONCallback: RawUTF8);
  ...
public
  ...
end;
...

...
procedure TfrmARISClient.FormCreate(Sender: TObject);
begin
  ...
  // se crea el cliente de ARIS
  fARISClient := TARISClient.Create(...);
  if not fARISClient.Client.ServerTimeStampSynchronize then
    raise Exception.Create('No se pudo conectar con ARIS');
  ...
  // se suscribe al callback para recibir notificaciones
  fARISClient.CallbackCreate(...,...,fCallback);
  // evento que procesa los callbacks
  TARISCallbackClient(ObjectFromInterface(fCallback)).OnCallback := DoOnCallback;
  // procesar callbacks en la hebra principal
  fARISClient.WSClient.ServiceNotificationMethodViaMessages(Handle,WM_SERVICENOTIFICATION); //--> *** LINE 1 ***
  ...  
end;
...
procedure TfrmARISClient.ServiceNotification(var Msg: TMessage);
begin
  TSQLRestClientURI.ServiceNotificationMethodExecute(Msg); //--> *** LINE 2 ***
end;
...
procedure TfrmARISClient.DoOnCallback(const aJSONCallback: RawUTF8);
begin
  // process callback in main thread (show progress bar, update labels, etc.)
end;

  ...
type
  ILongWorkCallback = interface(IInvokable)
    ['{425BF199-19C7-4B2B-B1A4-A5BE7A9A4748}']
    procedure WorkFinished(const workName: string; timeTaken: integer);
    procedure WorkFailed(const workName, error: string);
  end;

  ILongWorkService = interface(IInvokable)
    ['{09FDFCEF-86E5-4077-80D8-661801A9224A}']
    procedure StartWork(const workName: string; const onFinish: ILongWorkCallback);
    function TotalWorkCount: Integer;
  end;

  IAsynchLongWorkService = interface(IInvokable)
    ['{CFA559E5-B181-45BB-84AB-7279DDDA51A9}']
    procedure StartWork(const workName: string; const onFinish: Integer);
  end;
  ...
initialization
  TInterfaceFactory.RegisterInterfaces([
    TypeInfo(ILongWorkService),TypeInfo(ILongWorkCallback),TypeInfo(IAsynchLongWorkService)]);

  ...
type
  TLongWorkService = class(TInterfacedObject,ILongWorkService)
  protected
    fCallbackInterface: IAsynchLongWorkService;
    fDestinationInterface: IAsynchLongWorkService;
  public
    procedure StartWork(const workName: string; const onFinish: ILongWorkCallback);
    function TotalWorkCount: Integer;
  end;

  TAsynchLongWorkService = class(TInterfacedObject,IAsynchLongWorkService)
  protected
    fCallback: ILongWorkCallback;
    fWorkName: string;
    fTotalWorkCount: Integer;
  public
    procedure StartWork(const workName: string; const onFinish: Integer);
    function TotalWorkCount: Integer;
  end;
  ...

...
{ TLongWorkAsyncService }

procedure TLongWorkService.StartWork(const workName: string; const onFinish: ILongWorkCallback);
begin
  if fCallbackInterface=nil then begin
    fDestinationInterface := TAsynchLongWorkService.Create;
    ServiceContext.Request.Server.AsynchRedirect(IAsynchLongWorkService,fDestinationInterface,fCallbackInterface);
  end;
  onFinish._AddRef; // avoid GPF and the interface is available in asynch. routine
  fCallbackInterface.StartWork(workName,Integer(onFinish));
end;

function TLongWorkService.TotalWorkCount: Integer;
begin
  result := MaxInt; // this shows the asynchronous functioning
end;
...
{ TAsynchLongWorkService }

procedure TAsynchLongWorkService.StartWork(const workName: string; const onFinish: Integer);
var tix: Int64;
begin
  InterlockedIncrement(fTotalWorkCount);
  fCallback := ILongWorkCallback(onFinish);
  fWorkName := workName;
  TSQLLog.Add.Log(sllInfo,'%.Execute(%) started',[self,fWorkName]);
  tix := GetTickCount64;
  Sleep(5000+Random(1000)); // some hard work
  if Random(100)>20 then
    fCallback.WorkFinished(fWorkName,GetTickCount64-tix) else
    fCallback.WorkFailed(fWorkName,'expected random failure');
  TSQLLog.Add.Log(sllInfo,'%.Execute(%) notified',[self,fWorkName]);
  fCallback._Release; // release the interface out this function
end;

function TAsynchLongWorkService.TotalWorkCount: Integer;
begin
  result := fTotalWorkCount;
end;