TIdPeerThread.ReturnValue 不是 indy10

Question

我有一个非常特殊的问题，我无法在 Internet 上找到。

在我的公司中，我们有一个使用 Indy 9 使用 Delphi 7 开发的应用程序，但我们一劳永逸地决定迁移到 Delphi 10.2 Tokyo。这造成了过高的工作量，因为该程序处理了超过 52,000 行代码，而我不得不面对迁移到 Unicode 和 Indy 10 的问题。

我需要帮助知道如何替换它：

印地 9：

procedure TTraceForm.IdTCPServer1Disconnect (AThread: TIdPeerThread);
begin 
  try 
    AThread.Terminate;
    if (AThread.ReturnValue >= 1) and (AThread.ReturnValue <= MaxCtrlTrns) then
      try 
        QueueBlock.Enter; 
        TCPPeerThreads[AThread.ReturnValue] := Nil;
      finally 
        QueueBlock.Leave;
      end;
  except
    on E: Exception do
    begin 
      WriteLogSwitch('E' , 'Error TTraceForm.IdTCPServer1Disconnect (' + E. Message + ')');
    end;
  end;
end;

Indy 10 中的这一点：

procedure TTraceForm.IdTCPServer1Disconnect (AThread: TIdContext);
begin 
  try 
    AThread.Connection.Disconnect;
    if (AThread.ReturnValue >= 1) and (AThread.ReturnValue <= MaxCtrlTrns) then
      try 
        QueueBlock.Enter; 
        TCPPeerContext[AThread.ReturnValue] := Nil;
      finally 
        QueueBlock.Leave;
      end;
  except
    on E: Exception do
    begin 
      WriteLogSwitch('E' , 'Error TTraceForm.IdTCPServer1Disconnect (' + E. Message + ')');
    end;
  end;
end;

TIdContext中没有ReturnValue，不知道怎么替换。

Answer 1

在 Indy 9 中，TIdPeerThread 是 TThread 的后代。 ReturnValue 是 TThread 的属性。

在 Indy 10 中，人们努力将业务逻辑与线程分离。因此，TIdContext 不是TThread 的后代。但它通过TIdYarn 链接到TThread。因此，如果必须，您可以通过将TIdContext.Yarn 属性类型转换为TIdYarnOfThread 然后访问TIdYarnOfThread.Thread 属性来访问底层TThread，例如：

procedure TTraceForm.IdTCPServer1Connect (AContext: TIdContext);
var
  MyValue: Integer;
begin
  ...
  MyValue := ...;
  TIdYarnOfThread(AContext.Yarn).Thread.ReturnValue := MyValue;
  if (MyValue >= 1) and (MyValue <= MaxCtrlTrns) then
  begin
    QueueBlock.Enter; 
    try 
      TCPPeerThreads[MyValue] := AContext;
    finally 
      QueueBlock.Leave;
    end;
  end;
  ...
end;

procedure TTraceForm.IdTCPServer1Disconnect (AContext: TIdContext);
var
  MyValue: Integer;
begin 
  try 
    AContext.Connection.Disconnect;
    MyValue := TIdYarnOfThread(AContext.Yarn).Thread.ReturnValue;
    if (MyValue >= 1) and (MyValue <= MaxCtrlTrns) then
      try 
        QueueBlock.Enter; 
        TCPPeerThreads[MyValue] := Nil;
      finally 
        QueueBlock.Leave;
      end;
  except
    on E: Exception do
    begin 
      WriteLogSwitch('E' , 'Error TTraceForm.IdTCPServer1Disconnect (' + E. Message + ')');
    end;
  end;
end;

然而，TThread.ReturnValue 只对TThread.WaitFor() 方法有意义，因为它返回ReturnValue。而且由于您没有WaitFor() 服务器的线程，所以您根本不应该像现在这样使用ReturnValue。

Indy 9 的 TIdPeerThread 和 Indy 10 的 TIdContext 都有一个公共的 Data 属性，您可以使用它来存储用户定义的值，这就是它的用途（注意：如果您使用 Indy 10在支持 Delphi ARC 的编译器中 - Android、iOS、Linux 等 - 您必须改用 TIdContext.DataValue 属性。

仅供参考，没有任何理由在TIdTCPServer.OnDisconnect 事件中调用AThread.Terminate 或AContext.Connection.Disconnect。事件处理程序退出后，管理套接字的线程将自动停止，如果套接字尚未关闭，则将其关闭。

尝试类似的方法：

印地 9：

procedure TTraceForm.IdTCPServer1Connect (AThread: TIdPeerThread);
var
  MyValue: Integer;
begin
  ...
  MyValue := ...;
  AThread.Data := TObject(MyValue);
  if (MyValue >= 1) and (MyValue <= MaxCtrlTrns) then
  begin
    QueueBlock.Enter; 
    try 
      TCPPeerThreads[MyValue] := AThread;
    finally 
      QueueBlock.Leave;
    end;
  end;
  ...
end;

procedure TTraceForm.IdTCPServer1Disconnect (AThread: TIdPeerThread);
var
  MyValue: Integer;
begin 
  try 
    MyValue := Integer(AThread.Data);
    if (MyValue >= 1) and (MyValue <= MaxCtrlTrns) then
    begin
      QueueBlock.Enter; 
      try 
        TCPPeerThreads[MyValue] := Nil;
      finally 
        QueueBlock.Leave;
      end;
    end;
  except
    on E: Exception do
    begin 
      WriteLogSwitch('E' , 'Error TTraceForm.IdTCPServer1Disconnect (' + E. Message + ')');
    end;
  end;
end;

印地 10：

procedure TTraceForm.IdTCPServer1Connect (AContext: TIdContext);
var
  MyValue: Integer;
begin
  ...
  MyValue := ...;
  AContext.Data := TObject(MyValue); // or 'AContext.DataValue := MyValue;' on ARC
  if (MyValue >= 1) and (MyValue <= MaxCtrlTrns) then
  begin
    QueueBlock.Enter; 
    try 
      TCPPeerThreads[MyValue] := AContext;
    finally 
      QueueBlock.Leave;
    end;
  end;
  ...
end;

procedure TTraceForm.IdTCPServer1Disconnect (AContext: TIdContext);
var
  MyValue: Integer;
begin 
  try 
    MyValue := Integer(AContext.Data); // or 'MyValue := AContext.DataValue;' on ARC
    if (MyValue >= 1) and (MyValue <= MaxCtrlTrns) then
    begin
      QueueBlock.Enter; 
      try 
        TCPPeerThreads[MyValue] := Nil;
      finally 
        QueueBlock.Leave;
      end;
    end;
  except
    on E: Exception do
    begin 
      WriteLogSwitch('E' , 'Error TTraceForm.IdTCPServer1Disconnect (' + E. Message + ')');
    end;
  end;
end;

话虽如此，还有一个替代解决方案 - 从TIdPeerThread/TIdContext 派生一个新类，并根据需要向其中添加您自己的自定义成员，然后将该类分配给服务器的ThreadClass/@987654351 @ 激活服务器之前的属性。然后，当您需要访问您的成员时，您可以将服务器事件中提供的 AThread/AContext 对象类型转换为您的类，例如：

印地 9：

type
  TMyPeerThread = class(TIdPeerThread)
    MyValue: Integer;
  end;

procedure TTraceForm.FormCreate (Sender: TObject);
begin
  ...
  IdTCPServer1.ThreadClass := TMyPeerThread;
  IdTCPServer1.Active := True;
  ...
end;

procedure TTraceForm.IdTCPServer1Connect (AThread: TIdPeerThread);
var
  LThread: TMyPeerThread;
begin
  ...
  LThread := TMyPeerThread(AThread);
  LThread.MyValue := ...;
  if (LThread.MyValue >= 1) and (LThread.MyValue <= MaxCtrlTrns) then
  begin
    QueueBlock.Enter; 
    try 
      TCPPeerThreads[LThread.MyValue] := AThread;
    finally 
      QueueBlock.Leave;
    end;
  end;
  ...
end;

procedure TTraceForm.IdTCPServer1Disconnect (AThread: TIdPeerThread);
var
  LThread: TMyPeerThread;
begin 
  try 
    LThread := TMyPeerThread(AThread);
    if (LThread.MyValue >= 1) and (LThread.MyValue <= MaxCtrlTrns) then
    begin
      QueueBlock.Enter; 
      try 
        TCPPeerThreads[LThread.MyValue] := Nil;
      finally 
        QueueBlock.Leave;
      end;
    end;
  except
    on E: Exception do
    begin 
      WriteLogSwitch('E' , 'Error TTraceForm.IdTCPServer1Disconnect (' + E. Message + ')');
    end;
  end;
end;

印地 10：

type
  TMyContext = class(TIdServerContext)
    MyValue: Integer;
  end;

procedure TTraceForm.FormCreate (Sender: TObject);
begin
  ...
  IdTCPServer1.ContextClass := TMyContext;
  IdTCPServer1.Active := True;
  ...
end;

procedure TTraceForm.IdTCPServer1Connect (AContext: TMyContext);
var
  LContext: TMyContext;
begin
  ...
  LContext := TMyContext(AContext);
  TMyContext.MyValue := ...;
  if (LContext.MyValue >= 1) and (LContext.MyValue <= MaxCtrlTrns) then
  begin
    QueueBlock.Enter; 
    try 
      TCPPeerThreads[LContext.MyValue] := AContext;
    finally 
      QueueBlock.Leave;
    end;
  end;
  ...
end;

procedure TTraceForm.IdTCPServer1Disconnect (AContext: TIdContext);
var
  LContext: TMyContext;
begin 
  try 
    LContext := TMyContext(AContext);
    if (LContext.MyValue >= 1) and (LContext.MyValue <= MaxCtrlTrns) then
    begin
      QueueBlock.Enter; 
      try 
        TCPPeerThreads[LContext.MyValue] := Nil;
      finally 
        QueueBlock.Leave;
      end;
    end;
  except
    on E: Exception do
    begin 
      WriteLogSwitch('E' , 'Error TTraceForm.IdTCPServer1Disconnect (' + E. Message + ')');
    end;
  end;
end;