Search code examples
delphiindyindy10delphi-10.2-tokyo

TIdPeerThread.ReturnValue not indy10

I have a very particular problem that I have not been able to find on the Internet.

In my company, we have an application developed with Delphi 7 using Indy 9, but it has been decided once and for all to migrate to the Delphi 10.2 Tokyo. This has created a workload that is too high, since the program handles more than 52,000 lines of code and I have had to face issue with migrating to Unicode and Indy 10.

I need help knowing how to replace this:

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;

To this in 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;

In TIdContext, there is no ReturnValue, and I do not know how to replace it.

Solution

  • In Indy 9, TIdPeerThread is a TThread descendant. ReturnValue is a property of TThread.

    In Indy 10, there was effort made to separate business logic from threading. As such, TIdContext is not a TThread descendant. But it is linked to a TThread, via TIdYarn. So, if you have to, you can access the underlying TThread by type-casting the TIdContext.Yarn property to TIdYarnOfThread and then accessing the TIdYarnOfThread.Thread property, eg:

    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;

    However, TThread.ReturnValue only really has meaning to the TThread.WaitFor() method, as it returns the ReturnValue. And since you don't WaitFor() the server's threads, you really shouldn't be using the ReturnValue the way you are at all.

    Indy 9's TIdPeerThread and Indy 10's TIdContext both have a public Data property, you can use that instead to store user-defined values, that is what it is meant for (note: if you use Indy 10 in a Delphi ARC-enabled compiler - Android, iOS, Linux, etc - you will have to use the TIdContext.DataValue property instead).

    And FYI, there is no reason whatsoever to call AThread.Terminate or AContext.Connection.Disconnect in the TIdTCPServer.OnDisconnect event. The thread that manages the socket will be stopped automatically after the event handler exits, and the socket will be closed if it isn't already closed.

    Try something more like this instead:

    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;

    That being said, there is an alternative solution - derive a new class from TIdPeerThread/TIdContext and add your own custom members to it as needed, and then assign that class to the server's ThreadClass/ContextClass property before activating the server. You can then type-cast the provided AThread/AContext object in the server events to your class when you need to access your members, eg:

    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;