TIdPeerThread.ReturnValue而非indy10

Question

我有一个非常特殊的问题，我一直未能在互联网上找到。

在我的公司，我们有一个使用Indy 9用Delphi 7开发的应用程序，但是已经决定一劳永逸地迁移到Delphi10.2东京。这造成了工作量太大，因为程序处理了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;

在印第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的后代。但是它是通过TThread通过TIdYarn链接到的。因此，如果有必要，可以通过类型将TIdContext.Yarn属性转换为TIdYarnOfThread，然后访问TIdYarnOfThread.Thread属性来访问底层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()方法有意义，因为它返回ReturnValue。而且，由于您没有WaitFor()服务器的线程，所以您真的不应该以自己的方式使用ReturnValue。

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

而且，没有任何理由在AThread.Terminate事件中调用TIdTCPServer.OnDisconnect或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/ContextClass属性。然后，当您需要访问您的成员时，可以在服务器事件中将提供的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;