Works with one Socket but not two

[ChickenCoder]

I have stripped the code to the base essentials to still create the problem.
My intentions are to create instaces of a Scale class that has a listening
client. IT works if I only have one scale set in my database but will not
even get to FormShow if I set it up for two. On FormCreate, I make a
ScaleList (probably not neccesary since I never need to access the scale
object, once created) .

The CreateScale loops throught he databse to make a Scale instance which in
turn, creates a TReadingInfinitiThread instance.


I guess I have the thread instanciation screwed up. Am I even close to
doing this right?

Thanks,
Larry
=======================================================================================
unit uMain;

interface

uses ...

type
TScale = class
private
fScaleID: Integer;
fPortNbr: Integer;
fIPaddr: String;
fActive: Boolean;
fScaleName: String;

public
ReadingInfinitiThread : TReadingInfinitiThread;
Property ScaleName : String read fScaleName;
Property ScaleID : Integer read fScaleID;
Property PortNbr : Integer read fPortNbr;
Property IPaddr : String read fIPaddr;
Property Active : Boolean read fActive;
//constructor
Constructor Create( Const ScaleName : String;
Const ScaleID : Integer;
Const PortNbr : Integer;
Const IPaddr : String;
Const Active : Boolean);
end;

type
TfrmMain = class(TForm)
pnlMid: TPanel;
StatusBar1: TStatusBar;
ToolBar1: TToolBar;
Splitter1: TSplitter;
pnlBottom: TPanel;
Memo1: TMemo;

procedure Memo1DblClick(Sender: TObject);

procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);

procedure FormCreate(Sender: TObject);

private

FConnInCritSec: TCriticalSection;
fActiveSetID: Integer;

{ Private declarations }
public
{ Public declarations }
fBroadCast: String;

ScaleList : TObjectList;
Procedure DisplayBroadcast;

procedure MakeCriticalSections;
procedure CreateScale;
Property ActiveSetID : Integer read fActiveSetID write fActiveSetID;
Property ConnInCritSec : TCriticalSection read FConnInCritSec;
end;

var
frmMain: TfrmMain;

implementation

uses uDMmain, raw_ping, ABOUT;

{$R *.dfm}



procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
ScaleList.Free;
Action := caFree;
end;

procedure TfrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
FConnInCritSec.Free;
application.Terminate;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin

MakeCriticalSections;

ScaleList := TObjectList.Create(True);
CreateScale;
end;


procedure TfrmMain.MakeCriticalSections;
begin
FConnInCritSec := TCriticalSection.Create;
end;

procedure TfrmMain.Memo1DblClick(Sender: TObject);
begin
Memo1.Clear;
end;

procedure TfrmMain.CreateScale;
var
tScaleName : string;
tScaleID : integer;
tPortNbr : integer;
tIPaddr : string;
tActive : Boolean;

begin
Try
dmMain.qrySettings.open;
With dmMain.qrySettings do
Begin
While Not(Eof) do
Begin
tScaleName := FieldByName('ScaleName').AsString;
tScaleID := FieldByName('ScaleID').AsInteger;
tPortNbr := FieldByName('Port').AsInteger;
tIPaddr := FieldByName('IPAddress').AsString;
tActive := FieldByName('Active').AsBoolean;
ScaleList.Add(TScale.Create(tScaleName, tScaleID, tPortNbr, tIPaddr,
tActive));
Next;
End;
End;

Finally
dmMain.qrySettings.close;
End;
end;


procedure TfrmMain.DisplayBroadcast;
begin
Memo1.Lines.Add(fBroadcast);
end;

{ TScale }

constructor TScale.Create(const ScaleName: String; const ScaleID,
PortNbr: Integer; const IPaddr: String; const Active: Boolean);

Begin
fScaleName := ScaleName;
fScaleID := ScaleID;
fPortNbr := PortNbr;
fIPaddr := IPaddr;
fActive := Active;
ReadingInfinitiThread := TReadingInfinitiThread.Create(fPortNbr, fIPaddr,
fScaleID);
end;

end.

========================================================================================
unit ReadInfiniti;

interface

uses
Classes, IdTCPClient, StrUtils, forms, SysUtils, AdoDb, Windows,
IdTCPConnection;
type
TReadingInfinitiThread = class(TThread)
private
{ Private declarations }
FConn: TIdTCPClient;
Buffer : string;
FBroadcast : string;

procedure DisplayData;
protected

procedure Execute; override;
public

procedure AfterConstruction; override;
constructor Create(Port:integer; IPAddr:String; ScaleID : Integer);
reintroduce;

end;

implementation

uses uMain, IdIOHandler, uDM, dialogs;

{ TReadingInfinitiThread }

procedure TReadingInfinitiThread.AfterConstruction;
begin
inherited;
Resume;
FConn.Connect;
If FConn.Connected then
FConn.IOHandler.Write(Byte(22)); //SYN
end;

procedure TReadingInfinitiThread.DisplayData;
begin
frmMain.ConnInCritSec.Enter;
try
frmMain.fBroadCast := FBroadcast;
frmMain.DisplayBroadcast;
finally
frmMain.ConnInCritSec.Leave;
end;
end;

constructor TReadingInfinitiThread.Create(Port:integer; IPAddr:String;
ScaleID : Integer);
begin
inherited Create(True);
beep(1000, 100);
Priority := tpLower;

try
FConn := TIdTCPClient.Create(application);
with FConn do
begin
ConnectTimeout := 0;
Port := 9100;//Port;
Host := IPAddr;
ReadTimeout := -1;
end;

except
on e:exception do
Begin
FBroadcast := e.Message+' for scale '+IntToStr(ScaleID);
DisplayData;
End;
end;
end;

procedure TReadingInfinitiThread.Execute;
begin
while not Terminated do
begin
case FConn.IOHandler.ReadByte of
$02: // STX
begin
Buffer := FConn.IOHandler.ReadLn(Chr(3));
FBroadcast := 'Buffer '+ Buffer;
DisplayData;
end; // to be picked up by a second thread
else
Begin
FBroadcast := 'unknown character';
DisplayData;
End;
end; //case
end;
end;

end.

[Remy Lebeau (TeamB)]

Post by ChickenCoder
I have stripped the code to the base essentials to still create the problem.

Which is what exactly? You've shown all this code, but you didn't explain
what the underlying problem was.

Post by ChickenCoder
My intentions are to create instaces of a Scale class that has a listening
client. IT works if I only have one scale set in my database but will not
even get to FormShow if I set it up for two.

Sounds like you have a deadlocking issue then.

Post by ChickenCoder
On FormCreate, I make a ScaleList (probably not neccesary since I
never need to access the scale object, once created) .

You do need to keep track of them so you can free them later on.

Post by ChickenCoder
procedure TfrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
FConnInCritSec.Free;
application.Terminate;
end;

Don't call Application.Terminate() like that. The MainForm will handle that
automatically for you when the form is actually closed.

Post by ChickenCoder
ScaleList.Add(TScale.Create(tScaleName, tScaleID, tPortNbr,
tIPaddr, tActive));

I would suggest separating that into two statements, so you can free the
TScale if Add() fails:

Scale := TScale.Create(tScaleName, tScaleID, tPortNbr, tIPaddr,
tActive);
try
ScaleList.Add(Scale);
except
Scale.Free;
raise;
end;

Post by ChickenCoder
procedure TReadingInfinitiThread.AfterConstruction;
begin
inherited;
Resume;
FConn.Connect;
If FConn.Connected then
FConn.IOHandler.Write(Byte(22)); //SYN
end;

You need to move the second half of that code into Execute() instead.
AfterConstruction() runs in the same thread context as the constructor, so
you are calling Connect() and Write() in the context of the main thread, not
the listening thread. If either of those methods blocks, that would explain
why your main thread is freezing. Also, either method can raise an
exception, which you don't want to have happen in your main thread, either.

Post by ChickenCoder
procedure TReadingInfinitiThread.DisplayData;
begin
frmMain.ConnInCritSec.Enter;
try
frmMain.fBroadCast := FBroadcast;
frmMain.DisplayBroadcast;
finally
frmMain.ConnInCritSec.Leave;
end;
end;

That is the wrong way to update the UI. You can't use a critical section
for that. Use the TThread.Synchronize() method instead, or Indy's TIdSync
or TIdNotify class.

Post by ChickenCoder
FConn := TIdTCPClient.Create(application);

You should not be setting the Application as the Owner. Set it to nil
instead, and use the thread's destructor to free it.

Try this updated code:


--- uMain.pas ---

unit uMain;

interface

uses ...

type
TScale = class
private
fScaleID: Integer;
fPortNbr: Integer;
fIPaddr: String;
fActive: Boolean;
fScaleName: String;

public
ReadingInfinitiThread : TReadingInfinitiThread;
Property ScaleName : String read fScaleName;
Property ScaleID : Integer read fScaleID;
Property PortNbr : Integer read fPortNbr;
Property IPaddr : String read fIPaddr;
Property Active : Boolean read fActive;

//constructor
Constructor Create(
Const ScaleName : String;
Const ScaleID : Integer;
Const PortNbr : Integer;
Const IPaddr : String;
Const Active : Boolean);
end;

type
TfrmMain = class(TForm)
pnlMid: TPanel;
StatusBar1: TStatusBar;
ToolBar1: TToolBar;
Splitter1: TSplitter;
pnlBottom: TPanel;
Memo1: TMemo;

procedure Memo1DblClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);

private
fActiveSetID: Integer;

public
ScaleList : TObjectList;
Procedure DisplayBroadcast(const ABroadCast: String);

procedure CreateScale;
Property ActiveSetID : Integer read fActiveSetID write
fActiveSetID;
end;

var
frmMain: TfrmMain;

implementation

uses
uDMmain, raw_ping, ABOUT;

{$R *.dfm}

procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action := caFree;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
ScaleList := TObjectList.Create(True);
CreateScale;
end;

procedure TfrmMain.FormDestroy(Sender: TObject);
begin
ScaleList.Free;
end;

procedure TfrmMain.Memo1DblClick(Sender: TObject);
begin
Memo1.Clear;
end;

procedure TfrmMain.CreateScale;
var
tScaleName: string;
tScaleID: integer;
tPortNbr: integer;
tIPaddr: string;
tActive: Boolean;
Scale: TScale;
begin
dmMain.qrySettings.open;
Try
With dmMain.qrySettings do
Begin
While Not(Eof) do
Begin
tScaleName := FieldByName('ScaleName').AsString;
tScaleID := FieldByName('ScaleID').AsInteger;
tPortNbr := FieldByName('Port').AsInteger;
tIPaddr := FieldByName('IPAddress').AsString;
tActive := FieldByName('Active').AsBoolean;

Scale := TScale.Create(tScaleName, tScaleID, tPortNbr,
tIPaddr, tActive);
try
ScaleList.Add(Scale);
except
Scale.Free;
raise;
end;
Next;
End;
End;
Finally
dmMain.qrySettings.close;
End;
end;

procedure TfrmMain.DisplayBroadcast(const ABroadCast: String);
begin
Memo1.Lines.Add(ABroadCast);
end;

{ TScale }

constructor TScale.Create(const ScaleName: String; const ScaleID,
PortNbr: Integer; const IPaddr: String; const Active: Boolean);
Begin
fScaleName := ScaleName;
fScaleID := ScaleID;
fPortNbr := PortNbr;
fIPaddr := IPaddr;
fActive := Active;
ReadingInfinitiThread := TReadingInfinitiThread.Create(fPortNbr,
fIPaddr, fScaleID);
end;

end.


--- ReadInfiniti.pas ---

unit ReadInfiniti;

interface

uses
Classes, IdTCPClient, StrUtils, forms, SysUtils, AdoDb, Windows,
IdTCPConnection;

type
TReadingInfinitiThread = class(TThread)
private
FConn: TIdTCPClient;
Buffer : string;
FBroadcast : string;

procedure DisplayData;

protected
procedure AfterConstruction; override;
procedure Execute; override;

public
constructor Create(Port:integer; IPAddr:String; ScaleID :
Integer); reintroduce;
destructor Destroy; override;
end;

implementation

uses
uMain, IdIOHandler, uDM, dialogs;

{ TReadingInfinitiThread }

procedure TReadingInfinitiThread.AfterConstruction;
begin
inherited;
Resume;
end;

procedure TReadingInfinitiThread.DisplayData;
begin
frmMain.DisplayBroadcast(FBroadcast);
end;

constructor TReadingInfinitiThread.Create(Port:integer; IPAddr:String;
ScaleID : Integer);
begin
inherited Create(True);
beep(1000, 100);
Priority := tpLower;

try
FConn := TIdTCPClient.Create(nil);
with FConn do
Begin
ConnectTimeout := 0;
Port := 9100;//Port;
Host := IPAddr;
ReadTimeout := -1;
End;
except
on e: Exception do
Begin
FBroadcast := 'Error for scale ' + IntToStr(ScaleID) + ': '
+ e.Message;
DisplayData;
End;
end;
end;

destructor TReadingInfinitiThread.Destroy;
begin
FConn.Free;
inherited;
end;

procedure TReadingInfinitiThread.Execute;
begin
try
FConn.Connect;
try
FConn.IOHandler.Write(Byte(22)); //SYN
while not Terminated do
begin
case FConn.IOHandler.ReadByte of
$02: // STX
begin
Buffer := FConn.IOHandler.ReadLn(Chr(3));
FBroadcast := 'Buffer: ' + Buffer;
Synchronize(DisplayData);
end else
Begin
FBroadcast := 'unknown character';
Synchronize(DisplayData);
End;
end; //case
end;
finally
FConn.Disconnect;
end;
except
on e: Exception do
begin
FBroadcast := 'Error for scale ' + IntToStr(ScaleID) + ': '
+ e.Message;
Synchronize(DisplayData);
end;
end;
end;

end.


Gambit

[ChickenCoder]

Thanks remy,
As usual, you provided me with a lot of good recommendations.

The reason I truncated the code was for brevity. There is a lot more code
but does not pertain to the TCP client or scale.


It appears the After constructor logic was causing the problem but I won't
know for sure until I test on Monday unless I write a little simulator. I
was not aware that the After Constructor ran on the main thread. I learned
something new.

Thanks again for saving my project.

CC

Post by Remy Lebeau (TeamB)

Post by ChickenCoder
I have stripped the code to the base essentials to still create the problem.

Which is what exactly? You've shown all this code, but you didn't explain
what the underlying problem was.

Post by ChickenCoder
My intentions are to create instaces of a Scale class that has a
listening client. IT works if I only have one scale set in my database
but will not even get to FormShow if I set it up for two.

Sounds like you have a deadlocking issue then.

Post by ChickenCoder
On FormCreate, I make a ScaleList (probably not neccesary since I
never need to access the scale object, once created) .

You do need to keep track of them so you can free them later on.

Post by ChickenCoder
procedure TfrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
FConnInCritSec.Free;
application.Terminate;
end;

Don't call Application.Terminate() like that. The MainForm will handle
that automatically for you when the form is actually closed.

Post by ChickenCoder
ScaleList.Add(TScale.Create(tScaleName, tScaleID, tPortNbr,
tIPaddr, tActive));

I would suggest separating that into two statements, so you can free the
Scale := TScale.Create(tScaleName, tScaleID, tPortNbr, tIPaddr,
tActive);
try
ScaleList.Add(Scale);
except
Scale.Free;
raise;
end;

Post by ChickenCoder
procedure TReadingInfinitiThread.AfterConstruction;
begin
inherited;
Resume;
FConn.Connect;
If FConn.Connected then
FConn.IOHandler.Write(Byte(22)); //SYN
end;

You need to move the second half of that code into Execute() instead.
AfterConstruction() runs in the same thread context as the constructor, so
you are calling Connect() and Write() in the context of the main thread,
not the listening thread. If either of those methods blocks, that would
explain why your main thread is freezing. Also, either method can raise
an exception, which you don't want to have happen in your main thread,
either.

Post by ChickenCoder
procedure TReadingInfinitiThread.DisplayData;
begin
frmMain.ConnInCritSec.Enter;
try
frmMain.fBroadCast := FBroadcast;
frmMain.DisplayBroadcast;
finally
frmMain.ConnInCritSec.Leave;
end;
end;

That is the wrong way to update the UI. You can't use a critical section
for that. Use the TThread.Synchronize() method instead, or Indy's TIdSync
or TIdNotify class.

Post by ChickenCoder
FConn := TIdTCPClient.Create(application);

You should not be setting the Application as the Owner. Set it to nil
instead, and use the thread's destructor to free it.
--- uMain.pas ---
unit uMain;
interface
uses ...
type
TScale = class
private
fScaleID: Integer;
fPortNbr: Integer;
fIPaddr: String;
fActive: Boolean;
fScaleName: String;
public
ReadingInfinitiThread : TReadingInfinitiThread;
Property ScaleName : String read fScaleName;
Property ScaleID : Integer read fScaleID;
Property PortNbr : Integer read fPortNbr;
Property IPaddr : String read fIPaddr;
Property Active : Boolean read fActive;
//constructor
Constructor Create(
Const ScaleName : String;
Const ScaleID : Integer;
Const PortNbr : Integer;
Const IPaddr : String;
Const Active : Boolean);
end;
type
TfrmMain = class(TForm)
pnlMid: TPanel;
StatusBar1: TStatusBar;
ToolBar1: TToolBar;
Splitter1: TSplitter;
pnlBottom: TPanel;
Memo1: TMemo;
procedure Memo1DblClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
fActiveSetID: Integer;
public
ScaleList : TObjectList;
Procedure DisplayBroadcast(const ABroadCast: String);
procedure CreateScale;
Property ActiveSetID : Integer read fActiveSetID write fActiveSetID;
end;
var
frmMain: TfrmMain;
implementation
uses
uDMmain, raw_ping, ABOUT;
{$R *.dfm}
TCloseAction);
begin
Action := caFree;
end;
procedure TfrmMain.FormCreate(Sender: TObject);
begin
ScaleList := TObjectList.Create(True);
CreateScale;
end;
procedure TfrmMain.FormDestroy(Sender: TObject);
begin
ScaleList.Free;
end;
procedure TfrmMain.Memo1DblClick(Sender: TObject);
begin
Memo1.Clear;
end;
procedure TfrmMain.CreateScale;
var
tScaleName: string;
tScaleID: integer;
tPortNbr: integer;
tIPaddr: string;
tActive: Boolean;
Scale: TScale;
begin
dmMain.qrySettings.open;
Try
With dmMain.qrySettings do
Begin
While Not(Eof) do
Begin
tScaleName := FieldByName('ScaleName').AsString;
tScaleID := FieldByName('ScaleID').AsInteger;
tPortNbr := FieldByName('Port').AsInteger;
tIPaddr := FieldByName('IPAddress').AsString;
tActive := FieldByName('Active').AsBoolean;
Scale := TScale.Create(tScaleName, tScaleID, tPortNbr,
tIPaddr, tActive);
try
ScaleList.Add(Scale);
except
Scale.Free;
raise;
end;
Next;
End;
End;
Finally
dmMain.qrySettings.close;
End;
end;
procedure TfrmMain.DisplayBroadcast(const ABroadCast: String);
begin
Memo1.Lines.Add(ABroadCast);
end;
{ TScale }
constructor TScale.Create(const ScaleName: String; const ScaleID,
PortNbr: Integer; const IPaddr: String; const Active: Boolean);
Begin
fScaleName := ScaleName;
fScaleID := ScaleID;
fPortNbr := PortNbr;
fIPaddr := IPaddr;
fActive := Active;
ReadingInfinitiThread := TReadingInfinitiThread.Create(fPortNbr,
fIPaddr, fScaleID);
end;
end.
--- ReadInfiniti.pas ---
unit ReadInfiniti;
interface
uses
Classes, IdTCPClient, StrUtils, forms, SysUtils, AdoDb, Windows,
IdTCPConnection;
type
TReadingInfinitiThread = class(TThread)
private
FConn: TIdTCPClient;
Buffer : string;
FBroadcast : string;
procedure DisplayData;
protected
procedure AfterConstruction; override;
procedure Execute; override;
public
Integer); reintroduce;
destructor Destroy; override;
end;
implementation
uses
uMain, IdIOHandler, uDM, dialogs;
{ TReadingInfinitiThread }
procedure TReadingInfinitiThread.AfterConstruction;
begin
inherited;
Resume;
end;
procedure TReadingInfinitiThread.DisplayData;
begin
frmMain.DisplayBroadcast(FBroadcast);
end;
constructor TReadingInfinitiThread.Create(Port:integer; IPAddr:String;
ScaleID : Integer);
begin
inherited Create(True);
beep(1000, 100);
Priority := tpLower;
try
FConn := TIdTCPClient.Create(nil);
with FConn do
Begin
ConnectTimeout := 0;
Port := 9100;//Port;
Host := IPAddr;
ReadTimeout := -1;
End;
except
on e: Exception do
Begin
FBroadcast := 'Error for scale ' + IntToStr(ScaleID) + ': '
+ e.Message;
DisplayData;
End;
end;
end;
destructor TReadingInfinitiThread.Destroy;
begin
FConn.Free;
inherited;
end;
procedure TReadingInfinitiThread.Execute;
begin
try
FConn.Connect;
try
FConn.IOHandler.Write(Byte(22)); //SYN
while not Terminated do
begin
case FConn.IOHandler.ReadByte of
$02: // STX
begin
Buffer := FConn.IOHandler.ReadLn(Chr(3));
FBroadcast := 'Buffer: ' + Buffer;
Synchronize(DisplayData);
end else
Begin
FBroadcast := 'unknown character';
Synchronize(DisplayData);
End;
end; //case
end;
finally
FConn.Disconnect;
end;
except
on e: Exception do
begin
FBroadcast := 'Error for scale ' + IntToStr(ScaleID) + ': '
+ e.Message;
Synchronize(DisplayData);
end;
end;
end;
end.
Gambit