[sorockinalex]

сделал, работают функции:

Код:

unit Main;

interface

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

type
  //signature of the "ExecuteChild" procedure from the Package
  TExecuteChild = procedure;
  TFamilyName = function:string;
  TPluginName = function:string;
  TVersionNumber = function:cardinal;

  TMainForm = class(TForm)
    MainMenu: TMainMenu;
    mnuStructure: TMenuItem;
    mnuStructureEdit: TMenuItem;
    mnuStructureView: TMenuItem;
    Timer1: TTimer;
    procedure FormDestroy(Sender: TObject);
    procedure mnuStructureEditClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Timer1Timer(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    LoginPackage : HModule;
    ExecuteChild : TExecuteChild;
    FamilyName : TFamilyName;
    PluginName : TPluginName;
    VersionNumber : TVersionNumber;
    procedure LoginPackageLoad;
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

//uses DM;

{$R *.dfm}


procedure TMainForm.LoginPackageLoad;
begin
  //try loading the package (let's say it's in the same folder, where the main app. exe is)
  LoginPackage := LoadPackage('login_.bpl');

  //if loaded, try locating the ExecuteChild procedure
  if LoginPackage <> 0 then
  try
    @FamilyName := GetProcAddress(LoginPackage,'FamilyName');
    @PluginName := GetProcAddress(LoginPackage,'PluginName');
    @VersionNumber := GetProcAddress(LoginPackage,'VersionNumber');
    @ExecuteChild := GetProcAddress(LoginPackage,'ExecuteChild');
  except
    //display an error message if we fail
    ShowMessage ('Не найден login_.bpl');
  end;
  if Assigned(ExecuteChild) then ExecuteChild;
  if Assigned(FamilyName) then showmessage(FamilyName);
  if Assigned(PluginName) then showmessage(PluginName);
  if Assigned(VersionNumber) then showmessage(VersionNumber);
end;


procedure TMainForm.mnuStructureEditClick(Sender: TObject);
begin
  //lazzy load package
//  if StructureEditModule = 0 then PackageLoad;

  //if the ExecuteChild procedure was found in the package, call it
  if Assigned(ExecuteChild) then ExecuteChild;
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
  // if the package was loaded, make sure to free the resources
  if LoginPackage <> 0 then UnloadPackage(LoginPackage);
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
  MainForm.Width:=Screen.WorkAreaWidth;
  MainForm.Height:=Screen.WorkAreaHeight;
  MainForm.Left:=0;
  MainForm.Top:=0;
end;


procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  If Logon_Key<>0 then
  begin
  DM1.DataSet.CommandText:= 'SELECT * FROM LogonLogoff WHERE Key='+inttostr(Logon_Key);
  DM1.DataSet.Active:=true;
  DM1.DataSet.Edit;
  DM1.Dataset['LogoffTime']:= Date+Time;
  DM1.DataSet.UpdateBatch;
  DM1.DataSet.Close;
  DM1.DataSet.Active:=false;
  Application.Terminate;
  end;
end;

procedure TMainForm.Timer1Timer(Sender: TObject);
begin
  if Employee_Id<>0 then showmessage('TPMDocs - ['+inttostr(Employee_Id)+' '+Employee_Name1+' '+Employee_Name2+' '+Employee_Name3+']');
end;

procedure TMainForm.FormShow(Sender: TObject);
begin
  if (Employee_Key=0) or (Employee_Id=0) or (Employee_Pass='') or (Logon_Key=0) then LoginPackageLoad;
end;

end.

Код:

unit login;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, DB, DBClient, Provider, ADODB, DM;

type
  TLoginForm = class(TForm)
    Edit_EmployeeId: TEdit;
    Edit_EmployeePass: TEdit;
    Label_EmployeeId: TLabel;
    Label_EmployeePass: TLabel;
    Btn_OK: TButton;
    Btn_Close: TButton;
    procedure Btn_OKClick(Sender: TObject);
    procedure Btn_CloseClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);

  private
    { Private declarations }
  public

  end;

procedure ExecuteChild;
function FamilyName: string;
function PluginName: string;
function VersionNumber: cardinal;

//var
//  LoginForm: TLoginForm;

implementation

{$R *.dfm}

procedure TLoginForm.Btn_OKClick(Sender: TObject);
var
  EmployeeId_Temp : string;
  EmployeePass_Temp : String;
  n:Cardinal;
  MessageText, MessageCaption:string;
begin

if (Edit_EmployeeId.Text<>'') and (Edit_EmployeePass.Text<>'')  then
  begin
    EmployeeId_Temp:=Edit_EmployeeId.Text;
    EmployeePass_Temp:=Edit_EmployeePass.Text;

if (DM1.Query.Prepared) then showmessage('1') else showmessage('2');
    DM1.Query.SQL.Clear;
    DM1.Query.SQL.Add('SELECT Key, Id, Pass, Name1, Name2, Name3');
    DM1.Query.SQL.Add('FROM Employees');
    DM1.Query.SQL.Add('WHERE (Id='+EmployeeId_Temp+') AND (Employees.Pass="'+EmployeePass_Temp+'")');
    DM1.Query.Active:=True;
    DM1.Query.Open;
    n:=DM1.Query.RecordCount;
    //Если найдено единственное совпадение логина и пароля
    If n=1 then
      begin
        //Сохраняем глобальные переменные пользователя: ключ кользователя, табельный, пароль
        Employee_Key:=DM1.Query['Key'];
        Employee_Id:=DM1.Query['Id'];
        Employee_Pass:=DM1.Query['Pass'];
        Employee_Name1:=DM1.Query['Name1'];
        Employee_Name2:=DM1.Query['Name2'];
        Employee_Name3:=DM1.Query['Name3'];
        DM1.Query.Close;
        DM1.Query.Active:=False;
        DM1.Query.Free;
        //Добавляем запись в таблицу логинов
        DM1.DataSet.CommandText:= 'SELECT * FROM LogonLogoff';
        DM1.DataSet.Active:=true;
        DM1.DataSet.Insert;
        DM1.Dataset['EmployeeKey']:= Employee_Key;
        DM1.Dataset['LogonTime']:= Date+Time;
        DM1.DataSet.UpdateBatch;
        Logon_Key:=DM1.Dataset['Key'];
        DM1.DataSet.Close;
        DM1.DataSet.Active:=false;
        Self.Close;
      end
    //Если найдено более одного совпадения логина и пароля
    Else If n>1 then
      begin
        MessageText:='С вашим табельным номером найдено более одного пользователя в базе данных!'+ #13#10+'Обратитесь к системному администратору.';
        MessageCaption:='Дублированные записи в базе данных'
      end
    else
      begin
        MessageText:='Неверный пароль!'+ #13#10+'Обратитесь к системному администратору за новым паролем.';
        MessageCaption:='Неверный пароль'
      end;
    //Показываем информационное окно при неудачном логине
    If (MessageText<>'') and (MessageCaption<>'') then MessageBox(Application.Handle,PChar(MessageText),PChar(MessageCaption), MB_OK);
  end;
end;


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

procedure TLoginForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  //since this is an MDI child, make sure it gets closed when the user clicks the x button.
  Action := caFree;
end;

function FamilyName: string;
begin
  Result := 'TPMDocs';
end;

function PluginName: string;
begin
  Result := 'Login';
end;

function VersionNumber: cardinal;
begin
  Result := 1;
end;


procedure ExecuteChild;
var
  LoginForm:TLoginForm;
begin
  LoginForm := TLoginForm.Create(Application);
  Loginform.Hide;
  LoginForm.Showmodal;
end;

exports
  //NOTE!! The export name is CASE SENSITIVE
  ExecuteChild,
  FamilyName,
  PluginName,
  VersionNumber;

end.