如何在Delphi中打印PsafeArray中的信息？

问题描述 投票：0回答：2

我用 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
单元中生成的，如导入类型库信息时生成的代码中所指定。结果，
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.
c# delphi dll com
2个回答
0
投票

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.
0
投票

由于 64 位版本，变量 LData 应定义为“LData：NativeInt 数组”或“TArray”。 如果您使用“LData：整数数组”，您将损坏内存中的数据。

最新问题
© www.soinside.com 2019 - 2024. All rights reserved.