/////////////////////////////////////////////////////////////////////////////
// ПРИМЕР : есть 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, Вы писали:
LR>// создание промежуточной переменной типа IUnknown
LR>// спасает IChildCom от преждевременной кончины
LR>// ВОПРОС ЗНАТОКАМ — ЧТО ТАК И НУЖНО ????
LR>// ИЛИ ЕСТЬ БОЛЕЕ ЕСТЕСТВЕННЫЙ СПОСОБ
LR>// ЗАРАНЕЕ БЛАГОДАРЕН!!!!!!
LR>procedure TForm1.BitBtn3Click(Sender: TObject);
LR>begin
LR> FTormoz := CreateComObject(Class_ChildCom);
LR> FChildCom := FTormoz as IChildCom;
LR>end;
умирает потому что у тебя уничтожается ссылка (Delphi во wrappere автоматически делает Release)
имхо лучше не пользоваться всякими врапперами а создавать объект
так как предписано в COM API: через CoCreateInstance
var pUnk: IUnknown; pObj: IMyClassInterface;
CoInitialize(nil);
OleCheck(CoCreateInstance(CLSID_MyClass, nil,
CLSCTX_INPROC_SERVER, IUnknown, pUnk));
OleCheck(pUnk.QueryInterface(IMyClassInterface,pObj));
pObj.MyFunctionCall(x,y,z);