非rtti路由

非rtti路由

/// <author>2023-3-13</author> fit delphi\lazarus
unit api.router;
{$I def.inc}

interface

uses
  mormot.net.ws.core,
  mormot.net.http, yn.log, Classes, StrUtils, SysUtils;

type
  /// <summary>
  /// http function
  /// </summary>
  TFun = procedure(ctxt: THttpServerRequestAbstract) of object;
  /// <summary>
  /// websocket function
  /// </summary>
  TFunWs = function(reqFrame: TWebSocketFrame): RawByteString of object;
  /// <code>
  /// base-class
  /// </code>

  TFunc = class(TPersistent);

/// <summary>
/// router http function
/// </summary>
procedure router(className, funcName: string; ctxt: THttpServerRequestAbstract);
/// <summary>
/// router websocket function
/// </summary>
/// <param name="className"></param>
/// <param name="funcName"></param>
/// <param name="inFrame"></param>
/// <param name="outFrame"></param>
function routerWs(className, funcName: string; reqFrame: TWebSocketFrame): RawByteString;

implementation

function routerWs(className, funcName: string; reqFrame: TWebSocketFrame): RawByteString;
var
  m: TMethod;
  f: TFunWs;
  p: TPersistentClass;
begin
  try
    p := FindClass(className);
    if p = nil then
      exit;
    m.Data := Pointer(p);
    m.Code := p.MethodAddress(funcName);
    if Assigned(m.Code) then
    begin
      f := TFunWs(m);
      Result := f(reqFrame);
    end;
  except
    on E: Exception do
    begin
      yn.log.WriteLog('api.router.routerWs()' + E.Message);
    end;
  end;
end;

procedure router(className, funcName: string; ctxt: THttpServerRequestAbstract);
var
  m: TMethod;
  f: TFun;
  p: TPersistentClass;
begin
  try
    p := FindClass(className);
    if p = nil then
      exit;
    m.Data := Pointer(p);
    m.Code := p.MethodAddress(funcName);
    if Assigned(m.Code) then
    begin
      f := TFun(m);
      f(ctxt);
    end;
  except
    on E: Exception do
    begin
      yn.log.WriteLog('api.router.router()' + E.Message);
    end;
  end;
end;

end.