Question

在设置我的TCP客户端/服务器系统时，我已经将TIdServerContext子类化为添加索引标志，但似乎并不是OnWork事件。我需要重置计时器，比如在上传/下载大文件时，很多Indy组件都有一个OnWork事件，但是我找不到{{1}根据其他帖子，}或TIdServerContext，TIdTCPServer事件似乎未实现。

以下是我实施TIdTCPServer.OnStatus：

的方法

TIdServerContext

Answer 1

OnWork...类位于TIdComponent类中，而TIdServerContext并非来自TIdTCPConnection类。但是，TIdIOHandler和TIdContext会这样做。 Connection具有公开OnConnect属性，因此在您的服务器事件（OnExecute，TIdConnection.OnWork...等）中，您可以为{{1}分配处理程序根据需要发生事件：

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;

或者，在不使用AContext的情况下将WorkHandler传递给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;

另一种处理此问题的方法是覆盖TIdServerContext构造函数，该构造函数接收TIdTCPConnection对象作为参数。您可以使处理程序成为TUserContext类本身的方法，并让其构造函数立即分配OnWork...个事件，而不是等待服务器的On(Connect|OnExecute)事件首先触发：

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;

或者，如果您只是根据需要需要该活动：

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;

使用Delphi和Indy 10.6，我找不到OnWork for TIdServerContext

1 个答案: