Adding object methods to a stringlist so they can be invoked by name

问题

I have server code than accepts commands from clients and executes object methods, as determined by the command received. I want to build a stringlist using AddObject to associate the command with the desired procedure. This works fine with standalone procedures but I get "variable required" errors when trying to add object methods to my stringlist. Here's example code:

type
  TExample = class
  public
    var Commands: TStringList;
    constructor Create;
    destructor Destroy; override;
    procedure ExecCommand(Cmd, Msg: string);
    procedure Alpha(Msg: string);
    procedure Beta(Msg: string);
    procedure Gamma(Msg: string);
  end;

constructor TExample.Create;
begin
  inherited Create;
  Commands := TStringList.Create;
  Commands.AddObject('Alpha', @Alpha); // fails to compile: "variable required"
  Commands.AddObject('Beta', @Beta);
  Commands.AddObject('Gamma', @Gamma);
end;

destructor TExample.Destroy;
begin
  Commands.Free;
  inherited Destroy;
end;

procedure TExample.ExecCommand(Cmd, Msg: string);
type
  TProcType = procedure(Msg: string);
var
  i: integer;
  P: TProcType;
begin
  i := Commands.IndexOf(Cmd);
  if i >= 0 then
  begin
    P := TProcType(Commands.Objects[i]);
    P(Msg);
  end;
end;

procedure TExample.Alpha(Msg: string);
begin
  ShowMessage('Alpha: ' + Msg);
end;

procedure TExample.Beta(Msg: string);
begin
  ShowMessage('Beta: ' + Msg);
end;

procedure TExample.Gamma(Msg: string);
begin
  ShowMessage('Gamma: ' + Msg);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Example: TExample;
  Cmd, Msg: string;
begin
  Cmd := Edit1.Text;
  Msg := Edit2.Text;
  Example := TExample.Create;
  Example.ExecCommand(Cmd, Msg);
  Example.Free;
end;

回答1:

You are trying to call non-static class methods on TExample objects, so you need to add of object to the declaration of TPropType to handle the Self parameter:

type
  TProcType = procedure(Msg: string) of object;

However, non-static object method pointers are larger then plain vanilla pointers, as they carry two pieces of information - a pointer to the object, and a pointer to the method to call on the object - so you can't directly store a non-static method pointer in the TStringList.Objects[] list. However, you can store it indirectly.

One way is to dynamically allocating the method pointers, eg:

type
  TExample = class
  public
    var Commands: TStringList;
    constructor Create;
    destructor Destroy; override;
    procedure ExecCommand(Cmd, Msg: string);
    procedure Alpha(Msg: string);
    procedure Beta(Msg: string);
    procedure Gamma(Msg: string);
  end;

type
  TProcType = procedure(Msg: string) of object;
  PProcType = ^TProcType;

constructor TExample.Create;
var
  P: PProcType;
begin
  inherited Create;
  Commands := TStringList.Create;

  New(P);
  P^ := @Alpha;
  Commands.AddObject('Alpha', TObject(P));

  New(P);
  P^ := @Beta;
  Commands.AddObject('Beta', TObject(P));

  New(P);
  P^ := @Gamma;
  Commands.AddObject('Gamma', TObject(P));
end;

destructor TExample.Destroy;
var
  I: Integer;
begin
  for I := 0 to Commands.Count-1 do
    Dispose(PProcType(Commands.Objects[I]));
  Commands.Free;
  inherited Destroy;
end;

procedure TExample.ExecCommand(Cmd, Msg: string);
var
  i: integer;
  P: PProcType;
begin
  i := Commands.IndexOf(Cmd);
  if i >= 0 then
  begin
    P := PProcType(Commands.Objects[i]);
    P^(Msg);
  end;
end;

procedure TExample.Alpha(Msg: string);
begin
  ShowMessage('Alpha: ' + Msg);
end;

procedure TExample.Beta(Msg: string);
begin
  ShowMessage('Beta: ' + Msg);
end;

procedure TExample.Gamma(Msg: string);
begin
  ShowMessage('Gamma: ' + Msg);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Example: TExample;
  Cmd, Msg: string;
begin
  Cmd := Edit1.Text;
  Msg := Edit2.Text;
  Example := TExample.Create;
  Example.ExecCommand(Cmd, Msg);
  Example.Free;
end;

Another way is to store static pointers to the class methods, and then make use of the TMethod record to help you when you need to call the methods, like @OndrejKelle described in comments, eg:

type
  TExample = class
  public
    var Commands: TStringList;
    constructor Create;
    destructor Destroy; override;
    procedure ExecCommand(Cmd, Msg: string);
    procedure Alpha(Msg: string);
    procedure Beta(Msg: string);
    procedure Gamma(Msg: string);
  end;

type
  TProcType = procedure(Msg: string) of object;

constructor TExample.Create;
begin
  inherited Create;
  Commands := TStringList.Create;
  Commands.AddObject('Alpha', TObject(@TExample.Alpha));
  Commands.AddObject('Beta', TObject(@TExample.Beta));
  Commands.AddObject('Gamma', TObject(@TExample.Gamma));
end;

destructor TExample.Destroy;
begin
  Commands.Free;
  inherited Destroy;
end;

procedure TExample.ExecCommand(Cmd, Msg: string);
var
  i: integer;
  P: TProcType;
begin
  i := Commands.IndexOf(Cmd);
  if i >= 0 then
  begin
    TMethod(P).Data := Self;
    TMethod(P).Code := Pointer(Commands.Objects[i]);
    P(Msg);
  end;
end;

procedure TExample.Alpha(Msg: string);
begin
  ShowMessage('Alpha: ' + Msg);
end;

procedure TExample.Beta(Msg: string);
begin
  ShowMessage('Beta: ' + Msg);
end;

procedure TExample.Gamma(Msg: string);
begin
  ShowMessage('Gamma: ' + Msg);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Example: TExample;
  Cmd, Msg: string;
begin
  Cmd := Edit1.Text;
  Msg := Edit2.Text;
  Example := TExample.Create;
  Example.ExecCommand(Cmd, Msg);
  Example.Free;
end;

But either way, a TStringList is really not the best tool for this job. You really should use a TDictionary instead, then you are not having to jump through unnecessary hoops, eg:

uses
  ..., System.Generics.Collections;

type
  TProcType = procedure(Msg: string) of object;

  TExample = class
  public
    var Commands: TDictionary<String, TProcType>;
    constructor Create;
    destructor Destroy; override;
    procedure ExecCommand(Cmd, Msg: string);
    procedure Alpha(Msg: string);
    procedure Beta(Msg: string);
    procedure Gamma(Msg: string);
  end;

constructor TExample.Create;
begin
  inherited Create;
  Commands := TDictionary<String, TProcType>.Create;
  Commands.Add('Alpha', @Alpha);
  Commands.Add('Beta', @Beta);
  Commands.Add('Gamma', @Gamma);
end;

destructor TExample.Destroy;
begin
  Commands.Free;
  inherited Destroy;
end;

procedure TExample.ExecCommand(Cmd, Msg: string);
var
  P: TProcType;
begin
  if Commands.TryGetValue(Cmd, P) then
    P(Msg);
end;

procedure TExample.Alpha(Msg: string);
begin
  ShowMessage('Alpha: ' + Msg);
end;

procedure TExample.Beta(Msg: string);
begin
  ShowMessage('Beta: ' + Msg);
end;

procedure TExample.Gamma(Msg: string);
begin
  ShowMessage('Gamma: ' + Msg);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Example: TExample;
  Cmd, Msg: string;
begin
  Cmd := Edit1.Text;
  Msg := Edit2.Text;
  Example := TExample.Create;
  Example.ExecCommand(Cmd, Msg);
  Example.Free;
end;

回答2:

Thanks for the posted solutions. I decided to use the TMethod option and simplify it. Since I can make the passed in commands match my object method names exactly, I can skip the hash list and make the calls directly as such:

type
  TExample = class
  published
    procedure Alpha(Msg: string);
    procedure Beta(Msg: string);
    procedure Gamma(Msg: string);
  public
    procedure ExecCommand(Cmd, Msg: string);
  end;

procedure TExample.ExecCommand(Cmd, Msg: string);
type
  TProcType = procedure(Msg: string) of object;
var
  M: TMethod;
  P: TProcType;
begin
  M.Code := Self.MethodAddress(Cmd);
  if M.Code = Nil then ShowMessage('Unknown command: ' + Cmd) else
  begin
    M.Data := Pointer(Self);
    P := TProcType(M);
    P(Msg);
  end;
end;

来源：https://stackoverflow.com/questions/59779258/adding-object-methods-to-a-stringlist-so-they-can-be-invoked-by-name