SafeArrayPutElement

[BugHunter]

Hallo,

Ich möchte Objekte in ein eindimensionales PSafeArray schreiben, dafür benutze ich folgende Funktion:

Delphi-Quellcode:

function WriteSafeArray( const AList: TList ): PSafeArray;
var i, LArrInd: Integer;
  LSafeArrayBound: Array[0..0] of TSafeArrayBound;
  LSafeArray: PSafeArray;
  LDispatch: IDispatch;
begin
  LSafeArrayBound[0].cElements:= AList.Count;
  LSafeArrayBound[0].lLbound:= 0;
  LSafeArray:= ActiveX.SafeArrayCreate(VT_DISPATCH, 1, LSafeArrayBound);
  VariantInit(LVAriant);
  for i:= 0 to AList.Count-1 do begin
    LArrInd:= i;
    LDispatch:= UsedTicket_Type(AList.Items[i]) as IUsedTicket_Type;
    ActiveX.SafeArrayPutElement(LSafeArray, LArrInd, LDispatch);
  end;
  Result:= LSafeArray;
end;

jedes mal wenn "ActiveX.SafeArrayPutElement" aufgerufen wird bekomme ich die Fehlermeldung:

"Catastrophic failure (Exception from HRESULT: 0x8000FFFF (E_UNEXPECTED))"

Die Objekte sind von OleServer und einem Interface aus einer importierten tlb abgeleitet:

Delphi-Quellcode:

  UsedTicket_Type = class(OleServer, IUsedTicket_Type)
  private
    FAdvanceSale: Integer;
    FReversed: Integer;
    FSold: Integer;
    FTicketTypeName: WideString;
    FIsFreeTicket: WordBool;
    function Get_AdvanceSale: Integer; safecall;
    function Get_Reversed: Integer; safecall;
    function Get_Sold: Integer; safecall;
    function Get_TicketTypeName: WideString; safecall;
    function Get_IsFreeTicket: WordBool; safecall;
  protected
    function GetImplementedInterfaceID: TGUID; override;
  public
    constructor CreateInitialized(AReversed: Integer; const ATicketTypeName: string; ASold, AAdvanceSale: Integer; const AIsFreeTicket: Boolean);
    destructor Destroy; override;
    property AdvanceSale: Integer read Get_AdvanceSale write FAdvanceSale;
    property Reversed: Integer read Get_Reversed write FReversed;
    property Sold: Integer read Get_Sold write FSold;
    property TicketTypeName: WideString read Get_TicketTypeName write FTicketTypeName;
    property IsFreeTicket: WordBool read Get_IsFreeTicket write FIsFreeTicket;
  end;

// *********************************************************************//
// Schnittstelle: IUsedTicket_Type
// Flags:     (4416) Dual OleAutomation Dispatchable
// GUID:      {D7683C31-BDB1-49A9-AA56-CD7CF6E3764A}
// *********************************************************************//
  IUsedTicket_Type = interface(IDispatch)
    ['{D7683C31-BDB1-49A9-AA56-CD7CF6E3764A}']
    function Get_AdvanceSale: Integer; safecall;
    function Get_Reversed: Integer; safecall;
    function Get_Sold: Integer; safecall;
    function Get_TicketTypeName: WideString; safecall;
    function Get_IsFreeTicket: WordBool; safecall;
    property AdvanceSale: Integer read Get_AdvanceSale;
    property Reversed: Integer read Get_Reversed;
    property Sold: Integer read Get_Sold;
    property TicketTypeName: WideString read Get_TicketTypeName;
    property IsFreeTicket: WordBool read Get_IsFreeTicket;
  end;

Was mach ich da falsch?

Grüße und Danke
Marc

[sx2008]

Warum benützt du TList um eine Liste von Interfaces zu führen?
Das kann nämlich ganz leicht ins Auge gehen:

Delphi-Quellcode:

var
  ...
  LDispatch: IDispatch;
begin
  ...
  // hier wird der Zeiger, der in AList.Items[i] auf einen Interfacezeiger kopiert.  
  LDispatch:= UsedTicket_Type(AList.Items[i]) as IUsedTicket_Type;
  ...

  // und spätestens hier gibt's Probleme!!
  // LDispatch wird ungültig - die Referenzzählung schlägt zu und es wird unsichtbar
  // _Release aufgerufen.
  // Sollte das Interface vorher einen RefCount von 1 gehabt haben
  // dann ist jetzt der RefCount = 0 und damit wird das Objekt freigegeben
end;

Damit das nicht passiert, solltest du TInterfaceList anstelle von TList verwenden.

Mir ist auch nicht klar, weshalb du mit einem SafeArray arbeitest.
Ein Variantarray ist intern auch ein SafeArray; mit dem Vorteil, dass die ganzen interne Dinge
von Delphi gemanaged werden.

Delphi-Quellcode:

var
  mein_array : OleVariant;
  i : Integer;
begin
  mein_array := VarArrayCreate([0, list.Count-1], varDispatch);
  for i:=0 to list.count-1 do
    mein_array[i] := list.Items[i] as IDispatch;