Hosting CLR in Delphi with/without JCL - example

Question

Can somebody please post here an example how to host CLR in Delphi? I have read similar question here but I cannot use JCL as I want to host it in Delphi 5. Thank you.

Answer 1

Here you go:

program CallDotNetFromDelphiWin32;

{$APPTYPE CONSOLE}

uses
  Variants, JclDotNet, mscorlib_TLB, SysUtils;

var
  Host: TJclClrHost;
  Obj: OleVariant;
begin
  try
    Host := TJclClrHost.Create;
    Host.Start;
    WriteLn('CLRVersion = ' + Host.CorVersion);

    Obj := Host.DefaultAppDomain.CreateInstance('DelphiNET', 'DelphiNET.NETAdder').UnWrap;
    WriteLn('2 + 3 = ' + IntToStr(Obj.Add3(2)));

    Host.Stop;
  except
    on E: Exception do
      Writeln(E.Classname, ': ', E.Message);
  end;
end.

Note: Assumes that the DelphiNET.NETAdder type and the Add3 method in DelphiNet.dll is ComVisible. Thanks to Robert.

Update:

When using reflection you do not need the ComVisible attribute. Next example even works without being ComVisible.

Assm := Host.DefaultAppDomain.Load_2('NetAddr');
T := Assm.GetType_2('DelphiNET.NETAdder');
Obj := T.InvokeMember_3('ctor', BindingFlags_CreateInstance, nil, null, nil);
Params := VarArrayOf([2]);
WriteLn('2 + 3 = ' + IntToStr(T.InvokeMember_3('Add3', BindingFlags_InvokeMethod, nil, Obj, PSafeArray(VarArrayAsPSafeArray(Params)))));

Answer 2

Here's another option.

That's the C# Code. And even if you do not want to use my unmanaged exports, it would still explain how to use mscoree (the CLR hosting stuff) without going through IDispatch (IDispatch is pretty slow).

using System;
using System.Collections.Generic;
using System.Text;
using RGiesecke.DllExport;
using System.Runtime.InteropServices;

namespace DelphiNET
{

   [ComVisible(true)]
   [InterfaceType(ComInterfaceType.InterfaceIsIUnknown)]
   [Guid("ACEEED92-1A35-43fd-8FD8-9BA0F2D7AC31")]
   public interface IDotNetAdder
   {
      int Add3(int left);
   }

   [ComVisible(true)]
   [ClassInterface(ClassInterfaceType.None)]
   public class DotNetAdder : DelphiNET.IDotNetAdder
   {
      public int Add3(int left)
      {
         return left + 3;
      }
   }

   internal static class UnmanagedExports
   {
      [DllExport("createdotnetadder", CallingConvention = System.Runtime.InteropServices.CallingConvention.StdCall)]
      static void CreateDotNetAdderInstance([MarshalAs(UnmanagedType.Interface)]out IDotNetAdder instance)
      {
         instance = new DotNetAdder();
      }
   }
}

This is the Delphi interface declaration:

type
  IDotNetAdder = interface
  ['{ACEEED92-1A35-43fd-8FD8-9BA0F2D7AC31}']
    function Add3(left : Integer) : Integer; safecall;
  end;

If you use unmanaged exports, you can do it like so:

procedure CreateDotNetAdder(out instance :  IDotNetAdder); stdcall;
  external 'DelphiNET' name 'createdotnetadder';

var
  adder : IDotNetAdder;
begin
  try
   CreateDotNetAdder(adder);
   Writeln('4 + 3 = ', adder.Add3(4));
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
end.

When I adapt Lars' sample, it would look like so:

var
  Host: TJclClrHost;
  Obj: IDotNetAdder;
begin
  try
    Host := TJclClrHost.Create;
    Host.Start();
    WriteLn('CLRVersion = ' + Host.CorVersion);

    Obj := Host.DefaultAppDomain
               .CreateInstance('DelphiNET', 
                               'DelphiNET.DotNetAdder')
               .UnWrap() as IDotNetAdder;
    WriteLn('2 + 3 = ', Obj.Add3(2));

    Host.Stop();
  except
    on E: Exception do
      Writeln(E.Classname, ': ', E.Message);
  end;
end.

In this case you could remove the "UnmanagedExports" class from the C# code, of course.

Answer 3

Thanks this forum I find out the best solution to use dll C# with Lazarus:

C#:

using System;
using System.Collections.Generic;
using System.Text;
using RGiesecke.DllExport;
using System.Runtime.InteropServices;

namespace DelphiNET
{

    [ComVisible(true)]
    [InterfaceType(ComInterfaceType.InterfaceIsIUnknown)]
    [Guid("BA7DFB53-6CEC-4ADA-BE5E-16F1A46DFAC5")]
    public interface IDotNetAdder
    {
        int Add3(int left);

        int Mult3(int left);

        string Expr3(string palavra);
    }

    [ComVisible(true)]
    [ClassInterface(ClassInterfaceType.None)]
    public class DotNetAdder : DelphiNET.IDotNetAdder
    {
        public int Add3(int left)
        {
            return left + 3;
        }

        public int Mult3(int left)
        {
            return left * 3;
        }

        public string Expr3(string palavra)
        {
            return palavra + " é a palavra que estou esperando!";
        }
    }

    internal static class UnmanagedExports
    {
        [DllExport("createdotnetadder", CallingConvention = System.Runtime.InteropServices.CallingConvention.StdCall)]
        static void CreateDotNetAdderInstance([MarshalAs(UnmanagedType.Interface)]out IDotNetAdder instance)
        {
            instance = new DotNetAdder();
        }
    }
}

Lazarus:

unit uDLLC01;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls{, dynlibs};

type

   IDotNetAdder = interface
   ['{BA7DFB53-6CEC-4ADA-BE5E-16F1A46DFAC5}']
    function Add3(left : integer):integer; safecall; {stdcall nao funciona}
    function Mult3(left : integer):integer; safecall;
    function Expr3(left : WideString):WideString; safecall;
   end;

  { TForm1 }
  TForm1 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;


var
  Form1: TForm1;

implementation

{stdcall e cdecl work well; cdecl say is C style to Lazarus}
procedure createdotnetadder(out instance:IDotNetAdder); cdecl external 'IDotNetAdder.dll' name 'createdotnetadder';

{$R *.lfm}

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
var
  x     : LongInt = 0;
  y     : LongInt = 0;
  z     : WideString;
  nTam  : integer;
  adder : IDotNetAdder;
begin
  try
     createdotnetadder(adder);
     z := adder.Expr3('Antonio');
     nTam := Length(z);
     x := adder.Add3(4);
     y := adder.Mult3(4);
  finally
     showmessage('4 + 3 = '+ (inttostr(x)));
     showmessage('4 * 3 = '+ (inttostr(y)));
     showmessage('Expressão = ' + String(z));
  end;
end;

end.

Observe that var Z is WideString, the only type that worked as string type, I tried String, AnsiString and PChar but didnt work, they return only the first char. Im having problem with accent like the word "Antônio" to send as parameter, Im trying to find a converter that the C# can understand and send back the same word.

Answer 4

I faced some troubles with "TJclClrHost" component (cf. comments in src code). After searching around, i found-out "CppHostCLR" Microsoft sample which is the new interfaced path in order to host .NET runtime in Win32/64 application...

Here's a quick (and dirty) sample version written with Delphi (also available here : http://chapsandchips.com/Download/DelphiNETHost_v1.zip)

Only Delphi interfacing (with "OleVariant" / late binding) is implemented in this sample code.

hth, regards.

Pascal

unit uDelphiNETHosting;

interface

// Juin 2018 - "CorBindToRuntime*" deprecated API alternative by Pascal Chapuis with "Delphi 10.1 Berlin" version
//
// Sample implementation with .NET 4.0 interfaces defined in "metaHost.h" SDK with Delphi header (partial) source code
// "CLRCreateInstance" (mscorlib) API with "ICLRMetaHost", "ICLRRuntimeInfo", "ICorRuntimeHost" interfaces are used.
//
// This Delphi sample provides :
//  - Delphi Win32 .NET runtime advanced hosting
//  - .NET class late binding interface with Delphi (OleVariant) Win32/64 application (no REGASM is needed)
//  - Interfaced C# class is the same than provided in "CppHostCLR" Microsoft C++ sample available at :
//      https://code.msdn.microsoft.com/windowsdesktop/CppHostCLR-e6581ee0/sourcecode?fileId=21953&pathId=1366553273
//
// This sample was inspired by "TJclClrHost" troubles with "_AppDomain.CreateInstanceFrom" with .NET 4.0 :
//  - "CorBindToRuntime*" = deprecated API : "old-fashion" interfaced library vs. new interfaced COM/Interop API.
//  - AppDomainSetup "ApplicationBase" property (assembly loading with custom path implementation) : no delegated resolver impl.
//  - ComVisible .NET annotation is needed at least at class level or/and assembly level.
//


uses
    mscorlib_TLB, // imported from C:\Windows\Microsoft.NET\Framework\v4.0.30319\mscorlib.tlb
    mscoree_tlb,  // imported from C:\Windows\Microsoft.NET\Framework\v4.0...\mscoree.dll
    System.Classes, Vcl.Controls, Vcl.StdCtrls,
    Windows, Messages, SysUtils, Variants, Graphics, Forms,
    Dialogs, activeX, Vcl.ComCtrls;

Const

  // ICLRMetaHost GUID
  // EXTERN_GUID(IID_ICLRMetaHost, 0xD332DB9E, 0xB9B3, 0x4125, 0x82, 0x07, 0xA1, 0x48, 0x84, 0xF5, 0x32, 0x16);
  IID_ICLRMetaHost : TGuid = '{D332DB9E-B9B3-4125-8207-A14884F53216}';
  // EXTERN_GUID(CLSID_CLRMetaHost, 0x9280188d, 0xe8e, 0x4867, 0xb3, 0xc, 0x7f, 0xa8, 0x38, 0x84, 0xe8, 0xde);
  CLSID_CLRMetaHost : TGuid = '{9280188d-0e8e-4867-b30c-7fa83884e8de}';

  // ICLRRuntimeInfo GUID
  // EXTERN_GUID(IID_ICLRRuntimeInfo, 0xBD39D1D2, 0xBA2F, 0x486a, 0x89, 0xB0, 0xB4, 0xB0, 0xCB, 0x46, 0x68, 0x91);
  IID_ICLRRuntimeInfo   : TGuid   = '{BD39D1D2-BA2F-486A-89B0-B4B0CB466891}';
  CLASS_ICLRRuntimeInfo : TGuid = '{BD39D1D2-BA2F-486a-89B0-B4B0CB466891}';

type

  // .NET interface (defined in "metahost.h" SDK header)
  ICLRRuntimeInfo = interface(IUnknown)
    ['{BD39D1D2-BA2F-486a-89B0-B4B0CB466891}']
    function GetVersionString( pwzBuffer : PWideChar; var pcchBuffer : DWORD) : HResult; stdcall;
    function GetRuntimeDirectory(pwzBuffer : PWideChar; var pcchBuffer : DWORD) : HResult; stdcall;
    function IsLoaded( hndProcess  : THANDLE; out bLoaded : bool): HResult; stdcall;
    function LoadErrorString(iResourceID: UINT; pwzBuffer: PWideChar; var pcchBuffer : DWORD; iLocaleID :LONG): HResult; stdcall;
    function LoadLibrary(pwzDllName : PWideChar; phndModule : PHMODULE): HResult; stdcall;
    function GetProcAddress( pszProcName : PChar; var ppProc : Pointer) : HResult; stdcall;
    function GetInterface( const rclsid : TCLSID;const riid : TIID;  out ppUnk : IUnknown) : HResult;  stdcall;
    function IsLoadable( var pbLoadable :  Bool) : HResult; stdcall;
    function SetDefaultStartupFlags(dwStartupFlags : DWORD; pwzHostConfigFile : LPCWSTR) : HResult; stdcall;
    function GetDefaultStartupFlags(var pdwStartupFlags : PDWORD;pwzHostConfigFile : LPWSTR;var pcchHostConfigFile : DWORD )  : HResult; stdcall;
    function BindAsLegacyV2Runtime() : HResult;  stdcall;
    function IsStarted( var  pbStarted : bool;var pdwStartupFlags : DWORD ) : HResult;  stdcall;
   end;

  // .NET interface (defined in "metahost.h" SDK header)
  ICLRMetaHost = interface(IUnknown)
    ['{D332DB9E-B9B3-4125-8207-A14884F53216}']
    function GetRuntime(pwzVersion: LPCWSTR; const riid: TIID; out ppRuntime : IUnknown): HResult; stdcall;
    function GetVersionFromFile(const pwzFilePath: PWideChar; pwzBuffer: PWideChar; var pcchBuffer: DWORD): HResult; stdcall;
    function EnumerateInstalledRuntimes(out ppEnumerator: IEnumUnknown): HResult; stdcall;
    function EnumerateLoadedRuntimes(const hndProcess: THandle;  out ppEnumerator: IEnumUnknown): HResult; stdcall;
    function RequestRuntimeLoadedNotification(out pCallbackFunction: PPointer): HResult; stdcall;
    function QueryLegacyV2RuntimeBinding(const riid: TGUID;out ppUnk: PPointer): HResult; stdcall;
    procedure ExitProcess(out iExitCode: Int32); stdcall;
  end;

  TSampleForm = class(TForm)
    BtnTest: TButton;
    StatusBar1: TStatusBar;
    Label1: TLabel;
    Label2: TLabel;
    procedure BtnTestClick(Sender: TObject);
  private
    // CLR
    FPtrClr            : ICLRMetaHost;
    // CLR runtime info
    FPtrRunTime        : ICLRRuntimeInfo;
    // CLR Core runtime
    FPtrCorHost        : ICorRuntimeHost;
    FDefaultNetInterface : ICorRuntimeHost;
    //
    Procedure LoadAndBindAssembly();
  public
  end;

  // Main .NET hosting API entry point (before interfaced stuff)
  function CLRCreateInstance(const clsid,iid: TIID; out ppv : IUnknown): HRESULT; stdcall; external 'MSCorEE.dll';

var
  SampleForm: TSampleForm;

implementation

uses //JcldotNet  // original "TJclClrHost" component unit
      math,
      ComObj;     // COM init + uninit

{$R *.dfm}

Procedure TSampleForm.LoadAndBindAssembly();
Const
  NetApp_Base_Dir : WideString  = '.\Debug\';
  Sample_Test_Value             = 3.1415;
var
  hr            : HResult;
  Ov            : OleVariant;
  ws            : WideString;
  iDomAppSetup  : IUnknown;
  iDomApp       : IUnknown;
  // .Net interfaces...
  iDomAppSetup2 : IAppDomainSetup;
  iDomApp2      : AppDomain;
  objNET        : ObjectHandle;
begin
  // Delphi sample : https://adamjohnston.me/delphi-dotnet-interop-with-jvcl/
  // DomainSetup
  hr := FDefaultNetInterface.CreateDomainSetup( iDomAppSetup );
  if ( hr = S_OK) then
  begin
     // Domain Setup Application...
     iDomAppSetup2 := iDomAppSetup as IAppDomainSetup;
     // NB. Set "ApplicationBase" root directory is NOT ok WITHOUT additional "ResolveEventHandler" (cf 1*)
     // https://weblog.west-wind.com/posts/2009/Jan/19/Assembly-Loading-across-AppDomains
     hr := iDomAppSetup2.Set_ApplicationBase( NetApp_Base_Dir );
     //hr := iDomAppSetup2.Set_PrivateBinPath(  NetApp_Base_Dir );
     //hr := iDomAppSetup2.Set_DynamicBase(  NetApp_Base_Dir );
     if ( hr = S_OK ) then
     begin
       hr := iDomAppSetup2.Set_ConfigurationFile('CSClassLibrary.config');
       if ( hr = S_OK ) then
       begin
         hr := FDefaultNetInterface.CreateDomainEx( PWideChar('aNETClassHostSample'), iDomAppSetup2, nil, iDomApp );
         if ( hr = S_OK ) then
         begin
           iDomApp2 := iDomApp as AppDomain;
           iDomApp2.Get_BaseDirectory(ws); // *** Check setup directory is OK
           // CoBindEx... API troubles begins here... alternative (not deprecated implementation) solves them !
           // CreateInstanceFrom Doc : https://msdn.microsoft.com/en-us/library/we62chk6(v=vs.110).aspx
           //hr := (iDomApp as _AppDomain).CreateInstanceFrom( 'C:\Data\dev\delphi\NetHosting\Sample\CppHostCLR\C# and C++\C#,C++\CppHostCLR\CSClassLibrary\obj\Debug\CSClassLibrary.dll', 'CSClassLibrary.CSSimpleObject', objNET );
           hr := iDomApp2.CreateInstanceFrom( NetApp_Base_Dir+'CSClassLibrary.dll', // (1*) : NO ResolveEventHandler => absolute path
                                              'CSClassLibrary.CSSimpleObject', objNET );
           if ( hr = S_OK ) then
           begin
             // *** NB. ***
             // [ComVisible(true)] annotation on class definition is NEEDED (to invoke via late binding with COM)
             // *** and/or ***
             // .NET project option "Make assembly COM visible" (cf. AssemblyInfo.cs) : [assembly: ComVisible(true)]
             ov := objNET.Unwrap;
             ov.FloatProperty := Sample_Test_Value;
             ShowMessage( 'Result FloatProperty=' +FloatToStr( Currency(ov.FloatProperty) ) );  // Interop data type between Delphi and C# (Currency <=> float)
           end
           else ShowMessage( 'CreateInstanceFrom error: ' + SysErrorMessage(hr) );
         end
         else ShowMessage( 'CreateDomainEx error: ' + SysErrorMessage(hr) );
       end
       else ShowMessage( 'Set_ConfigurationFile error: ' + SysErrorMessage(hr) );
     end
     else ShowMessage( 'Set_ApplicationBase error: ' + SysErrorMessage(hr) );
  end
  else  ShowMessage( 'CreateDomainSetup error: ' + SysErrorMessage(hr) );
end;

procedure TSampleForm.BtnTestClick(Sender: TObject);
var
  // CLR status flags
  FLoadable         : Bool;  // framework is loadable ?
  FStarted          : Bool;  // framework is started ?
  FLoaded           : Bool;  // framework is loaded ?

  arrWideChar       : Array[0..30] of WChar;

  lArr              : Cardinal;

  Flags             : DWORD;

  hr1,hr2,hr3       : HResult;
begin

 // Part-1/2 : Host targetted .NET framework version with "CLRCreateInstance" entry point

 //CoInitializeEx(nil,COINIT_APARTMENTTHREADED); //COINIT_MULTITHREADED
 try
    FLoadable := false;
    FStarted  := false;
    FLoaded   := false;
    Flags := $ffff;
    try
     FPtrClr     := nil;
     FPtrRunTime := nil;
     FPtrCorHost := nil;
     hr1 := CLRCreateInstance(CLSID_CLRMetaHost, IID_ICLRMetaHost, IUnknown(FPtrClr) );  //  CLSID + IID
     if ( hr1 = S_OK) then
      begin
        FPtrRunTime := nil;
        hr1 := FPtrClr.GetRuntime( PWideChar('v4.0.30319'), IID_ICLRRuntimeInfo, IUnknown(FPtrRunTime) );
        if ( hr1 = S_OK ) then
        begin
         // Usefull to check overflow in case of wrong API prototype : call second method overflow other results...
         hr1 := FPtrRunTime.IsLoadable( FLoadable );
         hr2 := FPtrRunTime.IsStarted( FStarted, Flags ); // NB. OVERFLOW by defining FLoadable, FLoaded... local var. as "boolean" NOT "Bool"...
         hr3 := FPtrRunTime.IsLoaded( GetCurrentProcess(), FLoaded );
         if ( hr1 = S_OK ) and ( hr2 = S_OK ) and ( hr3 = S_OK ) then
         begin
            if ( not FLoaded ) and ( FLoadable ) and ( not FStarted ) then
            begin
              hr1 := FPtrRunTime.GetInterface( CLASS_CorRuntimeHost, IID_ICorRuntimeHost, IUnknown(FPtrCorHost) ); // IID_ICorRuntimeHost,
              if ( hr1 = S_OK ) then
              begin
                if ( FPtrCorHost <> nil ) then
                    FDefaultNetInterface := (FPtrCorHost  as Iunknown)  as ICorRuntimeHost
                else ; //  NOT available...
              end
              else ShowMessage( 'GetInterface error : ' + SysErrorMessage(hr1) );
            end
            else
            begin
              if (FLoaded and FStarted) then ShowMessage( '.NET Framework version is already loaded and started...')
              else ShowMessage( '.NET Framework version is N0T loadable...');
            end;
          end
          else
          begin
            ShowMessage( 'IID_ICLRRuntimeInfo.IsLoadable error : ' + SysErrorMessage( Min(hr1,hr2) ) );
          end;
        end
        else ShowMessage( 'GetRuntime error : ' + SysErrorMessage(hr1) );
      end
      else ShowMessage( 'CLRCreateInstance error: ' + SysErrorMessage(hr1) );
    Except on e:exception do
      if Assigned( e.InnerException ) then ShowMessage( e.InnerException.ToString )
      else ShowMessage( e.ToString );
    end;
    // Check a call to an assembly...
   if ( Assigned( FDefaultNetInterface )) then
    begin
      lArr := SizeOf( arrWideChar );
      FillChar( arrWideChar, SizeOf(arrWideChar), #0);
      hr1 := FPtrRunTime.GetVersionString( PWideChar(@arrWideChar[0]), lArr);;
      if ( hr1 = S_OK ) then ShowMessage('Framework version '+arrWideChar+' is available...')
      else  ShowMessage( 'GetVersionString error: ' + SysErrorMessage(hr1));
      hr1 := FDefaultNetInterface.Start();
      if ( hr1 <> S_OK ) then ShowMessage( 'CLRCreateInstance error: ' + SysErrorMessage(hr1) );
    end;
 finally
//   if (PtrClr<>nil) then
//   begin
//     PtrClr._Release;
//     //PtrClr := nil;
//   end;
//   if (PtrRunTime<>nil) then
//   begin
//     PtrRunTime._Release;
//  ///   PtrRunTime := nil;
//   end;
//   if (PtrCorHost<>nil) then
//   begin
//     PtrCorHost._Release;
//     //PtrCorHost := nil;
//   end;
   //FDefaultInterface._Release;

  //CoUnInitialize();
 end;

 // Part-2/2 : load, bind a class call sample assembly class with loaded framework...
 LoadAndBindAssembly();

end;

end.

Answer 5

The class has to be comvisible. Which might not be the case if you have ComVisible(false) for the whole assembly.

.Net classes will be IDispatch compatible by default, so your sample should work just fine, if the class really is comvisible..

But strip it down to the bare minimum first. Put your exe in the same folder as your .Net assembly and skip the config file and application base.

Before something gets mixed up, the exception happesn here, right?

 ov := obj.Unwrap;