Как распечатать информацию из PsafeArray в Delphi? ⇐ C#

[Anonymous]

Я создал библиотеку классов (в .NET Framework) на C#, которая позволяет извлекать информацию из следующего файла 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(json);

return Data;
}
}

}

}

Я создал еще одну программу на C#, чтобы протестировать разработанный код, и пришел к выводу, что она работает.
Затем я попробовал сделать то же самое в Делфи. Я вызвал .NET DLL из консольного приложения в Delphi, сделав библиотеку 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:\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.


Подробнее здесь: https://stackoverflow.com/questions/655 ... -in-delphi