TIdPeerThread.ReturnValue 不是 indy10

Question

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

在我的公司，我们有一个使用 Delphi 7 使用 Indy 9 开发的应用程序，但已经决定一劳永逸地迁移到 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 来访问基础 TThread 然后访问 TIdYarnOfThread.Thread 属性，例如：

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() 方法真正有意义，因为它 returns 对 ReturnValue。由于您没有 WaitFor() 服务器的线程，因此您根本不应该像现在这样使用 ReturnValue。

Indy 9 的 TIdPeerThread 和 Indy 10 的 TIdContext 都有一个 public Data 属性，你可以用它来存储用户定义的值，这就是它的意思（注意：如果您在 Delphi ARC-enabled 编译器中使用 Indy 10 - 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 派生一个新的 class 并根据需要向其添加您自己的自定义成员，然后分配给它class 到服务器的 ThreadClass/ContextClass 属性在激活服务器之前。然后，当您需要访问您的成员时，您可以将服务器事件中提供的 AThread/AContext 对象类型转换为您的 class，例如：

印地 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;

TIdPeerThread.ReturnValue 不是 indy10

TIdPeerThread.ReturnValue not indy10

delphi

indy

indy10

delphi-10.2-tokyo