ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/examples/dbInfo/Unit1.pas
Revision: 82
Committed: Mon Jan 1 11:31:13 2018 UTC (6 years, 2 months ago) by tony
Content type: text/x-pascal
File size: 4067 byte(s)
Log Message:
Add table name info to database info example

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 tony 82 IB, IBDatabase, IBDatabaseInfo, IBQuery, IBExternals;
10 tony 62
11     type
12    
13     { TForm1 }
14    
15     TForm1 = class(TForm)
16     IBDatabase1: TIBDatabase;
17     IBDatabaseInfo1: TIBDatabaseInfo;
18 tony 82 IBTransaction1: TIBTransaction;
19 tony 62 Memo1: TMemo;
20 tony 82 TableNameLookup: TIBQuery;
21 tony 62 procedure FormShow(Sender: TObject);
22     procedure IBDatabase1AfterConnect(Sender: TObject);
23     private
24 tony 82 procedure AddPerfStats(Heading: string; stats: TStrings);
25 tony 62 { private declarations }
26     procedure ShowBoolValue(aValue: Long; WhenTrue, WhenFalse: string);
27     procedure ShowStrings(aCaption: string; List: TStrings);
28     public
29     { public declarations }
30     end;
31    
32     var
33     Form1: TForm1;
34    
35     implementation
36    
37     {$R *.lfm}
38    
39     { TForm1 }
40    
41     procedure TForm1.FormShow(Sender: TObject);
42     begin
43     Memo1.Lines.Clear;
44     repeat
45     try
46     IBDatabase1.Connected := true;
47     except
48     on E:EIBClientError do
49     begin
50     Close;
51     Exit
52     end;
53     On E:Exception do
54     MessageDlg(E.Message,mtError,[mbOK],0);
55     end;
56     until IBDatabase1.Connected;
57     end;
58    
59     procedure TForm1.IBDatabase1AfterConnect(Sender: TObject);
60     begin
61 tony 82 IBTransaction1.Active := true;
62     TableNameLookup.Active := true;
63 tony 62 with IBDatabaseInfo1 do
64     begin
65     Memo1.Lines.Add('Allocation = ' + IntToStr(Allocation));
66     Memo1.Lines.Add('Base Level = ' + IntToStr(BaseLevel));
67     Memo1.Lines.Add('DB File Name = ' + DBFileName);
68     Memo1.Lines.Add('DB Site Name = ' + DBSiteName);
69     Memo1.Lines.Add('DB Implementation No = ' + IntToStr(DBImplementationNo));
70     Memo1.Lines.Add('DB Implementation Class = ' + IntToStr(DBImplementationClass));
71     ShowBoolValue(NoReserve, 'No Space Reserved','Space is Reserved');
72     Memo1.Lines.Add('ODS Minor Version = ' + IntToStr(ODSMinorVersion));
73     Memo1.Lines.Add('ODS Major Version = ' + IntToStr(ODSMajorVersion));
74     Memo1.Lines.Add('Page Size = ' + IntToStr(PageSize));
75     Memo1.Lines.Add('Version = ' + Version);
76     Memo1.Lines.Add('Current Memory = ' + IntToStr(CurrentMemory));
77     ShowBoolValue(ForcedWrites,'Forced Writes Enabled','Forced Writes Disabled');
78     Memo1.Lines.Add('Max Memory = ' + IntToStr(MaxMemory));
79     Memo1.Lines.Add('Number of Buffers = ' + IntToStr(NumBuffers));
80     Memo1.Lines.Add('Sweep Interval = ' + IntToStr(SweepInterval));
81     ShowStrings('User Names',UserNames);
82     Memo1.Lines.Add('Fetches = ' + IntToStr(Fetches));
83     Memo1.Lines.Add('Marks = ' + IntToStr(Marks));
84     Memo1.Lines.Add('Reads = ' + IntToStr(Reads));
85     Memo1.Lines.Add('Writes = ' + IntToStr(Writes));
86 tony 82 AddPerfStats('Backout Count',BackoutCount);
87     AddPerfStats('Delete Count',DeleteCount);
88     AddPerfStats('Expunge Count',ExpungeCount);
89     AddPerfStats('Insert Count',InsertCount);
90     AddPerfStats('Purge Count',PurgeCount);
91     AddPerfStats('Read Idx Count',ReadIdxCount);
92     AddPerfStats('Read Seq Count',ReadSeqCount);
93     AddPerfStats('Update Count',UpdateCount);
94     Memo1.Lines.Add('');
95 tony 62 Memo1.Lines.Add('DB SQLDialect = ' + IntToStr(DBSQLDialect));
96     ShowBoolValue(ReadOnly,'Database is Read Only','Database is Read/Write');
97     end;
98     end;
99    
100     procedure TForm1.ShowBoolValue(aValue: Long; WhenTrue, WhenFalse: string);
101     begin
102     if aValue <> 0 then
103     Memo1.Lines.Add(WhenTrue)
104     else
105     Memo1.Lines.Add(WhenFalse);
106     end;
107    
108     procedure TForm1.ShowStrings(aCaption: string; List: TStrings);
109     var s: string;
110     i: integer;
111     begin
112     s := aCaption + ': ';
113     for i := 0 to List.Count - 1 do
114     begin
115     if i > 0 then
116     s := s + ', ';
117     s := s + List[i];
118     end;
119     Memo1.Lines.Add(s);
120     end;
121    
122 tony 82 procedure TForm1.AddPerfStats(Heading: string;
123     stats: TStrings);
124     var i: integer;
125     begin
126     with Memo1.Lines do
127     begin
128     if stats.count = 0 then exit;
129     Add('');
130     Add(Heading);
131     for i := 0 to stats.Count - 1 do
132     begin
133     if TableNameLookup.Locate('RDB$RELATION_ID',stats.Names[i],[]) then
134     Add(' ' + TableNameLookup.FieldByName('RDB$RELATION_NAME').AsString + ' = ' + stats.ValueFromIndex[i]);
135     end;
136     end;
137     end;
138    
139    
140 tony 62 end.
141