在特定時間后在Delphi Datasnap Server應用程序中停止方法

Question

我已經構建了一個datasnap服務器應用程序來處理Windows應用程序和移動應用程序之間的數據。

一種方法可能需要一段時間，我希望能夠在一定時間（超時）后將其停止。

我該如何實現？

Answer 1

下面的代碼顯示了一種為服務器方法提供超時行為的方法。

可能花費太長時間的任務在服務器方法中啟動的輔助線程中執行。 此方法使用TSimpleEvent對象（請參閱聯機幫助）來使輔助線程能夠發信號通知服務器方法的線程已完成。 您在對Event.WaitFor的調用中指定的值（以毫秒為單位）定義了在調用超時之前要等待的時間。 如果對SimpleEvent的WaitFor調用超時，則可以采取任何想要通知服務器客戶端的操作。 如果對WaitFor的調用返回wsSignaled，則意味着在調用WaitFor時指定的時間段到期之前，DBThread必須已在Event對象上調用了SetEvent。

順便說一句，此示例是為D7編寫的，因此可能需要對西雅圖進行少量修改。 它還使用TForm后代作為“服務器”，但由於原理相同，因此在DataSnap服務器方法中也應同樣有效。

它沒有解決如何確切地停止在輔助線程中啟動的任何任務的問題，因為這是否可行以及如何執行（取決於任務的確切性）。 因此，您可能不想通過等待DBThread完成來延遲服務器方法，因此，盡管在現實世界中當然應該這樣做，但它不會嘗試釋放DBThread。

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;