In setting up my TCP Client/Server system, I've subclassed the TIdServerContext
to add an index flag, but there doesn't seem to be an OnWork
event. I need to reset a timer, say while uploading/downloading a large file, and a lot of the Indy components have an OnWork
event geared for this, but I can't find one for the TIdServerContext
or TIdTCPServer
, and the TIdTCPServer.OnStatus
event appears to be unimplemented, according to other posts.
Here's how I implemented the TIdServerContext
:
TUserContext = Class(TIdServerContext)
Protected
FUserID: Integer;
Public
Property UserID: Integer Read FUserID Write FUserID Default 0;
End;
Procedure FormCreate(Sender: TObject);
Begin
Server.ContextClass := TUserContext;
End;
Procedure ServerExecute(AContext: TIdContext);
Var
I: Integer;
Begin
I := TUserContext(AContext).UserID;
...
End;
The OnWork...
events are in the TIdComponent
class, which TIdServerContext
does not derive from. However, TIdTCPConnection
and TIdIOHandler
do. TIdContext
has a public Connection
property, so in your server's events (OnConnect
, OnExecute
, etc), you can assign handlers to the TIdConnection.OnWork...
events as needed:
procedure TMyForm.ServerConnect(AContext: TIdContext);
begin
AContext.Connection.Tag := NativeInt(AContext);
AContext.Connection.OnWork := WorkHandler;
end;
procedure TMyForm.WorkHandler(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
var
Ctx: TUserContext;
begin
Ctx := TUserContext(TIdTCPConnection(ASender).Tag);
// use Ctx members as needed...
end;
Or, another way to pass AContext
to WorkHandler
without using Tag
:
procedure TMyForm.ServerConnect(AContext: TIdContext);
var
Handler: TWorkEvent;
begin
Handler := WorkHandler;
TMethod(Handler).Data := AContext;
AContext.Connection.OnWork := Handler;
end;
procedure TMyForm.WorkHandler(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
var
Ctx: TUserContext;
begin
Ctx := TUserContext(Self);
// use Ctx members as needed...
end;
Another way to handle this is to override the TIdServerContext
constructor, which receives the TIdTCPConnection
object as a parameter. You could make your handlers be methods of the TUserContext
class itself, and have its constructor assign the OnWork...
events immediately, instead of waiting for the server's On(Connect|OnExecute)
events to fire first:
type
TUserContext = Class(TIdServerContext)
protected
FUserID: Integer;
procedure WorkHandler(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
public
constructor Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TIdContextThreadList = nil); override;
property UserID: Integer read FUserID write FUserID;
end;
constructor TUserContext.Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TIdContextThreadList = nil);
begin
inherited;
AConnection.OnWork := WorkHandler;
end;
procedure TUserContext.WorkHandler(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
begin
// use Self members as needed...
end;
Or, if you just need the event on an as-needed basis:
type
TUserContext = Class(TIdServerContext)
protected
FUserID: Integer;
procedure WorkHandler(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
public
procedure StartWorkTimer;
procedure StopWorkTimer;
property UserID: Integer read FUserID write FUserID;
end;
procedure TUserContext.StartWorkTimer;
begin
Connection.OnWork := WorkHandler;
end;
procedure TUserContext.StopWorkTimer;
begin
Connection.OnWork := nil;
end;
procedure TMyForm.ServerExecute(AContext: TIdContext);
var
Ctx: TUserContext;
begin
Ctx := TUserContext(AContext);
...
if (some condition) then
Ctx.StartWorkTimer;
...
if (some other condition) then
Ctx.StopWorkTimer;
...
end;