Hospedando o CLR no Delphi com / sem JCL – exemplo

Alguém pode por favor postar aqui um exemplo de como hospedar o CLR no Delphi? Eu li uma pergunta semelhante aqui, mas não posso usar JCL como eu quero hospedá-lo no Delphi 5. Obrigado.


EDIT: Este artigo sobre hospedagem CLR no Fox Pro parece promissor, mas eu não sei como acessar clrhost.dll do Delphi.


Edit 2: Eu desisto da exigência do Delphi 5. Agora estou tentando JCL com Delphi 7. Mas novamente não consigo encontrar nenhum exemplo. Aqui está o que eu tenho até agora:

Meu assembly c #:

namespace DelphiNET { public class NETAdder { public int Add3(int left) { return left + 3; } } } 

Eu compilei para DelphiNET.dll .

Agora eu quero usar este assembly do 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; 

Isso termina com erro: EOleError: Variant não faz referência a um object de automação

Eu não trabalhei com o Delphi por muito tempo, então estou preso aqui …


Solução: houve um problema na visibilidade de COM, que não é por padrão. Este é o assembly .NET correto:

 namespace DelphiNET { [ComVisible(true)] public class NETAdder { public int Add3(int left) { return left + 3; } } } 

Nota importante:

Ao trabalhar com o .NET do Delphi, é importante chamar Set8087CW($133F); no início do seu programa (ou seja, antes de Application.Initialize; ). O Delphi ativou exceções de ponto flutuante por padrão (veja isso ) e o CLR não gosta delas. Quando eu os habilitei, meu programa congelou estranhamente.

A class tem que ser visível. Qual não pode ser o caso se você tiver ComVisible (false) para o conjunto inteiro.

As classs .Net serão compatíveis com IDispatch por padrão, portanto, sua amostra deve funcionar bem, se a class realmente for visível.

Mas despir para o mínimo primeiro. Coloque o seu exe na mesma pasta que o seu assembly .Net e pule o arquivo de configuração e a base do aplicativo.

Antes que algo se misture, a exceção acontece aqui, certo?

  ov := obj.Unwrap; 

Aqui está outra opção.

Esse é o código c #. E mesmo que você não queira usar minhas exportações não gerenciadas , ele ainda explicaria como usar o mscoree (o material de hospedagem do CLR) sem passar pelo IDispatch (o IDispatch é bem lento).

 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(); } } } 

Esta é a declaração da interface do Delphi:

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

Se você usa exportações não gerenciadas, você pode fazer assim:

 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. 

Quando eu adaptar a amostra de Lars, seria assim:

 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. 

Nesse caso, você pode remover a class “UnmanagedExports” do código C #, é claro.

Aqui está:

 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. 

Nota: Assume que o tipo DelphiNET.NETAdder e o método Add3 no DelphiNet.dll é ComVisible . Obrigado ao Robert .

Atualização :

Ao usar reflexo, você não precisa do atributo ComVisible. O próximo exemplo funciona mesmo sem ser 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))))); 

Eu enfrentei alguns problemas com o componente “TJclClrHost” (cf. comentários em código src). Depois de pesquisar, descobri “CppHostCLR” exemplo da Microsoft, que é o novo caminho de interface para hospedar o runtime .NET no aplicativo Win32 / 64 …

Aqui está uma versão de amostra rápida (e suja) escrita com Delphi (também disponível aqui: http://chapsandchips.com/Download/DelphiNETHost_v1.zip )

Apenas a interface Delphi (com “OleVariant” / binding tardia) é implementada neste código de amostra.

hth, cumprimentos.

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.