PHP DM Gate v0.9 » Метод интерфейса, возвращающий интерфейс в exe com сервере <span class="vd">[Delphi]</span>

Serser (16.07.12 20:36) [0]

Добрый день!
Есть задача написать COM сервер, который бы предоставлял некоторую информацию. В силу обстоятельств требуется, чтобы сервер был out-of-process и мог обслуживать несколько клиентов одновременно.
Интерфейсы нужно организовать в цепочки, так как позволяет это делать Excel: WorkSheet.ActiveCell.Font.SetFont().
Как это сделать в delphi 2010 разобрался. Создал VCL приложение, туда добавил Automation Object.
В дизайнере сделал два интерфейса (IMyAutomationClass и IMySecondAutomation), у интерфейса IMyAutomationClass есть метод, возвращающий указатель на интерфейс IMySecondAutomation:

function TMyAutomationClass.Test2: IMySecondAutomation;
begin
Result := TMySecondAutomation.Create as IMySecondAutomation;
end;

Для обоих интерфейсов в дизайнере .ridl файла присутствуют Co-классы. Библиотека типов сервера зарегистрирована в реестре, как и сам сервер. В секции инициализации создается вторая фабрика для IMySecondAutomation:

TAutoObjectFactory.Create(ComServer, TMyAutomationClass, Class_MyAutomationClass,
ciMultiInstance, tmApartment);

TAutoObjectFactory.Create(ComServer, TMySecondAutomation, CLASS_MySecondAutomation,
ciMultiInstance, tmApartment);

Но, когда я в клиентском приложении выполняю этот код (импортировав до этого туда файл с библиотекой типов сервера):

procedure TForm1.Button1Click(Sender: TObject);
var
Unk,
Unk2: IUnknown;
Int: IMyAutomationClass;
Sec: IMySecondAutomation;
begin
Unk := CreateComObject(CLASS_MyAutomationClass);
Int := Unk as IMyAutomationClass;

Unk2 := Int.Test2; <-- ошибка
Sec := Unk2 as IMySecondAutomation;
end;

То в указанной строчке вылетает AV. Причем, это происходит, даже если TMyAutomationClass.Test2 в сервере не будет создавать объект, вообще ничего не будет делать.
Если же в TMyAutomationClass.Test2 в начале добавить MessageBox() то он тоже не покажется. видимо исключение происходит где-то еще до передачи управления серверу.
Подскажите пожалуйста в чем может быть дело?

<Цитата>
Serser (17.07.12 14:40) [1]

В общем вроде разобрался, чтобы вернуть интерфейс нужно в конструкторе .ridl файла в параметрах метода интерфейса, возвращающего интерфейс указать:
1. Возвращаемый тип - HRESULT
2. Параметр с любым именем типа "VARIANT *" и модификаторами out и retval.
После этого среда сгенерирует метод, возвращающий OleVariant, после этого можно создать в нем второй объект:
function TMyAutomationClass.Test3: OleVariant;
begin
Result := TMySecondAutomation.Create as IDispatch;
end;

В клиенте же делаю вот так:
procedure TForm1.Button1Click(Sender: TObject);
var
Unk: IUnknown;
Int: IMyAutomationClass;
Sec: IMySecondAutomation;
p: OleVariant;
begin
Unk := CreateComObject(CLASS_MyAutomationClass);
Int := Unk as IMyAutomationClass;
p := Int.Test3;
Sec := IDispatch(p) as IMySecondAutomation;
Sec.xTest1;

VarClear(p);
Int := nil;
Unk := nil;
end;

таким образом получается явно привести variant к второму интерфейсу

или вот так:
procedure TForm1.Button1Click(Sender: TObject);
var
Unk,
Unk2: IUnknown;
Int: IMyAutomationClass;
Sec: IMySecondAutomation;
p: OleVariant;
begin
Unk := CreateComObject(CLASS_MyAutomationClass);
Int := Unk as IMyAutomationClass;
p := Int.Test3;
p.xTest1;

VarClear(p);
Int := nil;
Unk := nil;
end;

так работает через позднее связывание.

<Цитата>