Hosting CLR in Delphi with/without JCL - example
https://stackoverflow.com/questions/2048540
italiano
english
français
española
中国
日本の
العربية
Deutsch
한국어
Português
RussianQuestion
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.
EDIT: This article about hosting CLR in Fox Pro looks promising but I don't know how to access clrhost.dll from Delphi.
Edit 2: I give up on Delphi 5 requirement. Now I'm trying JCL with Delphi 7. But again I am unable to find any example. Here is what I have till now:
My C# assembly:
namespace DelphiNET
{
public class NETAdder
{
public int Add3(int left)
{
return left + 3;
}
}
}
I have compiled it to DelphiNET.dll.
Now I want to use this assembly from Delphi:
uses JclDotNet, mscorlib_TLB;
procedure TForm1.Button1Click(Sender: TObject);
var
clr: TJclClrHost;
ads: TJclClrAppDomainSetup;
ad: TJclClrAppDomain;
ass: TJclClrAssembly;
obj: _ObjectHandle;
ov: OleVariant;
begin
clr := TJclClrHost.Create();
clr.Start;
ads := clr.CreateDomainSetup;
ads.ApplicationBase := 'C:\Delhi.NET';
ads.ConfigurationFile := 'C:\Delhi.NET\my.config';
ad := clr.CreateAppDomain('myNET', ads);
obj := (ad as _AppDomain).CreateInstanceFrom('DelphiNET.dll', 'DelphiNET.NETAdder');
ov := obj.Unwrap;
Button1.Caption := 'done ' + string(ov.Add3(5));
end;
This ends with error: EOleError: Variant does not reference an automation object
I have not worked with Delphi for a long time so I am stuck here...
Solution: There was problem in COM visibility which is not by default. This is the correct .NET assembly:
namespace DelphiNET
{
[ComVisible(true)]
public class NETAdder
{
public int Add3(int left)
{
return left + 3;
}
}
}
Important note:
When working with .NET from Delphi, it is important calling Set8087CW($133F); at the beginning of your program (i.e. before Application.Initialize;). Delphi has enabled floating point exceptions by default (see this) and the CLR doesn’t like them. When I had them enabled, my program weirdly freezed.
Solution
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;
OTHER TIPS
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.
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)))));
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.
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.
Licensed under: CC-BY-SA with attribution
Not affiliated with StackOverflow
