// TCP Komponenten Erstellen
procedure TValueGroup.CreateTCP;
var
tmp: TIdTCPClient;
begin
if Assigned( FTCP )
then
begin
if FTCP.Connected
then
try
FTCP.Disconnect( false );
// Hier kommt u.U. der Socket Error 10054
except
on e:
Exception do
frmTCPLog.Add( FTCP.Host + '
: Error on Disconnect "' + e.ClassName + '
: ' + e.
Message + '
". Do not care, we are recreating the connection' );
end;
if Assigned( FTCP.IOHandler )
then
FTCP.IOHandler.InputBuffer.Clear;
FreeAndNil( FTCP );
end;
// Hier sollte eigentlich kein Fehler passieren,
// aber falls doch, dann so absichern
tmp := TIdTCPClient.Create;
try
tmp.IOHandler := TIdIOHandlerStack.Create;
tmp.IOHandler.ReadTimeout := 1000;
tmp.Host := FIP;
tmp.Port := FPort;
tmp.OnStatus := OnTCPStatus;
FTCP := tmp;
tmp :=
nil;
finally
tmp.Free;
end;
end;
// Verbindungsherstellung
procedure TValueGroup.ConnectToGateway;
begin
try
FTCP.ConnectTimeout := 100;
if not FTCP.Connected
then
FTCP.Connect( );
except
on e:
Exception do
begin
// Exception komplett mitloggen
frmTCPLog.Add( FTCP.Host + '
: Connect failed with "' e.ClassName + '
: ' + e.
Message + '
" Recreating.' );
// try
CreateTCP;
// except
// end;
end;
end;
end;
// Meine Daten-Refresh Prozedur
procedure TValueGroup.RefreshData;
var
remainingBytes: Integer;
sAdr : Integer;
begin
remainingBytes := FMaxAddress + 4 + 2;
SetLength( FBuffer, remainingBytes );
try
if not FTCP.Connected
then
ConnectToGateway;
sAdr := 0;
while remainingBytes > 255
do
begin
FRequestBuffer[ 1 ] := Byte( sAdr
shr 8 );
FRequestBuffer[ 2 ] := Byte( sAdr
and $FF );
FRequestBuffer[ 4 ] := 255;
SendBuffer(
TCP, RequestBuffer );
ReceiveBuffer(
TCP, FBuffer, sAdr, 255 );
dec( remainingBytes, 255 );
inc( sAdr, 255 );
end;
FRequestBuffer[ 1 ] := Byte( sAdr
shr 8 );
FRequestBuffer[ 2 ] := Byte( sAdr
and $FF );
FRequestBuffer[ 4 ] := Byte( remainingBytes
and $FF );
SendBuffer(
TCP, RequestBuffer );
ReceiveBuffer(
TCP, FBuffer, sAdr, remainingBytes );
BufferToValues;
except
on e:
Exception do
begin
// Exception komplett mitloggen
frmTCPLog.Add( FTCP.Host + '
: Recovering from "' + e.ClassName + '
: ' + e.
Message + '
"' );
CreateTCP;
end;
end;
end;