有人可以在这里发布一个如何在Delphi中托管CLR的例子吗？我在这里读过类似的question，但我不能使用JCL，因为我想在Delphi 5中托管它。谢谢。
编辑：这个关于在Fox Pro中托管CLR的article看起来很有希望，但我不知道如何从Delphi访问clrhost.dll。
编辑2：我放弃了Delphi 5的要求。现在我正在尝试使用Delphi 7进行JCL。但是我再也找不到任何示例。这就是我现在所拥有的：
我的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不引用自动化对象
我已经很久没和德尔福合作了，所以我被困在这里......
解决方案：COM可见性存在问题，默认情况下不存在。这是正确的.NET程序集：
namespace DelphiNET
{
[ComVisible(true)]
public class NETAdder
{
public int Add3(int left)
{
return left + 3;
}
}
}
使用Delphi中的.NET时，重要的是在程序开头调用Set8087CW($133F);（即在Application.Initialize;之前）。 Delphi默认启用浮点异常（请参阅this），CLR不喜欢它们。当我启用它们时，我的程序奇怪地冻结了。
这堂课必须是可见的。如果您对整个程序集具有ComVisible（false），则可能不是这种情况。
默认情况下.Net类将与IDispatch兼容，因此如果类真的是可见的，那么你的样本应该可以正常工作。
但首先将它剥离到最低限度。将您的exe放在与.Net程序集相同的文件夹中，并跳过配置文件和应用程序库。
在事情变得混乱之前，这里发生了异常，对吧？
ov := obj.Unwrap;
这是另一种选择。
这是C＃代码。即使你不想使用my unmanaged exports，它仍然会解释如何使用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.
当我调整Lars的样本时，它看起来像这样：
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.
在这种情况下，您可以从C＃代码中删除“UnmanagedExports”类，当然。
干得好：
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.NET中的DelphiNET.NETAdder类型和Add3方法是ComVisible。感谢Robert。
更新：
使用反射时，您不需要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示例，这是新的接口路径，以便在Win32 / 64应用程序中托管.NET运行时...
这是一个用Delphi编写的快速（和脏）示例版本（也可在此处获取：http://chapsandchips.com/Download/DelphiNETHost_v1.zip）
此示例代码中仅实现了Delphi接口（使用“OleVariant”/后期绑定）。
亲爱的，问候。
复活节
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.
感谢这个论坛，我找到了使用dll C＃和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();
}
}
}
拉撒路：
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.
观察var Z是WideString，唯一的类型作为字符串类型，我尝试了String，AnsiString和PChar但是没有工作，他们只返回第一个字符。我有像“Antônio”这样的重音问题作为参数发送，我试图找到一个C＃可以理解的转换器并发回相同的单词。