Hosting CLR in Delphi with/without JCL - example
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.
-
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.
加载中...
- 热议问题