Procedure TDeskTop.TestButtonClick(Sender:TObject);
Begin
DBModule.DBPath:='\\B0000011\Base\DBase.mdb';
// DBModule.DBPath:='D:\test\DBase.mdb';
DBModule.DBConnect:=True;
If DBModule.DBConnect
 Then
  TestButton.Caption:='Офигеть! Соединение установлено.'
 Else
  TestButton.Caption:='Не работает...';
End;

Unit DBModuleUnit;

Interface

Uses
ADODB,Classes,DB,SysUtils;

Type
TDBModule=Class(TDataModule)
  DBConnection                                         :TADOConnection;
  Procedure DataModuleCreate(Sender:TObject);
  Procedure DBConnectionBeforeConnect(Sender:TObject);
 Private
  FDBPath                                              :String;
  Function GetDBConnect:Boolean;
  Procedure SetDBConnect(Value:Boolean);
  Procedure SetDBPath(Value:String);
 Public
 Published
  Property DBConnect:Boolean
   Read GetDBConnect
   Write SetDBConnect;
  Property DBPath:String
   Read FDBPath
   Write SetDBPath;
End;

Var
DBModule                                               :TDBModule;

Implementation

{$R *.dfm}

Procedure TDBModule.DataModuleCreate(Sender:TObject);
Begin
FDBPath:='';
End;

Procedure TDBModule.DBConnectionBeforeConnect(Sender:TObject);
Begin
DBConnection.ConnectionString:='Provider=Microsoft.Jet.OLEDB.4.0;'+
                               'Data Source=\"'+DBPath+'\";'+
                               'Persist Security Info=False;'+
                               'Jet OLEDB:Database Password=001007326';
End;

Function TDBModule.GetDBConnect:Boolean;
Begin
Result:=DBConnection.Connected;
End;

Procedure TDBModule.SetDBConnect(Value:Boolean);
Begin
Case Value Of
  True: Begin
         DBConnection.Connected:=False;
         DBConnection.Connected:=True;
        End;
 False: DBConnection.Connected:=False;
End;
End;

Procedure TDBModule.SetDBPath(Value:String);
Begin
FDBPath:=Value;
End;

End.

Unit DeskTopUnit;

Interface

Uses
Classes,Controls,DBModuleUnit,DBPathUnit,Dialogs,Forms,Graphics,Menus,Messages,
StdCtrls,SysUtils,Variants,Windows;

Type
TDeskTop=Class(TForm)
  TestButton                                           :TButton;
  AppMenu                                              :TMainMenu;
   N1                                                  :TMenuItem;
   N2                                                  :TMenuItem;
   N3                                                  :TMenuItem;
   N4                                                  :TMenuItem;
  Procedure TestButtonClick(Sender:TObject);
   procedure N2Click(Sender: TObject);
 Private
 Public
End;

Var
DeskTop                                                :TDeskTop;

Implementation

{$R *.dfm}

Procedure TDeskTop.TestButtonClick(Sender:TObject);
Begin
Try
 DBModule.DBConnect:=Not DBModule.DBConnect;
 If DBModule.DBConnect
  Then
    TestButton.Caption:='РАЗОРВАТЬ СОЕДИНЕНИЕ'
  Else
    TestButton.Caption:='НА ЖМИ МЕНЯ';
Except
 MessageDlg('А ВОТ ТЕБЕ, РОЖА БУРЖУЙСКАЯ, ДУЛЯ ПРОЛЕТАРСКАЯ!',mtError,[mbOK],0);
End;
End;

Procedure TDeskTop.N2Click(Sender: TObject);
Begin
DBPath.ShowModal;
End;

End.

Unit DBModuleUnit;

Interface

Uses
ADODB,Classes,DB,DBPathUnit,SysUtils;

Type
TDBModule=Class(TDataModule)
  DBConnection                                         :TADOConnection;
  DBQuery                                              :TADOQuery;
  Procedure DBConnectionBeforeConnect(Sender:TObject);
 Private
  Function GetDBConnect:Boolean;
  Procedure SetDBConnect(Value:Boolean);
 Public
  Property DBConnect:Boolean
   Read GetDBConnect
   Write SetDBConnect;
End;

Var
DBModule                                               :TDBModule;

Implementation

{$R *.dfm}

Procedure TDBModule.DBConnectionBeforeConnect(Sender:TObject);
Var
 Buffer                                                :String;
Begin
DBConnection.ConnectionString:='Provider=Microsoft.Jet.OLEDB.4.0;'+
                               'Data Source='+DBPath.DBPath+';'+
                               'Persist Security Info=False;'+
                               'Jet OLEDB:Database Password=0322907';
End;

Function TDBModule.GetDBConnect:Boolean;
Begin
Result:=DBConnection.Connected;
End;

Procedure TDBModule.SetDBConnect(Value:Boolean);
Begin
Case Value Of
  True: Begin
         If DBConnection.Connected
          Then
            DBConnection.Close;
         DBConnection.Open;
        End;
 False: DBConnection.Close;
End;
End;

End.

Unit DBPathUnit;

Interface

Uses
Classes,Controls,Graphics,Forms,Dialogs,Mask,Messages,
rxToolEdit,StdCtrls,SysUtils,Variants,Windows;

Type
TAppSettings=Record
 DBPath                                                :String[255];
 DayCount                                              :Integer;
End;
TDBPath=Class(TForm)
  DBPathHint                                           :TLabel;
  DBPathValue                                          :TFilenameEdit;
  ButtonSave                                           :TButton;
  ButtonClose                                          :TButton;
   procedure FormCreate(Sender: TObject);
   procedure FormActivate(Sender: TObject);
   procedure ButtonSaveClick(Sender: TObject);
   procedure ButtonCloseClick(Sender: TObject);
 Private
  Function GetDBPath:String;
  Procedure SetDBPath(Value:String);
 Public
  Property DBPath:String
   Read GetDBPath
   Write SetDBPath;
End;

Var
DBPath                                                 :TDBPath;

Implementation

{$R *.dfm}

Procedure TDBPath.FormCreate(Sender:TObject);
Begin
DBPathValue.Text:='';
DBPathValue.InitialDir:=ExtractFilePath(ParamStr(0));
DBPathValue.HistoryList.Clear;
DBPathValue.FileName:='';
DBPathValue.DefaultExt:='';
End;

Procedure TDBPath.FormActivate(Sender:TObject);
Begin
DBPathValue.InitialDir:=ExtractFilePath(ParamStr(0));
DBPathValue.HistoryList.Clear;
DBPathValue.DefaultExt:='';
DBPathValue.FileName:=DBPath;
End;

Procedure TDBPath.ButtonSaveClick(Sender:TObject);
Begin
DBPath:=DBPathValue.FileName;
ModalResult:=mrOk;
End;

Procedure TDBPath.ButtonCloseClick(Sender:TObject);
Begin
ModalResult:=mrCancel;
End;

Function TDBPath.GetDBPath:String;
Var
 FileSettings                                          :File Of TAppSettings;
 AppSettings                                           :TAppSettings;
Begin
AssignFile(FileSettings,ExtractFilePath(ParamStr(0))+'\Settings.cfg');
{$I-}
ReSet(FileSettings);
{$I+}
If IOResult=0
 Then
  Begin
   Read(FileSettings,AppSettings);
   CloseFile(FileSettings);
   Result:=AppSettings.DBPath;
  End
 Else
  Begin
   MessageDlg('Файл конфигурации отсутствует или поврежден.',mtWarning,[mbOk],0);
   Result:='';
  End;
End;

Procedure TDBPath.SetDBPath(Value:String);
Var
 FileSettings                                          :File Of TAppSettings;
 AppSettings                                           :TAppSettings;
Begin
AssignFile(FileSettings,ExtractFilePath(ParamStr(0))+'\Settings.cfg');
{$I-}
ReSet(FileSettings);
{$I+}
If IOResult=0
 Then
  Begin
   Read(FileSettings,AppSettings);
   CloseFile(FileSettings);
  End
 Else
  Begin
   AppSettings.DBPath:='';
   AppSettings.DayCount:=1;
  End;
AppSettings.DBPath:=Value;
{$I-}
ReWrite(FileSettings);
{$I+}
If IOResult=0
 Then
  Begin
   Write(FileSettings,AppSettings);
   CloseFile(FileSettings);
  End
 Else
   MessageDlg('Ошибка записи файла конфигурации.',mtError,[mbOk],0);
End;

End.

B0000011                        Admin                          

B0000067                        Admin                           B0000011                        Admin                          

B0000011                        Admin                           B0000067                        Admin