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
#	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