BPL

[Wizard2007]

Здравствуйте!
Хочу написать простое приложение.
экзешник проверяет логин и пароль в базе данных - есть
потом он из бпл - (загрузчика) вызывает функцию для загрузки другой бпл, которая покажет форму.
но все дело в том что ничего не происходит
Экзешник

PHP код:

unit LoginSystem;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, LoginDM, IniFiles, LoadManadger;

type
  TLoginForm = class(TForm)
    EditLogin: TEdit;
    EditPassowrd: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    ButtonConfirm: TButton;
    ButtonCansel: TButton;
    procedure ButtonCanselClick(Sender: TObject);
    procedure ButtonConfirmClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  LoginForm: TLoginForm;

implementation

{$R *.dfm}

procedure TLoginForm.ButtonCanselClick(Sender: TObject);
begin
  Close;
end;

procedure TLoginForm.ButtonConfirmClick(Sender: TObject);
var
   QueryStr:String;
begin
{
  QueryStr:='select * from Login_Info where User_Login='+''''+EditLogin.Text+''''+' and User_Password ='+''''+EditPassowrd.Text+''''+';';
  DMLogin.ADOConnectionLogin.Open;
  DMLogin.ADOQueryCheck.SQL.Clear;
  DMLogin.ADOQueryCheck.SQL.Add(QueryStr);
  DMLogin.ADOQueryCheck.Close;
  DMLogin.ADOQueryCheck.Open;

  if DMLogin.ADOQueryCheck.IsEmpty then
  begin
    ShowMessage('Не веерный логин или/и пароль.');
    exit;
  end;
  }
  showmessadge('h');
   LoadManadger.LoadBpl('MyUserForm.bpl');
end;

procedure TLoginForm.FormShow(Sender: TObject);
var
  MyIniFile: TIniFile;
  ConfigurationStr:String;
  ConfigPath:String;
begin
 if not FileExists('config.ini') then
 begin
  ShowMessage('Конфигурационный файл : config.ini не найден');
  exit;
 end;
 ConfigPath := ExtractFilePath(Application.ExeName);
 ConfigurationStr:='';
 MyIniFile:= TIniFile.Create(ConfigPath+'config.ini');

 ConfigurationStr:=ConfigurationStr+
 'Provider='+
 MyIniFile.ReadString('db','Provider','')+';';

 ConfigurationStr:=ConfigurationStr+
 'Password='+
 MyIniFile.ReadString('db','Password','')+';';

 ConfigurationStr:=ConfigurationStr+
 'User ID='+
 MyIniFile.ReadString('db','User_ID','')+';';

 ConfigurationStr:=ConfigurationStr+
 'Initial Catalog='+
 MyIniFile.ReadString('db','Initial_Catalog','')+';';

 ConfigurationStr:=ConfigurationStr+
 'Data Source='+
 MyIniFile.ReadString('db','Data_Source','')+';';
 ShowMessage(ConfigurationStr);
 DMLogin.ADOConnectionLogin.ConnectionString:=ConfigurationStr;
 DMLogin.ADOConnectionLogin.Open;
end;

end. 


Загрузчик

PHP код:

unit Loader;

interface
uses Windows, Dialogs;

resourcestring
  msgLoadError         = 'Ошибка при загрузке bpl модуля';
  msgLoadErrorNoExists = 'Файл не найден';
  msgLoadErrorNoProc   = 'Не найдена процедура "Load" в модуле';

procedure LoadBpl(const BplName : string);stdcall;

implementation

uses SysUtils;

procedure LoadBpl(const BplName : string);
var
  ModuleHandle : DWORD;
begin
  ShowMessage('1');
  ShowMessage(BplName);
  ModuleHandle := GetModuleHandle(PAnsiChar((BplName)));
  if ModuleHandle < 32 then
  begin
    if not FileExists(BplName) then
    begin
      ShowMessage(msgLoadErrorNoExists + ' "' + BplName + '"');
      Exit;
    end;
    ModuleHandle := LoadPackage(PAnsiChar(BplName));
    if ModuleHandle = 0 then
    begin
      ShowMessage(msgLoadError + ' "' + BplName + '"');
      Exit;
    end;
  end;
  ShowMessage('1');
end;
end. 


форма которую хочу увидеть

PHP код:

unit UserForm;

interface

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

type
  TFormSalary = class(TForm)
  private
    { Private declarations }
  public
    { Public declarations }
  end;
procedure LoadShablon(Aowner: TComponent);stdcall;
exports LoadShablon;
var
  FormSalary: TFormSalary;

implementation

{$R *.dfm}

procedure LoadShablon(Aowner: TComponent);
var
 fm:TFormSalary;
begin
 fm:=TFormSalary.Create(AOwner);
 fm.Show;
end;
end. 


[Terio]

А зачем такие сложности с bpl?

Я эту идею реализовал примерно так: главной форме присваиваем tag:=0
и пишем:

procedure TMainForm.FormShow(Sender: TObject); //открытие главной формы
begin

if MainForm.Tag=0 then
begin
  LoginForm:=TLoginForm.Create(self); //создать диалог входа пользователя
  LoginForm.ShowModal; //вызвать далог входа пользователя
end;

В проект добавляем новую форму LoginForm, подключаем ее к MainForm и наоборот. Кидаем ADOQuery, в SQL которого пишем:

SELECT * FROM TableUsers WHERE Login=:Par1 AND Password=:Par2

Устанавливаем ADOQuery.Active в false
На форму LoginForm помещаем два едита и кнопку, в событии Click которой пишем:

procedure TPasswordIn.Button1Click(Sender: TObject);
begin
with ADOQuery1.Parameters do //активируем запрос с параметрами:
begin
ParamByName('Par1').Value:=Edit1.Text; //имя пользователя 
ParamByName('Par2').Value:=Edit2.Text; //введенный пароль
end;
ADOQuery1.Open; //открывается запрос на существование в БД
if ADOQuery1.RecordCount>0 then // если запись существует
begin
MainForm.Tag:=1;  //присваиваем главной форме Tag=1 - открываем ее
ADOQuery1.Close; //закрываем запрос
LoginForm.CLose; //закрываем диалог
exit;  //выход из процедуры
end;
//иначе:
ShowMessage('В доступе отказано. Повторите ввод пароля.');
ADOQuery1.Close;
end;

Вот и все.

Добавлено через 3 минуты
Забыл сказать, что LoginForm надо убрать из автоматически создаваемых (см. Project -> Options).

[Wizard2007]

Забыл сказать, что LoginForm надо убрать из автоматически создаваемых (см. Project -> Options).

За это спасибо.

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

[Terio]

Думаю, дополнение одной маленькой формы к главной не слишком ее отяготит. Килобайт на 40 максимум.

А вообще, это хорошая идея. Нет информации почитать по этому поводу?
А то мой проект уже 6 Мб занимает, а это еще только третья часть. Слышал, что формы можно клепать только на основе WinAPI, как в Си-плюсах. Тогда вообще приложение копейки будет весить.

[Wizard2007]

Моно и WinAPI - только стремное это дело немного, а про BPL - надо книги для профессионалов читать, я пока методом тыка делаю что то у друзей спрошу, что сам проверю экспериментально.
вообще делают так
0. File - new - over - вкладка NEW - Package.
Заходим в него и стандартно
File - new - добавляем все что надо.

потом

PHP код:

procedure LoadBpl(AOwner : TComponent;ConnectionStr:String;Mode:String;const BplName : string);
var
  HandlePack: HModule;
  MDIFUNC   :procedure(AOwner : TComponent;ConnectionStr:String;Mode:String);stdcall;
begin
  HandlePack:=GetModuleHandle(PAnsiChar(BplName));
  if HandlePack<32
  then begin
      Screen.Cursor:=crHourGlass;
      HandlePack := LoadPackage(ExtractFilePath(Application.ExeName)+BplName);
      Screen.Cursor:=crDefault;
  end;

  if HandlePack > 0 then
  begin
            @MDIFUNC:=GetProcAddress(HandlePack,PChar('LoadShablon'));
            if @MDIFUNC<>nil
            then MDIFUNC(AOwner,ConnectionStr,Mode);
  end
  else begin
            //MessageBox(TForm(AOwner).Handle,PChar(LoadErrorG+BplName),PChar(ErrorCaptionG),MB_OK and MB_ICONWARNING);
  end;
end; 


Грузим BPL и вызываем функцию

PHP код:

procedure LoadShablon(AOwner: TComponent;ConnectionStr:String;Mode:String);stdcall;
exports LoadShablon;
var
  FormSalary: TFormSalary;

procedure LoadShablon(AOwner: TComponent;ConnectionStr:String;Mode:String);
var
 fm:TFormSalary;
begin

 fm:=TFormSalary.Create(AOwner);
 fm.ConnectionStr:=ConnectionStr;

 if Mode='mrHead' then
 begin
 fm.ButtonAddOrders.Enabled:=false;
 fm.ButtonEditOrders.Enabled:=false;
 fm.ButtonDeleteOrders.Enabled:=false;
 fm.EditOrdersNumber.Enabled:=false;
 fm.EditOrdersSum.Enabled:=false;
 end;

 if Mode='mrBranch' then
 begin
 fm.ButtonAddSuppliers.Enabled:=false;
 fm.ButtonEditSuppliers.Enabled:=false;
 fm.ButtonDeleteSuppliers.Enabled:=false;
 fm.EditAdressSuppliers.Enabled:=false;
 fm.EditNameSuppliers.Enabled:=false;
 end;
 fm.ShowModal;

end; 


Добавлено через 5 минут
Да кстати каким тегом пльзуешься для форматирования кода в сообщениях?

[Terio]

Цитата: Сообщение от Wizard2007 Да кстати каким тегом пльзуешься для форматирования кода в сообщениях?

Если правильно понял твой вопрос, для вывода сообщений используется простая функция
procedure ShowMessage(const Msg: string);
Пример:
ShowMessage('Пример простого сообщения.'+#10+ 'Данное сообщение выводится всегда в центре экрана.');
Еще есть
procedure ShowMessagePos(const Msg: string; X, Y: Integer);
Еще
function InputBox(const ACaption, APrompt, ADefault: string): string;

Больше в VCL не знаю функций для вывода сообщений, а лезть кочерыжить стандартный код не рискую, пользуюсь Canvas-ом:

procedure TForm1.FormPaint(Sender: TObject); 
var 
X: Integer; 
LF: TLogFont; 
Fnt: HFont; 
const 
Text = 'Лучшая в мире система программирования'; 
begin 
// Определяем параметры нового шрифта 
FillChar(LF, SizeOf(LF), 0); 
with LF do 
begin 
lfHeight := 20; 
lfWeight := fw_Normal; 
lfUnderline := 1; 
lfEscapement := 450; 
StrPCopy(lfFaceName, 'Courier New Cyr'); 
end; 
with Form1.Canvas do 
begin 
// Создаем шрифт 
Fnt := CreateFontIndirect(LF); 
// Присваиваем его дескриптор шрифту канвы 
Font.Handle := Fnt; 
// Выводим текст под углом +45 градусов 
TextOut(0, 300, Text); 
X := TextWidth(Text); 
DeleteObject(Fnt); // Удаляем ненужный шрифт 
// Изменяем параметры шрифта 
with LF do 
begin 
lfHeight := 90; 
lfEscapement := -900; 
lfWeight := fw_Heavy; 
StrPCopy(LF.lfFaceName, 'Arial Cyr'); 
end; 
Fnt := CreateFontIndirect(LF); // Создаем новый шрифт 
Font.Handle := Fnt; 
Font.Color := clRed; 
// Выводим с наклоном -90 градусов 
TextOut(X-10, 10, 'Delphi 5'); 
DeleteObject(Fnt); // Удаляем ненужный шрифт 
end; 
end;