Logo New book: Delphi 2007 Handbook
My blog in online
Delphi tech support service: support.marcocantu.com
Google
  Web www.marcocantu.com

Menu for Development

Site Menu
Delphi 2007 Handbook
Mastering Borland Delphi 2005
Essential Pascal
Essential Delphi
Buy Books Online
Code Repository
Newsgroups
White Papers
Tools
Conferences
Training
Delphi Links
Contact Marco

My Other Sites
Italian Site (www.marcocantu.it)
Developers Newsgroups Browser (dev.newswhat.com)
My town (www.piazzacavalli.net)
the delphi search
Wintech Italia (my company)

Breaking News
Buy Mastering Borland Delphi 2005 from Amazon
Free ebook: Mastering Delphi Update for Delphi 2006

Advertising
Home My Blog Books My Bookstore Development Links Marco


Home: Code Repository: Mastering Delphi 6

Chapter 14 - Project DdlSample

Project Structure

DdlSample.dpr
program DdlSample;

uses
  Forms,
  DdlForm in 'DdlForm.pas' {Form1};

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.
DdlForm.pas
unit DdlForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, DBTables, Db;

type
  TForm1 = class(TForm)
    Query1: TQuery;
    Database1: TDatabase;
    grpCommands: TRadioGroup;
    Memo1: TMemo;
    Button1: TButton;
    Button2: TButton;
    Label1: TLabel;
    procedure grpCommandsClick(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

const
  MaxCmds = 6;
  Commands: array [0..MaxCmds - 1] of PChar = (
    'CREATE TABLE Customers ('#13'  CUST_NO INTEGER NOT NULL CONSTRAINT CUST_PK PRIMARY KEY,'#13'  FIRSTNAME VARCHAR(30) NOT NULL,'#13'  LASTNAME VARCHAR(30) NOT NULL,'#13'  ADDRESS VARCHAR(30),'#13'  PHONE_NUMBER VARCHAR(20)'#13');'            ,
    'ALTER TABLE Customers DROP CONSTRAINT CUST_PK',
    'CREATE INDEX CUST_NAME ON CUSTOMERS (NAME);',
    'CREATE VIEW FullCustNames (FullName) AS'#13'SELECT (Name || " " || Surname) FROM Customers'  ,
    'CREATE GENERATOR custno_generator;',
    'CREATE TRIGGER SET_CUST_NO FOR CUSTOMERS'#13'BEFORE INSERT POSITION 0 AS'#13'BEGIN'#13'   new.cust_no = gen_id(custno_generator, 1);'#13'END'
          );

procedure TForm1.grpCommandsClick(Sender: TObject);
begin
  Memo1.Lines.SetText(Commands[grpCommands.ItemIndex]);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  Close;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Query1.SQL.Assign(Memo1.Lines);
  try
    Query1.ExecSQL;
    ShowMessage('SQL command executed successfully.');
  except
    raise;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  grpCommandsClick(nil);
end;

end.
DdlForm.dfm
object Form1: TForm1
  Left = 198
  Top = 144
  BorderStyle = bsDialog
  Caption = 'SQL''s Data Definition Language Commands sample'
     ClientHeight = 254
  ClientWidth = 480
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  Position = poDesktopCenter
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object Label1: TLabel
    Left = 5
    Top = 2
    Width = 472
    Height = 29
    AutoSize = False
    Caption =
       'WARNING: it''s not safe to allow client applications to execute D'    +
      'DL commands! Users may seriously corrupt the database.'
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clRed
    Font.Height = -11
    Font.Name = 'MS Sans Serif'
    Font.Style = [fsBold]
    ParentFont = False
    WordWrap = True
  end
  object grpCommands: TRadioGroup
    Left = 4
    Top = 33
    Width = 157
    Height = 183
    Caption = 'DDL Command'
    ItemIndex = 0
    Items.Strings = (
      'CREATE TABLE'
      'ALTER TABLE'
      'CREATE INDEX'
      'CREATE VIEW'
      'CREATE GENERATOR'
      'CREATE TRIGGER')
    TabOrder = 0
    OnClick = grpCommandsClick
  end
  object Memo1: TMemo
    Left = 164
    Top = 38
    Width = 313
    Height = 210
    TabOrder = 1
  end
  object Button1: TButton
    Left = 4
    Top = 223
    Width = 75
    Height = 25
    Caption = '&Execute!'
    TabOrder = 2
    OnClick = Button1Click
  end
  object Button2: TButton
    Left = 84
    Top = 223
    Width = 75
    Height = 25
    Caption = '&Close'
    TabOrder = 3
    OnClick = Button2Click
  end
  object Query1: TQuery
    DatabaseName = 'AppDB'
    Left = 132
    Top = 187
  end
  object Database1: TDatabase
    AliasName = 'IBLOCAL'
    DatabaseName = 'AppDB'
    Params.Strings = (
      'USER NAME=SYSDBA'
      'PASSWORD=masterkey'
      'OPEN MODE=READ/WRITE'
      'SCHEMA CACHE SIZE=8'
      'SQLPASSTHRU MODE=SHARED AUTOCOMMIT'
      'SCHEMA CACHE TIME=-1'
      'MAX ROWS=-1'
      'BATCH COUNT=200'
      'ENABLE SCHEMA CACHE=FALSE'
      'SCHEMA CACHE DIR='
      'ENABLE BCD=FALSE'
      'BLOBS TO CACHE=64'
      'BLOB SIZE=32')
    SessionName = 'Default'
    Left = 104
    Top = 187
  end
end