Stop method after certain time in Delphi Datasnap Server Application

Question

I've build a datasnap server application for handling data between a windows application and mobile apps.

One method can take a while, and I want to be able to stop it after a certain time(Timeout).

How can I achieve this?

Answer 1

The code below shows one way to provide a server method with timeout behaviour.

The task which may take too long is executed in a secondary thread which is started in the server method. This method uses a TSimpleEvent object (see the online help) to enable the secondary thread to signal back to the server method's thread that it has completed. The value (in milliseconds) you specify in the call to Event.WaitFor defines how long to wait before the call times out. If the call to WaitFor on the SimpleEvent times out, you can take whatever action you like to notify the server's client. If the call to WaitFor returns wsSignaled, that means that the DBThread must have called SetEvent on the Event object before the period specified when calling WaitFor expired.

Btw, this example was written for D7, so might require minor adaptation for Seattle. Also it uses a TForm descendant as the "server", but should work equally well in a DataSnap server method, since the principle is the same.

It doesn't address the issue of how exactly to stop whatever task you kick off in the secondary thread, because whether that is possible and how to do it if it is depends on exactly what the task is. Because of that, and the fact that you probably wouldn't want to delay the server method by waiting for the DBThread to complete, it does not attempt to free the DBThread, though in the real world that should of course be done.

type
  TServer = class;

  TDBThread = class(TThread)
  private
    FServer: TServer;
    FEvent: TSimpleEvent;
    FCancelled : Boolean;
    function GetCancelled: Boolean;
    procedure SetCancelled(const Value: Boolean);
  public
    procedure Execute; override;
    constructor Create(AServer : TServer);
    property Server : TServer read FServer;
    property Event : TSimpleEvent read FEvent;
    property Cancelled : Boolean read GetCancelled write SetCancelled;
  end;

  TServer = class(TForm)
    //  ignore the fact that in this case, TServer is a descendant of TForm
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
  protected
    CS : TCriticalSection;
    Event : TSimpleEvent;
  public
    procedure DoServerMethod;
  end;
[...]

{ TDBThread }

constructor TDBThread.Create(AServer: TServer);
begin
  inherited Create(True);  //  create suspended
  FreeOnTerminate := False;
  FServer := AServer;
  FEvent := FServer.Event;
end;

procedure TDBThread.Execute;
var
  StartTime : Cardinal;
begin
  Cancelled := False;
  //  Following is for illustration ONLY, to simulate a process which takes time.
  //  Do not call Sleep() in a loop in a real thread
  StartTime := GetTickCount;
  repeat
    Sleep(100);
  until GetTickCount - StartTime > 5000;
  if not Cancelled then begin
    { TODO : Transfer result back to server thread }
    Event.SetEvent;
  end;
end;

function TDBThread.GetCancelled: Boolean;
begin
  FServer.CS.Enter;
  try
    Result := FCancelled;
  finally
    FServer.CS.Leave;
  end;
end;

procedure TDBThread.SetCancelled(const Value: Boolean);
begin
  FServer.CS.Enter;
  try
    FCancelled := Value;
  finally
    FServer.CS.Leave;
  end;
end;

procedure TServer.DoServerMethod;
var
  DBThread : TDBThread;
  WaitResult : TWaitResult;
begin
  DBThread := TDBThread.Create(Self);
  DBThread.Resume;
  WaitResult := Event.WaitFor(1000);
  case WaitResult of
    wrSignaled : begin
      // the DBThread completed
      ShowMessage('DBThread completed');
    end;
    wrTimeOut : begin
      //  the DBThread time out
      DBThread.Cancelled := True;
      ShowMessage('DBThread timed out');
      //  Maybe use PostThreadMessage here to tell the DBThread to abort (if possible)
      //  whatever task it is doing that has taken too long.
    end;
  end; {case}
  { TODO : Terminate and dispose of the DBThread }
end;

procedure TServer.FormCreate(Sender: TObject);
begin
  CS := TCriticalSection.Create;
  Event := TSimpleEvent.Create;
end;

procedure TServer.Button1Click(Sender: TObject);
begin
  DoServerMethod;
end;