How to access Tag property-CodePudding

How can I access HTTPRIO.Tag previously assigned from, for instance, the HTTPRIO.OnBeforeExecute event? Is it possible?

Let's say I have something like this:

procedure TForm1.HTTPRIO1BeforeExecute(const MethodName: string; SOAPRequest: TStream);
begin
  if THHPRIO(Sender).Tag = 99 then
    ...some code...
end;

But I don't have a Sender on any of the THTTPRIO events.

CodePudding user response：

Since you are assigning events to multiple THTTPRIO objects, but don't have access to a Sender parameter in the events (bad design on THTTPRIO's author), one workaround is to use the TMethod record to manipulate the event handler's Self pointer to point at the THTTPRIO object rather than the TForm1 object, eg:

procedure TForm1.FormCreate(Sender: TObject);
var
  M: TBeforeExecuteEvent;
begin
  M := HTTPRIOBeforeExecute;
  TMethod(M).Data := HTTPRIO1;
  HTTPRIO1.OnBeforeExecute := M;

  M := HTTPRIOBeforeExecute;
  TMethod(M).Data := HTTPRIO2;
  HTTPRIO2.OnBeforeExecute := M;

  // and so on ...
end;

And then you can type-cast Self inside the events, eg:

procedure TForm1.HTTPRIOBeforeExecute(const MethodName: string; SOAPRequest: TStream);
begin
  if THTTPRIO(Self).Tag = 99 then
    ...some code...
end;

Alternatively, you can use a standalone procedure (or class static method) with an explicit parameter for the Self pointer, eg:

procedure HTTPRIOBeforeExecute(Sender: THTTPRIO; const MethodName: string; SOAPRequest: TStream);
begin
  if Sender.Tag = 99 then
    ...some code...
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  M: TBeforeExecuteEvent;
begin
  TMethod(M).Data := HTTPRIO1;
  TMethod(M).Code := @HTTPRIOBeforeExecute;
  HTTPRIO1.OnBeforeExecute := M;

  TMethod(M).Data := HTTPRIO2;
  TMethod(M).Code := @HTTPRIOBeforeExecute;
  HTTPRIO2.OnBeforeExecute := M;

  // and so on ...
end;

CodePudding user response：

While Remy's solution works, leaving the code in TForm1 leaves you at risk of accidentally referencing fields from TForm1 in TForm1.HTTPRIOBeforeExecute, and since "Self" isn't a TForm1 anymore, that would crash/corrupt memory.

I would personally use the following approach :

THTTPRIOMethodHolder = class(THTTPRIO)
public
  procedure HTTPRIOBeforeExecute(const MethodName: string; SOAPRequest: TStream);
end;

procedure THTTPRIOMethodHolder.HTTPRIOBeforeExecute(const MethodName: string; SOAPRequest: TStream);
begin
  if {self.}Tag = 99 then
    ...some code...
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  HTTPRIO1.OnBeforeExecute := THTTPRIOMethodHolder(HTTPRIO1).HTTPRIOBeforeExecute;
  HTTPRIO2.OnBeforeExecute := THTTPRIOMethodHolder(HTTPRIO2).HTTPRIOBeforeExecute;
end;

This should work as long as you don't add fields in THTTPRIOMethodHolder and HTTPRIOBeforeExecute is not made virtual.