Зависание приложения при выгрузке dll библиотеки с формой FireMonkey

[Maximus]

Здравствуйте. Возникла следующая проблема. Создал dll библиотеку с формой FireMonkey. Из приложения на VCL подключаю библиотеку, вызываю функцию создания формы

procedure CreateHD;
begin
  FormHD := TFormHD.Create(nil);
  FormHD.Caption := 'HD';
  FormHD.Show;
end;

форма создаётся, далее вызываю функцию закрытия и уничтожения формы FM

procedure CloseHD;
begin
  FormHD.Close;
  FreeAndNil(FormHD);
end;

Но при попытке выгрузить dll приложение зависает.

 

Возможно уничтожение формы FM как-то отличается от VCL и нужно что-то вызвать ещё кроме FreeAndNil или проблема в другом?

 

(dll и приложение написаны в Delphi XE6)

Приложение.zip

[d7d1cd]

А при пошаговой отладке на какой строке кода происходит зависание?

[Maximus]

А при пошаговой отладке на какой строке кода происходит зависание?

На строке выгрузки библиотеки.

FreeLibrary(HLib);

[d7d1cd]

Как я понимаю, если в dll будет VCL форма, то все хорошо? Надо посудить, что если библиотека создавалась на основе библиотеки FMX, то и работать с ней надо средствами FMX, то есть загружать и выгружать средствами FMX. Но вероятно я не прав. Я бы поэкспериментировал, а именно попробовал бы поработать с dll из проекта на FMX.

[Maximus]

Как я понимаю, если в dll будет VCL форма, то все хорошо? Надо посудить, что если библиотека создавалась на основе библиотеки FMX, то и работать с ней надо средствами FMX, то есть загружать и выгружать средствами FMX. Но вероятно я не прав. Я бы поэкспериментировал, а именно попробовал бы поработать с dll из проекта на FMX.

Да, если в dll будет VCL форма, то она выгружается без проблем. Библиотека не создаётся на основе FMX или VCL, библиотека это отдельный от них проект. К тому же выгрузка производится функцией WinAPI, она не знает о FMX и о VCL.

[d7d1cd]

В принципе, наверное Вы правы. Тогда ждем ответ от гуру.

[DirtyBorov]

Вот тут все разжевано http://www.gunsmoker.ru/2011/12/delphi.html

[vic85]

Столкнулся с похожей проблемой. Зависать FreeLibrary может если в dll в секции финализации какого-то модуля есть что-то что не положено делать в DLLMain, а делать там не положено очень много чего. Очевидное решение вызвать всю финализацию до выгрузки библиотеки. Это можно сделать если собрать dll как bpl пакет, это будет такая же dll, но у нее будут экспортироваться функции Initialize и finalize, об этом как раз есть в цикле статей из предыдущего совета. Мне помогло, но не понравилось что в bpl суется много всего и размер библиотеки сильно вырастает. Если bpl не подходит вот еще несколько костылей 

1) Загрузить dll из памяти, не средствами винды а самостоятельно, примеров в интернете куча, в этом случае DllMain вызывается не загрузчиком винды (со своими локами системных структур и дедлоками), а нашим кодом который ничего не блокирует, соответственно все проходит гладко. У меня такой способ заработал. Не на всех dll такое заработает, зависит от полности эмуляции загрузчика винды, на обычной форме сработал самый простой вариант c адаптацией под Delphi 2010. 

2) На стэковерфлоу у человека похожая проблема и ему помогла загрузка и выгрузка dll из секции инициализации/финализации хоста (не проверял, может и перевел не верно что он там пишет)

3) Я попробовал эмулировать вызов FinalizeUnits, тоже сработало, правда используются хаки:

{
  Модуль позволяет решить проблему с зависанием при выгрузки dll с FMX формой.
  Модуль нужно подключить самым первым в dpr файле, до подключения любых файлов
  с FMX, и вызвать функцию FinalizeAllExceptSystemUnits непосредственно перед
  выгрузкой dll через FreeLibrary.

  Например ваша dll экспортирует функцию уничтожения формы, которую вызывает
  хост перед выгрузкой, например

  procedure Done; stdcall;
  begin
    try
      //Уничтожим форму
      FreeAndNil(Form1);

      //Произведем финализацию модулей которая должна быть выполнена
      //в FreeLibrary, но все зависает
      FinalizeAllExceptSystemUnits;

      //Освобождаем GDI именно после финализации FMX
      if Assigned(GenericSansSerifFontFamily) then
        GenericSansSerifFontFamily.Free;
      if Assigned(GenericSerifFontFamily) then
        GenericSerifFontFamily.Free;
      if Assigned(GenericMonospaceFontFamily) then
        GenericMonospaceFontFamily.Free;
      if Assigned(GenericTypographicStringFormatBuffer) then
        GenericTypographicStringFormatBuffer.free;
      if Assigned(GenericDefaultStringFormatBuffer) then
        GenericDefaultStringFormatBuffer.Free;
      GdiplusShutdown(gdiplusToken);
    except
      on E: Exception do
        OutputDebugString(PChar(E.Message));
    end;
  end;
  
  author: Виктор Федоренков
  email: victor.fedorenkov@gmail.com
  skype: victor_fedorenkov
}
unit suEmulFinalizeUnitsForUnloadDllUnit;

interface

uses
  Windows,
  SysUtils;

procedure FinalizeAllExceptSystemUnits;

implementation

var
  _IsFinalizedThisUnit: Boolean = False;

//Получение структуры PackageInfo нашего приложения
//В System она находится в переменной InitTable, но не видна из других модулей
function GetInitTable: PackageInfo;
var
  Lib: PLibModule;
  Offset: LongWord;
  TypeInfo: PPackageTypeInfo;
begin
  Result := nil;

  Lib := LibModuleList;

  if not Assigned(Lib) then
    Exit;

  //Если загружено несколько модулей (BPL пакетов), то выходим,
  //я не изучал как работает механизм загрузки/выгрузки BPL, поэтому на всякий
  //случай выходим
  if Assigned(Lib^.Next) then
    Exit;

  Typeinfo := Lib^.TypeInfo;
  if Assigned(TypeInfo) then
  begin
    //Мы имеем TPackageTypeInfo
    //Теперь по нему можно получить PackageInfo
    //Воспользуемся особенностями компилятора.
    //В IDA видно, что ссылка TypeInfo указывает на середину структуры
    //PackageInfo программы
    //Поэтому для того что бы вычислить PackageInfo нужно вычесть из адреса
    //TypeInfo смещение этого поля
    Offset := LongWord(@PackageInfoTable(nil^).TypeInfo);
    Result := PackageInfo(PByte(TypeInfo) - Offset);
  end;
end;

//Проведем финализацию всего кроме RTL
procedure FinalizeAllExceptSystemUnits;
var
  P: Pointer;
  Count: Integer;
  OldProtect: LongWord;
  LExitProc: procedure;
  InitTable: PackageInfo;
  Table: PUnitEntryTable;
begin
  while ExitProc <> nil do
  begin
    @LExitProc := ExitProc;
    ExitProc := nil;
    LExitProc;
  end;

  InitTable := GetInitTable;

  if not Assigned(InitTable) then
    Exit;

  Table := InitTable^.UnitInfo;

  if not Assigned(Table) then
    Exit;

  //Мы не можем получить доступ к количеству инициализированных модулей, поэтому
  //будем работать из расчета что были инициализированы все модули.
  //Ведь так и есть, инициализирована только часть модулей может быть если
  //при нициализации произошло исключние в одном из модулей, но тогда будет
  //запущена финализация всего и видимо библиотека не будет загружена
  Count := InitTable^.UnitCount;

  //Разрешаем изменять структуру в которой хранятся ссылки на инициализаю/финализацию всех юнитов
  //для того что бы затирать уже вызваные секции финализации
  if not VirtualProtect(Table, SizeOf(PackageUnitEntry) * Count,
        PAGE_READWRITE, OldProtect) then
    Exit;

  try
    //Вызываем секции финализации пока не будет вызвана секция этого модуля
    //Так как этот модуль указан первым в dpr файле, то перед ним останется
    //только системные модули (менеджер памяти, sysutils) которые и без того
    //нормально финализируются в dll, и их работа нужна что бы отработать
    //выгрузку dll
    while not _IsFinalizedThisUnit do
    begin
      Dec(Count);

      //Получим указатель на секцию финализации модуля
      P := Table^[Count].FInit;

      //Удалим из структуры указатель на эту функцию что бы родной механизм
      //финализации повторно не начал ее выгружать
      Table^[Count].FInit := nil;

      if Assigned(P) and Assigned(Pointer(P^)) then
      asm
        //Похоже какой-то баг компилятора в 10.1 Berlin, и вызов финализации
        //через TProc(P)(; как это сделано в оригинальной System.FinalizeUnits падает,
        //поэтому вызываем ассемблером
        call [p];
      end;
    end;
  except
    FinalizeAllExceptSystemUnits;  //Пробуем финализировать другие модули
    raise;
  end;
end;

initialization

finalization
  //Выставим флаг что прошла финализация модуля
  _IsFinalizedThisUnit := True;
end.

Интересно услышать комментарий спецов по последнему способу, может я что-то не учел

Изменено 17 августа, 2017 пользователем vic85

[Maximus]

Есть вот такой вот комментарий принципиально поводу создания FMX внутри библиотеки http://forum.vingrad.ru/index.php?showtopic=380246&view=findpost&p=2626848

[vic85]

Я собрал пример из стартпоста на 10.1 Berlin - при выгрузке dll приложение падает, если собрать либу как bpl или добавить в CloseHD вызов FinalizeAllExceptSystemUnits из предыдущего моего коммента то выгружается все нормально. Значит дело было в локах из DllMain, но остается совершенно другая проблема.

При закрытии самого хоста в деструкторе application все падает. Дело в том что при уничтожении формы ищется новое активное окно, в нормальном приложении оно не находится и все закрывается, а после выгрузки загруженной dll c fmx такое окно находится - это ApplicationHWND из dll, оно создается при создании формы но не уничтожается. После выгрузки dll окно остается висеть, и его оконная процедура указывает на уже выгруженную область, и когда VCL находит этот хэндл и пытается сделать его активным - винда посылает этому окно сообщение и для его обработки вызывает WndProc окна которого уже нет. Все помирает.

FMX при создании окна Application позволяет получить хэндл окна снаружи с помощью RegisterApplicationHWNDProc, похоже именно так делает сама delphi что бы в себе отображать fmx формы в самой среде в десигнтайме. Что бы повторить этот трюк нужно экспортировать из dll еще одну функцию:

procedure InitApplication(VclApplicationHandleProc, VclApplicationStateProc: Pointer);
begin
  FMX.Platform.Win.RegisterApplicationHWNDProc(VclApplicationHandleProc);
  if FMX.Forms.Application <> nil then
    FMX.Forms.Application.ApplicationStateQuery := VclApplicationStateProc;
end;

Ну а в самом хосте вызвать эту функцию:

TInitVCLApplicationFunc = procedure(VclApplicationHandleProc, VclApplicationStateProc: Pointer);

var
  InitApplication: TInitVCLApplicationFunc;

function VclApplicationHandle: HWND;
begin
  Result := Vcl.Forms.Application.Handle;
end;

type
  TFMXApplicationState = (None, Running, Terminating, Terminated);

function VclApplicationState: TFMXApplicationState;
begin
  if Vcl.Forms.Application <> nil then
    Result := TFMXApplicationState.Running
  else
    Result := TFMXApplicationState.None;
end;

...

procedure TForm1.Button3Click(Sender: TObject);
begin
  HLib:=0;
  try
    HLib := LoadLibrary('Project1.dll');
    if HLib > HINSTANCE_ERROR then
      begin
        InitApplication := GetProcAddress(HLib,'InitApplication');
        CreateHD := GetProcAddress(HLib,'CreateHD');
        CloseHD := GetProcAddress(HLib,'CloseHD');      
      end else ShowMessage('Библиотека не найдена');

      InitApplication(@VclApplicationHandle, @VclApplicationState);
  except
    if HLib > HINSTANCE_ERROR then FreeLibrary(HLib);
  end;
end;

Все это набросано на коленке, и тестировалось на пустой форме, возможно есть еще какие-то ньюансы которые должны знать разработчики FMX.

Изменено 17 августа, 2017 пользователем vic85