COM-умирает раньше времени
От: LexusR Россия  
Дата: 26.07.02 04:05
Оценка:
/////////////////////////////////////////////////////////////////////////////
// ПРИМЕР : есть 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;
 
Подождите ...
Wait...
Пока на собственное сообщение не было ответов, его можно удалить.