如何从 Delphi 中的 PsafeArray 打印信息？
Posted
技术标签:
【中文标题】如何从 Delphi 中的 PsafeArray 打印信息？【英文标题】：How to print information from a PsafeArray in Delphi? 【发布时间】：2021-04-08 20:41:46 【问题描述】：我用 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 中做同样的事情。我通过将库 COM 变为可见并将其作为类型库导入，从 Delphi 的控制台应用程序中调用了 .NET DLL。因此，代码在TypeLibName_TLB 单元中生成，如Code Generated When You Import Type Library Information 中所指定。因此，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:\Users\Documents\file.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.
【问题讨论】：
可以直接在Delphi中解析JSON，以防不知道... 非常感谢您的回答，您是否推荐任何有关此主题的文档？ @Joana 阅读 Embarcadero 的 JSON documentation @RemyLebeau 谢谢你的回答。我会阅读文档。不过，您知道我当前的代码有什么问题吗？非常感谢您的帮助 @Joana 看到我刚刚发布的答案 【参考方案1】：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() 的第三个参数。您提取的每个整数仅保存在 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:\Users\Documents\file.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.
【讨论】：
以上是关于如何从 Delphi 中的 PsafeArray 打印信息？的主要内容，如果未能解决你的问题，请参考以下文章
如何从 Firemonkey/Delphi 中的条码扫描仪获取数据
SQLite - 如何从 XML 文件插入 JPG 图像（使用 Delphi 2009）