examples/dbInfo/Unit1.pas

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  IB, IBDatabase, IBDatabaseInfo, IBExternals;

type

  { TForm1 }

  TForm1 = class(TForm)
    IBDatabase1: TIBDatabase;
    IBDatabaseInfo1: TIBDatabaseInfo;
    Memo1: TMemo;
    procedure FormShow(Sender: TObject);
    procedure IBDatabase1AfterConnect(Sender: TObject);
  private
    { private declarations }
    procedure ShowBoolValue(aValue: Long; WhenTrue, WhenFalse: string);
    procedure ShowStrings(aCaption: string; List: TStrings);
  public
    { public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.FormShow(Sender: TObject);
begin
  Memo1.Lines.Clear;
  repeat
    try
      IBDatabase1.Connected := true;
    except
     on E:EIBClientError do
      begin
        Close;
        Exit
      end;
    On E:Exception do
     MessageDlg(E.Message,mtError,[mbOK],0);
    end;
  until IBDatabase1.Connected;
end;

procedure TForm1.IBDatabase1AfterConnect(Sender: TObject);
begin
  with IBDatabaseInfo1 do
  begin
    Memo1.Lines.Add('Allocation = ' + IntToStr(Allocation));
    Memo1.Lines.Add('Base Level = ' + IntToStr(BaseLevel));
    Memo1.Lines.Add('DB File Name = ' + DBFileName);
    Memo1.Lines.Add('DB Site Name = ' + DBSiteName);
    Memo1.Lines.Add('DB Implementation No = ' + IntToStr(DBImplementationNo));
    Memo1.Lines.Add('DB Implementation Class = ' + IntToStr(DBImplementationClass));
    ShowBoolValue(NoReserve, 'No Space Reserved','Space is Reserved');
    Memo1.Lines.Add('ODS Minor Version = ' + IntToStr(ODSMinorVersion));
    Memo1.Lines.Add('ODS Major Version = ' + IntToStr(ODSMajorVersion));
    Memo1.Lines.Add('Page Size = ' + IntToStr(PageSize));
    Memo1.Lines.Add('Version = ' + Version);
    Memo1.Lines.Add('Current Memory = ' + IntToStr(CurrentMemory));
    ShowBoolValue(ForcedWrites,'Forced Writes Enabled','Forced Writes Disabled');
    Memo1.Lines.Add('Max Memory = ' + IntToStr(MaxMemory));
    Memo1.Lines.Add('Number of Buffers = ' + IntToStr(NumBuffers));
    Memo1.Lines.Add('Sweep Interval = ' + IntToStr(SweepInterval));
    ShowStrings('User Names',UserNames);
    Memo1.Lines.Add('Fetches = ' + IntToStr(Fetches));
    Memo1.Lines.Add('Marks = ' + IntToStr(Marks));
    Memo1.Lines.Add('Reads = ' + IntToStr(Reads));
    Memo1.Lines.Add('Writes = ' + IntToStr(Writes));
    ShowStrings('Backout Count',BackoutCount);
    ShowStrings('Delete Count',DeleteCount);
    ShowStrings('Expunge Count',ExpungeCount);
    ShowStrings('Insert Count',InsertCount);
    ShowStrings('Purge Count',PurgeCount);
    ShowStrings('Read Idx Count',ReadIdxCount);
    ShowStrings('Read Seq Count',ReadSeqCount);
    ShowStrings('Update Count',UpdateCount);
    Memo1.Lines.Add('DB SQLDialect = ' + IntToStr(DBSQLDialect));
    ShowBoolValue(ReadOnly,'Database is Read Only','Database is Read/Write');
  end;
end;

procedure TForm1.ShowBoolValue(aValue: Long; WhenTrue, WhenFalse: string);
begin
  if aValue <> 0 then
    Memo1.Lines.Add(WhenTrue)
  else
    Memo1.Lines.Add(WhenFalse);
end;

procedure TForm1.ShowStrings(aCaption: string; List: TStrings);
var s: string;
    i: integer;
begin
  s := aCaption + ': ';
  for i := 0 to List.Count - 1 do
  begin
    if i > 0 then
      s := s + ', ';
    s := s + List[i];
  end;
  Memo1.Lines.Add(s);
end;

end.

Revision:	62
Committed:	Wed Apr 12 09:19:59 2017 UTC (7 years, 7 months ago) by tony
Content type:	text/x-pascal
File size:	3388 byte(s)
Log Message:	Avoid "Object is nil" error when opening a database with DefaultSystemCodePage = true
#	User	Rev	Content
1	tony	62	unit Unit1;
2
3			{$mode objfpc}{$H+}
4
5			interface
6
7			uses
8			Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
9			IB, IBDatabase, IBDatabaseInfo, IBExternals;
10
11			type
12
13			{ TForm1 }
14
15			TForm1 = class(TForm)
16			IBDatabase1: TIBDatabase;
17			IBDatabaseInfo1: TIBDatabaseInfo;
18			Memo1: TMemo;
19			procedure FormShow(Sender: TObject);
20			procedure IBDatabase1AfterConnect(Sender: TObject);
21			private
22			{ private declarations }
23			procedure ShowBoolValue(aValue: Long; WhenTrue, WhenFalse: string);
24			procedure ShowStrings(aCaption: string; List: TStrings);
25			public
26			{ public declarations }
27			end;
28
29			var
30			Form1: TForm1;
31
32			implementation
33
34			{$R *.lfm}
35
36			{ TForm1 }
37
38			procedure TForm1.FormShow(Sender: TObject);
39			begin
40			Memo1.Lines.Clear;
41			repeat
42			try
43			IBDatabase1.Connected := true;
44			except
45			on E:EIBClientError do
46			begin
47			Close;
48			Exit
49			end;
50			On E:Exception do
51			MessageDlg(E.Message,mtError,[mbOK],0);
52			end;
53			until IBDatabase1.Connected;
54			end;
55
56			procedure TForm1.IBDatabase1AfterConnect(Sender: TObject);
57			begin
58			with IBDatabaseInfo1 do
59			begin
60			Memo1.Lines.Add('Allocation = ' + IntToStr(Allocation));
61			Memo1.Lines.Add('Base Level = ' + IntToStr(BaseLevel));
62			Memo1.Lines.Add('DB File Name = ' + DBFileName);
63			Memo1.Lines.Add('DB Site Name = ' + DBSiteName);
64			Memo1.Lines.Add('DB Implementation No = ' + IntToStr(DBImplementationNo));
65			Memo1.Lines.Add('DB Implementation Class = ' + IntToStr(DBImplementationClass));
66			ShowBoolValue(NoReserve, 'No Space Reserved','Space is Reserved');
67			Memo1.Lines.Add('ODS Minor Version = ' + IntToStr(ODSMinorVersion));
68			Memo1.Lines.Add('ODS Major Version = ' + IntToStr(ODSMajorVersion));
69			Memo1.Lines.Add('Page Size = ' + IntToStr(PageSize));
70			Memo1.Lines.Add('Version = ' + Version);
71			Memo1.Lines.Add('Current Memory = ' + IntToStr(CurrentMemory));
72			ShowBoolValue(ForcedWrites,'Forced Writes Enabled','Forced Writes Disabled');
73			Memo1.Lines.Add('Max Memory = ' + IntToStr(MaxMemory));
74			Memo1.Lines.Add('Number of Buffers = ' + IntToStr(NumBuffers));
75			Memo1.Lines.Add('Sweep Interval = ' + IntToStr(SweepInterval));
76			ShowStrings('User Names',UserNames);
77			Memo1.Lines.Add('Fetches = ' + IntToStr(Fetches));
78			Memo1.Lines.Add('Marks = ' + IntToStr(Marks));
79			Memo1.Lines.Add('Reads = ' + IntToStr(Reads));
80			Memo1.Lines.Add('Writes = ' + IntToStr(Writes));
81			ShowStrings('Backout Count',BackoutCount);
82			ShowStrings('Delete Count',DeleteCount);
83			ShowStrings('Expunge Count',ExpungeCount);
84			ShowStrings('Insert Count',InsertCount);
85			ShowStrings('Purge Count',PurgeCount);
86			ShowStrings('Read Idx Count',ReadIdxCount);
87			ShowStrings('Read Seq Count',ReadSeqCount);
88			ShowStrings('Update Count',UpdateCount);
89			Memo1.Lines.Add('DB SQLDialect = ' + IntToStr(DBSQLDialect));
90			ShowBoolValue(ReadOnly,'Database is Read Only','Database is Read/Write');
91			end;
92			end;
93
94			procedure TForm1.ShowBoolValue(aValue: Long; WhenTrue, WhenFalse: string);
95			begin
96			if aValue <> 0 then
97			Memo1.Lines.Add(WhenTrue)
98			else
99			Memo1.Lines.Add(WhenFalse);
100			end;
101
102			procedure TForm1.ShowStrings(aCaption: string; List: TStrings);
103			var s: string;
104			i: integer;
105			begin
106			s := aCaption + ': ';
107			for i := 0 to List.Count - 1 do
108			begin
109			if i > 0 then
110			s := s + ', ';
111			s := s + List[i];
112			end;
113			Memo1.Lines.Add(s);
114			end;
115
116			end.
117