Форум программистов [Powered by Invision Power Board]

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Delphi: Общие вопросы > Подгружаемые модули

Автор: Гость_Anton 29.10.2003, 18:43

Проблема такая есть главное приложение, подключаю dpl c формой

unit Unit2;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs;

type
TForm2 = class(TForm)
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form2: TForm2;

implementation

{$R *.dfm}

initialization
form2 := TForm2.Create(Application);
form2.Show;
end.

форма 2 должна быть MDIChild как это сделать?

Автор: Unregistered 29.10.2003, 18:55

По отношению к главной форме приложения

Автор: gray_k 29.10.2003, 19:24

Form2.FormStyle:=fsMDIChild

Автор: Unregistered 30.10.2003, 12:21

тогда Access Vioalation

Автор: Unregistered 30.10.2003, 12:37

поправка

Cannot create form. No MDI forms are currenty active

Автор: man2002ua 30.10.2003, 12:57

ну так сделай главную форму fsMDIForm

Автор: Unregistered 30.10.2003, 13:00

она такая и есть

Автор: man2002ua 30.10.2003, 13:04

а покажи файл dpr

Автор: Unregistered 30.10.2003, 13:37

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, ActnList, XPStyleActnCtrls, ActnMan, StdCtrls;

type
TForm1 = class(TForm)
MainMenu1: TMainMenu;
Start1: TMenuItem;
procedure Start1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
FPackageHandle: THandle;
procedure LoadPluginPackage;
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.LoadPluginPackage;
var
FileName: TFileName;
begin
FileName:='C:\plugins\package1.bpl';
FPackageHandle:=LoadPackage(FileName);
end;

procedure TForm1.Start1Click(Sender: TObject);
begin
LoadPluginPackage;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
UnloadPackage(FPackageHandle);
end;

end.

Автор: Unregistered 30.10.2003, 13:39

program Project1;

uses
Forms,
Unit1 in 'Unit1.pas' {Form1};

{$R *.res}

begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

Автор: man2002ua 30.10.2003, 15:16

самое первое, что приходит в голову - это то, что плагин ничего не знает о главном Application...
я попробовал передать объект Application - запускается и работает, но при закрытии главной формы - каскад ошибок

Автор: Unregistered 30.10.2003, 15:21

А как сделать что бы знал?

Автор: Unregistered 30.10.2003, 15:27

Добавить в requred пакаджа главную форму проекта?

Автор: Unregistered 30.10.2003, 15:34

я попробовал передать объект Application - запускается и работает, но при закрытии главной формы - каскад ошибок

вышлите плиз

Автор: man2002ua 30.10.2003, 16:04

Цитата

вышлите плиз

нечего высылать, это неверное решение :-\

// package
var
GlobalMemoryPointerForApplication: DWORD;
initialization
GlobalMemoryPointerForApplication := <я передавал руками, чтобы быстрее было>
Application := TApplication(GlobalMemoryPointerForApplication);
form2 := TForm2.Create(Application);
form2.Show;
end.

Автор: man2002ua 30.10.2003, 16:15

Цитата

Добавить в requred пакаджа главную форму проекта?

Наиболее правильное решение :-) Вот только если это плагин - тогда неверное

Автор: man2002ua 31.10.2003, 11:31

Вот так у меня заработало без сбоев - хотя я предпочитаю вызывать dll...

главный модуль:

Код


procedure TForm1.Start11Click(Sender: TObject);
var X: Integer;
    iObj: TInterPackage;
begin
  iObj := TInterPackage.Create;
  if not iObj.Init(sizeof(DWORD)) then
  begin
    MessageDlg(iObj.LastErrorText, mtError, [mbOK], 0);
    exit;
  end;
  X := Integer(@Application);
  if not iObj.WriteData(@X) then
  begin
    MessageDlg(iObj.LastErrorText, mtError, [mbOK], 0);
    exit;
  end;
  H := LoadPackage('C:\PROJECTS\PluginLoad\Package1.bpl');
  iObj.Free;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  //if h <> 0 then UnloadPackage(H); - слет при выгрузке :)
end;

модуль пакета:

Код


var
  Form2: TForm2;
  X: Integer;
  lpA: ^TApplication;
  iObj: TInterPackage;

implementation

{$R *.dfm}

initialization
  iObj := TInterPackage.Create;
  if not iObj.Init(sizeof(DWORD)) then
  begin
    MessageDlg(iObj.LastErrorText,mtError,[mbok],0);
    exit;
  end;
  if not iObj.ReadData(@X) then
  begin
    MessageDlg(iObj.LastErrorText,mtError,[mbok],0);
    exit;
  end;
  lpA := pointer(X);
  Application := lpA^;
  Form2 := TForm2.Create(nil);
  Form2.Show;

end.

доп. модуль, чтобы передать указатель из приложения в пакет (через mapped file):

Код


unit InterProc;

interface

uses
  Windows, Messages, SysUtils;

const IPACK_NAME = 'GLOBAL_PACKAGE_PARAMETER1';

type
  TInterPackage = class(TObject)
    Hmap: Integer;
    lpMap: Pointer;
    szData: Integer;
    function Init(iszData: DWORD; Name: string = IPACK_NAME): Boolean;
    procedure Free;
    function WriteData(lpData: Pointer): Boolean;
    function ReadData(lpData: Pointer): Boolean;
  public
    LastErrorText: string;
  end;

implementation

procedure TInterPackage.Free;
begin
  if lpMap <> nil then UnmapViewOfFile(lpMap);
  if Hmap > 0 then CloseHandle(Hmap);
  lpMap := nil;
  Hmap := 0;
end;

function TInterPackage.Init(iszData: DWORD; Name: string): Boolean;
begin
  Result := FALSE;
  szData := iszData;
  Hmap := CreateFileMapping(THANDLE($FFFFFFFF),nil, PAGE_READWRITE or
     SEC_COMMIT, 0, szData, PChar(Name));
  if Hmap <= 0 then
  begin
    LastErrorText := 'Ошибка создания вирт. файла ' + inttostr(GetLastError());
    exit;
  end;
  lpMap := MapViewOfFile(Hmap, FILE_MAP_ALL_ACCESS, 0, 0, szData);
  if lpMap = nil then
  begin
    LastErrorText := 'Ошибка проецирования файла ' + inttostr(GetLastError());
    CloseHandle(Hmap);
    Hmap := 0;
    exit;
  end;
  Result := TRUE;
end;

function TInterPackage.WriteData(lpData: Pointer): Boolean;
begin
  Result := FALSE;
  if lpMap = nil then
  begin
    LastErrorText := 'Нет проекции файла!';
    exit;
  end;
  MoveMemory(lpMap, lpData, szData);
  Result := TRUE;
end;

function TInterPackage.ReadData(lpData: Pointer): Boolean;
begin
  Result := FALSE;
  if lpMap = nil then
  begin
    LastErrorText := 'Нет проекции файла!';
    exit;
  end;
  MoveMemory(lpData, lpMap, szData);
  Result := TRUE;
end;

end.

Автор: Unregistered 3.11.2003, 16:39

Работая дальше получил следующую ошибку
На Form1 лежит компонент TSQLConnection, на форме2 лежит TSQLDataSet где в поле SQLConnection указан Form1.TSQLConnection в момент LoadPackage вылазит ошибка

Аpplication is not licensed to use this feature

Автор: man2002ua 3.11.2003, 16:43

Оп-па

ну и изврат

) Щас попробую. Поборники грамотности извините, предлагаю ввести список слов, подлегаемых автоисправлению. Например: "Щас" - "сейчас" и т.д.

Автор: man2002ua 4.11.2003, 12:58

После initialization в package поставь MainInstance := GetModuleHandle(nil); ...
Пришлось раскрутить rtl.bpl, чтобы понять, чего ж ему надо - оказалось он ищет ресурс DVCLAL в подключенных модулях, если MainInstance = 0. А оно почему-то равно 0...

Автор: Unregistered 11.11.2003, 14:32

Пошел немножко по другому пути но проблеммы с MDIChilds все равно остались. У меня 2 вопроса
1. что означают строки и для чего они нужны
lpA := pointer(X);
Application := lpA^;
2. Как можно избавится от ACCESS VIOALATION при выгрузке пакета

Автор: man2002ua 11.11.2003, 14:34

1) изврат, но осталось как есть - передача Application через указатель
2) не выгружать пакет... или восстанавливать перед выгрузкой все данные (Application, и .тп.)

Автор: Unregistered 11.11.2003, 15:28

Application восстанавливаю все равно AV