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

# 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, IBQuery, IBExternals;
10
11 type
12
13 { TForm1 }
14
15 TForm1 = class(TForm)
16 IBDatabase1: TIBDatabase;
17 IBDatabaseInfo1: TIBDatabaseInfo;
18 IBTransaction1: TIBTransaction;
19 Memo1: TMemo;
20 TableNameLookup: TIBQuery;
21 procedure FormShow(Sender: TObject);
22 procedure IBDatabase1AfterConnect(Sender: TObject);
23 private
24 procedure AddPerfStats(Heading: string; stats: TStrings);
25 { 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 IBTransaction1.Active := true;
62 TableNameLookup.Active := true;
63 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 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 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 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 end.
141