ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/fbintf/examples/SelectInto/TestSelectInto.lpr
Revision: 402
Committed: Mon Aug 1 10:07:24 2022 UTC (2 years, 4 months ago) by tony
File size: 3808 byte(s)
Log Message:
IBX Release 2.5.0

File Contents

# Content
1 program TestSelectInto;
2
3 {$mode delphi}
4 {$codepage UTF8}
5 {$interfaces COM}
6
7 uses Classes, FBUDRController, FBUdrPlugin, IB, UdrSelectInto;
8
9 procedure ReportResult(aValue: IResults);
10 var i: integer;
11 begin
12 for i := 0 to aValue.getCount - 1 do
13 writeln(aValue[i].Name,' = ',aValue[i].AsString);
14 end;
15
16 procedure ReportResults(cursor: IResultset);
17 begin
18 while not cursor.IsEof do
19 begin
20 ReportResult(cursor);
21 cursor.FetchNext;
22 end;
23 end;
24
25 procedure TestSelectInto(UDRPlugin: TFBUdrPluginEmulator);
26 var SelectInto: TExternalProcedureWrapper;
27 Transaction: ITransaction;
28 Results: IProcedureResults;
29 begin
30 {Get the emulator wrapper for the row_count function, declared as MyRowCount}
31 SelectInto := UDRPlugin.makeProcedure('SELECT_INTO', {Name of procedure in database - case sensitive}
32 '', {package name is empty}
33 'selectinto!select_into' {entry point}
34 );
35 try
36 SelectInto.InputParams.ByName('select_statement').AsString := 'Select * From EMPLOYEE Where Salary < 50000';
37 SelectInto.InputParams.ByName('table_name').AsString := 'LOWER_PAID';
38 SelectInto.InputParams.ByName('table_type').AsString := '';
39 Transaction := UDRPlugin.Attachment.StartTransaction([isc_tpb_write,isc_tpb_nowait,isc_tpb_read_committed],taCommit);
40 Results := SelectInto.Execute(Transaction);
41 if Results.FetchNext then
42 writeln('Procedure Returns ',Results.ByName('Status').AsString)
43 else
44 writeln('No results');
45
46 writeln('Show Table');
47 ReportResults(UDRPlugin.Attachment.OpenCursorAtStart(Transaction,'Select * From LOWER_PAID'));
48 finally
49 SelectInto.Free;
50 end;
51 end;
52
53 const
54 DDL: array [0..0] of Ansistring = ('create or alter procedure select_into (' +
55 'select_statement blob sub_type 1 not null,'+
56 'table_name varchar(63) not null,'+
57 'table_type varchar(25) not null' +
58 ') returns ('+
59 'status varchar(100)) as begin end'
60 );
61
62 CleanUpDDL: array [0..0] of Ansistring = ('Drop procedure select_into'
63 );
64
65
66 procedure RunTest;
67 var Attachment: IAttachment;
68 DPB: IDPB;
69 UDRPlugin: TFBUdrPluginEmulator;
70 i: integer;
71 begin
72 {Open a connection with the example employee database. Amend database parameters
73 as needed.}
74 DPB := FirebirdAPI.AllocateDPB;
75 DPB.Add(isc_dpb_user_name).setAsString('SYSDBA');
76 DPB.Add(isc_dpb_password).setAsString('masterkey');
77 DPB.Add(isc_dpb_lc_ctype).setAsString('UTF8');
78 DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(3);
79 Attachment := FirebirdAPI.OpenDatabase('localhost:employee',DPB);
80 for i := 0 to Length(DDL) -1 do
81 Attachment.ExecImmediate([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],DDL[i]);
82 try
83 UDRPlugin := TFBUdrPluginEmulator.Create(FBUDRControllerOptions.ModuleName);
84 try
85 {initialize the emulator with the database connection}
86 UDRPlugin.Attachment := Attachment;
87 TestSelectInto(UDRPlugin);
88 finally
89 UDRPlugin.Free;
90 end;
91 finally
92 for i := 0 to Length(CleanUpDDL) -1 do
93 Attachment.ExecImmediate([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],CleanUpDDL[i]);
94 Attachment.Disconnect(true);
95 end;
96 end;
97
98 begin
99 with FBUDRControllerOptions do
100 begin
101 ModuleName := 'selectinto';
102 AllowConfigFileOverrides := true;
103 LogFileNameTemplate := 'SelectInto.log';
104 LogOptions := [loLogFunctions, loLogProcedures, loLogTriggers, loDetails];
105 end;
106 RunTest;
107 {$IFDEF WINDOWS}
108 readln; {force console window to stay open}
109 {$ENDIF}
110 end.
111

Properties

Name Value
svn:eol-style native