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

# 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