Hosting CLR en Delphi con / sin JCL – ejemplo

¿Alguien puede publicar aquí un ejemplo de cómo alojar CLR en Delphi? He leído una pregunta similar aquí, pero no puedo usar JCL porque quiero alojarlo en Delphi 5. Gracias.


EDITAR: Este artículo sobre el alojamiento de CLR en Fox Pro parece prometedor, pero no sé cómo acceder clrhost.dll desde Delphi.


Editar 2: renuncio al requisito de Delphi 5. Ahora estoy probando JCL con Delphi 7. Pero nuevamente no puedo encontrar ningún ejemplo. Esto es lo que tengo hasta ahora:

Mi ensamblaje de C #:

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

Lo he comstackdo en DelphiNET.dll .

Ahora quiero usar este ensamblaje de 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; 

Esto finaliza con un error: EOleError: Variant no hace referencia a un objeto de automatización

No he trabajado con Delphi durante mucho tiempo, así que estoy atrapado aquí …


Solución: Hubo un problema en la visibilidad COM que no es por defecto. Este es el ensamblaje correcto de .NET:

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

Nota IMPORTANTE:

Cuando se trabaja con .NET desde Delphi, es importante llamar a Set8087CW($133F); al comienzo de su progtwig (es decir, antes de la Application.Initialize; ). Delphi ha habilitado excepciones de coma flotante por defecto (ver esto ) y al CLR no le gustan. Cuando los tuve habilitados, mi progtwig se bloqueó extrañamente.

    La clase tiene que ser comisionable. Lo cual podría no ser el caso si tiene ComVisible (falso) para toda la asamblea.

    Las clases .Net serán compatibles con IDispatch por defecto, por lo que su muestra debería funcionar bien, si la clase es realmente comisible.

    Pero primero quítelo al mínimo. Coloque su archivo exe en la misma carpeta que su ensamblado .Net y omita el archivo de configuración y la base de la aplicación.

    Antes de que algo se mezcle, la excepción sucede aquí, ¿verdad?

      ov := obj.Unwrap; 

    Aquí hay otra opción.

    Ese es el C # Code. E incluso si no desea utilizar mis exportaciones no administradas , aún así explique cómo usar mscoree (el material de alojamiento de CLR) sin pasar por IDispatch (IDispatch es bastante 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 es la statement de interfaz de Delphi:

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

    Si usa exportaciones no gestionadas, puede hacerlo así:

     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. 

    Cuando adapte la muestra de Lars, se vería así:

     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. 

    En este caso, puedes eliminar la clase “UnmanagedExports” del código C #, por supuesto.

    Aqui tienes:

     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: Supone que el tipo DelphiNET.NETAdder y el método Add3 en DelphiNet.dll es ComVisible . Gracias a Robert .

    Actualización :

    Cuando usa la reflexión, no necesita el atributo ComVisible. El siguiente ejemplo incluso funciona sin 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))))); 

    Tuve algunos problemas con el componente “TJclClrHost” (consulte los comentarios en el código src). Después de buscar, descubrí el ejemplo de Microsoft “CppHostCLR”, que es la nueva ruta interconectada para alojar el tiempo de ejecución de .NET en la aplicación Win32 / 64 …

    Aquí hay una versión de muestra rápida (y sucia) escrita con Delphi (también disponible aquí: http://chapsandchips.com/Download/DelphiNETHost_v1.zip )

    Solo la interfaz de Delphi (con “OleVariant” / enlace tardío) se implementa en este código de ejemplo.

    hth, respetos.

    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.