Marco's Web Center

Menu for Development

Site Menu
Object Pascal Handbook
Delphi Handbooks Collection
Mastering Borland Delphi 2005
(Old) White Papers
(Old)Tools
(Old) Conferences

My Other Sites
Italian Site (www.marcocantu.it)
the delphi search

Spirit of delphi

Advertising
Home My Blog Books Object Pascal Marco

Home: Code Repository: Mastering Delphi 5

Project UPDSQL2

Project Structure


UPDSQL2.DPR

program UpdSql2;

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

{$R *.RES}

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

UPDATEFORM.PAS

unit UpdateForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  IBDatabase, Db, IBCustomDataSet, IBUpdateSQL, IBQuery, DBTables,
  ExtCtrls, DBCtrls, Grids, DBGrids, DBActns, ActnList, ComCtrls, ToolWin;

type
  TForm1 = class(TForm)
    EmpDS: TDataSource;
    IBQuery1: TIBQuery;
    IBUpdateSQL1: TIBUpdateSQL;
    IBDatabase1: TIBDatabase;
    IBTransaction1: TIBTransaction;
    DBGrid1: TDBGrid;
    IBDataSet1: TIBDataSet;
    ActionList1: TActionList;
    DataSetCancel1: TDataSetCancel;
    DataSetDelete1: TDataSetDelete;
    DataSetEdit1: TDataSetEdit;
    DataSetFirst1: TDataSetFirst;
    DataSetInsert1: TDataSetInsert;
    DataSetLast1: TDataSetLast;
    DataSetNext1: TDataSetNext;
    DataSetPost1: TDataSetPost;
    DataSetPrior1: TDataSetPrior;
    DataSetRefresh1: TDataSetRefresh;
    acCommit: TAction;
    acRollback: TAction;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    ToolButton6: TToolButton;
    ToolButton7: TToolButton;
    ToolButton8: TToolButton;
    ToolButton10: TToolButton;
    ToolButton11: TToolButton;
    ToolButton12: TToolButton;
    ToolButton9: TToolButton;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ActionUpdateTransactions(Sender: TObject);
    procedure acCommitExecute(Sender: TObject);
    procedure acRollbackExecute(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

uses
  Registry;

procedure TForm1.FormCreate(Sender: TObject);
var
  Reg: TRegistry;
begin
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    Reg.OpenKey(
      '\Software\Borland\Borland Shared\Data', False);
    IBDatabase1.DatabaseName :=
      Reg.ReadString('Rootdir') + '\employee.gdb';
  finally
    Reg.CloseKey;
    Reg.Free;
  end;
  EmpDS.DataSet.Open;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
  nCode: Integer;
begin
  if IBTransaction1.InTransaction then
  begin
    nCode := MessageDlg ('Commit Transaction? (No to rollback)',
      mtConfirmation, mbYesNoCancel, 0);
    case nCode of
      mrYes: IBTransaction1.Commit;
      mrNo: IBTransaction1.Rollback;
      mrCancel: Action := caNone; // don't close
    end;
  end;
end;

procedure TForm1.ActionUpdateTransactions(Sender: TObject);
begin
  acCommit.Enabled := IBTransaction1.InTransaction;
  acRollback.Enabled := acCommit.Enabled;
end;

procedure TForm1.acCommitExecute(Sender: TObject);
begin
  IBTransaction1.CommitRetaining;
end;

procedure TForm1.acRollbackExecute(Sender: TObject);
begin
  IBTransaction1.Rollback;
  IBTransaction1.StartTransaction;
  EmpDS.DataSet.Open;
end;

end.

UPDATEFORM.DFM

object Form1: TForm1
  Left = 108
  Top = 117
  Width = 734
  Height = 480
  Caption = 'UpdSql2'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  OnClose = FormClose
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object DBGrid1: TDBGrid
    Left = 0
    Top = 25
    Width = 726
    Height = 428
    Align = alClient
    DataSource = EmpDS
    TabOrder = 0
    TitleFont.Charset = DEFAULT_CHARSET
    TitleFont.Color = clWindowText
    TitleFont.Height = -11
    TitleFont.Name = 'MS Sans Serif'
    TitleFont.Style = []
  end
  object ToolBar1: TToolBar
    Left = 0
    Top = 0
    Width = 726
    Height = 25
    ButtonHeight = 21
    ButtonWidth = 55
    Caption = 'ToolBar1'
    ShowCaptions = True
    TabOrder = 1
    object ToolButton1: TToolButton
      Left = 0
      Top = 2
      Action = DataSetFirst1
    end
    object ToolButton2: TToolButton
      Left = 55
      Top = 2
      Action = DataSetPrior1
    end
    object ToolButton3: TToolButton
      Left = 110
      Top = 2
      Action = DataSetNext1
    end
    object ToolButton4: TToolButton
      Left = 165
      Top = 2
      Action = DataSetLast1
    end
    object ToolButton7: TToolButton
      Left = 220
      Top = 2
      Action = DataSetInsert1
    end
    object ToolButton8: TToolButton
      Left = 275
      Top = 2
      Action = DataSetDelete1
    end
    object ToolButton5: TToolButton
      Left = 330
      Top = 2
      Action = DataSetEdit1
    end
    object ToolButton6: TToolButton
      Left = 385
      Top = 2
      Action = DataSetPost1
    end
    object ToolButton10: TToolButton
      Left = 440
      Top = 2
      Action = DataSetCancel1
    end
    object ToolButton9: TToolButton
      Left = 495
      Top = 2
      Action = DataSetRefresh1
    end
    object ToolButton11: TToolButton
      Left = 550
      Top = 2
      Action = acCommit
    end
    object ToolButton12: TToolButton
      Left = 605
      Top = 2
      Action = acRollback
    end
  end
  object IBQuery1: TIBQuery
    Database = IBDatabase1
    Transaction = IBTransaction1
    CachedUpdates = True
    SQL.Strings = (

              'SELECT Employee.EMP_NO, Employee.FIRST_NAME, Employee.LAST_NAME,' +
        ' Department.DEPARTMENT, Job.JOB_TITLE, Employee.SALARY, Employee' +
        '.DEPT_NO, Employee.JOB_CODE, Employee.JOB_GRADE, Employee.JOB_CO' +
        'UNTRY'
      'FROM EMPLOYEE Employee'
      '   INNER JOIN DEPARTMENT Department'
      '   ON  (Department.DEPT_NO = Employee.DEPT_NO)  '
      '   INNER JOIN JOB Job'
      '   ON  (Job.JOB_CODE = Employee.JOB_CODE)  '
      '   AND  (Job.JOB_GRADE = Employee.JOB_GRADE)  '
      '   AND  (Job.JOB_COUNTRY = Employee.JOB_COUNTRY)  '
      'ORDER BY Department.DEPARTMENT')
    UpdateObject = IBUpdateSQL1
    Left = 116
    Top = 136
  end
  object IBUpdateSQL1: TIBUpdateSQL
    RefreshSQL.Strings = (
      'SELECT Employee.EMP_NO, Employee.FIRST_NAME, Employee.LAST_NAME,'

              'Department.DEPARTMENT, Job.JOB_TITLE, Employee.SALARY, Employee.' +
        'DEPT_NO,'
      'Employee.JOB_CODE, Employee.JOB_GRADE, Employee.JOB_COUNTRY'
      'FROM EMPLOYEE Employee'
      'INNER JOIN DEPARTMENT Department'
      'ON (Department.DEPT_NO = Employee.DEPT_NO)'
      'INNER JOIN JOB Job'
      'ON (Job.JOB_CODE = Employee.JOB_CODE)'
      'AND (Job.JOB_GRADE = Employee.JOB_GRADE)'
      'AND (Job.JOB_COUNTRY = Employee.JOB_COUNTRY)'
      'WHERE Employee.EMP_NO=:EMP_NO'
      ''
      ''
      ''
      '')
    ModifySQL.Strings = (
      'update EMPLOYEE'
      'set'
      '  FIRST_NAME = :FIRST_NAME,'
      '  LAST_NAME = :LAST_NAME,'
      '  SALARY = :SALARY,'
      '  DEPT_NO = :DEPT_NO,'
      '  JOB_CODE = :JOB_CODE,'
      '  JOB_GRADE = :JOB_GRADE,'
      '  JOB_COUNTRY = :JOB_COUNTRY'
      'where'
      '  EMP_NO = :OLD_EMP_NO')
    InsertSQL.Strings = (
      'insert into EMPLOYEE'
      '  (FIRST_NAME, LAST_NAME, SALARY, DEPT_NO, JOB_CODE, JOB_GRADE, '
      'JOB_COUNTRY)'
      'values'

              '  (:FIRST_NAME, :LAST_NAME, :SALARY, :DEPT_NO, :JOB_CODE, :JOB_G' +
        'RADE, '
      ':JOB_COUNTRY)')
    DeleteSQL.Strings = (
      'delete from EMPLOYEE'
      'where'
      '  EMP_NO = :OLD_EMP_NO')
    Left = 120
    Top = 192
  end
  object EmpDS: TDataSource
    DataSet = IBDataSet1
    Left = 188
    Top = 176
  end
  object IBDatabase1: TIBDatabase
    Params.Strings = (
      'user_name=SYSDBA'
      'password=masterkey')
    LoginPrompt = False
    IdleTimer = 0
    SQLDialect = 1
    TraceFlags = [tfQPrepare, tfQExecute, tfQFetch, tfError, tfStmt, tfConnect, tfTransact, tfBlob, tfService, tfMisc]
    Left = 40
    Top = 192
  end
  object IBTransaction1: TIBTransaction
    Active = False
    DefaultDatabase = IBDatabase1
    Left = 40
    Top = 112
  end
  object IBDataSet1: TIBDataSet
    Database = IBDatabase1
    Transaction = IBTransaction1
    BufferChunks = 32
    CachedUpdates = False
    DeleteSQL.Strings = (
      'delete from EMPLOYEE'
      'where'
      '  EMP_NO = :OLD_EMP_NO')
    InsertSQL.Strings = (
      'insert into EMPLOYEE'
      '  (FIRST_NAME, LAST_NAME, SALARY, DEPT_NO, JOB_CODE, JOB_GRADE, '
      'JOB_COUNTRY)'
      'values'

              '  (:FIRST_NAME, :LAST_NAME, :SALARY, :DEPT_NO, :JOB_CODE, :JOB_G' +
        'RADE, '
      ':JOB_COUNTRY)')
    RefreshSQL.Strings = (
      'SELECT Employee.EMP_NO, Employee.FIRST_NAME, Employee.LAST_NAME,'

              'Department.DEPARTMENT, Job.JOB_TITLE, Employee.SALARY, Employee.' +
        'DEPT_NO,'
      'Employee.JOB_CODE, Employee.JOB_GRADE, Employee.JOB_COUNTRY'
      'FROM EMPLOYEE Employee'
      'INNER JOIN DEPARTMENT Department'
      'ON (Department.DEPT_NO = Employee.DEPT_NO)'
      'INNER JOIN JOB Job'
      'ON (Job.JOB_CODE = Employee.JOB_CODE)'
      'AND (Job.JOB_GRADE = Employee.JOB_GRADE)'
      'AND (Job.JOB_COUNTRY = Employee.JOB_COUNTRY)'
      'WHERE Employee.EMP_NO=:EMP_NO')
    SelectSQL.Strings = (

              'SELECT Employee.EMP_NO, Employee.FIRST_NAME, Employee.LAST_NAME,' +
        ' Department.DEPARTMENT, Job.JOB_TITLE, Employee.SALARY, Employee' +
        '.DEPT_NO, Employee.JOB_CODE, Employee.JOB_GRADE, Employee.JOB_CO' +
        'UNTRY'
      'FROM EMPLOYEE Employee'
      '   INNER JOIN DEPARTMENT Department'
      '   ON  (Department.DEPT_NO = Employee.DEPT_NO)  '
      '   INNER JOIN JOB Job'
      '   ON  (Job.JOB_CODE = Employee.JOB_CODE)  '
      '   AND  (Job.JOB_GRADE = Employee.JOB_GRADE)  '
      '   AND  (Job.JOB_COUNTRY = Employee.JOB_COUNTRY)  '
      'ORDER BY Department.DEPARTMENT')
    UpdateRecordTypes = [cusUnmodified, cusModified, cusInserted]
    ModifySQL.Strings = (
      'update EMPLOYEE'
      'set'
      '  FIRST_NAME = :FIRST_NAME,'
      '  LAST_NAME = :LAST_NAME,'
      '  SALARY = :SALARY,'
      '  DEPT_NO = :DEPT_NO,'
      '  JOB_CODE = :JOB_CODE,'
      '  JOB_GRADE = :JOB_GRADE,'
      '  JOB_COUNTRY = :JOB_COUNTRY'
      'where'
      '  EMP_NO = :OLD_EMP_NO')
    Left = 120
    Top = 256
  end
  object ActionList1: TActionList
    Left = 192
    Top = 256
    object DataSetCancel1: TDataSetCancel
      Category = 'Dataset'
      Caption = '&Cancel'
      Hint = 'Cancel'
      ImageIndex = 8
    end
    object DataSetDelete1: TDataSetDelete
      Category = 'Dataset'
      Caption = '&Delete'
      Hint = 'Delete'
      ImageIndex = 5
    end
    object DataSetEdit1: TDataSetEdit
      Category = 'Dataset'
      Caption = '&Edit'
      Hint = 'Edit'
      ImageIndex = 6
    end
    object DataSetFirst1: TDataSetFirst
      Category = 'Dataset'
      Caption = '&First'
      Hint = 'First'
      ImageIndex = 0
    end
    object DataSetInsert1: TDataSetInsert
      Category = 'Dataset'
      Caption = '&Insert'
      Hint = 'Insert'
      ImageIndex = 4
    end
    object DataSetLast1: TDataSetLast
      Category = 'Dataset'
      Caption = '&Last'
      Hint = 'Last'
      ImageIndex = 3
    end
    object DataSetNext1: TDataSetNext
      Category = 'Dataset'
      Caption = '&Next'
      Hint = 'Next'
      ImageIndex = 2
    end
    object DataSetPost1: TDataSetPost
      Category = 'Dataset'
      Caption = 'P&ost'
      Hint = 'Post'
      ImageIndex = 7
    end
    object DataSetPrior1: TDataSetPrior
      Category = 'Dataset'
      Caption = '&Prior'
      Hint = 'Prior'
      ImageIndex = 1
    end
    object DataSetRefresh1: TDataSetRefresh
      Category = 'Dataset'
      Caption = '&Refresh'
      Hint = 'Refresh'
      ImageIndex = 9
    end
    object acCommit: TAction
      Category = 'Transactions'
      Caption = '&Commit'
      OnExecute = acCommitExecute
      OnUpdate = ActionUpdateTransactions
    end
    object acRollback: TAction
      Category = 'Transactions'
      Caption = '&Rollback'
      OnExecute = acRollbackExecute
      OnUpdate = ActionUpdateTransactions
    end
  end
end