ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/testsuite/Test11.pas
Revision: 315
Committed: Thu Feb 25 11:56:36 2021 UTC (3 years, 9 months ago) by tony
Content type: text/x-pascal
File size: 3007 byte(s)
Log Message:
Updated for IBX 4 release

File Contents

# 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     FEvents.UnRegisterEvents;
113     finally
114     IBDatabase.DropDatabase;
115     end;
116     end;
117    
118     initialization
119     RegisterTest(TTest11);
120    
121     end.
122