Question

我有一个非常特别的问题，我无法在互联网上找到。

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

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

Indy 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后代。但它通过TThread与TIdYarn相关联。因此，如果必须，您可以通过将TThread属性压缩为TIdContext.Yarn然后访问TIdYarnOfThread来访问基础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＆＃39; TIdPeerThread和Indy 10＆＃39; TIdContext都有公共Data属性，您可以使用它来存储用户定义的值，是它的意思（注意：如果你在支持Delphi ARC的编译器中使用Indy 10 - Android，iOS，Linux等 - 你将不得不使用TIdContext.DataValue属性）。

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

尝试更像这样的东西：

Indy 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;

Indy 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派生一个新类，并根据需要添加自己的自定义成员，然后将该类分配给服务器＆＃39 ; s ThreadClass / ContextClass属性，然后激活服务器。然后，当您需要访问您的成员时，可以将服务器事件中提供的AThread / AContext对象类型转换为您的类，例如：

Indy 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;

Indy 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

1 个答案: