Перейти к содержанию
Fire Monkey от А до Я
  • 1

Зависание приложения при выгрузке 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

Ссылка на комментарий

Рекомендуемые сообщения

  • 0

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

Ссылка на комментарий
  • 0

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

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

Ссылка на комментарий
  • 0

Столкнулся с похожей проблемой. Зависать 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.

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

Изменено пользователем vic85
Ссылка на комментарий
  • 0

Я собрал пример из стартпоста на 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.

Изменено пользователем vic85
Ссылка на комментарий

Присоединяйтесь к обсуждению

Вы можете написать сейчас и зарегистрироваться позже. Если у вас есть аккаунт, авторизуйтесь, чтобы опубликовать от имени своего аккаунта.

Гость
Ответить на вопрос...

×   Вставлено с форматированием.   Вставить как обычный текст

  Разрешено использовать не более 75 эмодзи.

×   Ваша ссылка была автоматически встроена.   Отображать как обычную ссылку

×   Ваш предыдущий контент был восстановлен.   Очистить редактор

×   Вы не можете вставлять изображения напрямую. Загружайте или вставляйте изображения по ссылке.

×
×
  • Создать...