Home: Code Repository: Mastering Delphi 5

Project DBERROR

Project Structure

DBERROR.DPR
DBERRFO.PAS
DBERRFO.DFM

program DbError;

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

{$R *.RES}

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

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.

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