ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/fbintf/testsuite/Test6.pas
Revision: 56
Committed: Mon Mar 6 10:20:02 2017 UTC (7 years, 9 months ago) by tony
Content type: text/x-pascal
File size: 5085 byte(s)
Log Message:
Committing updates for Trunk

File Contents

# Content
1 unit Test6;
2 {$IFDEF MSWINDOWS}
3 {$DEFINE WINDOWS}
4 {$ENDIF}
5
6 {$IFDEF FPC}
7 {$mode delphi}
8 {$codepage UTF8}
9 {$ENDIF}
10
11 {Test 6: Blob Handling}
12
13 {
14 1. Create an empty database and populate with a single table.
15
16 2. Show the character sets available (List RDB$CHARACTER_SETS)
17
18 3. Select all from new table and show metadata.
19
20 4. Insert row and include WIN1252 characters known to be in two byte UTF8, plus Fixed point
21
22 5. Select all from new table
23
24 6. Use Update Query to set blob field with plain text loaded from file
25
26 7. Select all from new table
27
28 8. Add another row with a null blob
29
30 9. Update this row's blob field with a copy of the first row (demo of blob assignment)
31
32 10. Select all from new table.
33
34 11. Drop Database and repeat above but with no default connection character set.
35 }
36
37 interface
38
39 uses
40 Classes, SysUtils, TestManager, IB;
41
42 type
43
44 { TTest6 }
45
46 TTest6 = class(TTestBase)
47 private
48 procedure UpdateDatabase(Attachment: IAttachment);
49 public
50 function TestTitle: AnsiString; override;
51 procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
52 end;
53
54 implementation
55
56 const
57 sqlCreateTable =
58 'Create Table TestData ('+
59 'RowID Integer not null,'+
60 'FixedPoint Decimal(8,2), '+
61 'FloatingPoint Double Precision, '+
62 'Title VarChar(32) Character Set UTF8,'+
63 'BlobData Blob sub_type 1 Character Set UTF8,'+
64 'Primary Key(RowID)'+
65 ')';
66
67 sqlGetCharSets = 'Select RDB$CHARACTER_SET_NAME,RDB$CHARACTER_SET_ID from RDB$CHARACTER_SETS order by 2';
68
69 sqlInsert = 'Insert into TestData(RowID,Title,FixedPoint,FloatingPoint) Values(:RowID,:Title,:FP, :DP)';
70
71 sqlUpdate = 'Update TestData Set BlobData = ? Where RowID = ?';
72
73
74 { TTest6 }
75
76 procedure TTest6.UpdateDatabase(Attachment: IAttachment);
77 var Transaction: ITransaction;
78 Statement,
79 Statement2: IStatement;
80 ResultSet: IResultSet;
81 i: integer;
82 begin
83 Transaction := Attachment.StartTransaction([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
84
85 Statement := Attachment.Prepare(Transaction,sqlGetCharSets);
86 PrintMetaData(Statement.GetMetaData);
87 ReportResults(Statement);
88 Statement := Attachment.Prepare(Transaction,'Select * from TestData');
89 PrintMetaData(Statement.GetMetaData);
90 Statement := Attachment.PrepareWithNamedParameters(Transaction,sqlInsert);
91 ParamInfo(Statement.SQLParams);
92 with Statement.GetSQLParams do
93 begin
94 ByName('rowid').AsInteger := 1;
95 ByName('title').AsString := 'Blob Test ©€';
96 ByName('Fp').AsDouble := 20.28;
97 ByName('DP').AsDouble := 3.142;
98 end;
99 Statement.Execute;
100 Statement := Attachment.Prepare(Transaction,'Select * from TestData');
101 ReportResults(Statement);
102
103
104 Statement := Attachment.Prepare(Transaction,sqlUpdate);
105 ParamInfo(Statement.SQLParams);
106 Statement.SQLParams[0].AsBlob := Attachment.CreateBlob(Transaction,'TestData','BlobData').LoadFromFile('testtext.txt');
107 Statement.SQLParams[1].AsInteger := 1;
108 Statement.Execute;
109 Statement := Attachment.Prepare(Transaction,'Select * from TestData');
110 ReportResults(Statement);
111
112 {second row}
113 Statement := Attachment.PrepareWithNamedParameters(Transaction,sqlInsert);
114 ParamInfo(Statement.SQLParams);
115 with Statement.GetSQLParams do
116 begin
117 ByName('rowid').AsInteger := 2;
118 ByName('title').AsString := 'Blob Test ©€';
119 end;
120 Statement.Execute;
121 Statement := Attachment.Prepare(Transaction,'Select * from TestData Where rowid = 1');
122 ResultSet := Statement.OpenCursor;
123 if ResultSet.FetchNext then
124 begin
125 Statement2 := Attachment.Prepare(Transaction,sqlUpdate);
126 Statement2.SQLParams[0].AsBlob := ResultSet.ByName('BlobData').AsBlob; {test duplication of blob}
127 Statement2.SQLParams[1].AsInteger := 2;
128 Statement2.Execute;
129 Statement := Attachment.Prepare(Transaction,'Select * from TestData');
130 ReportResults(Statement);
131 end;
132 end;
133
134 function TTest6.TestTitle: AnsiString;
135 begin
136 Result := 'Test 6: Blob Handling';
137 end;
138
139 procedure TTest6.RunTest(CharSet: AnsiString; SQLDialect: integer);
140 var DPB: IDPB;
141 Attachment: IAttachment;
142 begin
143 DPB := FirebirdAPI.AllocateDPB;
144 DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
145 DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword);
146 DPB.Add(isc_dpb_lc_ctype).setAsString(CharSet);
147 DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
148 Attachment := FirebirdAPI.CreateDatabase(Owner.GetNewDatabaseName,DPB);
149 Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateTable);
150 UpdateDatabase(Attachment);
151
152 Attachment.DropDatabase;
153
154 {Repeat with no lc_ctype}
155 DPB := FirebirdAPI.AllocateDPB;
156 DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
157 DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword);
158 DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
159 Attachment := FirebirdAPI.CreateDatabase(Owner.GetNewDatabaseName,DPB);
160 Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateTable);
161 UpdateDatabase(Attachment);
162
163 Attachment.DropDatabase;
164 end;
165
166 initialization
167 RegisterTest(TTest6);
168 end.
169