Ребята, нашёл другой пример, сделал небольшой шаблон. 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.
|