vic85

Пользователи
  • Публикации

    5
  • Зарегистрирован

  • Посещение

  1. Я использую IStream, при компиляции под винду он лежит в WinApi.AtiveX, при компиляции под макось кажется в Types. TOleStream пришлось выдрать для макоси в отдельный файл, его же использую и для винды в вместо того что в VCL.ActiveX, так как у нас используется один сторонний компонент, который не работает если в fmx приложении подключены модули из VCL (а при подключении VCL.ActiveX к приложению это происходит)
  2. Я собрал пример из стартпоста на 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.
  3. Делаем так, в dll метод создания формы может быть таким procedure Init(ParentWindow: HWND; const Rect: Windows.TRect); stdcall; begin try StartupInput.DebugEventCallback := nil; StartupInput.SuppressBackgroundThread := False; StartupInput.SuppressExternalCodecs := False; StartupInput.GdiplusVersion := 1; GdiplusStartup(gdiplusToken, @StartupInput, nil); Form1 := TForm1.Create(nil); Form1.Show; if ParentWindow <> 0 then begin //Скроем иконку приложения с панели задач ShowWindow(ApplicationHWND, SW_HIDE); //Сменим стиль окна что бы оно не перехватывало фокус с родительского окна SetWindowLong(FmxHandleToHWND(Form1.Handle), GWL_STYLE, GetWindowLong(FmxHandleToHWND(Form1.Handle), GWL_STYLE) and (not WS_POPUP) OR WS_CHILD); //Встроим окно в родительское Windows.SetParent(FmxHandleToHWND(Form1.Handle), ParentWindow); //Установим размеры окна такими которыми инициализирована DLL SetWindowPos(FmxHandleToHWND(Form1.Handle), 0, Rect.Left, Rect.Top, RectWidth(Rect), RectHeight(Rect), 0); end; except on E: Exception do MessageBox(0, PChar(E.Message), '', 0); end; end; Эта функция создаст форму и встроит ее на хост в vcl приложении. У формы в dfm должен быть убраны границы что бы оно вписалось. Так же для того что бы форма изменяла размеры вписываясь в хост экспортируем функцию получения хэндла function GetFormHandle: HWND; stdcall; begin Result := 0; try Result := FormToHWND(Form1); except on E: Exception do MessageBox(0, PChar(E.Message), '', 0); end; end; Собственно в хосте загружаем dll, и создаем форму кидая ее на панель Init(panel1.Handle, panel1.ClientRect); Что бы форма меняла размер как и панель - нужно создать обработчик изменения размеров панели и там менять размер встроенной формы procedure THostForm.Panel1Resize(Sender: TObject); var h: HWND; Rect: Windows.TRect; begin h := 0; Rect := Panel1.ClientRect; if Assigned(FGetFormHandleProc) then h := FGetFormHandleProc; if h <> 0 then SetWindowPos(h, 0, Rect.Left, Rect.Top, RectWidth(Rect), RectHeight(Rect), 0); end; Вот так получается втсроить FMX форму из Dll в VCL приложение
  4. Столкнулся с похожей проблемой. Зависать 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. Интересно услышать комментарий спецов по последнему способу, может я что-то не учел
  5. Посмотри у меня в блоге пример http://victor-vik.blogspot.ru/2014/09/how-execute-console-application-with.html