При закрытии программы , RealTime Error

[Лисенок]

Доброе время суток.
Я создала свой компонент по юниту, который мне когда-то подсказали на вашем форуме. Мне нужно было вылавливать событие сохранение документа Word при позднем связывании.
Так выглядит часть юнита, которую я использую:

unit UnMyServerEventDispatch;
 
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ActiveX, ComObj, unSTP, main;
 
type
 
  TMyServerEventDispatch = class(TObject, IUnknown, IDispatch)
  private
    InternalRefCount : Integer;
  public
    { IUnknown }
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
    { IDispatch }
    function GetTypeInfoCount(out Count: Integer): HResult; stdcall;
    function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;
    function GetIDsOfNames(const IID: TGUID; Names: Pointer;
      NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
    function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
      Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
 
 
    constructor Create();
  end;
 
implementation
const
//   WordEvent: TGUID = '{000209FE-0000-0000-C000-000000000046}'; // Word 2000
   WordEvent: TGUID = '{00020A00-0000-0000-C000-000000000046}'; // Word 2002
 
function TMyServerEventDispatch.Invoke(DispID: Integer; const IID: TGUID;
  LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo,
  ArgErr: Pointer): HResult;
var v: olevariant;
begin
   if (DispID = 8) then  //save
     begin
       unSTP.want_to_ask:=false;
       v:=ExtractFilePath(Application.ExeName)+'\temp\111.doc';
       unSTP.Wrd.ActiveDocument.SaveAs(v, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam);
       v:=ExtractFilePath(Application.ExeName)+'\temp\222.doc';
       unSTP.Wrd.ActiveDocument.SaveAs(v, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam);
       // ShowMessage(ClientDataSet1.FieldByName('ID_STP').AsString);
       if unstp.text_STP_or_notif=1 then
         begin
           MainForm.ClientDataSet1.Edit;
           MainForm.ClientDataSet1TEXT_STP.LoadFromFile(ExtractFilePath(Application.ExeName)+'\temp\111.doc');
           ask_post:=false;
           MainForm.ClientDataSet1.Post;
           ask_post:=true;
           SetForegroundWindow(MainForm.Handle);
         end;
       if unstp.text_STP_or_notif=2 then
         begin
           MainForm.ClientDataSet2.Edit;
           MainForm.ClientDataSet2TEXT_NOTIF.LoadFromFile(ExtractFilePath(Application.ExeName)+'\temp\111.doc');
           ask_post:=false;
           MainForm.ClientDataSet2.Post;
           ask_post:=true;
           SetForegroundWindow(MainForm.Handle);
         end;
     end;
   Result := S_OK;
end;
 
end.

В основной программе я использовала его таким образом:

              Wrd:=CreateOleObject('Word.Application');
              punk:=IUnknown(Wrd);
              ComObj.InterfaceConnect(punk, WordEvent, MyWord1, Connection);
              wrd.documents.open(path_stp);
              Wrd.Visible := true;

Но так неудобно было использовать этот класс, потому что для каждой программы нужно переписывать код класса TMyServerEventDispatch, где он обрабатывает сохранение файла.
Я решила создать компонент, чтобы можно было писать обработку сохранения документа прямо из остновной программы.
Вот как выглядет код этого компонента:

unit MyWord;
 
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ActiveX, ComObj;
 
type
 
  TWordSave = procedure(ASender: TObject) of object;
 
  TMyWord = class(TComponent, IUnknown, IDispatch)
  private
    InternalRefCount : Integer;
    FOnSave: TWordSave;
    { IUnknown }
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
    { IDispatch }
    function GetTypeInfoCount(out Count: Integer): HResult; stdcall;
    function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;
    function GetIDsOfNames(const IID: TGUID; Names: Pointer;
      NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
    function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
      Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property OnSave: TWordSave read FOnSave write FOnSave;
  end;
 
procedure Register;
 
implementation
const
//   WordEvent: TGUID = '{000209FE-0000-0000-C000-000000000046}'; // Word 2000
   WordEvent: TGUID = '{00020A00-0000-0000-C000-000000000046}'; // Word 2002
 
procedure Register;
begin
  RegisterComponents('Servers', [TMyWord]);
end;
 
function TMyWord.Invoke(DispID: Integer; const IID: TGUID;
  LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo,
  ArgErr: Pointer): HResult;
//var v: olevariant;
begin
   if (DispID = 8) then  //save
     begin
       if Assigned(FOnSave) then FOnSave(Self);
     end;
   Result := S_OK;
end;
 
end.

В основной программе я пишу код собятия OnSave:

       UnSTP.want_to_ask:=false;
       v:=ExtractFilePath(Application.ExeName)+'\temp\111.doc';
       UnSTP.Wrd.ActiveDocument.SaveAs(v, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam);
       v:=ExtractFilePath(Application.ExeName)+'\temp\222.doc';
       UnSTP.Wrd.ActiveDocument.SaveAs(v, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam);
       // ShowMessage(ClientDataSet1.FieldByName('ID_STP').AsString);
       if UnSTP.text_STP_or_notif=1 then
         begin
           ClientDataSet1.Edit;
           ClientDataSet1TEXT_STP.LoadFromFile(ExtractFilePath(Application.ExeName)+'\temp\111.doc');
           ask_post:=false;
           ClientDataSet1.Post;
           ask_post:=true;
           SetForegroundWindow(Handle);
         end;
       if UnSTP.text_STP_or_notif=2 then
         begin
           ClientDataSet2.Edit;
           ClientDataSet2TEXT_NOTIF.LoadFromFile(ExtractFilePath(Application.ExeName)+'\temp\111.doc');
           ask_post:=false;
           ClientDataSet2.Post;
           ask_post:=true;
           SetForegroundWindow(Handle);
         end;

И у меня стала возникать ошибка уже после закрытия программы "RunTime Error". Она возникает, если срабатывает ComObj.InterfaceConnect(punk, WordEvent, MainForm.MyWord1, Connection);
Я наверное слишком длинно рассказывала, но помогите мне, пожалуйста, я в тупике...
Заранее благодарна

[RuSA]

Перекос, скорее всего из=за того что освобождаетс форма, но не оповещает об этом "MyWord", а тот пытается вызвать FOnSave...
1) Тебе надо навеситься на форму при присвоении FOnSave, чтобы вовремя аннулировать указатель на метод (при освобождении формы).
слежение можно сделать так:

type
  TMyWord = class(TComponent, IUnknown, IDispatch)
  private
   ...
     procedure SetOnSave( const AOnSave: TWordSave ); // <-- добавлено
  protected
        
  public
   ...
  published
    property OnSave: TWordSave read FOnSave write SetOnSave;
  end;
...
 
type
   // вспомогательная структура для представления обработчика событий объекта
   //
   TEventStruc =
   packed record
      proc : pointer;
      case byte of
         0: (objPtr: pointer);
         1: (obj   : TObject)
   end;
 
procedure TMyWord.SetOnSave( const Value: TWordOnSave );
var
   ev: TEventStruc;
begin
   if not CompareMem( @@FOnSave, @@Value, sizeof(TWordOnSave) ) then
   begin
      FOnSave := Value;
 
      // "навешиваемся" на компонент, чей метод обрабатывается...
      ev := TEventStruc(Value);
      if ev.obj is TComponent then
         TComponent(ev.obj).FreeNotification(Self);
   end;
end;
 
procedure TMyWord.Notification( AComponent: TComponent;
  Operation: TOperation);
begin
   inherited;
 
   if Operation = opRemove then
   begin
 
      // если освобождается объект, метод которого надо вызвать
      // для FOnSave -> очищаем FOnSave;
      if AComponent = TEventStruc(Self.FOnSave).obj then
         FOnSave := nil;
   end;
end;
 
2) Также MyWord надо аккуратно особождать - через MyWord._Release. Если ты сделал компонент MyWord. то скорее всего его владелец - форма,
которая его грохнет автоматически. Просто надо в деструкторе MyWord отцепиться от MS Word через InterfaceDisconnect !
Последний параметр в InterfaceDisconnect - это тот же самый что и у InterfaceConnect: "Connection: longint", так что его придется хранить в самом TMyWord.

Добавлено 29.03.06, 11:56
Вот так можно отслеживать более безопасно:

type
   TMyWord = class( {TComponent, IUnknown, IDispatch)
   private
     ...
    // последние контролируемые события
    FCurConnection: integer;
    FCurInterface: IUnknown;
    FCurGUID: TGUID;
 
   protected
   ...
   public
    constructor Create( AOwner: TComponent ); override;
    destructor Destroy; override;
 
    // выполнить присоединение Self к обработке событий punk с ID=EvGUID;
    // предыдущее автоматически отсоединяется;
    // если punk = nil -> просто отсоединиться от всего;
    //
    procedure DoConnect( punk: IUnknown; EvGUID: TGUID );
 
    procedure DoDisconnect; // отсоединиться
   end;
 
...
 
// (!) Create привожу чтобы точно показать что вызывается inherited (!)
//
constructor TMyWord.Create;
begin
   inherited;
   InternalRefCount := 1;
end;
 
destructor TMyWord.Destroy;
begin
   DoDisсonnect; // гарантировано отсоединяемся
   inherited;
end;
 
procedure TMyWord.DoDisconnect; // отсоединиться
begin
   DoConnect( nil, FCurGUID );
end;
 
procedure TMyWord.DoConnect( punk: IInterface; EvGUID: TGUID);
begin
   // отсоединиться от прежнего...
   if FCurInterface <> nil then
      ComObj.InterfaceDisconnect( FCurInterface, FCurGUID, FCurConnection );
 
   // присоединиться к новому, если надо
   //
   FCurConnection := 0;
   FCurInterface := punk;
   FCurGUID := EvGUID;
 
   if punk <> nil then
      ComObj.InterfaceConnect( FCurInterface, FCurGUID, Self, FCurConnection );
end;

[Лисенок]

Спасибо огромное, RuSa. Ты меня выручил, теперь все работает.
Вопрос можно считать закрытым