Code: Alles auswählen
unit TCPListenerThread;
interface
uses
Classes, IdTCPConnection;
type
TTCPListenerThread = class(TThread)
private
{ Private-Deklarationen }
FConnection : TIdTCPConnection;
FOnDataPresent: TNotifyEvent;
FReadDataSize : integer;
function GetConnection: TIdTCPConnection;
procedure SetConnection(Value: TIdTCPConnection);
procedure LookForData;
procedure DoDataPresent;
protected
procedure Execute; override;
public
constructor Create(ASuspended: boolean);
property Connection: TIdTCPConnection read FConnection write FConnection;
property OnDataPresent: TNotifyEvent
read FOnDataPresent write FOnDataPresent;
property ReadDataSize: integer read FReadDataSize write FReadDataSize;
end;
implementation
{ Wichtig: Methoden und Eigenschaften von Objekten in visuellen Komponenten dürfen
nur in einer Methode namens Synchronize aufgerufen werden, z.B.
Synchronize(UpdateCaption);
und UpdateCaption könnte folgendermaßen aussehen:
procedure TTCPListenerThread.UpdateCaption;
begin
Form1.Caption := 'Aktualisiert in einem Thread';
end; }
{ TTCPListenerThread }
{-----------------------------------------------------------------------------
Class: TTCPListenerThread
Methode: Create
Author: hardy
Date: 07-Jun-2006
Arguments: ASuspended: boolean
-----------------------------------------------------------------------------}
constructor TTCPListenerThread.Create(ASuspended: boolean);
const
cProcName = 'TCPListenerThread.TTCPListenerThread.Create';
function SetErrorParams: string;
begin
Result:= '';
// 'ASuspended: boolean'
end; // of function SetErrorParams: string
begin
{ procedure body }
inherited Create(ASuspended);
{$IFDEF WIN32}
Self.Priority:= tpIdle;
{$ENDIF}
{$IFDEF LINUX}
Self.Priority:= 3;
{$ENDIF}
end; // of TTCPListenerThread.Create
{-----------------------------------------------------------------------------
Class: TTCPListenerThread
Method: GetConnection
Author: hardy
Date: 06-Jun-2006
Arguments: None
Result: TIdTCPConnection
-----------------------------------------------------------------------------}
function TTCPListenerThread.GetConnection: TIdTCPConnection;
const
cProcName = 'TCPListenerThread.TTCPListenerThread.GetConnection';
function SetErrorParams: string;
begin
Result:= '';
// 'None'
// 'TIdTCPConnection';
end; // of function SetErrorParams: string
begin
{ function body }
try
Result:= FConnection;
except
raise;
end;
end; // of TTCPListenerThread.GetConnection
{-----------------------------------------------------------------------------
Class: TTCPListenerThread
Methode: SetConnection
Author: hardy
Date: 06-Jun-2006
Arguments: Value: TIdTCPConnection
-----------------------------------------------------------------------------}
procedure TTCPListenerThread.SetConnection(Value: TIdTCPConnection);
const
cProcName = 'TCPListenerThread.TTCPListenerThread.SetConnection';
function SetErrorParams: string;
begin
Result:= '';
// 'Value: TIdTCPConnection'
end; // of function SetErrorParams: string
begin
{ procedure body }
try
if (Value <> FConnection) and (Value <> nil) then begin
FConnection:= Value;
end; // of if (Value <> FConnection) then begin
except
raise;
end;
end; // of TTCPListenerThread.SetConnection
{-----------------------------------------------------------------------------
Class: TTCPListenerThread
Method: LookForData
Author: hardy
Date: 06-Jun-2006
Arguments: None
-----------------------------------------------------------------------------}
procedure TTCPListenerThread.LookForData;
const
cProcName = 'TCPListenerThread.TTCPListenerThread.LookForData';
function SetErrorParams: string;
begin
Result:= '';
// 'var ADataSize: integer'
// 'boolean';
end; // of function SetErrorParams: string
begin
{ function body }
if (FConnection.IOHandler <> nil) then begin
{-------------------------------------------------------------------------
Author: hardy
Date: 13-Jun-2006
Subject: Wichtig
Comment: An dieser Stelle auf keinen Fall etwas ändern.
Der except-Block muß leer bleiben, da sonst
ein Disconnect des Client durchgeführt wird. Dies
tritt immer dann ein, wenn der Read-Stack des Sockets
leer, der Server also vorübergehend keine Daten sendet
-------------------------------------------------------------------------}
try
FConnection.InputBuffer.PackBuffer;
FReadDataSize:= FConnection.ReadFromStack(false, -1, false);
except
end;
end; // of if (Con.IOHandler <> nil) then begin
end; // of TTCPListenerThread.LookForData
{-----------------------------------------------------------------------------
Class: TTCPListenerThread
Methode: DoDataPresent
Author: hardy
Date: 06-Jun-2006
Arguments: None
-----------------------------------------------------------------------------}
procedure TTCPListenerThread.DoDataPresent;
const
cProcName = 'TCPListenerThread.TTCPListenerThread.DoDataPresent';
function SetErrorParams: string;
begin
Result:= '';
// 'None'
end; // of function SetErrorParams: string
begin
{ procedure body }
if Assigned(FOnDataPresent) then begin
Self.Suspended:= true;
OnDataPresent(Self);
Self.Suspended:= false;
end;
end; // of TTCPListenerThread.DoDataPresent
{-----------------------------------------------------------------------------
Class: TTCPListenerThread
Methode: Execute
Author: hardy
Date: 06-Jun-2006
Arguments: None
-----------------------------------------------------------------------------}
procedure TTCPListenerThread.Execute;
const
cProcName = 'TCPListenerThread.TTCPListenerThread.Execute';
function SetErrorParams: string;
begin
Result:= '';
// 'None'
end; // of function SetErrorParams: string
begin
{ procedure body }
repeat
if not(Suspended) and not(Terminated) then begin
Self.Synchronize(LookForData);
if (FReadDataSize > 0) then Self.Synchronize(DoDataPresent);
end; // of if FConnection.Connected then begin
until Self.Terminated;
end; // of TTCPListenerThread.Execute
end.
.
Verein
Links
Suche