unit Unit1;
// This unit creates an Access 2000 database using ADOX.
//
// Author: David Simpson (drs@ihug.com.au)
//
// 15 October 2000
//
// This code demonstrates some of the ways ADOX can be used with Object Pascal,
// as well as pointing out some traps and pitfalls.  Access 97 databases can
// be created by ADOX also, by changing the Jet Engine Type code from 5 to 4,
// but some of the code in this example is not Access 97 compatible.
//
// This code was tested with ADO/ADOX 2.6.
//
// No claim is made that the subsequent database is in fact useful in any way.    interface    uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ADOX_TLB, ADODB_TLB;    // ADODB_TLB can be obtained by importing the ADO Type Library:
//
// Select Project/Import Type Library...
// Select 'Microsoft ActiveX Data Objects 2.6 Library'
// or Add C:\Program Files\Common Files\System\ADO\msado15.dll
//
// ADOX_TLB can be obtained by importing the ADOX Type Library:
//
// Select Project/Import Type Library...
// Select 'Microsoft ADO Ext. 2.6 for DDL and Security'
// or Add C:\Program Files\Common Files\System\ado\msadox.dll
//
// The Generate Code Wrapper option is not needed.
//
// ADOX is documented in ado260.chm, which is available as a separate download
// from www.microsoft.com/data, or as part of the Platform SDK or the MSDN
// library, specifically:
//
// Data Access Services/
// Microsoft Data Access Components (MDAC) SDK/
// Microsoft ActiveX Data Objects/
// Microsoft ADOX Programmer's Reference
//
// The OLE DB provider properties (as distinct from ADOX object properties)
// are documented in:
//
// Data Access Services/
// Microsoft Data Access Components (MDAC) SDK/
// Microsoft Data Access Technical Articles/
// ActiveX Data Objects (ADO) Technical Articles/
// Migrating from DAO to ADO/
// Appendix B: Microsoft Jet 4.0 OLE DB Properties Reference.    type
  TForm1 = class(TForm)
    btnGo: TButton;
    cbxDatabaseCreated: TCheckBox;
    procedure btnGoClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;    var
  Form1: TForm1;    implementation    {$R *.DFM}    procedure TForm1.btnGoClick(Sender: TObject);
// This procedure creates an Access database using ADOX.
//
// The database has two tables and two stored procedures.
//
// The MTable has seven columns, the first two of which (MColumn1 and
// MColumn2) are strings used to create a multi-column primary key.  The third
// is an integer column.  The fourth is a hyperlink.  The fifth is a GUID.
// The sixth is a string, and is used to demonstrate changing properties.
// The seventh is a float.
//
// The DTable has an autoincrementing primary key (DColumn3), and two
// string columns (DColumn1 and DColumn2) which form the multi-column foreign
// key.  The foreign key implements full referential integrity.    const
  BaseName = 'Dummy.mdb';    var
  DataSource: string;
  Catalog: _Catalog; // the database
  MTable: _Table; // the master table
  DTable: _Table; // the detail table
  MColumn1,
    MColumn2,
    MColumn3,
    MColumn4,
    MColumn5,
    MColumn6,
    MColumn7: _Column; // columns for the master table
  DColumn1,
    DColumn2,
    DColumn3: _Column; // columns for the detail table
  MIndex1, // index objects to index primary key columns
  MIndex2,
    MIndex3,
    MIndex6: _Index; // index objects for the master table
  DIndex1,
    DIndex2,
    DIndex3: _Index; // index objects for the detail table
  DPKey,
    DFKey: _Key; // foreign key object for the detail table
  Connection: _Connection; // from ADODB; Connection object to open new db
  Command1,
    Command2: _Command; // from ADODB_TLB; Command object for stored proc      procedure CreateCatalog;
  begin
    // A spot of housekeeping first up
    if FileExists(BaseName) then
      DeleteFile(BaseName);        // Create a catalog (database) object using the provided COM object
    // creation method - no need for wrappers and no need for garbage
    // collection.  All COM objects created will be automatically destroyed
    // when they go out of scope. (The OP compiler adds code to decrement
    // each object's reference count when they go out of scope.  Since creating
    // the object in OP automatically increments its reference count to 1, this
    // ensures that COM will destroy the object because its reference count
    // then equals 0.  Note that the scope is defined by the object's
    // declaration procedure, which is not necessarily where they are created).
    Catalog := CoCatalog.Create;        // Set the connection string.
    // Note that properties specified in the connection string, such as
    // Jet OLEDB:Engine Type or Jet OLEDB:Encrypt Database are subsequently
    // used in the Catalog.Create method, but not all connection properties are
    // supported.  See the Microsoft Jet 4.0 OLE DB Properties Reference for
    // further details.
    // BTW, Jet Engine Type 5 = Access 2000; Type 4 = Access 97
    DataSource := 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=' + BaseName +
      ';Jet OLEDB:Engine Type=5';        // Create a new Access database
    Catalog.Create(DataSource);
  end;      procedure CreateTables;
  begin
    // Create the table objects
    MTable := CoTable.Create;
    with MTable do
      begin
        ParentCatalog := Catalog;
        Name := 'MasterTable';
      end;
    DTable := CoTable.Create;
    with DTable do
      begin
        ParentCatalog := Catalog;
        Name := 'DetailTable';
      end;
  end;      procedure CreateColumns;
  begin
    // Create the column objects for the master table
    MColumn1 := CoColumn.Create;
    with MColumn1 do
      begin
        ParentCatalog := Catalog;
        Name := 'Column1';
        // The adVarWchar and adWchar types produce Unicode (WideString) strings
        // in Access 2000.  If you are creating an Access 97 database you will
        // get adVarChar and adChar (ANSI) strings instead.
        Type_ := adVarWchar;
        // DefinedSize only has meaning for strings (but not memos).
        DefinedSize := 50; // characters
        // Specify a human-readable string description of the column.
        //
        // Note that you must use the expanded syntax in order to write to
        // the Properties collection.  If you try to use an abbreviated syntax
        // based on the Properties collection default (Value), such as:
        //
        //   Properties['x'] := false
        //
        // you will get a compiler error about trying to write to a read-only
        // property.
        Properties['Description'].Value :=
          'This column is part 1 of a multi-column primary key';
        // Specify whether this column allows NULLs.  The Nullable property
        // = Access's Required property but the specification is inverted:
        //
        //   If Nullable = false then Required = true
        Properties['Nullable'].Value := false;
        // Determines whether zero-length strings can be inserted into this
        // column. Ignored for data types that are not strings. This is similar
        // to the Nullable property but distinct. Zero-length strings are not
        // NULLs in Jet.
        Properties['Jet OLEDB:Allow Zero Length'].Value := false;
        // Determines whether Jet should compress UNICODE strings on the disk.
        // This applies only to the version 4.0 .mdb file format and is ignored
        // when running against all other storage formats.  The default is true.
        Properties['Jet OLEDB:Compressed UNICODE Strings'].Value := true;
      end;        MColumn2 := CoColumn.Create;
    with MColumn2 do
      begin
        ParentCatalog := Catalog;
        Name := 'Column2';
        Type_ := adVarWchar;
        DefinedSize := 50;
        Properties['Description'].Value :=
          'This column is part 2 of a multi-column primary key';
        Properties['Nullable'].Value := false;
        Properties['Jet OLEDB:Allow Zero Length'].Value := false;
      end;        MColumn3 := CoColumn.Create;
    with MColumn3 do
      begin
        ParentCatalog := Catalog;
        Name := 'Column3';
        Type_ := adInteger;
        // DefinedSize has meaning only for strings, so you could omit this
        // line.
        DefinedSize := 0;
        // A bug in ADO 2.5 means that the Default property value will not be
        // accepted and no error will be given. This bug is not in 2.1 or 2.6.
        Properties['Default'].Value := 0;
        // Expression to be evaluated on a column to validate its value before
        // allowing it to be set. This operates in a fashion similar to SQL-92
        // CHECK clauses.
        Properties['Jet OLEDB:Column Validation Rule'].Value := '>= 0';
        // Error string to display when the validation rule specified in
        // Jet OLEDB:Column Validation Rule is not met.
        Properties['Jet OLEDB:Column Validation Text'].Value :=
          'Please enter a number greater than or equal to 0';
      end;        MColumn4 := CoColumn.Create;
    with MColumn4 do
      begin
        ParentCatalog := Catalog;
        Name := 'Column4';
        Type_ := adLongVarWChar;
        Properties['Default'].Value := 'http://www.borland.com/delphi';
        // Specify whether the data in the column is a hyperlink.  Only for
        // Jet 4.0 or later.
        Properties['Jet OLEDB:Hyperlink'].Value := true;
      end;        MColumn5 := CoColumn.Create;
    with MColumn5 do
      begin
        ParentCatalog := Catalog;
        Name := 'Column5';
        // adGUID is an Access AutoNumber with a Field Size of 'Replication ID'
        // instead of 'Long Integer'.
        Type_ := adGUID;
        // Specify whether a GUID should be automatically generated for the
        // column. This property is ignored unless the column type is adGUID.
        Properties['Jet OLEDB:Autogenerate'].Value := true;
      end;        MColumn6 := CoColumn.Create;
    with MColumn6 do
      begin
        ParentCatalog := Catalog;
        Name := 'Column6';
        Type_ := adVarWchar;
        DefinedSize := 25;
        Properties['Nullable'].Value := false;
        Properties['Jet OLEDB:Allow Zero Length'].Value := false;
        Properties['Jet OLEDB:Compressed UNICODE Strings'].Value := true;
      end;        // Create the column objects for the detail table.
    // The primary key for this table will be an autoincrementing integer
    // (an Access AutoNumber).
    DColumn3 := CoColumn.Create;
    with DColumn3 do
      begin
        ParentCatalog := Catalog;
        Name := 'Column3';
        Type_ := adInteger;
        // The default for AutoIncrement is false but we want an AutoNumber
        Properties['AutoIncrement'].Value := true;
        // Specify the value by which an AutoIncrement column is incremented.
        // The default is 1.
        Properties['Increment'].Value := 2;
        // Specify the value that will be used in an autoincrement column for
        // the next added record.
        Properties['Seed'].Value := 100;
      end;        // Columns 1 & 2 in the detail table  will be used to form the foreign key,
    // so they must be of the same type and size as columns 1 & 2 in the
    // master table.  The detail columns are given the same names as the master
    // columns only to aid understanding.
    DColumn1 := CoColumn.Create;
    with DColumn1 do
      begin
        ParentCatalog := Catalog;
        Name := MColumn1.Name;
        Type_ := MColumn1.Type_;
        DefinedSize := MColumn1.DefinedSize;
        Properties['Nullable'].Value := false;
        Properties['Jet OLEDB:Allow Zero Length'].Value := false;
      end;        DColumn2 := CoColumn.Create;
    with DColumn2 do
      begin
        ParentCatalog := Catalog;
        Name := MColumn2.Name;
        Type_ := MColumn2.Type_;
        DefinedSize := MColumn2.DefinedSize;
        Properties['Nullable'].Value := false;
        Properties['Jet OLEDB:Allow Zero Length'].Value := false;
      end;
  end;      procedure AppendColumnsToTables;
  begin
    // Append the master table columns.
    // Note that passing a Column object instead of the column name as parameter
    // 1 causes the object's properties to override the other Columns.Append
    // parameter values:
    //
    //  MTable.Columns.Append(MColumn3, aIgnoredType, aIgnoredDefinedSize);
    //
    // If you pass the column name as the first parameter there is no need to
    // create a Column object, since that is done by the Columns.Append method,
    // but you have no control over its other properties:
    //
    //  MTable.Columns.Append('aName',adSomeType,0);
    //
    MTable.Columns.Append(MColumn1, Unassigned, Unassigned);
    MTable.Columns.Append(MColumn2, Unassigned, Unassigned);
    MTable.Columns.Append(MColumn3, Unassigned, Unassigned);
    MTable.Columns.Append(MColumn4, Unassigned, Unassigned);
    MTable.Columns.Append(MColumn5, Unassigned, Unassigned);
    MTable.Columns.Append(MColumn6, Unassigned, Unassigned);        // Append the detail table columns.
    // Note that the order in which you append the columns defines each
    // column's ordinal position in the Columns collection.
    DTable.Columns.Append(DColumn3, Unassigned, Unassigned);
    DTable.Columns.Append(DColumn1, Unassigned, Unassigned);
    DTable.Columns.Append(DColumn2, Unassigned, Unassigned);
  end;      procedure AppendTablesToCatalog;
  begin
    // Append tables to the database
    // Note that the order in which you append the tables defines each
    // table's ordinal position in the Tables collection.
    Catalog.Tables.Append(MTable);
    Catalog.Tables.Append(DTable);
  end;      procedure CreateIndexes;
  begin
    // Ensure the primary key columns for the master table are indexed (no
    // duplications).
    MIndex1 := CoIndex.Create;
    with MIndex1 do
      begin
        Name := MColumn1.Name;
        Columns.Append(MColumn1.Name, MColumn1.Type_, MColumn1.DefinedSize);
        PrimaryKey := false;
        Unique := true;
      end;        MIndex2 := CoIndex.Create;
    with MIndex2 do
      begin
        Name := MColumn2.Name;
        Columns.Append(MColumn2.Name, MColumn2.Type_, MColumn2.DefinedSize);
        PrimaryKey := false;
        Unique := true;
      end;        // Ensure the foreign key columns are indexed (duplicates OK)
    DIndex1 := CoIndex.Create;
    with DIndex1 do
      begin
        Name := DColumn1.Name;
        Columns.Append(DColumn1.Name, DColumn1.Type_, DColumn1.DefinedSize);
        PrimaryKey := false;
        Unique := false;
      end;        DIndex2 := CoIndex.Create;
    with DIndex2 do
      begin
        Name := DColumn2.Name;
        Columns.Append(DColumn2.Name, DColumn2.Type_, DColumn2.DefinedSize);
        PrimaryKey := false;
        Unique := false;
      end;        // ensure the primary key is indexed (no duplicates)
    DIndex3 := CoIndex.Create;
    with DIndex3 do
      begin
        Name := DColumn3.Name;
        Columns.Append(DColumn3.Name, DColumn3.Type_, DColumn3.DefinedSize);
        PrimaryKey := false;
        Unique := true;
      end;
  end;      procedure CreatePrimaryKeys;
    // This procedure demonstrates two methods for implementing primary keys.
    // The first uses an Index object.  The second uses a Key object.
  begin
    // Create the primary key for the master table.
    //
    // Multi-column keys are problematic at best, but are illustrative, and
    // single-column keys are implemented the same way.
    // Primary and Unique keys can be actually created indirectly using the
    // index object.
    MIndex3 := CoIndex.Create;
    with MIndex3 do
      begin
        Name := 'PrimaryKey';
        Columns.Append(MColumn1.Name, MColumn1.Type_, MColumn1.DefinedSize);
        // The SortOrder property only has meaning for index columns.
        // adSortAscending is the default.
        Columns[MColumn1.Name].SortOrder := adSortAscending;
        Columns.Append(MColumn2.Name, MColumn2.Type_, MColumn2.DefinedSize);
        Columns[MColumn2.Name].SortOrder := adSortAscending;
        PrimaryKey := True;
        // The Unique property here seems to be ignored when the PrimaryKey
        // property is true, hence the use of the MIndex1 & MIndex2 objects
        // above.
        Unique := True;
        // Columns which are null will not have an index entry.
        // adIndexNullsDisallow is the default.
        IndexNulls := adIndexNullsDisallow;
        // Specify whether the index is clustered.  The default is false.
        // Access does not support clustering, but SQL Server does.
        Clustered := false;
      end;        // create the primary key for the detail table
    DPKey := CoKey.Create;
    with DPKey do
      begin
        Name := 'PrimaryKey';
        Type_ := adKeyPrimary;
        // do not leave out these lines, or else you will get a
        // 'constraint is not DBCONSTRAINTTYPE_FOREIGNKEY and
        // cForeignKeyColumns is not zero' error message when you try to
        // append it to the Keys collection.
        RelatedTable := '';
        Columns.Append(DColumn3.Name, DColumn3.Type_, DColumn3.DefinedSize);
        Columns[DColumn3.Name].RelatedColumn := '';
      end;
  end;      procedure AppendIndexesToTables;
  begin
    // Append theindexes to the master table
    // Note that the order in which you append the indexes defines each
    // index's ordinal position in the Indexes collection.
    MTable.Indexes.Append(MIndex1, EmptyParam);
    MTable.Indexes.Append(MIndex2, EmptyParam);        // Append the indexes for the detail table
    DTable.Indexes.Append(DIndex3, EmptyParam); // primary key index        DTable.Indexes.Append(DIndex1, EmptyParam);
    DTable.Indexes.Append(DIndex2, EmptyParam);
  end;      procedure AppendPrimaryKeysToTables;
  begin
    // Append the master table primary key
    MTable.Indexes.Append(MIndex3, EmptyParam);
    // Append the detail table primary key
    DTable.Keys.Append(DPKey, adKeyPrimary, EmptyParam, '', '');
  end;      procedure CreateForeignKeys;
  begin
    // Create the foreign key object
    DFKey := CoKey.Create;
    with DFKey do
      begin
        Name := MTable.Name + DTable.Name;
        Type_ := adKeyForeign;
        RelatedTable := MTable.Name;
        // append multiple columns for a multi-field foreign key
        Columns.Append(DColumn1.Name, DColumn1.Type_, DColumn1.DefinedSize);
        Columns[DColumn1.Name].RelatedColumn := MColumn1.Name;
        Columns.Append(DColumn2.Name, DColumn2.Type_, DColumn2.DefinedSize);
        Columns[DColumn2.Name].RelatedColumn := MColumn2.Name;
        // Specify a 1-Many relationship by enforcing referential integrity.
        // Specify what happens when a primary key is deleted.
        // The default is adRINone.
        DeleteRule := adRICascade;
        // Specify what happens when a primary key is updated.
        // The default is adRINone.
        UpdateRule := adRICascade;
      end;
  end;      procedure AppendForeignKeysToTables;
  begin
    // Append the foreign key.
    // Note carefully the use of Unassigned and EmptyParam.  This is not
    // arbitrary.
    DTable.Keys.Append(DFKey, Unassigned, EmptyParam, Unassigned, Unassigned);
  end;      procedure CloseAndReopenDatabase;
  begin
    // 'Close' the database by freeing the Catalog object's connection and
    // then the Catalog itself.
    Catalog.Set_ActiveConnection(Unassigned);
    Catalog := nil;
    // Open an ordinary ADO connection to the database
    Connection := CoConnection.Create;
    with Connection do
      begin
        ConnectionString := DataSource;
        // Specify exclusive access because we intend modifying the database's
        // structure.  The default is adModeUnknown.
        Mode := adModeShareExclusive;
        Open('', '', '', Unassigned);
      end;
    // Recreate the Catalog object
    Catalog := CoCatalog.Create;
    // Link the Catalog object to the open connection
    Catalog._Set_ActiveConnection(Connection);
  end;      procedure ChangeSomeColumnProperties;
    // A small number of column properties can be changed.  However, most often
    // it will be better to append a new column and delete the old one.
  begin
    // You need to 'reset' your objects now that the database has been
    // created, closed, and opened.
    MTable := Catalog.Tables[MTable.Name];
    MColumn6 := MTable.Columns[MColumn6.Name];
    with MColumn6 do
      begin
        Name := 'NotColumn6';
        // You cannot change the column type
        //Type_ := adInteger;
        // You cannot change the DefinedSize
        //DefinedSize := 75;
        // You cannot change the Nullable property
        //Properties['Nullable'].Value := true;
        Properties['Jet OLEDB:Allow Zero Length'].Value := true;
        // You cannot change the UNICODE compression setting
        //Properties['Jet OLEDB:Compressed UNICODE Strings'].Value := false;
      end;
  end;      procedure CreateAndAppendNewIndex;
    // Indexes can be added and deleted from an existing Index collection
  begin
    // Index MColumn6 (duplicates OK) in descending order
    MIndex6 := CoIndex.Create;
    with MIndex6 do
      begin
        Name := MColumn6.Name;
        Columns.Append(MColumn6.Name, MColumn6.Type_, MColumn6.DefinedSize);
        Columns[MColumn6.Name].SortOrder := adSortDescending;
        PrimaryKey := false;
        Unique := false;
      end;
    MTable.Indexes.Append(MIndex6, EmptyParam);
  end;      procedure CreateAndAppendNewColumn;
    // Modifying column properties is so problematic that usually you're better
    // of deleting the old column and appending a new one to a table's
    // existing Columns collection.
  begin
    MColumn7 := CoColumn.Create;
    with MColumn7 do
      begin
        ParentCatalog := Catalog;
        Name := 'Column7';
        Type_ := adDouble;
        // A bug in ADO 2.5 means that the Default property value will not be
        // accepted and no error will be given. This bug is not in 2.1 or 2.6.
        Properties['Default'].Value := 0;
      end;
    MTable.Columns.Append(MColumn7, Unassigned, Unassigned);
  end;      procedure CreateAndAppendStoredProcedure;
    // Creating a stored procedure requires an ADO Command object.
    // Furthermore, the stored procedure will not be visible in Access's Queries
    // pane, even though it's in the Procedures collection.  Microsoft's
    // software enginers clearly inhale illegal vegetable substances.
  begin
    Command1 := CoCommand.Create;
    with Command1 do
      begin
        CommandText := 'SELECT MasterTable.* FROM MasterTable;';
        // adCmdText tells ADO(X) that the CommandText property value is to be
        // treated as SQL.  Do not use adCmdStoredProc here because we're
        // trying to define a stored procedure, not execute one.
        //
        // As a side note, go out of your way to avoid using adCmdUnknown (the
        // default value), because you may experience poor performance.  This
        // is because ADO must make calls to the provider to determine if the
        // CommandText property is an SQL statement, a stored procedure, or a
        // table name. If you know what type of command you're using, setting
        // the CommandType property instructs ADO to go directly to the
        // relevant code.
        CommandType := adCmdText;
      end;
    Catalog.Procedures.Append('Query1', Command1);        // Create a stored procedure which takes a parameter.  The mechanism is
    // exactly the same.  ADOX won't help you get the SQL right.
    Command2 := CoCommand.Create;
    with Command2 do
      begin
        CommandText := 'PARAMETERS [AParam] Text('
          + IntToStr(MColumn1.DefinedSize)
          + ');'
          + 'Select MasterTable.* FROM MasterTable Where Column1 = [AParam]';
        CommandType := adCmdText;
      end;
    Catalog.Procedures.Append('Query2', Command2);
  end;    begin
  cbxDatabaseCreated.Checked := false;      CreateCatalog;
  CreateTables;
  CreateColumns;
  AppendColumnsToTables;
  AppendTablesToCatalog;      // Insert a dummy delay to allow Access 97 to resync itself before
  // refreshing the schema.  Use this if Access 97 seems to be giving problems.
  //Sleep(1000);      // Refresh the database schema
  Catalog.Tables.Refresh;      // Now that we've created the tables and columns we can add indexes and keys
  CreateIndexes;
  CreatePrimaryKeys;
  AppendIndexesToTables;
  AppendPrimaryKeysToTables;
  CreateForeignKeys;
  AppendForeignKeysToTables;      // Open the database as if it were pre-existing.
  CloseAndReopenDatabase;      ChangeSomeColumnProperties;
  CreateAndAppendNewIndex;
  CreateAndAppendNewColumn;
  CreateAndAppendStoredProcedure;      cbxDatabaseCreated.Checked := true;
end;    end.