COM-объект умирает раньше времени

← →
LexusR (2002-07-26 07:43) [0]

/////////////////////////////////////////////////////////////////////////////
// есть DLL с Com-объектом и объектом реализующим интерфейс //
/////////////////////////////////////////////////////////////////////////////
unit ChildCom;
...
type
TForm1 = class(TForm) // Объект(форма) - реализущая интерфейс com-объекта
Edit1: TEdit;
private
{ Private declarations }
public
{ Public declarations }
procedure ShowCaption;
end;

TChildCom = class(TComObject,IChildCom) // com - объект
FMyForm : TForm1;
private
protected
public
destructor Destroy; override;
procedure Initialize; override;
// делегируем реализацию интерфейса IChildCom форме FMyForm
property MyForm : TForm1 read FMyForm implements IChildCom;
end;

{ TChildCom }

destructor TChildCom.Destroy;
begin
FMyForm.Free;
// ShowMessage("destroy"); //отладочный контроль вызова деструктора
inherited;
end;

procedure TChildCom.Initialize;
begin
inherited;
FMyForm := TForm1.Create(nil);
FMyForm.Show;
end;

{ TForm1 }

procedure TForm1.ShowCaption;
begin
Caption := "Implements";
end;

initialization
TComObjectFactory.Create(ComServer, TChildCom, Class_ChildCom, "ChildCom", "", ciMultiInstance, tmApartment);

end.
////////////////////////////////////////////////////////////////////////////////////////////////////////////
// Описание интерфейса
////////////////////////////////////////////////////////////////////////////////////////////////////////////
unit MyInterfaces;
....
type

IChildCom = interface(IUnknown) ["{F75DEF8F-A00D-49D1-87F2-42171BA1AE4E}"]
procedure ShowCaption;
end;

const
Class_ChildCom: TGUID = "{81E4407D-7273-424E-8F8A-226FDE16A2A4}";

implementation

end.

////////////////////////////////////////////////////////////////////////////////////////////////////////////
// Клиент вызывающий COM-объект
////////////////////////////////////////////////////////////////////////////////////////////////////////////

unit Main;
...
type
TForm1 = class(TForm)
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
BitBtn3: TBitBtn;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure BitBtn1Click(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
procedure BitBtn3Click(Sender: TObject);
private
{ Private declarations }
protected
FTormoz : IUnknown;
FChildCom : IChildCom;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

// создание COM-объекта - ВАРИАНТ 1
// при выходе из процедуры BitBtn1Click COM-объект приказывает долго жить
// типа FChildCom - локальная переменная ????????
// даьнейший вызов BitBtn2Click естественно сопровождается
// любимым приветствием Access violation
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
FChildCom := CreateComObject(Class_ChildCom)as IChildCom;
// FChildCom := FTormoz as IChildCom;
// FTormoz := CreateComObject(Class_ChildCom);
// FChildCom := FTormoz as IChildCom;
end;
// создание COM-объекта - ВАРИАНТ 2
// создание промежуточной переменной типа IUnknown
// спасает IChildCom от преждевременной кончины
// ВОПРОС ЗНАТОКАМ - ЧТО ТАК И НУЖНО ????
// ИЛИ ЕСТЬ БОЛЕЕ ЕСТЕСТВЕННЫЙ СПОСОБ
// ЗАРАНЕЕ БЛАГОДАРЕН!!!!!!
procedure TForm1.BitBtn3Click(Sender: TObject);
begin
FTormoz := CreateComObject(Class_ChildCom);
FChildCom := FTormoz as IChildCom;
end;
// вызов метода COM-объекта
procedure TForm1.BitBtn2Click(Sender: TObject);
begin
FChildCom.ShowCaption;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
FChildCom := nil;
end;

← →
LexusR (2002-07-26 10:20) [1]

← →
Fellomena (2002-07-26 12:13) [2]

Впринципе вот это правильно:

FChildCom:= CreateComObject(Class_ChildCom) as IChildCom;
imho трабл в области видимости - попробуй описать FChildCom : IChildCom; в разделе private, а не protected

← →
LexusR (2002-07-26 12:46) [3]

To Fellomena
Увы не помогает

← →
Mike_Goblin (2002-07-26 12:58) [4]

Ты смешиваешь модель работы с объектом и интерфейсом
Путь 1:
Работать через интерфейсы (чтобы св-ва были не объектными, а интерфейсами)
Путь 2:
Самостоятельно реализовать работу со счетчиком ссылок на объект

COM-объект умирает раньше времени Найти похожие ветки