Хостинг CLR в Delphi с / без JCL – пример

Может кто-нибудь, пожалуйста, напишите здесь пример того, как размещать CLR в Delphi? Я прочитал аналогичный вопрос здесь, но я не могу использовать JCL, поскольку я хочу разместить его в Delphi 5. Спасибо.


EDIT: Эта статья о размещении CLR в Fox Pro выглядит многообещающе, но я не знаю, как получить доступ к clrhost.dll из Delphi.


Изменить 2: я отказываюсь от требования Delphi 5. Теперь я пытаюсь использовать JCL с Delphi 7. Но опять же я не могу найти ни одного примера. Вот что я имею до сих пор:

Моя assembly C #:

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

Я скомпилировал его в DelphiNET.dll .

Теперь я хочу использовать эту сборку из 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; 

Это заканчивается ошибкой: EOleError: Variant не ссылается на объект автоматизации

Я давно не работал с Delphi, поэтому я застрял здесь …


Решение. В просмотре COM была проблема, которая не по умолчанию. Это правильная assembly .NET:

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

Важная заметка:

При работе с .NET из Delphi важно вызвать Set8087CW($133F); в начале вашей программы (т.е. перед Application.Initialize; ). По умолчанию Delphi разрешил исключения с плавающей запятой (см. Это ), и CLR им не нравится. Когда я включил их, моя программа была заморожена.

    Класс должен быть понятным. Что может быть не так, если у вас есть ComVisible (false) для всей сборки.

    .Net-classы будут совместимы по IDispatch по умолчанию, поэтому ваш образец должен работать нормально, если class действительно доступен.

    Но сначала разделите его на минимальный минимум. Поместите ваш exe в ту же папку, что и ваша assembly .Net, и пропустите файл конфигурации и базу приложений.

    Прежде чем что-то запутается, исключение здесь происходит, верно?

      ov := obj.Unwrap; 

    Вот еще один вариант.

    Это код C #. И даже если вы не хотите использовать мой неуправляемый экспорт , он все равно объяснит, как использовать mscoree (хостинг для CLR), не проходя IDispatch (IDispatch довольно медленный).

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

    Это заявление интерфейса Delphi:

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

    Если вы используете неуправляемый экспорт, вы можете сделать это так:

     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. 

    Когда я адаптирую образец Ларса, он будет выглядеть так:

     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. 

    В этом случае, конечно, вы можете удалить class «UnmanagedExports» из кода C #.

    Ну вот:

     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. 

    Примечание. Предполагается, что тип DelphiNET.NETAdder и метод Add3 в DelphiNet.dll являются ComVisible . Спасибо Роберту .

    Обновление :

    При использовании отражения вам не нужен атрибут ComVisible. Следующий пример даже работает без 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))))); 

    Я столкнулся с некоторыми проблемами с компонентом «TJclClrHost» (см. Комментарии в коде src). После поиска, я обнаружил образец «CppHostCLR» Microsoft, который является новым сопряженным путем для размещения среды выполнения .NET в приложении Win32 / 64 …

    Вот быстрая (и грязная) версия образца, написанная с помощью Delphi (также доступна здесь: http://chapsandchips.com/Download/DelphiNETHost_v1.zip )

    В этом примере кода реализован только интерфейс Delphi (с «OleVariant» / поздняя привязка).

    hth, привет.

    паскаль

     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. 
    Давайте будем гением компьютера.