delphiipworks

TThread with Non-Block tcp calls


I am using the ipWorks component TipwIPPort within a TThread. As I understand it, TipwIPPort is non-blocking.

I am familiar with creating threads where all processing within the Execute method is "blocking".

In this instance I need to connect to a remote server, then make subsequent calls using TIpwIPPort.DataToSend. I call the Connect method in the Execute function of the thread. But the OnConnected event is never fired.

What parameters and properties do I need to set (e.g. "CreateSuspended" passed to constructor, FreeOnTerminate value) so that I can control when to terminate the thread.

type TMyThread=class(TThread)
private
  IPPort1: TipwIPPort;
  procedure IPPort1Connected(Sender: TObject; StatusCode: Integer; const Description: String);
  procedure IPPort1DataIn(Sender: TObject; Text: String; EOL: Boolean);
end;



procedure TMyThread.IPPort1Connected(Sender: TObject; StatusCode: Integer; const Description: String);
begin
// never get here
  AppendToLog('Status Code in Connect:'+inttostr(StatusCode)+'; Description:'+Description);
  if StatusCode = 0 then begin
    //  send data to server using ipport1.datatosend.....
  end;
end;

procedure TMyThread.Execute;
begin
  appendtolog('TMyThread.Execute');
  IPPort1    := TipwIPPort.Create(nil);
  try
    With IPPort1 do begin
      EOL := #4;
      KeepAlive           := True;
      OnConnected         := IPPort1Connected;
      OnDataIn            := IPPort1DataIn;
    end;
    IPPort1.Connect('xxx.xxx.xxx.xxx',8888);
    appendtolog('done with execute');
  finally
  end;
end;

procedure TMyThread.IPPort1DataIn(Sender: TObject; Text: String; EOL: Boolean);
begin

  if (Pos('keytoendconnection',Text)>0)  then begin
    ipPort1.Disconnect;
    // Terminate the thread and free
  end;
end;

procedure TForm1.Button1Click(sender: TObject);
var
  myThread;
begin
  // what parameters and properties do I need to set to allow me to control when the thread is terminated???
  myThread := TMyThread.Create(True);
  mSouthernObject.FreeOnTerminate := False;
  mSouthernObject.Resume;
end;

Solution

  • If you read the documentation for the IPPort component, it states:

    The operation of the component is almost completely asynchronous. All the calls except the ones that deal with domain name resolution operate through asynchronous messages (no blocking calls). The gain in performance is considerable when compared to using blocking calls.

    As such, your thread needs its own message queue/loop to receive and dispatch those socket messages, eg:

    type
      TMyThread = class(TThread)
      private
        IPPort1: TipwIPPort;
        procedure IPPort1Connected(Sender: TObject; StatusCode: Integer; const Description: String);
        procedure IPPort1DataIn(Sender: TObject; Text: String; EOL: Boolean);
      protected
        procedure Execute; override;
        procedure DoTerminate; override;
        procedure TerminatedSet; override;
      end;
    
    procedure TMyThread.IPPort1Connected(Sender: TObject; StatusCode: Integer; const Description: String);
    begin
      AppendToLog('Status Code in Connect:'+inttostr(StatusCode)+'; Description:'+Description);
      if StatusCode = 0 then begin
        //  send data to server using ipport1.datatosend.....
      end else begin
        // start a timer or something to issue WM_CONNECT again after a small delay, say 5-10 seconds at least...
      end;
    end;
    
    const
      WM_CONNECT = WM_APP+1;
    
    procedure TMyThread.Execute;
    var
      Message: TMsg;
    begin
      appendtolog('TMyThread.Execute');
      IPPort1 := TipwIPPort.Create(nil);
      try
        IPPort1.EOL := #4;
        IPPort1.KeepAlive := True;
        IPPort1.OnConnected := IPPort1Connected;
        IPPort1.OnDataIn := IPPort1DataIn;
        PostThreadMessage(ThreadID, WM_CONNECT, 0, 0);
        while not Terminated do
        begin
          if not GetMessage(Message, 0, 0, 0) then Break;
          case Message.Msg of
            WM_CONNECT:
            begin
              IPPort1.Connect('xxx.xxx.xxx.xxx', 8888);
            end;
            //...
          else
            TranslateMessage(Message);
            DispatchMessage(Message);
          end;
        end;
      finally
        IPPort1.Free;
      end;
    end;
    
    procedure TMyThread.DoTerminate;
    begin
      appendtolog('done with execute');
      inherited;
    end;
    
    procedure TMyThread.TerminatedSet;
    begin
      PostThreadMessage(ThreadID, WM_QUIT, 0, 0);
    end;
    
    procedure TMyThread.IPPort1DataIn(Sender: TObject; Text: String; EOL: Boolean);
    begin
      if Pos('keytoendconnection', Text) > 0 then
      begin
        ipPort1.Disconnect;
        Terminate;
      end;
    end;
    

    private
      myThread: TMyThread;
    
    procedure TForm1.Button1Click(sender: TObject);
    begin
      myThread := TMyThread.Create(False);
    end;
    
    procedure TForm1.Button2Click(sender: TObject);
    begin
      if myThread <> nil then
      begin
        myThread.Terminate;
        myThread.WaitFor;
        FreeAndNil(myThread);
      end;
    end;