Search code examples
delphiindytcpserver

With Delphi and Indy 10.6 I can't find OnWork for TIdServerContext


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;

Solution

  • 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;