trunk/testsuite/Test02.pas

unit Test02;

{$mode objfpc}{$H+}

{Test 2: Database Event Handlers and Idle disconnect}

{ This test opens and closes a database in order to test the connect/disconnect
  handlers. The database is re-opened to test disconnect on idle.

  The transaction handlers are also tested, along with Transaction end on idle.

  SQL Dialect Downgrade warning tested.
}

interface

uses
  Classes, SysUtils,   TestApplication, IBXTestBase, IB;

const
  aTestID    = '02';
  aTestTitle = 'Database Event Handlers and Idle disconnect';

type

{ TTest02 }

  TTest02 = class(TIBXTestBase)
  private
    FConnectedAt: TDateTime;
    FStartedAt: TDateTime;
    procedure HandleBeforeConnect(Sender: TObject);
    procedure HandleAfterConnect(Sender: TObject);
    procedure HandleBeforeDisconnect(Sender: TObject);
    procedure HandleAfterDisconnect(Sender: TObject);
    procedure HandleIdleTime(Sender: TObject);
    procedure HandleDialectDowngradeWarning(Sender: TObject);
    procedure HandleTransactionStart(Sender: TObject);
    procedure HandleBeforeTransactionEnd(Sender: TObject);
    procedure HandleAfterTransactionEnd(Sender: TObject);
  protected
    procedure CreateObjects(Application: TTestApplication); override;
    function GetTestID: AnsiString; override;
    function GetTestTitle: AnsiString; override;
    procedure InitTest; override;
  public
    procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
  end;


implementation

uses DateUtils, IBDatabase;

{ TTest02 }

procedure TTest02.HandleBeforeConnect(Sender: TObject);
begin
  writeln(OutFile,'Before Connect');
end;

procedure TTest02.HandleAfterConnect(Sender: TObject);
begin
  FConnectedAt := Now;
  writeln(OutFile,'Connected to ' + (Sender as TIBDatabase).DatabaseName);
  PrintDPB((Sender as TIBDatabase).attachment.getDPB);
end;

procedure TTest02.HandleBeforeDisconnect(Sender: TObject);
begin
  writeln(OutFile,'Before Disconnect');
end;

procedure TTest02.HandleAfterDisconnect(Sender: TObject);
begin
  writeln(OutFile,(Sender as TIBDatabase).DatabaseName,' Disconnected after ',MilliSecondsBetween(FConnectedAt,Now),' ms');
end;

procedure TTest02.HandleIdleTime(Sender: TObject);
begin
  writeln(OutFile,'Idle Timer Expired for ',(Sender as TComponent).Name);
end;

procedure TTest02.HandleDialectDowngradeWarning(Sender: TObject);
begin
  writeln(OutFile,'Warning: SQL Dialect Downgrade of ',(Sender as TIBDatabase).DatabaseName);
end;

procedure TTest02.HandleTransactionStart(Sender: TObject);
begin
  write(OutFile,'Requested ');
  PrintTPB((Sender as TIBTransaction).TPB);
  writeln(OutFile,'Transaction Starts');
  PrintTPB((Sender as TIBTransaction).TransactionIntf.getTPB);
  FStartedAt := Now;
end;

procedure TTest02.HandleBeforeTransactionEnd(Sender: TObject);
begin
  writeln(OutFile,'Transaction Ending');
end;

procedure TTest02.HandleAfterTransactionEnd(Sender: TObject);
begin
  writeln(OutFile,'Transaction Ended after ',MilliSecondsBetween(FStartedAt,Now),' ms');
end;

procedure TTest02.CreateObjects(Application: TTestApplication);
begin
  inherited CreateObjects(Application);
end;

function TTest02.GetTestID: AnsiString;
begin
  Result := aTestID;
end;

function TTest02.GetTestTitle: AnsiString;
begin
  Result := aTestTitle;
end;

procedure TTest02.InitTest;
begin
  IBDatabase.DatabaseName := Owner.GetEmployeeDatabaseName;
  IBDatabase.BeforeConnect := @HandleBeforeConnect;
  IBDatabase.AfterConnect := @HandleAfterConnect;
  IBDatabase.BeforeDisconnect := @HandleBeforeDisconnect;
  IBDatabase.AfterDisconnect := @HandleAfterDisconnect;
  IBDatabase.OnIdleTimer := @HandleIdleTime;
  IBDatabase.OnDialectDowngradeWarning := @HandleDialectDowngradeWarning;
  IBTransaction.OnStartTransaction := @HandleTransactionStart;
  IBTransaction.BeforeTransactionEnd := @HandleBeforeTransactionEnd;
  IBTransaction.AfterTransactionEnd := @HandleAfterTransactionEnd;
  IBTransaction.OnIdleTimer := @HandleIdleTime;
  ReadOnlyTransaction;
end;

procedure TTest02.RunTest(CharSet: AnsiString; SQLDialect: integer);
begin
  IBDatabase.Connected := true;
  IBDatabase.Connected := false;
  IBDatabase.IdleTimer := 2000; {miliseconds}
  IBDatabase.Connected := true;
  while IBDatabase.Connected do
    CheckSynchronize(100);
  writeln(OutFile,'Database Closed');

  writeln(OutFile,'Transaction Events');
  IBDatabase.Connected := true;
  IBTransaction.Active := true;
  IBTransaction.Active := false;
  writeln(Outfile,'Transaction idle timer test');
  IBTransaction.IdleTimer := 1000; {millseconds}
  IBTransaction.Active := true;
  while IBTransaction.Active do
    CheckSynchronize(100);
  IBDatabase.Connected := false;

  writeln(OutFile,'SQL Dialect Downgrade test');
  IBDatabase.DatabaseName := Owner.GetNewDatabaseName;
  IBDatabase.CreateIfNotExists := true;
  IBDatabase.SQLDialect := 1;
  ReadWriteTransaction;
  IBDatabase.Connected := true;
  if IBDatabase.Connected then
  begin
    writeln(OutFile,IBDatabase.DatabaseName,' created');
    IBDatabase.Connected := false;
    IBDatabase.SQLDialect := 3;
    IBDatabase.Connected := true;
    IBDatabase.DropDatabase;
  end;
end;

initialization
  RegisterTest(TTest02);

end.

Revision:	315
Committed:	Thu Feb 25 11:56:36 2021 UTC (3 years, 2 months ago) by tony
Content type:	text/x-pascal
File size:	5153 byte(s)
Log Message:	Updated for IBX 4 release
#	Content
1	unit Test02;
2
3	{$mode objfpc}{$H+}
4
5	{Test 2: Database Event Handlers and Idle disconnect}
6
7	{ This test opens and closes a database in order to test the connect/disconnect
8	handlers. The database is re-opened to test disconnect on idle.
9
10	The transaction handlers are also tested, along with Transaction end on idle.
11
12	SQL Dialect Downgrade warning tested.
13	}
14
15	interface
16
17	uses
18	Classes, SysUtils, TestApplication, IBXTestBase, IB;
19
20	const
21	aTestID = '02';
22	aTestTitle = 'Database Event Handlers and Idle disconnect';
23
24	type
25
26	{ TTest02 }
27
28	TTest02 = class(TIBXTestBase)
29	private
30	FConnectedAt: TDateTime;
31	FStartedAt: TDateTime;
32	procedure HandleBeforeConnect(Sender: TObject);
33	procedure HandleAfterConnect(Sender: TObject);
34	procedure HandleBeforeDisconnect(Sender: TObject);
35	procedure HandleAfterDisconnect(Sender: TObject);
36	procedure HandleIdleTime(Sender: TObject);
37	procedure HandleDialectDowngradeWarning(Sender: TObject);
38	procedure HandleTransactionStart(Sender: TObject);
39	procedure HandleBeforeTransactionEnd(Sender: TObject);
40	procedure HandleAfterTransactionEnd(Sender: TObject);
41	protected
42	procedure CreateObjects(Application: TTestApplication); override;
43	function GetTestID: AnsiString; override;
44	function GetTestTitle: AnsiString; override;
45	procedure InitTest; override;
46	public
47	procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
48	end;
49
50
51	implementation
52
53	uses DateUtils, IBDatabase;
54
55	{ TTest02 }
56
57	procedure TTest02.HandleBeforeConnect(Sender: TObject);
58	begin
59	writeln(OutFile,'Before Connect');
60	end;
61
62	procedure TTest02.HandleAfterConnect(Sender: TObject);
63	begin
64	FConnectedAt := Now;
65	writeln(OutFile,'Connected to ' + (Sender as TIBDatabase).DatabaseName);
66	PrintDPB((Sender as TIBDatabase).attachment.getDPB);
67	end;
68
69	procedure TTest02.HandleBeforeDisconnect(Sender: TObject);
70	begin
71	writeln(OutFile,'Before Disconnect');
72	end;
73
74	procedure TTest02.HandleAfterDisconnect(Sender: TObject);
75	begin
76	writeln(OutFile,(Sender as TIBDatabase).DatabaseName,' Disconnected after ',MilliSecondsBetween(FConnectedAt,Now),' ms');
77	end;
78
79	procedure TTest02.HandleIdleTime(Sender: TObject);
80	begin
81	writeln(OutFile,'Idle Timer Expired for ',(Sender as TComponent).Name);
82	end;
83
84	procedure TTest02.HandleDialectDowngradeWarning(Sender: TObject);
85	begin
86	writeln(OutFile,'Warning: SQL Dialect Downgrade of ',(Sender as TIBDatabase).DatabaseName);
87	end;
88
89	procedure TTest02.HandleTransactionStart(Sender: TObject);
90	begin
91	write(OutFile,'Requested ');
92	PrintTPB((Sender as TIBTransaction).TPB);
93	writeln(OutFile,'Transaction Starts');
94	PrintTPB((Sender as TIBTransaction).TransactionIntf.getTPB);
95	FStartedAt := Now;
96	end;
97
98	procedure TTest02.HandleBeforeTransactionEnd(Sender: TObject);
99	begin
100	writeln(OutFile,'Transaction Ending');
101	end;
102
103	procedure TTest02.HandleAfterTransactionEnd(Sender: TObject);
104	begin
105	writeln(OutFile,'Transaction Ended after ',MilliSecondsBetween(FStartedAt,Now),' ms');
106	end;
107
108	procedure TTest02.CreateObjects(Application: TTestApplication);
109	begin
110	inherited CreateObjects(Application);
111	end;
112
113	function TTest02.GetTestID: AnsiString;
114	begin
115	Result := aTestID;
116	end;
117
118	function TTest02.GetTestTitle: AnsiString;
119	begin
120	Result := aTestTitle;
121	end;
122
123	procedure TTest02.InitTest;
124	begin
125	IBDatabase.DatabaseName := Owner.GetEmployeeDatabaseName;
126	IBDatabase.BeforeConnect := @HandleBeforeConnect;
127	IBDatabase.AfterConnect := @HandleAfterConnect;
128	IBDatabase.BeforeDisconnect := @HandleBeforeDisconnect;
129	IBDatabase.AfterDisconnect := @HandleAfterDisconnect;
130	IBDatabase.OnIdleTimer := @HandleIdleTime;
131	IBDatabase.OnDialectDowngradeWarning := @HandleDialectDowngradeWarning;
132	IBTransaction.OnStartTransaction := @HandleTransactionStart;
133	IBTransaction.BeforeTransactionEnd := @HandleBeforeTransactionEnd;
134	IBTransaction.AfterTransactionEnd := @HandleAfterTransactionEnd;
135	IBTransaction.OnIdleTimer := @HandleIdleTime;
136	ReadOnlyTransaction;
137	end;
138
139	procedure TTest02.RunTest(CharSet: AnsiString; SQLDialect: integer);
140	begin
141	IBDatabase.Connected := true;
142	IBDatabase.Connected := false;
143	IBDatabase.IdleTimer := 2000; {miliseconds}
144	IBDatabase.Connected := true;
145	while IBDatabase.Connected do
146	CheckSynchronize(100);
147	writeln(OutFile,'Database Closed');
148
149	writeln(OutFile,'Transaction Events');
150	IBDatabase.Connected := true;
151	IBTransaction.Active := true;
152	IBTransaction.Active := false;
153	writeln(Outfile,'Transaction idle timer test');
154	IBTransaction.IdleTimer := 1000; {millseconds}
155	IBTransaction.Active := true;
156	while IBTransaction.Active do
157	CheckSynchronize(100);
158	IBDatabase.Connected := false;
159
160	writeln(OutFile,'SQL Dialect Downgrade test');
161	IBDatabase.DatabaseName := Owner.GetNewDatabaseName;
162	IBDatabase.CreateIfNotExists := true;
163	IBDatabase.SQLDialect := 1;
164	ReadWriteTransaction;
165	IBDatabase.Connected := true;
166	if IBDatabase.Connected then
167	begin
168	writeln(OutFile,IBDatabase.DatabaseName,' created');
169	IBDatabase.Connected := false;
170	IBDatabase.SQLDialect := 3;
171	IBDatabase.Connected := true;
172	IBDatabase.DropDatabase;
173	end;
174	end;
175
176	initialization
177	RegisterTest(TTest02);
178
179	end.
180