toolsdb.pas

示范复制、排序、输出、过滤、查询、打印、压缩重整 ( Pack )、取得字段及索引信息的范例程序

unit ToolsDb;

interface

uses
  {$IFDEF WIN32} BDE,Windows,ComCtrls,{$ELSE}Winprocs,{$ENDIF}
  Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons, DB, DbiTypes, FileCtrl, DBTables;

type
  TForm2 = class(TForm)
    CbTipoTabla: TComboBox;
    Label6: TLabel;
    BitBtn1: TBitBtn;
    EditNewAlias: TEdit;
    DriveComboBox1: TDriveComboBox;
    Directory1: TDirectoryListBox;
    BitBtn2: TBitBtn;
    Memo1: TMemo;
    Label2: TLabel;
    GroupBox1: TGroupBox;
    RBdBase: TRadioButton;
    RBParadox: TRadioButton;
    Label1: TLabel;
    Label3: TLabel;
    ListBoxAlias: TListBox;
    BBDelete: TBitBtn;
    BitBtn3: TBitBtn;
    Table1: TTable;
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure CbTipoTablaChange(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Directory1Change(Sender: TObject);
    procedure EditNewAliasExit(Sender: TObject);
    procedure RBdBaseClick(Sender: TObject);
    procedure ListBoxAliasClick(Sender: TObject);
    procedure BBDeleteClick(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
  private
    { Private declarations }
   sPath,sAlias,sType : String;
  public
    { Public declarations }
  end;

var
  Form2: TForm2;
  {Variables for MsAccess DataBase}
  DbEngine  : Variant;
  DbWAccess : Variant;
  DbTable1  : Variant;
  Dir       : String;

const
  {Variables for MsAccess DataBase}
  DbVersion30   = 32;
  DbLangGeneral = ';LANGID=0x0409;CP=1252;COUNTRY=0';

implementation

(*
// if you have Microsoft DAO Installed, remove Comment in this line and in line 122
// Microsoft Dao is part of Ms Office proffesional and others of MicroSoft software
uses OleAuto; // OleAuto.*, Ole2.*, OleCtl.*, in \Delphi\Source\...
*)

{$R *.DFM}

procedure TForm2.FormShow(Sender: TObject);
begin
 ListBoxAlias.Items.Clear;

 // Get the names of the Driver of the BDE
 try
  Session.GetDriverNames(CbTipoTabla.Items);
 except
  CbTipoTabla.Items.Clear;
 end;
 CbTipoTabla.ItemIndex := 0;

 // Get the parameters of the first driver
 try
  Session.GetDriverParams(CbTipoTabla.Text,Memo1.Lines);
 except
  Memo1.Lines.Clear;
 end;

 // Get the Alias Names
 try
  Session.GetAliasNames(ListBoxAlias.Items);
 except
  ListBoxAlias.Items.Clear;
 end;

 // To update the Path and type of Driver
 Directory1Change(nil);

end;

procedure TForm2.BitBtn1Click(Sender: TObject);
var
 fConfigMode: TConfigMode;
 i : Integer;
begin

 // We prove that it has been introduced the name of the Alias
 if Length(sAlias) = 0 then Exit;

 // We prove if exists the Alias before creating it
 i := 0;
 while Length(ListBoxAlias.Items[i]) > 0 do begin
  if ListBoxAlias.Items[i] = sAlias then begin
   ShowMessage('The New Alias exists.');
   Exit;
  end;
  if i < (ListBoxAlias.Items.Count - 1) then Inc(i) else Break;
 end;

 Directory1Change(nil);

(*
 // When the driver is MSACCESS, we create a table .mdb with the Microsoft DAO
 // For this, it is necessary that you may have installed the Microsoft DAO in
 // your machine.
 // The product is part of MSAccess, Visual Basic 4/5, etc.
 // If you do not has the DAO, it will have to be put in touch with Microsoft

  if sType = 'MSACCESS' then begin
   try
    DbEngine := CreateOleObject('Dao.DbEngine.35');
   except
    try
     DbEngine := CreateOleObject('Dao.DbEngine');
    except
     ShowMessage('Impossible init DAO' + #13 +
                 'It must be installed the Microsoft DAO in your machine' + #13 +
                 'The product is part of MS Access, Visual Basic 4/5, etc.');
     Exit;
    end;
   end;

   DbWAccess := DbEngine.WorkSpaces[0];

   // If it does not exist the file .mdb, we create it with DAO
   if not FileExists(sPath + sALias + '.mdb') then begin
    // Create .mdb DataBase with DAO
    DbTable1 := DbWAccess.CreateDatabase(sPath + sAlias + '.mdb',DbLangGeneral,DbVersion30);
   end;
   DbWAccess.Close;
   // Once has created the file .mdb, it can create tables as if it would be a
   // driver standard as dBase or Paradox
  end;
*)

 // Create new Alias in BDE
 fConfigMode := Session.ConfigMode;
 try
  DbiInit(nil);
  Session.AddAlias(sAlias, sType, Memo1.Lines);
  Session.SaveConfigFile;
 finally
  Session.ConfigMode := fConfigMode;
 end;

 // To update the Alias list
 try
  Session.GetAliasNames(ListBoxAlias.Items);
 except
  ListBoxAlias.Items.Clear;
 end;

end;

procedure TForm2.BitBtn2Click(Sender: TObject);
begin
 Close;
end;

procedure TForm2.CbTipoTablaChange(Sender: TObject);
begin
 // Get params by default of the driver
 Memo1.Lines.Clear;
 Session.GetDriverParams(CbTipoTabla.Text,Memo1.Lines);
 Directory1Change(nil);
end;

procedure TForm2.Directory1Change(Sender: TObject);
begin
 // Browse the path
 sPath := Directory1.Directory;
 if sPath[Length(sPath)] <> '\' then sPath := sPath + '\';

 sType  := CbTipoTabla.Text;
 if sType = 'STANDARD' then begin
  Memo1.Lines[0]    := 'PATH=' + Directory1.Directory;
  GroupBox1.Enabled := True;
 end;

 if sType = 'MSACCESS' then begin
  Memo1.Lines[0]    := 'DATABASE NAME=' + sPath + sAlias + '.mdb';
  GroupBox1.Enabled := False;
 end;

end;

procedure TForm2.EditNewAliasExit(Sender: TObject);
begin
 sAlias := EditNewAlias.Text;
end;

procedure TForm2.RBdBaseClick(Sender: TObject);
var
 i,j : Integer;
begin
 // Select Driver dBase or Paradox when the driver is Standard
 for i := 1 to Memo1.Lines.Count do
  if Pos('DEFAULT DRIVER',Memo1.Lines[i]) > 0 then j := i;

 if RbdBase.Checked then Memo1.Lines[j] := 'DEFAULT DRIVER=DBASE'
                    else Memo1.Lines[j] := 'DEFAULT DRIVER=PARADOX'
end;

procedure TForm2.ListBoxAliasClick(Sender: TObject);
begin
 // Get params of the Alias
 try
  Session.GetAliasParams(ListBoxAlias.Items[ListBoxAlias.ItemIndex], Memo1.Lines);
 except
  Memo1.Lines.Clear;
 end;
end;

procedure TForm2.BBDeleteClick(Sender: TObject);
var
 s : String;
 fConfigMode: TConfigMode;
begin

 // Has to have an alias selected
 if ListBoxAlias.ItemIndex = -1 then begin
  ShowMessage('Please, select the Alias');
  Exit;
 end;

 // Get the Alias and to ask if we erase it
 s := ListBoxAlias.Items[ListBoxAlias.ItemIndex];
 if MessageDlg('緿elete Alias: ' + s + ' ?' , mtConfirmation, [mbYes, mbNo], 0) = mrYes
  then begin
   Screen.Cursor := CrHourGlass;

   // Delete the alias
   fConfigMode := Session.ConfigMode;
   try
    DbiInit(nil);
    Session.DeleteAlias(s);
    Session.SaveConfigFile;
   finally
    Session.ConfigMode := fConfigMode;
   end;

   // Get name of alias
   try
    Session.GetAliasNames(ListBoxAlias.Items);
   except
    ListBoxAlias.Items.Clear;
   end;
   Directory1Change(nil);
   Screen.Cursor := CrDefault;
  end;
end;

procedure TForm2.BitBtn3Click(Sender: TObject);
begin
 with Table1 do begin
  Close;
  DatabaseName := ListBoxAlias.Items[ListBoxAlias.ItemIndex];
  TableName    := 'Table1';
  with FieldDefs do
   begin
   Clear;
   Add('Clave',        ftInteger,      0, True);
   Add('cString',      ftString,      20, False);
   Add('cMemo',        ftMemo,         0, False);
   Add('cBoolean',     ftBoolean,      0, False);
   Add('cDate',        ftDate,         0, False);
   Add('cInteger',     ftInteger,      0, False);
   Add('cSmallint',    ftSmallint,     0, False);
   Add('cWord',        ftWord,         0, False);
   Add('cCurrency',    ftCurrency,     0, False);
   Add('cFloat',       ftFloat,        0, False);
   Add('cTypedBinary', ftTypedBinary,  0, False);
   end;
  with IndexDefs do begin
   Clear;
   Add('Clave', 'Clave', []);
  end;
  CreateTable;
  Open;
 end;
end;

end.