ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/examples/dbInfo/Unit1.pas
Revision: 62
Committed: Wed Apr 12 09:19:59 2017 UTC (6 years, 11 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

File Contents

# 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