examples/dbInfo/Unit1.pas

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  IB, IBDatabase, IBDatabaseInfo, IBQuery, IBExternals;

type

  { TForm1 }

  TForm1 = class(TForm)
    IBDatabase1: TIBDatabase;
    IBDatabaseInfo1: TIBDatabaseInfo;
    IBTransaction1: TIBTransaction;
    Memo1: TMemo;
    TableNameLookup: TIBQuery;
    procedure FormShow(Sender: TObject);
    procedure IBDatabase1AfterConnect(Sender: TObject);
  private
    procedure AddPerfStats(Heading: string; stats: TStrings);
    { 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
  IBTransaction1.Active := true;
  TableNameLookup.Active := true;
  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));
    AddPerfStats('Backout Count',BackoutCount);
    AddPerfStats('Delete Count',DeleteCount);
    AddPerfStats('Expunge Count',ExpungeCount);
    AddPerfStats('Insert Count',InsertCount);
    AddPerfStats('Purge Count',PurgeCount);
    AddPerfStats('Read Idx Count',ReadIdxCount);
    AddPerfStats('Read Seq Count',ReadSeqCount);
    AddPerfStats('Update Count',UpdateCount);
    Memo1.Lines.Add('');
    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;

procedure TForm1.AddPerfStats(Heading: string;
  stats: TStrings);
var i: integer;
begin
  with Memo1.Lines do
  begin
    if stats.count = 0 then exit;
    Add('');
    Add(Heading);
    for i := 0 to stats.Count - 1 do
    begin
      if TableNameLookup.Locate('RDB$RELATION_ID',stats.Names[i],[]) then
        Add('  ' + TableNameLookup.FieldByName('RDB$RELATION_NAME').AsString + ' = ' + stats.ValueFromIndex[i]);
    end;
  end;
end;


end.

Revision:	82
Committed:	Mon Jan 1 11:31:13 2018 UTC (6 years, 10 months ago) by tony
Content type:	text/x-pascal
File size:	4067 byte(s)
Log Message:	Add table name info to database info example
#	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