在 TIdHttpServer 的 OnCommandGet 事件处理程序中等待线程执行

Question

我的 Delphi 柏林应用程序使用 TIdHttpServer 通过 HTTP GET 从客户端获取一些数据，处理它并发回。

所有逻辑都在单个事件处理程序中执行：OnCommandGet。标识符在 QueryString 中接收，然后数据将被转换并返回到同一 OnCommandGet 事件处理程序中的客户端。

数据转换在单独的线程中实现，该线程使用PostMessage通知主线程工作线程完成执行，数据已准备好发送回客户端。

数据在 AResponseInfo.ContentText 属性.

中发送

我的问题是：

How do I make OnCommandGet handler wait until the worker thread does its job and sends the pointer to a transformed data, so I can get the value and fire it back in a AResponseInfo.ContentText?

更新这是我要执行的伪代码：

type
  TMyResponsesArray = array[0..5] of TMyObjectAttributes;
  PMyResponsesArray = ^TMyResponsesArray;

{There will be 6 tasks run in parallel. Tasks' responses
will be stored in the below declared Responses array.}

var
  Responses: TMyResponsesArray;

{Below is a Server handler, which takes the input parameter and calls
a proc which runs 6 threads in parallel. The result of each thread is
stored as an ordered array value. Only when the array is completely
populated, ServerCommandGet may send the response!}

procedure TMainForm.ServerCommandGet(AContext: TIdContext;
  ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var
  ObjectId: string;
begin
  ObjectId := ARequestInfo.Params.Values['oid'];
  RunTasksInParallel(ObjectId);
end;

{Below is a procedure invoked by ServerCommandGet. It runs 6 tasks in
parallel. Each of the thread instantiates an object, sets its basic
parameter and fires the method. Each task runs queued. When each thread
completes the job, it sends a WM to the main thread (via ParentHandler
which must accept and process the response.}

procedure TMainForm.RunTasksInParallel(const ObjectId: string);
const
  c: array[0..5] of Byte = (0, 1, 2, 3, 4, 5);
var
  ParentHandle: HWND;
begin

  {running 6 tasks in parallel}
  TTask.Run(
    procedure
    begin
      TParallel.For(Low(c), High(c),
        procedure(index: Integer)
        var
          MyObj: TMyObject;
          i: Byte;
        begin
          i := c[index];
          MyObj := TMyObject.Create;

          try
            MyObj.SetMyParameter := Random(10);
            Responses[i] := MyObj.CallMyMethd(ObjectId);

            TThread.Queue(nil,
              procedure
              begin
                SendMessage(ParentHandle,
                  UM_DATAPACKET, i, Integer(@Responses));
              end);

          finally
            MyObj.Free;
          end;

        end);
    end);
end;

{Now the WM handler. It decreases internal task counter and when
TaskCounter = 0, it means that all tasks finished execution and the
Responses array is fully populated. Then we somehow need to pass the
Response array to the ServerCommandGet and send it back to client...}

procedure TMainForm.OnDataPacket(var Msg: TMessage);
begin
  i := Msg.WParam;
  Responses := PMyResponsesArray(Msg.LParam)^;

  {Skipped for for brevity:
  When ALL tasks have finished execution, the Responses array is FULL.
  Then all array values are wrapped into XML and sent back to initial
  invoker ** ServerCommandGet ** which must send XML to client.}
end;

Answer 1

您使用全局 Responses 数组是不安全的，除非您将 TIdHTTPServer 限制为一次仅允许 1 个连接的客户端。否则，您可能有多个客户端同时发送请求并覆盖数组中彼此的值。 ServerCommandGet() 的每次调用都应使用本地数组。

TIdHTTPServer 不适用于您尝试执行的异步处理类型。 ServerCommandGet() 必须阻止，因为 TIdHTTPServer 在 OnCommandGet 处理程序退出时向客户端发送响应，除非处理程序首先发送响应，而您没有这样做。因此，关于您的任务线程管理，我建议：

摆脱 TTask.Run() 并让 RunTasksInParallel() 直接调用 TParallel.For()。
或至少在调用 TParallel.For() 的 TTask 对象上调用 TTask.Wait()。

任何一种方式都会使 RunTasksInParallel() 阻塞（并因此使 ServerCommandGet() 阻塞）直到所有任务完成。然后你可以在RunTasksInParallel()退出的时候立即将响应发送给客户端。您无需等待任务 post UM_DATAPACKET 到主线程并往返返回 TIdHTTPServer。如果您将 UM_DATAPACKET 用于其他用途，那很好，但我不建议您将其用于 HTTP 处理。

尝试更像这样的东西：

const
  MaxResponses = 6;

type
  TMyResponsesArray = array[0..MaxResponses-1] of TMyObjectAttributes;

  {$POINTERMATH ON}
  PMyResponsesArray = ^TMyResponsesArray;

{There will be 6 tasks run in parallel. Tasks' responses
will be stored in the below declared Responses array.}

procedure TMainForm.ServerCommandGet(AContext: TIdContext;
  ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var
  ObjectId: string;
  Responses: TMyResponsesArray;
begin
  ObjectId := ARequestInfo.Params.Values['oid'];
  RunTasksInParallel(ObjectId, @Responses);
  {ALL tasks have finished execution, the Responses array is FULL.
  Wrap all array values into XML and send it back to the client.}
end;

{Below is a procedure invoked by ServerCommandGet. It runs 6 tasks in
parallel. Each of the thread instantiates an object, sets its basic
parameter and fires the method.}

procedure TMainForm.RunTasksInParallel(const ObjectId: string; Responses: PMyResponsesArray);
begin
  {running 6 tasks in parallel}
  TParallel.For(0, MaxResponses-1,
    procedure(index: Integer)
    var
      MyObj: TMyObject;
    begin
      MyObj := TMyObject.Create;
      try
        MyObj.SetMyParameter := Random(10);
        Responses[index] := MyObj.CallMyMethd(ObjectId);
      finally
        MyObj.Free;
      end;
    end
  );
end;

我也不建议在主线程中进行数据库更新。如果您不能直接在 ServerCommandGet() 中或直接在各个任务线程中更新数据库，那么我建议有一个单独的线程专用于您 post 根据需要进行的数据库更新。尽量远离主线程。

在 TIdHttpServer 的 OnCommandGet 事件处理程序中等待线程执行

Wait for thread execution inside TIdHttpServer's OnCommandGet event handler

multithreading

delphi

async-await

idhttp