Дмитрий Полщанов
дата публикации 09-10-2001 15:05

---

Версия для печати

1. Облегчение сопровождения. Приложение разбивается на функциональные модули так, чтобы можно было без опаски заменить "ошибочный" модуль на (якобы) "исправленный" J.
2. Обеспечение "наращиваемости". То есть, путем добавления нового модуля и (может быть) прописывания некоторой информации в реестре Windows (или ini-файле - кому как нравится) основное приложение без перекомпиляции получало бы новые функциональные (или интерфейсные) возможности.
3. Обеспечение "взаимозаменяемости" модулей. То есть, спроектировать систему так, чтобы можно было заменить один модуль на другой (поддерживающий, естественно, тот же или расширенный функционал) без потери работоспособности системы в целом.

• Приходится утомительно долго описывать "экспортные" функции в dll и "рисовать" модули импорта;
• "Взаимозаменяемость" обеспечить в принципе можно, но "наращиваемость" и сопровождение оставляют желать лучшего;
• Наличие "некоторых тонкостей" (типа упаковки дочерних окон в dll - эта тема достаточно широко обсуждалась у Круглого Стола ⁽¹⁾ ) вообще затрудняют использование данного метода, тем более для новичка;

1. Более легкое сопровождение.
2. Исключительно легкая взаимозаменяемость.
3. Наращиваемость - только и мечтать.

1. Дикое разрастание объема выполняемого кода (если, конечно, не использовать компиляцию с пакетами) - но это чревато ослабленной устойчивостью L применительно к dll. С чем это связано, мне определить не удалось - ошибки возникают при выгрузке приложения, но в каком именно месте - осталось невыясненным.
2. Обычно такие "навороты" мало кому нужны. Разве что при обеспечении межпроцессного ⁽³⁾ или межкомпьютерного ⁽⁶⁾ взаимодействия. Кстати, для последнего лучше подходит CORBA…
3. Как ни старалась Borland облегчить работу с COM, на мой взгляд то, что получилось абсолютно не удовлетворительно. Мало того, что существуют "некоторые" существенные ограничения на типы входных и выходных параметров, но и методика работы с COM в Delphi оставляет желать лучшего…

• Практически невозможность дальнейшего сопровождения. При любом изменении виртуальной таблицы методов (VMT) ⁽⁵⁾ базового класса - пакеты, их использующие, становятся неработоспособными. И даже более того - опасными!
• Условная взаимозаменяемость. Так или иначе, придется скрупулезно проверять вызов каждой функции и каждого метода ⁽⁶⁾.
• "Усложненность" разработки. Как показывает практика, при уровне "наследуемости" пакетов больше трех ⁽⁷⁾ процесс компиляции понравится только мазохистам (а если учесть 1 пункт, то проще на все плюнуть J)

во-первых, как можно эффективно использовать встроенные в компилятор средства поддержки COM (при этом не таская за собой ее громоздкую библиотеку поддержки);
и во-вторых, предложить небольшую модернизацию метода Игоря Трофимова;

1. начать с чего-нибудь привычного (а кому это не привычно - он прочувствует, что это не так сложно, как это кажется на первый взгляд)
2. просто иметь некоторую стартовую точку
3. показать, что и разработанные на текущий момент проекты могут быть легко модернизированы с учетом данной методики (возможно, их придется переписывать заново (или начисто, в зависимости от того, как к этому относиться!), - но это даже иногда полезно ).

procedure TForm1.LoadPluginPackage;
var
  FileName: TFileName;
Begin
  // предполагаем, что пакет хранится в том же каталоге, что и исполняемое приложение
  FileName := ExtractFilePath(Application.ExeName);
  FileName := FileName + 'plugin.bpl';
  // Загружаем пакет
  FPackageHandle := LoadPackage(FileName);
  if FPackageHandle = 0 then RaiseLastWin32Error() // пакет не загружен, выбрасываем исключение
  else MessageBox(Handle,  'Пакет plugin загружен',
	 'Информация', MB_APPLMODAL+MB_ICONINFORMATION+MB_OK);
end;

procedure TForm1.aOpenExecute(Sender: TObject);
var
  frmClass: TFormClass;
  frm: TForm;
begin
   frmClass := TFormClass(GetClass('TfrmChild')); // получаем класс дочернего окна
   if not Assigned(frmClass) then 
   begin
     MessageBox(Handle, PChar(Format('Не найден класс %s', ['TfrmDialogFrom'])),
                        'Ошибка',
                        MB_APPLMODAL+MB_ICONERROR+MB_OK);
     Exit;
   end;

   frm := frmClass.Create(Self); // создаем дочернее окно
end;

procedure TForm1.aOpenDialogExecute(Sender: TObject);
var
  frmClass: TFormClass;
begin
   frmClass := TFormClass(GetClass('TfrmDialogFrom')); // получаем класс диалогового окна
   if not Assigned(frmClass) then
   begin
     MessageBox(Handle, PChar(Format('Не найден класс %s', ['TfrmDialogFrom'])),
                        'Ошибка',
                        MB_APPLMODAL+MB_ICONERROR+MB_OK);
     Exit;
   end;

  // создаем и показываем окно диалога
   with frmClass.Create(Self) do
   try
     case ShowModal of
           mrOk: MessageDlg('Выбрано Ok!', mtInformation, [mbOk], 0);
       mrCancel: MessageDlg('Выбрано Cancel!', mtInformation, [mbOk], 0);
           else  MessageDlg('Выбрано хрен знает что!', mtInformation, [mbOk], 0);
     end;
   finally
     Free();
   end;
end;

procedure TForm1.aOpenUpdate(Sender: TObject);
begin
  aOpen.Enabled := FPackageHandle > 0;
  aOpenDialog.Enabled := FPackageHandle > 0;
end;

type 
IMyInitialize = interface
['{7D501741-B419-11D5-915B-ED714AED3037}']     // то самое 16-битное число в строковом
  // представлении. Получается 
  // в Delphi нажатием клавиш Ctrl+g.
    procedure InitializeForm(const ACaption: String);  //  а это процедура интерфейса.
end;

• Первый имеет название QueryInterface. Для любителей COM он является привычным, так как используется в оном вдоль и поперек.
• Второй называется GetInterface.

unit CommonInterfaces;

interface

type
  IMyInitialize = interface
  ['{7D501741-B419-11D5-915B-ED714AED3037}']
    procedure InitializeForm(const ACaption: String);
  end;

  IMyHello = interface
  ['{7D501742-B419-11D5-915B-ED714AED3037}']
    function ShowHello(AText: String): String;
  end;

implementation
end.

1. для дочерней формы:

type
  TfrmChild = class(TForm, IMyInitialize, IMyHello) // так наследуются интерфейсы
  Private
    {  описание методов  IMyInitialize }
    procedure InitializeForm(const ACaption: String);
    { описание методов IMyHello }
    function ShowHello(AText: String): String;
end;

Что мы тут сделали? Мы сказали, что TfrmChild является наследником TForm, но помимо методов TForm VMT класа TfrmChild содержит еще два цельных куска, один из которых идентичен VMT IMyInitialize, а второй VMT IMyHello.

2. для диалоговой формы:

type
  TfrmDialogFrom = class(TForm, IMyInitialize)
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    Label1: TLabel;
  private
  { описание методов IMyInitialize }
    procedure InitializeForm(const ACaption: String);
end;

procedure TForm1.aOpenExecute(Sender: TObject);
var
  frmClass: TFormClass;
  frm: TForm;
  MyInitialize: IMyInitialize;
begin
   frmClass := TFormClass(GetClass('TfrmChild'));
   if not Assigned(frmClass) then
   begin
     MessageBox(Handle, PChar(Format(' Не найден класс %s', ['TfrmDialogFrom'])),
                        'Ошибка',
                        MB_APPLMODAL+MB_ICONERROR+MB_OK);
     exit;
   end;

   frm := frmClass.Create(Self);

   // производим вызов метода интерфейса
   if frm.GetInterface(IMyInitialize, MyInitialize) then
   begin  // интерфейс поддерживается формой, можно вызывать его методы 
     MyInitialize.InitializeForm(Format('Дочернее окно  ? %d', [Tag]));
     Tag := Tag + 1;
   end
  else raise Exception.CreateFmt('Интерфейс %s не поддерживается классом %s', 
                                                   ['ImyInitialize', frm.GetClassName]);
end;

procedure TForm1.aOpenDialogExecute(Sender: TObject);
var
  frmClass: TFormClass;
  MyInitialize: IMyInitialize;
begin
   frmClass := TFormClass(GetClass('TfrmDialogFrom'));
   if not Assigned(frmClass) then
   begin
     MessageBox(Handle, PChar(Format('Не найден класс %s', ['TfrmDialogFrom'])),
                        'Внимание!',
                        MB_APPLMODAL+MB_ICONERROR+MB_OK);
     Exit;
   end;

   with frmClass.Create(Self) do
   try
      if GetInterface(IMyInitialize, MyInitialize) then
        begin  // Интерфейс поддерживается фомой, вызываем его метод
          MyInitialize.InitializeForm(' Диалог');  
        end
      else raise Exception.CreateFmt('Интерфейс %s не поддерживается классом %s', 
                                                   ['ImyInitialize', frm.GetClassName]);

     case ShowModal of
           mrOk: MessageDlg('Ok!', mtInformation, [mbOk], 0);
       mrCancel: MessageDlg('Cancel!', mtInformation, [mbOk], 0);
           else  MessageDlg('Неизвестная распальцовка!', mtInformation, [mbOk], 0);
     end;
   finally
     Free();
   end;
end;

• Во-первых, мы не знаем действительный тип как дочернего, так и диалогового окон. Но между тем вызываем функции, входящие в его VMT.
• Во-вторых, мы запросто можем поменять наш пакет на другой. Имена классов форм пакета особого значения не имеют - их можно сохранять в файле настроек или реестре и подгружать при инициализации основного приложения. Единственное, что необходимо неукоснительно соблюдать - дочернее и диалоговое окно ДОЛЖНЫ поддерживать необходимые интерфейсы.
• В третьих, мы можем КАК УГОДНО изменять формы пакета (включая изменения самой виртуальной таблицы методов, естественно, не затрагивая описания интерфейсов) - общая система приложение-пакет останутся в рабочем состоянии.

ICallBackInterface = interface
  ['{7D501743-B419-11D5-915B-ED714AED3037}']
    procedure Callback(Text: String);
  end;

type
  TForm1 = class(TForm, ICallBackInterface)
    MainMenu: TMainMenu;
  …
protected
   { ICallBackInterface }
    procedure Callback(Text: String);
…
end;

var
  Form1: TForm1;

implementation
…
procedure TForm1.Callback(Text: String);
begin
  ShowMessage('Из главной формы с приветом "' + Text + '"');
end;
…

procedure TfrmChild.aQueryInMainFormExecute(Sender: TObject);
var
  CallBackInterface: ICallBackInterface;
begin
  if Application.MainForm.GetInterface(ICallBackInterface, CallBackInterface) then
    CallBackInterface.Callback('Привет от дочерней формы ' + Caption);
end;

function TfrmChild.ShowHello(AText: String): String;
begin
  InputQuery('Вот что спросили', AText, Result);
  ListBox1.Items.Add('Вот что спросили:');
  ListBox1.Items.Add(AText);
  ListBox1.Items.Add('Вот что ответили:');
  ListBox1.Items.Add(Result);
  ListBox1.Items.Add('');
end;

procedure TfrmDialogFrom.Button1Click(Sender: TObject);
 var
  MyHello: IMyHello;
  Result: String;
begin
  if Assigned(Application.MainForm.ActiveMDIChild) and
     Application.MainForm.ActiveMDIChild.GetInterface(IMyHello, MyHello) then
  begin
    Result := MyHello.ShowHello('Где начало того конца, которым начинается начало?');
    ShowMessage(Result);
  end;
end;

ICallbackInterface2 = interface
 ['{7D501744-B419-11D5-915B-ED714AED3037}']
    procedure Callback(Text: String);
  end;

type
  TForm1 = class(TForm, ICallBackInterface, ICallbackInterface2)
    MainMenu: TMainMenu;
    File1: TMenuItem;
…

…
protected
  // перенаправляем вызов через ICallBackInterface к процедуре Callback1
    procedure ICallBackInterface.Callback = Callback1; 
// перенаправляем вызов через ICallBackInterface2 к процедуре Callback2
    procedure ICallBackInterface2.Callback = Callback2;
    
    procedure Callback1(Text: String);
    procedure Callback2(Text: String);
…
end;
…
procedure TForm1.Callback1(Text: String);
begin
  ShowMessage('Из главной формы 1 "' + Text + '"');
end;

procedure TForm1.Callback2(Text: String);
begin
  ShowMessage(' Из главной формы 2 "' + Text + '"');
end;

type
  TfrmChild = class(TForm, IMyInitialize, IMyHello)
…
    aQueryInMainForm: TAction;
    aQueryInMainForm2: TAction;
…
    procedure aQueryInMainFormExecute(Sender: TObject);
    procedure aQueryInMainForm2Execute(Sender: TObject);
  private
…

procedure TfrmChild.aQueryInMainFormExecute(Sender: TObject);
var
  CallBackInterface: ICallBackInterface;
begin
  if Application.MainForm.GetInterface(ICallBackInterface, CallBackInterface) then
    CallBackInterface.Callback('Привет от ' + Caption);
end;

procedure TfrmChild.aQueryInMainForm2Execute(Sender: TObject);
var
  CallBackInterface: ICallBackInterface2;
begin
  if Application.MainForm.GetInterface(ICallBackInterface2, CallBackInterface) then
    CallBackInterface.Callback('Привет от ' + Caption);
end;
…

Полный исходный код этой части находится в архиве (каталог Step4).

IMainForm = interface
  ['{765B2E71-B81C-11D5-9160-C43E6EC62937}']
  function GetCaption: TCaption;
  procedure SetCaption(const Value: TCaption);

  function GetFont: TFont;
  procedure SetFont(conts Value: TFont);

  function GetSelf: TForm;

  property Caption: TCaption read GetCaption write SetCaption;
  property Font: TFont read GetFont write SetFont;
  property Self: TForm read GetSelf;
end

ICallBackInterface = interface
  ['{7D501743-B419-11D5-915B-ED714AED3037}']
    procedure Callback(Text: String);
  end;

ICallBackInterfaceEx = interface(ICallBackInterface)
  ['{7D501743-B419-11D5-915B-ED714AED3038}']
    procedure CallbackEx(Text: String);
end;

TForm1 = class(TForm, ICallBackInterface, ICallbackInterfaceEx)

1. Старые приложения (или пакеты - все зависит от места использования интерфейса), не знающего ICallBackInterfaceEx, будут вызывать ICallBackInterface и останутся в работоспособном состоянии.
2. Новые приложения (или пакеты), уже имеющие сведения о ICallBackInterfaceEx, вполне могут вызывать как ICallBackInterfaceEx, так и ICallBackInterface (в зависимости от прихоти программиста).

function QueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall;

if Succeeded(QueryInterface(IMyHello, MyHello)) then …

 function QueryInterface(const  AObject: TObject, const IID: TGUID; out Obj): HResult; 
 begin
    if AObject.GetInterface(IID, Obj) then Result := S_OK
     else Result := E_NOINTERFACE;
 end;

type
  TInterfacedForm = class(TForm, IUnknown)
public
   function QueryInterface(const IID: TGUID; out Obj): HResult; override;
end;
…
implementation
  function TInterfacedForm .QueryInterface(const IID: TGUID; out Obj): HResult; 
begin
  Result := inherited QueryInterface(IID, Obj);
end;

end.

var
  MainForm: TInterfacedForm;
begin
  if  Application.MainForm is TInterfacedForm then
  begin
    MainForm := Application.MainForm is TInterfacedForm;
    if Succeeded(MainForm.QueryInterface(IMyHello, MyHello)) then …
    …
  end;
end;

• Наследование интерфейсов есть наследование интерфейсов, но не реализации. Реализацию каждый раз придется писать заново. Это в худшем случае. Но ничто не мешает создать "базовый" набор классов, содержащий реализации основных интерфейсов, оформить их в пакет и использовать в дальнейшем (дописывая лишь индивидуальные особенности) ⁽²⁴⁾ .
• Освобождать интерфейсы напрямую нельзя. Delphi это делает автоматически, вызывая неявно функцию _Release. Точно так же, при инициализации интерфейса неявно вызывается функция _AddRef. Эти функции оперируют так называемым "счетчиком ссылок" - целой переменной. хранящейся в объекте. _AddRef его увеличивает, а _Release уменьшает. Когда счетчик ссылок станет равным нулю, функция _Release может вызвать метод Free объекта, содержащего интерфейс. А последнее обстоятельство чревато внезапным исключением, приводящим к катастрофе всего приложения. Следует проследить за этим обстоятельством. Одним из способов его обхода является явный вызов _AddRef в конструкторе объекта - это гарантировано увеличит счетчик на 1 и позволит объекту оставаться в памяти до явного вызова деструктора. Однако такое встречается довольно редко. Во всяком случае, обычные наследники TComponent не имеют счетчика ссылок, а _AddRef и _Release ничего не делают и всегда возвращают -1 ⁽²⁵⁾ . А вот с наследниками TInterfacedObject следует быть осторожным…
• Существует опасность использование интерфейса объекта, который был удален. Например, приложение запрашивает у plugin'а какой-либо интерфейс, и начинает с ним работать. А plugin, как последняя редиска, вдруг выгружается. В итоге у приложения в руках оказывается ссылка на VMT, которой в действительности уже нету. Естественно, это ошибка программиста и за этим нужно следить.
• После того как интерфейс описан и начал использоваться - он не подлежит изменению ⁽²⁶⁾. Если что-то нужно к нему добавить, следует сделать его наследника.
• Эту методику можно и в случае обыкновенных dll. Только (при компиляции dll без пакетов) следует иметь ввиду, что глобальный объект Application у приложения и dll будут разными и для доступа к главной форме из dll в последнюю надо будет передать Application из exe. При компиляции с VCL50 этого делать не нужно.
• Наверное, существует что-то еще (что определиться опытным путем в дальнейшем или умные люди подскажут …

Дмитрий Полщанов
9 октября 2001 г
Специально для Королевства Delphi