Показать сообщение отдельно
  #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.
Ответить с цитированием