FMX调用JAR里的JAVA类Init方法

本文背景：Delphi XE10.3 RIO

由于FMX的JNIBridge将init作为默认的JAVA对象构造函数名，JAR中如果有方法名为init的类方法，FMX都会映射为构成函数，造成调用失败。这一问题需要官方修改Androidapi.JNIBridge单元的MethodIDFor方法逻辑，这里给出一个临时的Fix方法。

unit TU2Helper.Android;

interface

uses System.TypInfo;

procedure TU2FixJavaClassInit(const CTypeInfo: PTypeInfo; const ClsID: Pointer);

implementation

uses System.Rtti, System.SysUtils, System.Generics.Collections,
  Androidapi.Jni, Androidapi.JNIMarshal, Androidapi.JNIBridge;


procedure GetMethodsInVTableOrder(const RttiType: TRttiType; const Methods:TList<TRttiMethod>); overload;
var
  BaseType: TRttiType;
  Method: TRttiMethod;
begin
  BaseType := RttiType.BaseType;
  if BaseType <> nil then
    GetMethodsInVTableOrder(BaseType, Methods);
  for Method in RttiType.GetDeclaredMethods do
    Methods.Add(Method);
end;

function TU2GetMethodsInVTableOrder(const CTypeInfo: PTypeInfo): TList<TRttiMethod>;
var
  Context: TRttiContext;
  RttiType: TRttiType;
begin
  Result := nil;
  Context := TRttiContext.Create;
  try
    RttiType := Context.GetType(CTypeInfo);
    if RttiType <> nil then
    begin
      Result := TList<TRttiMethod>.Create;
      GetMethodsInVTableOrder(RttiType, Result);
    end;
  finally
    Context.Free;
  end;
end;

function MangleType(const AType: TRttiType): string; forward;

function MangleGenericType(const AType: TRttiType): string;
var
  BaseName: string;
  Context: TRttiContext;
  ArrType: TRttiType;
begin
  BaseName := AType.ToString;
  BaseName := BaseName.Substring(BaseName.IndexOf('<') + 1);
  BaseName := BaseName.Substring(0, BaseName.IndexOf('>'));
  Result := BaseName;

  Context := TRttiContext.Create;
  try
    ArrType := Context.FindType(BaseName);
    if ArrType = nil then
      ArrType := Context.GetType(TRegTypes.GetType(BaseName));
    Result := '[' + MangleType(ArrType);
  finally
    Context.Free;
  end;
end;

function MangleType(const AType: TRttiType): string;
var
  Attrs: TArray<TCustomAttribute>;
  SigAttr: JavaSignatureAttribute;
  OrdType: TRttiOrdinalType;
begin
  Result := '';

  case AType.TypeKind of
    tkEnumeration: Result := 'Z'; // Boolean type

    tkWChar: Result := 'C';

    tkInteger:
    begin
      if AType.IsOrdinal then
      begin
        OrdType := AType.AsOrdinal;
        case OrdType.OrdType of
          otSWord, otUWord: Result := 'S';
          otUByte, otSByte: Result := 'B';
          otSLong, otULong: Result := 'I';
        end
      end
      else
        Result := 'I';
    end;

    tkInt64: Result := 'J';

    tkClass:  // We use tkClass to detect array types
      Result := MangleGenericType(AType);

    tkInterface:
    begin
      Attrs := AType.GetAttributes;  // We need the class signature
      if Length(Attrs) > 0 then
      begin
        SigAttr := JavaSignatureAttribute(Attrs[0]);
        Result := 'L' + SigAttr.Signature + ';';
      end;
    end;

    tkFloat:
    begin
      case TRttiFloatType(AType).FloatType of
        ftSingle: Result := 'F';
        ftDouble: Result := 'D';
      end
    end
  end;
end;

function TU2GetMethodSignature(const Method: TRttiMethod): string;
var
  Param: TRttiParameter;
begin
  Result := '(';
  for Param in Method.GetParameters do
    Result := Result + MangleType(Param.ParamType);
  Result := Result + ')';

  if Method.ReturnType <> nil then
    Result := Result + MangleType(Method.ReturnType)
  else
    Result := Result + 'V';
end;

type
  TOpenVTableCache = class(TVTableCache);
  TOpenJavaVTable = class(TRawVTable)
  private
    FMethodInfoData: TArray<JNIMethodInvokeData>;
  end;

procedure TU2FixJavaClassInit(const CTypeInfo: PTypeInfo; const ClsID: Pointer);
var
  JVT: TJavaVTable;
  pMID: PJNIMethodInvokeData;
  cnt, i: Integer;
  lMethods: TList<TRttiMethod>;
  lMethod: TRttiMethod;
  MethodSig: string;
begin
  JVT := TOpenVTableCache.GetVTable(CTypeInfo, ClsID, True);
  cnt := Length(TOpenJavaVTable(JVT).FMethodInfoData);
  if cnt>0 then
  begin
    lMethods := nil;
    pMID := @TOpenJavaVTable(JVT).FMethodInfoData[0];
    for I := 0 to cnt-1 do
    begin
      if (pMID.MethodID=nil) and (pMID.MethodType=mkClassMethod) then
      begin
        if lMethods=nil then
        begin
          lMethods := TU2GetMethodsInVTableOrder(CTypeInfo);
          if lMethods.Count<>cnt then
            raise Exception.Create('Something is wrong');
        end;
        lMethod := lMethods[i];
        if lMethod.Name<>DefaultJConstructorName then
          raise Exception.Create('Something is wrong');
        MethodSig := TU2GetMethodSignature(lMethod);
        pMID.MethodID := TJNIResolver.GetJavaStaticMethodID(ClsID, DefaultJConstructorName, MethodSig);
      end;
      Inc(pMID);
    end;
  end;
end;

end.

使用上只需对jar中含有init方法的类执行一遍该方法即可修复JNI的方法调用信息表。

创建一个测试jar：

package com.tu2.fmx.libtu2;

public class MyClass {

    public int mId;

    public MyClass(){
        mId = -100;  //无参构造函数
    }

    public MyClass(final int id){
        mId = -id;  //构造函数
    }

    public void init(){
        mId = 100;  //对象无参init方法
    }

    public void init(final int id){
        mId = id;  //对象init方法
    }

    public static void init(final MyClass obj){
        obj.mId = 10000;  //类init方法
    }

    public static void init(final MyClass obj, final int id){
        obj.mId = 10000+id;  //类init方法
    }
}

MyClass接口声明单元：

unit libtu2.MyClass;

interface

uses Androidapi.JNIBridge, Androidapi.JNI.JavaTypes;

type
  [JavaSignature('com/tu2/fmx/libtu2/MyClass')]
  JMyClass = interface(JObject)
  ['{65383CE1-0BCF-4772-B95A-D1C110D95A47}']
    function _GetmId: Integer; //I
    procedure _SetmId(amId: Integer); //(I)V

    procedure init; cdecl; overload; //()V
    procedure init(id: Integer); cdecl; overload; //(I)V
    property mId: Integer read _GetmId write _SetmId;
  end;

  JMyClassClass = interface(JObjectClass)
  ['{8D808E82-FCC3-4447-80D9-8D5606FEA5D5}']
    {class} function init: JMyClass; cdecl; overload; //()V
    {class} function init(id: Integer): JMyClass; cdecl; overload; //(I)V

    {class} procedure init(P1: JMyClass); cdecl; overload; //(Lcom/tu2/fmx/libtu2/MyClass;)V
    {class} procedure init(id: JMyClass; P2: Integer); cdecl; overload; //(Lcom/tu2/fmx/libtu2/MyClass;I)V
  end;

  TJMyClass = class(TJavaGenericImport<JMyClassClass, JMyClass>) end;

implementation

end.

测试调用：

var
  myObj: JMyClass;

procedure TForm2.Button1Click(Sender: TObject);
begin
  myObj := TJMyClass.Create;  //映射到无参构造函数
  memo1.lines.Add('创建对象：'+myObj.mId.ToString);
end;

procedure TForm2.Button2Click(Sender: TObject);
begin
  myObj.init;
  memo1.lines.Add('对象方法Init()设置ID：'+myObj.mId.ToString);
  myObj.init(50);
  memo1.lines.Add('对象方法Init(50)设置ID：'+myObj.mId.ToString);
  //方法名为init的对象方法都可以正常调用
end;

procedure TForm2.Button3Click(Sender: TObject);
begin
  try
    myObj := TJMyClass.JavaClass.init(50);
    memo1.lines.Add('类构造方法Init(50)创建新对象：'+myObj.mId.ToString);
    //两个类方法init都不能直接call
    TJMyClass.JavaClass.init(myObj);
    TJMyClass.JavaClass.init(myObj, 500);
  except
    on E: Exception do
      memo1.lines.Add('异常:'+E.Message);
  end;
end;

procedure TForm2.Button4Click(Sender: TObject);
begin
  try
    //TJMyClass.JavaClass;
    TU2FixJavaClassInit(TypeInfo(JMyClassClass), TJMyClass.GetClsID);
    //现在两个类方法init都能直接call
    TJMyClass.JavaClass.init(myObj);
    memo1.lines.Add('类方法Init设置ID：'+myObj.mId.ToString);
    TJMyClass.JavaClass.init(myObj, 500);
    memo1.lines.Add('类方法Init(500)设置ID：'+myObj.mId.ToString);
  except
    on E: Exception do
      memo1.lines.Add('异常:'+E.Message);
  end;
end;

测试结果：

完整演示代码下载。

转载请注明出处，使用请勿修改代码签名。