我用C#构建了一个类库(在.NET Framework中)，它允许从以下json文件中提取信息：
{
"Class2": {
"array_1_class2":[1603924965, 1603925021],
"array_2_class2":[1603925041,1603925054]
},
"Class3":{
"array_1_class3":[1,2,3,4],
"array_2_class3":[5,6,8,9,10]
}
}
下面是用 C# 开发的代码：
using System;
using System.IO;
using Newtonsoft.Json;
namespace dll
{
public class Class1
{
public Class2 class2;
public Class3 class3;
}
public class Class2
{
public int[] array_1_class2;
public int[] array_2_class2;
}
public class Class3
{
public int[] array_1_class3;
public int[] array_2_class3;
}
public class Class4
{
public Class1 LoadJson(string filePath)
{
using (StreamReader r = new StreamReader(filePath))
{
string json = r.ReadToEnd();
Class1 Data = JsonConvert.DeserializeObject<Class1>(json);
return Data;
}
}
}
}
我构建了另一个 C# 程序来测试开发的代码，我得出的结论是它可以工作。
然后，我试图在德尔福做同样的事情。我从 Delphi 中的控制台应用程序调用了 .NET DLL，方法是将库 COM 变为可见并将其导入为类型库。因此，代码是在生成的TypeLibName_TLB单元中生成的，如导入类型库信息时生成的代码中所述。因此，array_1_class2、array_2_class2、array_1_class3、array_2_class3变得PSafeArrays。
我的目标是在控制台中写入所有数组。但是，在下面的示例中，我将只尝试打印array_1_class2。 这是我用Delphi编写的代码：
program dllTester;
{$APPTYPE CONSOLE} {$POINTERMATH ON}
{$R *.res}
uses
System.SysUtils,
Variants,
Classes,
ActiveX,
FMX.Memo,
dll_TLB in 'dll_TLB.pas';
var
filePath : WideString;
V_class1: _Class1;
V_class2: TClass2;
V_class3: TClass3;
V_class4: TClass4;
Class2_SafeArray: PSafeArray;
Class2_LBound, Class2_UBound, I: LongInt;
Index: LongInt;
LData: array[0..1] of integer;
begin
CoInitialize(nil);
V_class4:= TClass4.Create(nil);
V_class2:= TClass2.Create(nil);
try
filePath:='C:UsersDocumentsfile.json';
V_class1 := V_class4.LoadJson(filePath);
finally
V_class4.Free;
end;
//get the PSafeArray
Class2_SafeArray := V_class2.array_1_class2;
//get the bounds
SafeArrayGetLBound(Class2_SafeArray, 1, Class2_LBound);
SafeArrayGetUBound(Class2_SafeArray, 1, Class2_UBound);
WriteLn('Class2 array_1:');
for I := Class2_LBound to Class2_UBound do
begin
Index:=I;
SafeArrayGetElement(Class2_SafeArray, Index , LData);
end;
WriteLn(LData[0]) ;
WriteLn(LData[1]) ;
ReadLn;
SafeArrayDestroy(Class2_SafeArray);
CoUninitialize();
end.
当我运行代码时，控制台中写入了以下文本：
Class2 array_1:
0
0
这意味着LData没有正确的信息。它应该有1603924965和1603925021，但它有0和0。
此外，我无法完成代码的调试。调试器卡在ReadLn.
这是dll_TLB单元的代码：
unit dll_TLB;
{$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers.
{$WARN SYMBOL_PLATFORM OFF}
{$WRITEABLECONST ON}
{$VARPROPSETTER ON}
{$ALIGN 4}
interface
uses Winapi.Windows, mscorlib_TLB, System.Classes, System.Variants, System.Win.StdVCL, Vcl.Graphics, Vcl.OleServer, Winapi.ActiveX;
// *********************************************************************//
// GUIDS declared in the TypeLibrary. Following prefixes are used:
// Type Libraries : LIBID_xxxx
// CoClasses : CLASS_xxxx
// DISPInterfaces : DIID_xxxx
// Non-DISP interfaces: IID_xxxx
// *********************************************************************//
const
// TypeLibrary Major and minor versions
dllMajorVersion = 1;
dllMinorVersion = 0;
LIBID_dll: TGUID = '{E4D3D725-8DFA-4EFE-8729-D412EC40D6FF}';
IID__Class1: TGUID = '{E2C374EE-FAC0-38E2-B188-925F1A47CAA2}';
IID__Class2: TGUID = '{70E4C4D8-1C96-337C-A3B1-90217021B4D7}';
IID__Class3: TGUID = '{4C6F2CFA-C886-3B6F-90ED-0EBBAC07E3F6}';
IID__Class4: TGUID = '{7FBDFC4C-887D-3891-81F6-AD1D99057826}';
CLASS_Class1: TGUID = '{465A4623-BB3D-3C8C-8D86-663855D180CD}';
CLASS_Class2: TGUID = '{7FF9F5CF-1C3B-3234-B5B1-F7EF39E18356}';
CLASS_Class3: TGUID = '{F412CD3D-4246-3970-A46A-3830175F5775}';
CLASS_Class4: TGUID = '{6C78853D-D584-35FF-8CD9-7C7214DFCA8F}';
type
// *********************************************************************//
// Forward declaration of types defined in TypeLibrary
// *********************************************************************//
_Class1 = interface;
_Class1Disp = dispinterface;
_Class2 = interface;
_Class2Disp = dispinterface;
_Class3 = interface;
_Class3Disp = dispinterface;
_Class4 = interface;
_Class4Disp = dispinterface;
// *********************************************************************//
// Declaration of CoClasses defined in Type Library
// (NOTE: Here we map each CoClass to its Default Interface)
// *********************************************************************//
Class1 = _Class1;
Class2 = _Class2;
Class3 = _Class3;
Class4 = _Class4;
// *********************************************************************//
// Interface: _Class1
// Flags: (4560) Hidden Dual NonExtensible OleAutomation Dispatchable
// GUID: {E2C374EE-FAC0-38E2-B188-925F1A47CAA2}
// *********************************************************************//
_Class1 = interface(IDispatch)
['{E2C374EE-FAC0-38E2-B188-925F1A47CAA2}']
function Get_ToString: WideString; safecall;
function Equals(obj: OleVariant): WordBool; safecall;
function GetHashCode: Integer; safecall;
function GetType: _Type; safecall;
function Get_Class2: _Class2; safecall;
procedure _Set_Class2(const pRetVal: _Class2); safecall;
function Get_Class3: _Class3; safecall;
procedure _Set_Class3(const pRetVal: _Class3); safecall;
property ToString: WideString read Get_ToString;
property Class2: _Class2 read Get_Class2 write _Set_Class2;
property Class3: _Class3 read Get_Class3 write _Set_Class3;
end;
// *********************************************************************//
// DispIntf: _Class1Disp
// Flags: (4560) Hidden Dual NonExtensible OleAutomation Dispatchable
// GUID: {E2C374EE-FAC0-38E2-B188-925F1A47CAA2}
// *********************************************************************//
_Class1Disp = dispinterface
['{E2C374EE-FAC0-38E2-B188-925F1A47CAA2}']
property ToString: WideString readonly dispid 0;
function Equals(obj: OleVariant): WordBool; dispid 1610743809;
function GetHashCode: Integer; dispid 1610743810;
function GetType: _Type; dispid 1610743811;
property Class2: _Class2 dispid 1610743812;
property Class3: _Class3 dispid 1610743814;
end;
// *********************************************************************//
// Interface: _Class2
// Flags: (4560) Hidden Dual NonExtensible OleAutomation Dispatchable
// GUID: {70E4C4D8-1C96-337C-A3B1-90217021B4D7}
// *********************************************************************//
_Class2 = interface(IDispatch)
['{70E4C4D8-1C96-337C-A3B1-90217021B4D7}']
function Get_ToString: WideString; safecall;
function Equals(obj: OleVariant): WordBool; safecall;
function GetHashCode: Integer; safecall;
function GetType: _Type; safecall;
function Get_array_1_class2: PSafeArray; safecall;
procedure Set_array_1_class2(pRetVal: PSafeArray); safecall;
function Get_array_2_class2: PSafeArray; safecall;
procedure Set_array_2_class2(pRetVal: PSafeArray); safecall;
property ToString: WideString read Get_ToString;
property array_1_class2: PSafeArray read Get_array_1_class2 write Set_array_1_class2;
property array_2_class2: PSafeArray read Get_array_2_class2 write Set_array_2_class2;
end;
// *********************************************************************//
// DispIntf: _Class2Disp
// Flags: (4560) Hidden Dual NonExtensible OleAutomation Dispatchable
// GUID: {70E4C4D8-1C96-337C-A3B1-90217021B4D7}
// *********************************************************************//
_Class2Disp = dispinterface
['{70E4C4D8-1C96-337C-A3B1-90217021B4D7}']
property ToString: WideString readonly dispid 0;
function Equals(obj: OleVariant): WordBool; dispid 1610743809;
function GetHashCode: Integer; dispid 1610743810;
function GetType: _Type; dispid 1610743811;
property array_1_class2: {NOT_OLEAUTO(PSafeArray)}OleVariant dispid 1610743812;
property array_2_class2: {NOT_OLEAUTO(PSafeArray)}OleVariant dispid 1610743814;
end;
// *********************************************************************//
// Interface: _Class3
// Flags: (4560) Hidden Dual NonExtensible OleAutomation Dispatchable
// GUID: {4C6F2CFA-C886-3B6F-90ED-0EBBAC07E3F6}
// *********************************************************************//
_Class3 = interface(IDispatch)
['{4C6F2CFA-C886-3B6F-90ED-0EBBAC07E3F6}']
function Get_ToString: WideString; safecall;
function Equals(obj: OleVariant): WordBool; safecall;
function GetHashCode: Integer; safecall;
function GetType: _Type; safecall;
function Get_array_1_class3: PSafeArray; safecall;
procedure Set_array_1_class3(pRetVal: PSafeArray); safecall;
function Get_array_2_class3: PSafeArray; safecall;
procedure Set_array_2_class3(pRetVal: PSafeArray); safecall;
property ToString: WideString read Get_ToString;
property array_1_class3: PSafeArray read Get_array_1_class3 write Set_array_1_class3;
property array_2_class3: PSafeArray read Get_array_2_class3 write Set_array_2_class3;
end;
// *********************************************************************//
// DispIntf: _Class3Disp
// Flags: (4560) Hidden Dual NonExtensible OleAutomation Dispatchable
// GUID: {4C6F2CFA-C886-3B6F-90ED-0EBBAC07E3F6}
// *********************************************************************//
_Class3Disp = dispinterface
['{4C6F2CFA-C886-3B6F-90ED-0EBBAC07E3F6}']
property ToString: WideString readonly dispid 0;
function Equals(obj: OleVariant): WordBool; dispid 1610743809;
function GetHashCode: Integer; dispid 1610743810;
function GetType: _Type; dispid 1610743811;
property array_1_class3: {NOT_OLEAUTO(PSafeArray)}OleVariant dispid 1610743812;
property array_2_class3: {NOT_OLEAUTO(PSafeArray)}OleVariant dispid 1610743814;
end;
// *********************************************************************//
// Interface: _Class4
// Flags: (4560) Hidden Dual NonExtensible OleAutomation Dispatchable
// GUID: {7FBDFC4C-887D-3891-81F6-AD1D99057826}
// *********************************************************************//
_Class4 = interface(IDispatch)
['{7FBDFC4C-887D-3891-81F6-AD1D99057826}']
function Get_ToString: WideString; safecall;
function Equals(obj: OleVariant): WordBool; safecall;
function GetHashCode: Integer; safecall;
function GetType: _Type; safecall;
function LoadJson(const filePath: WideString): _Class1; safecall;
property ToString: WideString read Get_ToString;
end;
// *********************************************************************//
// DispIntf: _Class4Disp
// Flags: (4560) Hidden Dual NonExtensible OleAutomation Dispatchable
// GUID: {7FBDFC4C-887D-3891-81F6-AD1D99057826}
// *********************************************************************//
_Class4Disp = dispinterface
['{7FBDFC4C-887D-3891-81F6-AD1D99057826}']
property ToString: WideString readonly dispid 0;
function Equals(obj: OleVariant): WordBool; dispid 1610743809;
function GetHashCode: Integer; dispid 1610743810;
function GetType: _Type; dispid 1610743811;
function LoadJson(const filePath: WideString): _Class1; dispid 1610743812;
end;
// *********************************************************************//
// The Class CoClass1 provides a Create and CreateRemote method to
// create instances of the default interface _Class1 exposed by
// the CoClass Class1. The functions are intended to be used by
// clients wishing to automate the CoClass objects exposed by the
// server of this typelibrary.
// *********************************************************************//
CoClass1 = class
class function Create: _Class1;
class function CreateRemote(const MachineName: string): _Class1;
end;
// *********************************************************************//
// OLE Server Proxy class declaration
// Server Object : TClass1
// Help String :
// Default Interface: _Class1
// Def. Intf. DISP? : No
// Event Interface:
// TypeFlags : (2) CanCreate
// *********************************************************************//
TClass1 = class(TOleServer)
private
FIntf: _Class1;
function GetDefaultInterface: _Class1;
protected
procedure InitServerData; override;
function Get_ToString: WideString;
function Get_Class2: _Class2;
procedure _Set_Class2(const pRetVal: _Class2);
function Get_Class3: _Class3;
procedure _Set_Class3(const pRetVal: _Class3);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Connect; override;
procedure ConnectTo(svrIntf: _Class1);
procedure Disconnect; override;
function Equals(obj: OleVariant): WordBool;
function GetHashCode: Integer;
function GetType: _Type;
property DefaultInterface: _Class1 read GetDefaultInterface;
property ToString: WideString read Get_ToString;
property Class2: _Class2 read Get_Class2 write _Set_Class2;
property Class3: _Class3 read Get_Class3 write _Set_Class3;
published
end;
// *********************************************************************//
// The Class CoClass2 provides a Create and CreateRemote method to
// create instances of the default interface _Class2 exposed by
// the CoClass Class2. The functions are intended to be used by
// clients wishing to automate the CoClass objects exposed by the
// server of this typelibrary.
// *********************************************************************//
CoClass2 = class
class function Create: _Class2;
class function CreateRemote(const MachineName: string): _Class2;
end;
// *********************************************************************//
// OLE Server Proxy class declaration
// Server Object : TClass2
// Help String :
// Default Interface: _Class2
// Def. Intf. DISP? : No
// Event Interface:
// TypeFlags : (2) CanCreate
// *********************************************************************//
TClass2 = class(TOleServer)
private
FIntf: _Class2;
function GetDefaultInterface: _Class2;
protected
procedure InitServerData; override;
function Get_ToString: WideString;
function Get_array_1_class2: PSafeArray;
procedure Set_array_1_class2(pRetVal: PSafeArray);
function Get_array_2_class2: PSafeArray;
procedure Set_array_2_class2(pRetVal: PSafeArray);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Connect; override;
procedure ConnectTo(svrIntf: _Class2);
procedure Disconnect; override;
function Equals(obj: OleVariant): WordBool;
function GetHashCode: Integer;
function GetType: _Type;
property DefaultInterface: _Class2 read GetDefaultInterface;
property ToString: WideString read Get_ToString;
property array_1_class2: PSafeArray read Get_array_1_class2 write Set_array_1_class2;
property array_2_class2: PSafeArray read Get_array_2_class2 write Set_array_2_class2;
published
end;
// *********************************************************************//
// The Class CoClass3 provides a Create and CreateRemote method to
// create instances of the default interface _Class3 exposed by
// the CoClass Class3. The functions are intended to be used by
// clients wishing to automate the CoClass objects exposed by the
// server of this typelibrary.
// *********************************************************************//
CoClass3 = class
class function Create: _Class3;
class function CreateRemote(const MachineName: string): _Class3;
end;
// *********************************************************************//
// OLE Server Proxy class declaration
// Server Object : TClass3
// Help String :
// Default Interface: _Class3
// Def. Intf. DISP? : No
// Event Interface:
// TypeFlags : (2) CanCreate
// *********************************************************************//
TClass3 = class(TOleServer)
private
FIntf: _Class3;
function GetDefaultInterface: _Class3;
protected
procedure InitServerData; override;
function Get_ToString: WideString;
function Get_array_1_class3: PSafeArray;
procedure Set_array_1_class3(pRetVal: PSafeArray);
function Get_array_2_class3: PSafeArray;
procedure Set_array_2_class3(pRetVal: PSafeArray);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Connect; override;
procedure ConnectTo(svrIntf: _Class3);
procedure Disconnect; override;
function Equals(obj: OleVariant): WordBool;
function GetHashCode: Integer;
function GetType: _Type;
property DefaultInterface: _Class3 read GetDefaultInterface;
property ToString: WideString read Get_ToString;
property array_1_class3: PSafeArray read Get_array_1_class3 write Set_array_1_class3;
property array_2_class3: PSafeArray read Get_array_2_class3 write Set_array_2_class3;
published
end;
// *********************************************************************//
// The Class CoClass4 provides a Create and CreateRemote method to
// create instances of the default interface _Class4 exposed by
// the CoClass Class4. The functions are intended to be used by
// clients wishing to automate the CoClass objects exposed by the
// server of this typelibrary.
// *********************************************************************//
CoClass4 = class
class function Create: _Class4;
class function CreateRemote(const MachineName: string): _Class4;
end;
// *********************************************************************//
// OLE Server Proxy class declaration
// Server Object : TClass4
// Help String :
// Default Interface: _Class4
// Def. Intf. DISP? : No
// Event Interface:
// TypeFlags : (2) CanCreate
// *********************************************************************//
TClass4 = class(TOleServer)
private
FIntf: _Class4;
function GetDefaultInterface: _Class4;
protected
procedure InitServerData; override;
function Get_ToString: WideString;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Connect; override;
procedure ConnectTo(svrIntf: _Class4);
procedure Disconnect; override;
function Equals(obj: OleVariant): WordBool;
function GetHashCode: Integer;
function GetType: _Type;
function LoadJson(const filePath: WideString): _Class1;
property DefaultInterface: _Class4 read GetDefaultInterface;
property ToString: WideString read Get_ToString;
published
end;
procedure Register;
resourcestring
dtlServerPage = 'ActiveX';
dtlOcxPage = 'ActiveX';
implementation
uses System.Win.ComObj;
class function CoClass1.Create: _Class1;
begin
Result := CreateComObject(CLASS_Class1) as _Class1;
end;
class function CoClass1.CreateRemote(const MachineName: string): _Class1;
begin
Result := CreateRemoteComObject(MachineName, CLASS_Class1) as _Class1;
end;
procedure TClass1.InitServerData;
const
CServerData: TServerData = (
ClassID: '{465A4623-BB3D-3C8C-8D86-663855D180CD}';
IntfIID: '{E2C374EE-FAC0-38E2-B188-925F1A47CAA2}';
EventIID: '';
LicenseKey: nil;
Version: 500);
begin
ServerData := @CServerData;
end;
procedure TClass1.Connect;
var
punk: IUnknown;
begin
if FIntf = nil then
begin
punk := GetServer;
Fintf:= punk as _Class1;
end;
end;
procedure TClass1.ConnectTo(svrIntf: _Class1);
begin
Disconnect;
FIntf := svrIntf;
end;
procedure TClass1.DisConnect;
begin
if Fintf <> nil then
begin
FIntf := nil;
end;
end;
function TClass1.GetDefaultInterface: _Class1;
begin
if FIntf = nil then
Connect;
Assert(FIntf <> nil, 'DefaultInterface is NULL. Component is not connected to Server. You must call "Connect" or "ConnectTo" before this operation');
Result := FIntf;
end;
constructor TClass1.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
end;
destructor TClass1.Destroy;
begin
inherited Destroy;
end;
function TClass1.Get_ToString: WideString;
begin
Result := DefaultInterface.ToString;
end;
function TClass1.Get_Class2: _Class2;
begin
Result := DefaultInterface.Class2;
end;
procedure TClass1._Set_Class2(const pRetVal: _Class2);
begin
DefaultInterface.Class2 := pRetVal;
end;
function TClass1.Get_Class3: _Class3;
begin
Result := DefaultInterface.Class3;
end;
procedure TClass1._Set_Class3(const pRetVal: _Class3);
begin
DefaultInterface.Class3 := pRetVal;
end;
function TClass1.Equals(obj: OleVariant): WordBool;
begin
Result := DefaultInterface.Equals(obj);
end;
function TClass1.GetHashCode: Integer;
begin
Result := DefaultInterface.GetHashCode;
end;
function TClass1.GetType: _Type;
begin
Result := DefaultInterface.GetType;
end;
class function CoClass2.Create: _Class2;
begin
Result := CreateComObject(CLASS_Class2) as _Class2;
end;
class function CoClass2.CreateRemote(const MachineName: string): _Class2;
begin
Result := CreateRemoteComObject(MachineName, CLASS_Class2) as _Class2;
end;
procedure TClass2.InitServerData;
const
CServerData: TServerData = (
ClassID: '{7FF9F5CF-1C3B-3234-B5B1-F7EF39E18356}';
IntfIID: '{70E4C4D8-1C96-337C-A3B1-90217021B4D7}';
EventIID: '';
LicenseKey: nil;
Version: 500);
begin
ServerData := @CServerData;
end;
procedure TClass2.Connect;
var
punk: IUnknown;
begin
if FIntf = nil then
begin
punk := GetServer;
Fintf:= punk as _Class2;
end;
end;
procedure TClass2.ConnectTo(svrIntf: _Class2);
begin
Disconnect;
FIntf := svrIntf;
end;
procedure TClass2.DisConnect;
begin
if Fintf <> nil then
begin
FIntf := nil;
end;
end;
function TClass2.GetDefaultInterface: _Class2;
begin
if FIntf = nil then
Connect;
Assert(FIntf <> nil, 'DefaultInterface is NULL. Component is not connected to Server. You must call "Connect" or "ConnectTo" before this operation');
Result := FIntf;
end;
constructor TClass2.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
end;
destructor TClass2.Destroy;
begin
inherited Destroy;
end;
function TClass2.Get_ToString: WideString;
begin
Result := DefaultInterface.ToString;
end;
function TClass2.Get_array_1_class2: PSafeArray;
begin
Result := DefaultInterface.array_1_class2;
end;
procedure TClass2.Set_array_1_class2(pRetVal: PSafeArray);
begin
DefaultInterface.array_1_class2 := pRetVal;
end;
function TClass2.Get_array_2_class2: PSafeArray;
begin
Result := DefaultInterface.array_2_class2;
end;
procedure TClass2.Set_array_2_class2(pRetVal: PSafeArray);
begin
DefaultInterface.array_2_class2 := pRetVal;
end;
function TClass2.Equals(obj: OleVariant): WordBool;
begin
Result := DefaultInterface.Equals(obj);
end;
function TClass2.GetHashCode: Integer;
begin
Result := DefaultInterface.GetHashCode;
end;
function TClass2.GetType: _Type;
begin
Result := DefaultInterface.GetType;
end;
class function CoClass3.Create: _Class3;
begin
Result := CreateComObject(CLASS_Class3) as _Class3;
end;
class function CoClass3.CreateRemote(const MachineName: string): _Class3;
begin
Result := CreateRemoteComObject(MachineName, CLASS_Class3) as _Class3;
end;
procedure TClass3.InitServerData;
const
CServerData: TServerData = (
ClassID: '{F412CD3D-4246-3970-A46A-3830175F5775}';
IntfIID: '{4C6F2CFA-C886-3B6F-90ED-0EBBAC07E3F6}';
EventIID: '';
LicenseKey: nil;
Version: 500);
begin
ServerData := @CServerData;
end;
procedure TClass3.Connect;
var
punk: IUnknown;
begin
if FIntf = nil then
begin
punk := GetServer;
Fintf:= punk as _Class3;
end;
end;
procedure TClass3.ConnectTo(svrIntf: _Class3);
begin
Disconnect;
FIntf := svrIntf;
end;
procedure TClass3.DisConnect;
begin
if Fintf <> nil then
begin
FIntf := nil;
end;
end;
function TClass3.GetDefaultInterface: _Class3;
begin
if FIntf = nil then
Connect;
Assert(FIntf <> nil, 'DefaultInterface is NULL. Component is not connected to Server. You must call "Connect" or "ConnectTo" before this operation');
Result := FIntf;
end;
constructor TClass3.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
end;
destructor TClass3.Destroy;
begin
inherited Destroy;
end;
function TClass3.Get_ToString: WideString;
begin
Result := DefaultInterface.ToString;
end;
function TClass3.Get_array_1_class3: PSafeArray;
begin
Result := DefaultInterface.array_1_class3;
end;
procedure TClass3.Set_array_1_class3(pRetVal: PSafeArray);
begin
DefaultInterface.array_1_class3 := pRetVal;
end;
function TClass3.Get_array_2_class3: PSafeArray;
begin
Result := DefaultInterface.array_2_class3;
end;
procedure TClass3.Set_array_2_class3(pRetVal: PSafeArray);
begin
DefaultInterface.array_2_class3 := pRetVal;
end;
function TClass3.Equals(obj: OleVariant): WordBool;
begin
Result := DefaultInterface.Equals(obj);
end;
function TClass3.GetHashCode: Integer;
begin
Result := DefaultInterface.GetHashCode;
end;
function TClass3.GetType: _Type;
begin
Result := DefaultInterface.GetType;
end;
class function CoClass4.Create: _Class4;
begin
Result := CreateComObject(CLASS_Class4) as _Class4;
end;
class function CoClass4.CreateRemote(const MachineName: string): _Class4;
begin
Result := CreateRemoteComObject(MachineName, CLASS_Class4) as _Class4;
end;
procedure TClass4.InitServerData;
const
CServerData: TServerData = (
ClassID: '{6C78853D-D584-35FF-8CD9-7C7214DFCA8F}';
IntfIID: '{7FBDFC4C-887D-3891-81F6-AD1D99057826}';
EventIID: '';
LicenseKey: nil;
Version: 500);
begin
ServerData := @CServerData;
end;
procedure TClass4.Connect;
var
punk: IUnknown;
begin
if FIntf = nil then
begin
punk := GetServer;
Fintf:= punk as _Class4;
end;
end;
procedure TClass4.ConnectTo(svrIntf: _Class4);
begin
Disconnect;
FIntf := svrIntf;
end;
procedure TClass4.DisConnect;
begin
if Fintf <> nil then
begin
FIntf := nil;
end;
end;
function TClass4.GetDefaultInterface: _Class4;
begin
if FIntf = nil then
Connect;
Assert(FIntf <> nil, 'DefaultInterface is NULL. Component is not connected to Server. You must call "Connect" or "ConnectTo" before this operation');
Result := FIntf;
end;
constructor TClass4.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
end;
destructor TClass4.Destroy;
begin
inherited Destroy;
end;
function TClass4.Get_ToString: WideString;
begin
Result := DefaultInterface.ToString;
end;
function TClass4.Equals(obj: OleVariant): WordBool;
begin
Result := DefaultInterface.Equals(obj);
end;
function TClass4.GetHashCode: Integer;
begin
Result := DefaultInterface.GetHashCode;
end;
function TClass4.GetType: _Type;
begin
Result := DefaultInterface.GetType;
end;
function TClass4.LoadJson(const filePath: WideString): _Class1;
begin
Result := DefaultInterface.LoadJson(filePath);
end;
procedure Register;
begin
RegisterComponents(dtlServerPage, [TClass1, TClass2, TClass3, TClass4]);
end;
end.
默认情况下Class2.array_1_class2为空。 如果直接创建Class2对象，则 C# 代码不会向其array_1_class2成员分配任何数据。
Class4.LoadJson()返回一个您忽略的Class1对象。Class1包含一个Class2对象，其array_1_class2成员将由LoadJson()填充。 因此，在您的 Delphi 代码中，您应该访问V_class1.Class2.array_1_class2而不是V_class2.array_1_class2.
此外，您错误地使用了SafeArrayGetElement()的第 3 个参数。 您提取的每个整数仅保存在LData[0]中，您永远不会为LData[1]分配任何值。
尝试更多类似的东西：
program dllTester;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils,
Variants,
Classes,
ActiveX,
ComObj,
dll_TLB in 'dll_TLB.pas';
var
filePath : WideString;
V_class1: _Class1;
V_class4: _Class4;
Class2_SafeArray: PSafeArray;
Class2_LBound, Class2_UBound, Index: LongInt;
LData: array of Int32;
//ptr: Pointer;
begin
OleCheck(CoInitialize(nil));
try
try
V_class4 := CoClass4.Create;
try
filePath := 'C:UsersDocumentsfile.json';
V_class1 := V_class4.LoadJson(filePath);
finally
V_class4 := nil;
end;
//get the PSafeArray
Class2_SafeArray := V_class1.Class2.array_1_class2;
try
//get the bounds
OleCheck(SafeArrayGetLBound(Class2_SafeArray, 1, Class2_LBound));
OleCheck(SafeArrayGetUBound(Class2_SafeArray, 1, Class2_UBound));
// allocate the array
SetLength(LData, (Class2_UBound - Class2_LBound) + 1);
WriteLn('Class2 array_1:');
for Index := Class2_LBound to Class2_UBound do begin
OleCheck(SafeArrayGetElement(Class2_SafeArray, Index, LData[Index]));
end;
{ alternatively:
OleCheck(SafeArrayAccessData(Class2_SafeArray, ptr));
try
Move(ptr^, PInt32(LData)^, SizeOf(Int32) * Length(LData));
finally
OleCheck(SafeArrayUnaccessData(Class2_SafeArray));
end;
}
for Index := Low(LData) to High(LData) do begin
WriteLn(LData[Index]);
end;
finally
// note sure if this is appropriate or not here,
// since the C# code owns the original int array...
SafeArrayDestroy(Class2_SafeArray);
end;
finally
V_class1 := nil;
end;
finally
CoUninitialize();
end;
ReadLn;
end.