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 6

Chapter 13 - Project DbError

Project Structure

DbError.dpr
program DbError;

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

{$R *.RES}

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

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Grids, DBGrids, DB, DBTables, StdCtrls, AppEvnts;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Label1: TLabel;
    Table1: TTable;
    DataSource1: TDataSource;
    DBGrid1: TDBGrid;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Query1: TQuery;
    ApplicationEvents1: TApplicationEvents;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Table1DeleteError(DataSet: TDataSet; E: EDatabaseError;
      var Action: TDataAction);
    procedure Table1EditError(DataSet: TDataSet; E: EDatabaseError;
      var Action: TDataAction);
    procedure Table1PostError(DataSet: TDataSet; E: EDatabaseError;
      var Action: TDataAction);
    procedure ApplicationEvents1Exception(Sender: TObject; E: Exception);
  private
    { Private declarations }
  public
    procedure ShowError (E: EDBEngineError);
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.ShowError(E: EDBEngineError);
var
  I: Integer;
begin
  Memo1.Lines.Add('');
  Memo1.Lines.Add('Error: ' + (E.Message));
  Memo1.Lines.Add('Number of errors: ' +
    IntToStr(E.ErrorCount));
  // iterate through the Errors
  for I := 0 to E.ErrorCount - 1 do
  begin
    Memo1.Lines.Add('Message: ' +
      E.Errors[I].Message);
    Memo1.Lines.Add('   Category: ' +
      IntToStr(E.Errors[I].Category));
     Memo1.Lines.Add('   Error Code: ' +
      IntToStr(E.Errors[I].ErrorCode));
    Memo1.Lines.Add('   SubCode: ' +
      IntToStr(E.Errors[I].SubCode));
    Memo1.Lines.Add('   Native Error: ' +
      IntToStr(E.Errors[I].NativeError));
    Memo1.Lines.Add('');
  end;
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
  Table1.FieldByName ('Name').Value := 'something';
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  S: String;
begin
  s := Table1.FieldByName ('Name').Value;
  Table1.Insert;
  Table1.FieldByName ('Name').Value := s;
  Table1.Post;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  Query1.SQL.Clear;
  Query1.SQL.Add (
    'select * from Countries where Population > 100000');
  Query1.Open;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  Query1.SQL.Clear;
  Query1.SQL.Add (
    'select * from Country where Populations > 100000');
  Query1.Open;
end;

procedure TForm1.Table1DeleteError(DataSet: TDataSet; E: EDatabaseError;
  var Action: TDataAction);
begin
  Memo1.Lines.Add (' -> Delete Error: ' + E.Message);
end;

procedure TForm1.Table1EditError(DataSet: TDataSet; E: EDatabaseError;
  var Action: TDataAction);
begin
  Memo1.Lines.Add (' -> Edit Error: ' + E.Message);
end;

procedure TForm1.Table1PostError(DataSet: TDataSet; E: EDatabaseError;
  var Action: TDataAction);
begin
  Memo1.Lines.Add (' -> Post Error: ' + E.Message);
end;

procedure TForm1.ApplicationEvents1Exception(Sender: TObject;
  E: Exception);
begin
  Beep;
  if E is EDBEngineError then
    ShowError (EDBEngineError (E))
  else
    ShowMessage (E.Message);
end;

end.
DBErrFo.dfm
object Form1: TForm1
  Left = 206
  Top = 111
  Width = 435
  Height = 447
  Caption = 'Database Errors'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = True
  PixelsPerInch = 96
  TextHeight = 13
  object Label1: TLabel
    Left = 112
    Top = 152
    Width = 27
    Height = 13
    Caption = 'Errors'
  end
  object Memo1: TMemo
    Left = 112
    Top = 168
    Width = 313
    Height = 233
    ScrollBars = ssVertical
    TabOrder = 0
  end
  object DBGrid1: TDBGrid
    Left = 5
    Top = 5
    Width = 417
    Height = 137
    DataSource = DataSource1
    TabOrder = 1
    TitleFont.Charset = DEFAULT_CHARSET
    TitleFont.Color = clWindowText
    TitleFont.Height = -11
    TitleFont.Name = 'MS Sans Serif'
    TitleFont.Style = []
  end
  object Button1: TButton
    Left = 8
    Top = 168
    Width = 97
    Height = 25
    Caption = 'Change data'
    TabOrder = 2
    OnClick = Button1Click
  end
  object Button2: TButton
    Left = 8
    Top = 200
    Width = 97
    Height = 25
    Caption = 'Duplicate record'
    TabOrder = 3
    OnClick = Button2Click
  end
  object Button3: TButton
    Left = 8
    Top = 232
    Width = 97
    Height = 25
    Caption = 'SQL Error 1'
    TabOrder = 4
    OnClick = Button3Click
  end
  object Button4: TButton
    Left = 8
    Top = 264
    Width = 97
    Height = 25
    Caption = 'SQL Error 2'
    TabOrder = 5
    OnClick = Button4Click
  end
  object Table1: TTable
    Active = True
    OnDeleteError = Table1DeleteError
    OnEditError = Table1EditError
    OnPostError = Table1PostError
    DatabaseName = 'DBDEMOS'
    TableName = 'COUNTRY.DB'
    Left = 16
    Top = 8
  end
  object DataSource1: TDataSource
    DataSet = Table1
    Left = 16
    Top = 56
  end
  object Query1: TQuery
    OnDeleteError = Table1DeleteError
    OnEditError = Table1EditError
    OnPostError = Table1PostError
    DatabaseName = 'DBDEMOS'
    Left = 16
    Top = 104
  end
  object ApplicationEvents1: TApplicationEvents
    OnException = ApplicationEvents1Exception
    Left = 72
    Top = 16
  end
end