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
#	Content
1	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