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

# User Rev Content
1 tony 402 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