trunk/testsuite/Test11.pas

unit Test11;

{$mode objfpc}{$H+}

{Test 11: Event Handling}

{ This tests calling an event handler in response to a database event.
  A simple database is used consisting of a stored procedure only.
  Two cases are tested: event registration before and after DB Open.
}

interface

uses
  Classes, SysUtils,   TestApplication, IBXTestBase, IB, IBEvents,
  IBStoredProc;

const
  aTestID    = '11';
  aTestTitle = 'Event Handling';

type

{ TTest11 }

  TTest11 = class(TIBXTestBase)
  private
    FEvents: TIBEvents;
    FExecProc: TIBStoredProc;
    procedure EventHandler( Sender: TObject; EventName: string; EventCount: longint;
                           var CancelAlerts: Boolean);
  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

{ TTest11 }

procedure TTest11.EventHandler(Sender: TObject; EventName: string;
  EventCount: longint; var CancelAlerts: Boolean);
begin
  writeln(OutFile,'Event Handled: ',EventName, ', Count = ',EventCount);
end;

procedure TTest11.CreateObjects(Application: TTestApplication);
begin
  inherited CreateObjects(Application);
  FEvents := TIBEvents.Create(Application);
  FEvents.Database := IBDatabase;
  FEvents.OnEventAlert := @EventHandler;
  FEvents.Events.Add('EVENT1');
  FEvents.Events.Add('EVENT2');
  FExecProc := TIBStoredProc.Create(Application);
  FExecProc.Database := IBDatabase;
end;

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

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

procedure TTest11.InitTest;
begin
  IBDatabase.DatabaseName := Owner.GetNewDatabaseName;
  IBDatabase.CreateIfNotExists := true;
  ReadWriteTransaction;
end;

procedure TTest11.RunTest(CharSet: AnsiString; SQLDialect: integer);
begin
  writeln(OutFile,'Case #1: Deferred Event Registration');
  FEvents.DeferredRegister := true;
  IBDatabase.Connected := true;
  try
    IBTransaction.Active := true;
    CheckSynchronize(1);
    FExecProc.StoredProcName := 'CALLEVENT';
    FExecProc.Prepare;
    FExecProc.Params[0].AsString := 'EVENT1';
    FExecProc.ExecProc;
    writeln(OutFile,'Event Called');
    IBTransaction.Commit;
    CheckSynchronize(5);
  finally
    IBDatabase.DropDatabase;
  end;
  writeln(OutFile,'Case #2: Event Registration after DB Open');
  IBDatabase.Connected := true;
  try
    FEvents.Registered := true;
    IBTransaction.Active := true;
    CheckSynchronize(1);
    FExecProc.StoredProcName := 'CALLEVENT';
    FExecProc.Prepare;
    FExecProc.Params[0].AsString := 'EVENT2';
    FExecProc.ExecProc;
    writeln(OutFile,'Event Called');
    IBTransaction.Commit;
    CheckSynchronize(5);
    Sleep(1000);
    FEvents.UnRegisterEvents;
  finally
    IBDatabase.DropDatabase;
  end;
end;

initialization
  RegisterTest(TTest11);

end.

Revision:	319
Committed:	Thu Feb 25 12:05:40 2021 UTC (3 years, 6 months ago) by tony
Content type:	text/x-pascal
File size:	3024 byte(s)
Log Message:	Merge into public release
#	User	Rev	Content
1	tony	315	unit Test11;
2
3			{$mode objfpc}{$H+}
4
5			{Test 11: Event Handling}
6
7			{ This tests calling an event handler in response to a database event.
8			A simple database is used consisting of a stored procedure only.
9			Two cases are tested: event registration before and after DB Open.
10			}
11
12			interface
13
14			uses
15			Classes, SysUtils, TestApplication, IBXTestBase, IB, IBEvents,
16			IBStoredProc;
17
18			const
19			aTestID = '11';
20			aTestTitle = 'Event Handling';
21
22			type
23
24			{ TTest11 }
25
26			TTest11 = class(TIBXTestBase)
27			private
28			FEvents: TIBEvents;
29			FExecProc: TIBStoredProc;
30			procedure EventHandler( Sender: TObject; EventName: string; EventCount: longint;
31			var CancelAlerts: Boolean);
32			protected
33			procedure CreateObjects(Application: TTestApplication); override;
34			function GetTestID: AnsiString; override;
35			function GetTestTitle: AnsiString; override;
36			procedure InitTest; override;
37			public
38			procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
39			end;
40
41
42			implementation
43
44			{ TTest11 }
45
46			procedure TTest11.EventHandler(Sender: TObject; EventName: string;
47			EventCount: longint; var CancelAlerts: Boolean);
48			begin
49			writeln(OutFile,'Event Handled: ',EventName, ', Count = ',EventCount);
50			end;
51
52			procedure TTest11.CreateObjects(Application: TTestApplication);
53			begin
54			inherited CreateObjects(Application);
55			FEvents := TIBEvents.Create(Application);
56			FEvents.Database := IBDatabase;
57			FEvents.OnEventAlert := @EventHandler;
58			FEvents.Events.Add('EVENT1');
59			FEvents.Events.Add('EVENT2');
60			FExecProc := TIBStoredProc.Create(Application);
61			FExecProc.Database := IBDatabase;
62			end;
63
64			function TTest11.GetTestID: AnsiString;
65			begin
66			Result := aTestID;
67			end;
68
69			function TTest11.GetTestTitle: AnsiString;
70			begin
71			Result := aTestTitle;
72			end;
73
74			procedure TTest11.InitTest;
75			begin
76			IBDatabase.DatabaseName := Owner.GetNewDatabaseName;
77			IBDatabase.CreateIfNotExists := true;
78			ReadWriteTransaction;
79			end;
80
81			procedure TTest11.RunTest(CharSet: AnsiString; SQLDialect: integer);
82			begin
83			writeln(OutFile,'Case #1: Deferred Event Registration');
84			FEvents.DeferredRegister := true;
85			IBDatabase.Connected := true;
86			try
87			IBTransaction.Active := true;
88			CheckSynchronize(1);
89			FExecProc.StoredProcName := 'CALLEVENT';
90			FExecProc.Prepare;
91			FExecProc.Params[0].AsString := 'EVENT1';
92			FExecProc.ExecProc;
93			writeln(OutFile,'Event Called');
94			IBTransaction.Commit;
95			CheckSynchronize(5);
96			finally
97			IBDatabase.DropDatabase;
98			end;
99			writeln(OutFile,'Case #2: Event Registration after DB Open');
100			IBDatabase.Connected := true;
101			try
102			FEvents.Registered := true;
103			IBTransaction.Active := true;
104			CheckSynchronize(1);
105			FExecProc.StoredProcName := 'CALLEVENT';
106			FExecProc.Prepare;
107			FExecProc.Params[0].AsString := 'EVENT2';
108			FExecProc.ExecProc;
109			writeln(OutFile,'Event Called');
110			IBTransaction.Commit;
111			CheckSynchronize(5);
112	tony	319	Sleep(1000);
113	tony	315	FEvents.UnRegisterEvents;
114			finally
115			IBDatabase.DropDatabase;
116			end;
117			end;
118
119			initialization
120			RegisterTest(TTest11);
121
122			end.
123