Collections and IenumVariant (one more time)

Hi fellows,

    I know this has been discussed already, but only reading the old posts
was not enought to clear all my doubts. Based on the old posts (most part
from Bhin Ly and Argo) I came with the code at the end of the message, to be
used in a collection like ASP Application object.
    When the host application (a VB script) process the for each instruction
the next statment is called, but when it leaves a GPF is raised. What could
be wrong with it?

    Another question,  my Collection object uses a TStringList to store the
Item associated with a string key (as I said just like ASP Application
behaves). When _NewEnum is called it creates a TVariantEnum, just assign the
source list (from the collection) to the Enum list. Could this be a problem
(with reference coun objects, for example) or not?

Cheers,

Eric.

-------
unit uVariantCollection;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
  Classes, ComObj, ActiveX, AspParser_TLB, StdVcl, Variants;

type
  POleVariant = ^olevariant;

  TVariantEnum = class(TInterfacedObject, IEnumVariant)
  private
    FItems: TStringList;   // list of objects in collection
    FIndex: Integer;
  protected
    function Next(celt: LongWord; var rgvar : OleVariant; out pceltFetched:
LongWord): HResult; stdcall;
    function Skip(celt: LongWord): HResult; stdcall;
    function Reset: HResult; stdcall;
    function Clone(out Enum: IEnumVariant): HResult; stdcall;
  public
    constructor Create(aList: TStringList; aIndex:Integer);
    destructor Destroy; override;
  end;

  TVariantCollection = class(TAutoObject, IVariantCollection)
  private
    FItems: TStringList;
  protected
    function Get_Count: Integer; safecall;
    function Get_Items(const Index: WideString): OleVariant; safecall;
    procedure _Set_Items(const Index: WideString; var Value: OleVariant);
      safecall;
    function AddObject(const Index: WideString; Value: OleVariant): Integer;
      safecall;
    procedure Set_Items(const Index: WideString; Value: OleVariant);
safecall;
    procedure Delete(const Index: WideString); safecall;
    function Get__NewEnum: IUnknown; safecall;
    { Protected declarations }
  public
    procedure Initialize; override;
    destructor Destroy; override;
  end;

implementation

uses ComServ;

function TVariantCollection.Get_Count: Integer;
begin
  Result := FItems.Count;
end;

function TVariantCollection.Get_Items(const Index: WideString): OleVariant;
var
  iIndex: integer;
begin
  iIndex := FItems.IndexOf (Index);
  if (iIndex > -1) then
    Result := POleVariant (FItems.Objects [iIndex])^
  else
    Result := VarEmpty;
end;

procedure TVariantCollection._Set_Items(const Index: WideString;
  var Value: OleVariant);
var
  iIndex: integer;
begin
  iIndex := FItems.IndexOf (Index);
  if (iIndex > -1) then
      AddObject(Index, Value)
  else
    POleVariant(FItems.Objects [iIndex])^ := Value;
end;

function TVariantCollection.AddObject(const Index: WideString;
  Value: OleVariant): Integer;
begin
  Result := FItems.AddObject (Index, TObject (new (POleVariant)));
  POleVariant(FItems.Objects[Result])^ := Value;
end;

procedure TVariantCollection.Set_Items(const Index: WideString;
  Value: OleVariant);
begin
  Set_Items(Index, Value);
end;

destructor TVariantCollection.Destroy;
begin
  FItems.Free;
  inherited;
end;

procedure TVariantCollection.Initialize;
begin
  inherited;
  FItems := TStringList.Create;
end;

procedure TVariantCollection.Delete(const Index: WideString);
var
  iIndex: integer;
begin
  iIndex := FItems.IndexOf(Index);
  if iIndex = -1 then
    Exit;
  Dispose (POleVariant(FItems.Objects [iIndex]));
  FItems.Delete(iIndex);
end;

function TVariantCollection.Get__NewEnum: IUnknown;
begin
  Result := TVariantEnum.Create(FItems, 0);
end;

{ TVariantEnum }

function TVariantEnum.Clone(out Enum: IEnumVariant): HResult;
begin
  Enum := TVariantEnum.Create(FItems, FIndex);
  Result := S_OK;
end;

constructor TVariantEnum.Create(aList: TStringList; aIndex:Integer);
begin
  inherited Create;
  FIndex := aIndex;
  FItems := TStringList.Create;
  FItems.Assign(aList);
end;

destructor TVariantEnum.Destroy;
begin
  FItems.Free;
  inherited;
end;

function TVariantEnum.Next(celt: LongWord; var rgvar: OleVariant;
  out pceltFetched: LongWord): HResult;
begin
  if @pceltFetched <> nil then
    pceltFetched := 0;

  rgvar := VarArrayCreate([0, celt-1], varVariant);
  while (FIndex < FItems.Count) and (pceltFetched < celt) do
  begin
    rgvar[pceltFetched] := POleVariant(FItems.Objects[FIndex])^;
    Inc(FIndex);
    Inc(pceltFetched);
  end;

  if pceltFetched = celt then
    Result := S_OK
  else
    Result := S_FALSE;
end;

function TVariantEnum.Reset: HResult;
begin
  Findex := 0;
end;

function TVariantEnum.Skip(celt: LongWord): HResult;
begin
  result := S_FALSE;
  Inc(Findex, celt);
  if FINDEX < FItems.Count then
    Result := S_OK
  else
    FIndex := FItems.Count;
end;

initialization
  TAutoObjectFactory.Create(ComServer, TVariantCollection,
Class_VariantCollection,
    ciMultiInstance, tmApartment);
end.