//Formular, wo das Ganze aktiviert oder deaktiviert wird
unit FormMain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TfrmMain =
class(TForm)
cbTCPConnection: TCheckBox;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject;
var Action: TCloseAction);
procedure cbTCPConnectionClick(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
frmMain: TfrmMain;
ConnectionActive: Boolean;
implementation
uses
Connection;
{$R *.dfm}
procedure TfrmMain.cbTCPConnectionClick(Sender: TObject);
begin
ConnectionActive := cbTCPConnection.Checked;
if cbTCPConnection.Checked = false
then
begin
cbTCPConnection.Caption := '
nicht verbunden';
if Assigned(TCPConnection)
then
TCPConnection.TCPClient.Disconnect;
end
else
cbTCPConnection.Caption := '
Verbindung wird hergestellt...';
end;
procedure TfrmMain.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
if Assigned(TCPConnection)
then
TCPConnection.TCPClient.Disconnect;
end;
procedure TfrmMain.FormCreate(Sender: TObject);
begin
ConnectionActive := cbTCPConnection.Checked;
TConnectionWatcher.Create(false);
end;
initialization
TCPConnection :=
nil;
end.
//Und hier die beiden Threads
unit Connection;
interface
uses
Classes, Dialogs, SysUtils, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient;
type
TTCPConnectionClient =
class(TThread)
constructor Create (CreateSuspended: Boolean);
destructor Destroy;
override;
private
Status:
string;
RestData:
string;
protected
procedure Execute;
override;
procedure ClientStatus(ASender: TObject;
const AStatus: TIdStatus;
const AStatusText:
String);
procedure ChangeStatus;
public
TCPClient: TIdTCPClient;
class function Use: TTCPConnectionClient;
end;
type
TConnectionWatcher =
class(TThread)
constructor Create(CreateSuspended: Boolean);
protected
procedure Execute;
override;
end;
var
TCPConnection: TTCPConnectionClient;
ConnectionCheckCounter: integer;
implementation
uses
FormMain;
constructor TTCPConnectionClient.Create(CreateSuspended: Boolean);
begin
inherited Create(CreateSuspended);
FreeOnTerminate := true;
end;
destructor TTCPConnectionClient.Destroy;
begin
if Assigned(TCPConnection)
then
TCPConnection :=
nil;
inherited Destroy;
end;
procedure TTCPConnectionClient.ClientStatus(ASender: TObject;
const AStatus: TIdStatus;
const AStatusText:
String);
begin
if AStatus = hsConnecting
then
Status := '
Verbindung wird hergestellt...'
else if AStatus = hsConnected
then
Status := '
verbunden'
else if (AStatus = hsDisconnecting)
or (AStatus = hsDisconnected)
then
Status := '
nicht verbunden';
Synchronize(ChangeStatus);
end;
procedure TTCPConnectionClient.ChangeStatus;
begin
frmMain.cbTCPConnection.Caption := Status;
end;
procedure TTCPConnectionClient.Execute;
var
RowData, Data, ServerData:
string;
begin
ConnectionCheckCounter := 0;
TCPClient := TIdTCPClient.Create(
nil);
TCPClient.OnStatus := ClientStatus;
TCPClient.Host := '
localhost';
TCPClient.Port := 44491;
try
TCPClient.Connect;
while not Terminated
and TCPClient.Connected
do
begin
ConnectionCheckCounter := 0;
ServerData := TCPClient.IOHandler.ReadLn();
if Length(ServerData) > 0
then
begin
//Hier kommt der Code für die Bearbeitung der empfangenen Daten. Dieser Code ist in Ordnung und ist nicht die Ursache des Problems.
end;
end;
except
end;
if TCPClient.Connected
then
TCPClient.Disconnect;
TCPClient.Free;
end;
class function TTCPConnectionClient.Use: TTCPConnectionClient;
begin
if not Assigned(TCPConnection)
then
begin
TCPConnection := TTCPConnectionClient.Create(false);
end;
Result := TCPConnection;
end;
constructor TConnectionWatcher.Create;
begin
inherited Create(CreateSuspended);
FreeOnTerminate := true;
end;
procedure TConnectionWatcher.Execute;
begin
while not Terminated
do
begin
if ConnectionActive
then
begin
if TCPConnection =
nil then
TCPConnection := TTCPConnectionClient.Use
else
begin
ConnectionCheckCounter := ConnectionCheckCounter + 1;
if ConnectionCheckCounter = 5
then
begin
if TCPConnection <>
nil then
TCPConnection.TCPClient.Disconnect;
end;
end;
end;
Sleep(1000);
end;
end;
end.