Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > [ "Начинающим" ]
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 17.08.2012, 19:25
sorockinalex sorockinalex вне форума
Начинающий
 
Регистрация: 08.08.2012
Сообщения: 178
Репутация: 10
Восклицание Двусторонний обмен данными с MDIChild Dll

Ребята, делфи пользуюсь давно, но как продвинутый пользователь. Недавно столкнулся с задачей сделать MDI DLL, программа была написана без модулей.. Скачал в интернете пример MDI DLL окна, прочитал данную тему, но ничего толком не понял в каком месте объявлять переменные, чтобы они были доступны двусторонне.. Стоит задача передать переменные из главной формы, чтобы изменить их и уже при закрытии MDI формы изменённые значения использовать в главной форме, помогите пожалуйста! Чувствую, моиз знаний недостаточно для этого, нервничать уже начал (
Если кому не сложно - измените пример по ссылке, пожалуйста! Нужно передать и принять в главной форме несколько переменных. Огромное спасибо заранее тому, кто поможет! Вот здесь скачал пример MDI DLL
Ответить с цитированием
  #2  
Старый 17.08.2012, 19:38
sorockinalex sorockinalex вне форума
Начинающий
 
Регистрация: 08.08.2012
Сообщения: 178
Репутация: 10
По умолчанию

или лучше использовать bpl пакет? кто-нибудь имеет в наличии рабочий пример?
Ответить с цитированием
  #3  
Старый 17.08.2012, 21:07
sorockinalex sorockinalex вне форума
Начинающий
 
Регистрация: 08.08.2012
Сообщения: 178
Репутация: 10
По умолчанию

нашёл пример bpl, решил его использовать
http://www.delphikingdom.com/asp/vie...?catalogid=274

адаптирую свой старый юнит с формой, но вылетает ошибка:
Method 'Exporter Name' not found in base class..
Где ошибка?

Код:
unit FieldEdit;

interface

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

type
  TFieldEditForm = class(TForm)
    FieldEdit: TEdit;
    Label3: TLabel;
    AddButton: TButton;
    CancelButton: TButton;
    EditButton: TButton;
    procedure AddButtonClick(Sender: TObject);
    procedure CancelButtonClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
  public
    class function ExporterName: string; override;
  end;

var
  FieldEditForm: TFieldEditForm;
  InputFieldKey, InputFieldName, OutputFieldKey, OutputFieldName:string;

implementation

uses
  UClassManager;
  
{$R *.dfm}

class function TFieldEditForm.ExporterName: string;
begin
  Result := 'Редактирование месторождения';
end;

procedure TFieldEditForm.AddButtonClick(Sender: TObject);
begin
end;

procedure TFieldEditForm.FormShow(Sender: TObject);
end;

procedure TFieldEditForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
end;

{ ============================================= }
initialization
{ ============================================= }
ClassManager.Add(TFieldEditForm);

{ ============================================= }
finalization
{ ============================================= }
ClassManager.Remove(TFieldEditForm);

end.


Код:
{ ============================================= }
unit UClassManager;
{ ============================================= }

{ ============================================= }
interface
{ ============================================= }
uses
  Classes;
  
type
  TClassManager = class(TList);

function ClassManager: TClassManager;

{ ============================================= }
implementation
{ ============================================= }
var
  Manager: TClassManager;

function ClassManager: TClassManager;
begin
  Result := Manager;
end;

{ ============================================= }
initialization
{ ============================================= }
Manager := TClassManager.Create;

{ ============================================= }
finalization
{ ============================================= }
Manager.Free;


end{ ========================================== }.

Последний раз редактировалось sorockinalex, 17.08.2012 в 21:12.
Ответить с цитированием
  #4  
Старый 17.08.2012, 21:51
sorockinalex sorockinalex вне форума
Начинающий
 
Регистрация: 08.08.2012
Сообщения: 178
Репутация: 10
По умолчанию

понял в чём дело..
другой пакет использует того же наследника класса...
но при попытке добавить в секцию requires ту же DCU, содержащую описания этих классов возникает ошибка "Another File with the same nase name is already on the search path"
Как избежать дублирования? Иначе пакет в исполняемом файле отказывается загружатся с ошибкой: "Cannot load the package. It contains unit which is also contained in package..." Короче, он не может загрузить пакет, так как он содержит юнит, который уже загружен в другом пакете... Помогите пожалуйста, друзья!
Ответить с цитированием
  #5  
Старый 17.08.2012, 22:03
sorockinalex sorockinalex вне форума
Начинающий
 
Регистрация: 08.08.2012
Сообщения: 178
Репутация: 10
По умолчанию

блин, вот я туплю... разобрался... удалил путь поиска в Delphi\Projects\BPL )))
Ответить с цитированием
  #6  
Старый 17.08.2012, 22:18
Аватар для cotseec
cotseec cotseec вне форума
Активный
 
Регистрация: 16.07.2008
Сообщения: 353
Версия Delphi: D7,TDE06,RAD09
Репутация: 1443
По умолчанию

театр одного актера
__________________
Понять, что хочет заказчик - бесценно, ведь он платит MasterCard
Ответить с цитированием
  #7  
Старый 17.08.2012, 22:39
sorockinalex sorockinalex вне форума
Начинающий
 
Регистрация: 08.08.2012
Сообщения: 178
Репутация: 10
По умолчанию

ребята, помогите, пожалуйста! не силён в этом, простите уж.. мучаюсь, мучаюсь, никак не разберусь... как заставить форму мою FieldEditForm открываться при нажатии кнопки FieldEditForm на главной формею.. Никак не пойму устройство классов в примере...

http://zalil.ru/33688750
Ответить с цитированием
  #8  
Старый 18.08.2012, 22:05
sorockinalex sorockinalex вне форума
Начинающий
 
Регистрация: 08.08.2012
Сообщения: 178
Репутация: 10
Злость

Пожалуйста, прошу помощи! Сегодня опять взялся за код, ничего не вышло
Ответить с цитированием
  #9  
Старый 21.08.2012, 15:58
sorockinalex sorockinalex вне форума
Начинающий
 
Регистрация: 08.08.2012
Сообщения: 178
Репутация: 10
По умолчанию

Ребята, нашёл другой пример, сделал небольшой шаблон. bpl форма грузится из главного окна, но при выполнении действия после нажатия кнопки вылетает ошибка: Access Violation.
Дело в том, что в bpl я использую модуль DataModule, на котором стоит ADOQuery. И по нажатии на кнопку OK должен происходить запрос, а при попытке обращения к нему и вылезает ошибка. DataModule включил в uses... Не пойму в чём дело... Яндекс не помог ((

Код:
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;

  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 FormShow(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    LoginPackage : HModule;
    ExecuteChild : TExecuteChild;
    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
    @ExecuteChild := GetProcAddress(LoginPackage,'ExecuteChild');
  except
    //display an error message if we fail
    ShowMessage ('Íå íàéäåí login.bpl');
  end;
  if Assigned(ExecuteChild) then ExecuteChild;
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 StructureEditModule <> 0 then UnloadPackage(StructureEditModule);
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
  LoginForm.ADODataSet.CommandText:= 'SELECT * FROM LogonLogoff WHERE Key='+inttostr(Logon_Key);
  LoginForm.ADODataSet.Active:=true;
  LoginForm.ADODataSet.Edit;
    LoginForm.ADODataset['LogoffTime']:= Date+Time;
    LoginForm.ADODataSet.UpdateBatch;
  LoginForm.ADODataSet.Close;
  LoginForm.ADODataSet.Active:=false;
  Application.Terminate;
  end;}
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;

procedure TMainForm.Timer1Timer(Sender: TObject);
begin
  MainForm.Caption:='TPMDocs - ['+inttostr(Employee_Id)+' '+Employee_Name1+' '+Employee_Name2+' '+Employee_Name3+']';
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;    { Public declarations }

//var
//  LoginForm: TLoginForm;

implementation

//uses DM;

{$R *.dfm}


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

if (Edit_EmployeeId.Text<>'') and (Edit_EmployeePass.Text<>'')  then
  begin
    EmployeeId_Temp:=PChar(Edit_EmployeeId.Text);
    EmployeePass_Temp:=Edit_EmployeePass.Text;
    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;
//        LoginForm.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
  //LoginForm.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;

procedure ExecuteChild;
begin
  TLoginForm.Create(Application);
end;

exports
  //NOTE!! The export name is CASE SENSITIVE
  ExecuteChild;

end.

Код:
unit DM;

interface

uses
  SysUtils, Classes, DB, ADODB;

type
  TDM1 = class(TDataModule)
    Query: TADOQuery;
    DataSet: TADODataSet;
    procedure DataModuleCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  DM1: TDM1;
  //Ãëîáàëüíûå ïåðåìåííûå äëÿ ëîãèíà ïîëüçîâàòåëÿ
  Employee_Key:Cardinal;
  Employee_Id:Cardinal;
  Employee_Pass,
  Employee_Name1,
  Employee_Name2,
  Employee_Name3:string;
  Logon_Key:Cardinal;

implementation

{$R *.dfm}

Procedure ScanDir(StartDir,Mask: String; List: TStrings);
Var SearchRec: TSearchRec;
begin
  IF Mask=''then Mask:='*.*';
  IF StartDir[Length(StartDir)]<>'\'then StartDir := StartDir + '\';
  // Ñíà÷àëà íàõîäèì è ïå÷àòàåì âñå ôàéëû èç
  // ãëàâíîé ïàïêè ïî ìàñêå Mask
  List.Add(StartDir);
  IF FindFirst(StartDir+Mask,faAnyFile,SearchRec)=0 then Repeat
  IF(SearchRec.Attr and faDirectory)<>faDirectory then
  List.Add(StartDir+SearchRec.Name);
      Until FindNext(SearchRec)<>0;
  // Òåïåðü íàõîäèì âñå ïîäïàïêè è ïðîäîëæàåì â íèõ ïîèñê
  IF FindFirst(StartDir+'*.*',faAnyFile,SearchRec)=0 then Repeat
  IF((SearchRec.Attr and faDirectory)=faDirectory)and
  ((SearchRec.Name<>'..')and(SearchRec.Name <> '.'))then
  ScanDir(StartDir+SearchRec.Name+'\',Mask,List);
  Until FindNext(SearchRec)<>0;
  FindClose(SearchRec);
end;



procedure TDM1.DataModuleCreate(Sender: TObject);
var
  path:string;
begin
  path:=ExtractFilePath(ParamStr(0))+'db.mdb';
  DM1.Query.ConnectionString:='Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+path+';Persist Security Info=False;';
end;

end.
Ответить с цитированием
  #10  
Старый 21.08.2012, 16:47
Аватар для poli-smen
poli-smen poli-smen вне форума
Профессионал
 
Регистрация: 06.08.2012
Адрес: Кривой Рог
Сообщения: 1,791
Версия Delphi: Delphi 7, XE2
Репутация: 4415
По умолчанию

Цитата:
Сообщение от sorockinalex
Ребята, нашёл другой пример, сделал небольшой шаблон. bpl форма грузится из главного окна, но при выполнении действия после нажатия кнопки вылетает ошибка: Access Violation.
Дело в том, что в bpl я использую модуль DataModule, на котором стоит ADOQuery. И по нажатии на кнопку OK должен происходить запрос, а при попытке обращения к нему и вылезает ошибка. DataModule включил в uses... Не пойму в чём дело... Яндекс не помог ((
В сообщении "Access Violation" ещё указывается адрес в котором произошло исключение - этот адрес часто помогает найти место ошибки.
А в том коде что ты привёл не поймёшь где возникает ошибка.

А вообще мне не нравится вот эта строка:
Код:
EmployeeId_Temp:=PChar(Edit_EmployeeId.Text);

Последний раз редактировалось poli-smen, 21.08.2012 в 16:50.
Ответить с цитированием
  #11  
Старый 21.08.2012, 17:11
robt robt вне форума
Активный
 
Регистрация: 17.02.2011
Сообщения: 298
Репутация: -1806
По умолчанию

Цитата:
Сообщение от sorockinalex
делфи пользуюсь давно, но как продвинутый пользователь.
вот тут самое интересное
Ответить с цитированием
  #12  
Старый 21.08.2012, 17:36
sorockinalex sorockinalex вне форума
Начинающий
 
Регистрация: 08.08.2012
Сообщения: 178
Репутация: 10
По умолчанию

Цитата:
Сообщение от poli-smen
А в том коде что ты привёл не поймёшь где возникает ошибка.

А вообще мне не нравится вот эта строка:
Код:
EmployeeId_Temp:=PChar(Edit_EmployeeId.Text);

Цитата:
Access Violation at address 003E209A in module login_bpl
Read of address 00000058
Как узнать где именно ошибка? Не пользовался этим никогда.

Убрал PChar, всё равно также...

Насчёт "продвинутости" у меня своя лесенка:
чайник - HelloWorld,
продвинутый
профи - чьё призвание в программировании
Ответить с цитированием
  #13  
Старый 21.08.2012, 18:03
Аватар для poli-smen
poli-smen poli-smen вне форума
Профессионал
 
Регистрация: 06.08.2012
Адрес: Кривой Рог
Сообщения: 1,791
Версия Delphi: Delphi 7, XE2
Репутация: 4415
По умолчанию

Цитата:
Сообщение от sorockinalex
Как узнать где именно ошибка? Не пользовался этим никогда.
В обычной ситуации для этого используется меню "Search" -> "Find Error..." (Приложение при этом должно быть запущено в отладчике).
Но в твоём случае ошибка возникает внутри bpl. Тут сложнее. Во-первых нужно узнать с какого адреса загрузилась bpl-ка, а во-вторых откомпилировать её с включённой генерацией Map-файла: "Options" -> "Linker" -> "Map file" -> "Detailed"
Или прикрепи исходники проекта, я дома посмотрю.

Цитата:
Сообщение от sorockinalex
Убрал PChar, всё равно также...
Ну я не говорил, что ошибка пропадёт. Просто в том месте у меня "глаз споткнулся". Вот зачем в том месте используется PChar вместо string?
Ответить с цитированием
Этот пользователь сказал Спасибо poli-smen за это полезное сообщение:
sorockinalex (26.08.2012)
  #14  
Старый 26.08.2012, 23:14
sorockinalex sorockinalex вне форума
Начинающий
 
Регистрация: 08.08.2012
Сообщения: 178
Репутация: 10
По умолчанию

http://www.fayloobmennik.net/2146952

Спасибо большое за готовность помочь! Прикрепил файл.

Последний раз редактировалось sorockinalex, 26.08.2012 в 23:57.
Ответить с цитированием
  #15  
Старый 26.08.2012, 23:40
sorockinalex sorockinalex вне форума
Начинающий
 
Регистрация: 08.08.2012
Сообщения: 178
Репутация: 10
По умолчанию

сделал, работают функции:
Код:
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.

Последний раз редактировалось sorockinalex, 26.08.2012 в 23:58.
Ответить с цитированием
Ответ


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 12:27.


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2023

ВКонтакте   Facebook   Twitter