ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/fbintf/testsuite/Test15.pas
Revision: 45
Committed: Tue Dec 6 10:33:46 2016 UTC (8 years ago) by tony
Content type: text/x-pascal
File size: 4158 byte(s)
Log Message:
Committing updates for Release R2-0-0

File Contents

# User Rev Content
1 tony 45 unit Test15;
2    
3     {$mode objfpc}{$H+}
4     {$codepage UTF8}
5    
6     {Test 15: Blob Handling and BPBs}
7    
8     {
9     1. A database is created with two tables. One has an untyped Blob. the other
10     is UTF8 text.
11    
12     2. An image is inserted into the first.
13    
14     3. Win1252 text into the second with a Blob Filter request to transform to UTF8.
15    
16     4. The Data is read back and written out.
17     }
18    
19     interface
20    
21     uses
22     Classes, SysUtils, TestManager, IB;
23    
24     type
25     { TTest15 }
26    
27     TTest15 = class(TTestBase)
28     private
29     procedure UpdateDatabase(Attachment: IAttachment);
30     procedure QueryDatabase(Attachment: IAttachment);
31     public
32     function TestTitle: string; override;
33     procedure RunTest(CharSet: string; SQLDialect: integer); override;
34     end;
35    
36    
37     implementation
38    
39     const
40     sqlCreateTable =
41     'Create Table TestData ('+
42     'RowID Integer not null,'+
43     'Title VarChar(32) Character Set UTF8,'+
44     'BlobData Blob sub_type 0, '+
45     'Primary Key(RowID)'+
46     ')';
47    
48     sqlCreateTable2 =
49     'Create Table TestData2 ('+
50     'RowID Integer not null,'+
51     'Title VarChar(32) Character Set UTF8,'+
52     'BlobData Blob sub_type 1 Character Set UTF8, '+
53     'Primary Key(RowID)'+
54     ')';
55    
56     sqlInsert = 'Insert into TestData(RowID,Title, BlobData) Values(:RowID,:Title,:BlobData)';
57     sqlInsert2 = 'Insert into TestData2(RowID,Title, BlobData) Values(:RowID,:Title,:BlobData)';
58    
59     { TTest15 }
60    
61     procedure TTest15.UpdateDatabase(Attachment: IAttachment);
62     var Transaction: ITransaction;
63     Statement: IStatement;
64     aBlob: IBlob;
65     BPB: IBPB;
66     aText: RawByteString;
67     begin
68     Transaction := Attachment.StartTransaction([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
69    
70     Statement := Attachment.PrepareWithNamedParameters(Transaction,sqlInsert);
71     with Statement.GetSQLParams do
72     begin
73     ByName('rowid').AsInteger := 1;
74     ByName('title').AsString := 'Blob Test';
75     ByName('BlobData').AsBlob := Attachment.CreateBlob(Transaction,'TestData','BlobData').LoadFromFile('testimage.jpg');
76     end;
77     Statement.Execute;
78    
79     BPB := Attachment.AllocateBPB;
80     BPB.Add(isc_bpb_target_type).AsInteger := 1;
81     BPB.Add(isc_bpb_target_interp).AsInteger := 4; {utf8}
82     BPB.Add(isc_bpb_source_type).AsInteger := 1;
83     BPB.Add(isc_bpb_source_interp).AsInteger := 53; {WIN1252}
84     aText := #$C9#$63#$6F#$75#$74#$65#$20#$6D#$6F#$69; {Écoute moi' encoded in Win1252}
85     aBlob := Attachment.CreateBlob(Transaction,'TestData2','BlobData',BPB).SetString(aText);
86     Statement := Attachment.PrepareWithNamedParameters(Transaction,sqlInsert2);
87     with Statement.GetSQLParams do
88     begin
89     ByName('rowid').AsInteger := 1;
90     ByName('title').AsString := 'Blob Test';
91     ByName('BlobData').AsBlob := aBlob;
92     end;
93     Statement.Execute;
94     end;
95    
96     procedure TTest15.QueryDatabase(Attachment: IAttachment);
97     var Transaction: ITransaction;
98     Statement: IStatement;
99     begin
100     Transaction := Attachment.StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
101     Statement := Attachment.Prepare(Transaction,'Select * from TestData ');
102     writeln(OutFile);
103     writeln(OutFile,'Testdata');
104     writeln(OutFile);
105     ReportResults(Statement);
106     Statement := Attachment.Prepare(Transaction,'Select * from TestData2 ');
107     writeln(OutFile);
108     writeln(OutFile,'Testdata 2');
109     writeln(OutFile);
110     ReportResults(Statement);
111     end;
112    
113     function TTest15.TestTitle: string;
114     begin
115     Result := 'Test 15: Blob Handling and BPBs';
116     end;
117    
118     procedure TTest15.RunTest(CharSet: string; SQLDialect: integer);
119     var DPB: IDPB;
120     Attachment: IAttachment;
121     begin
122     DPB := FirebirdAPI.AllocateDPB;
123     DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
124     DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword);
125     DPB.Add(isc_dpb_lc_ctype).setAsString('UTF8');
126     DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
127     Attachment := FirebirdAPI.CreateDatabase(Owner.GetNewDatabaseName,DPB);
128     Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateTable);
129     Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateTable2);
130    
131     UpdateDatabase(Attachment);
132     QueryDatabase(Attachment);
133     Attachment.DropDatabase;
134     end;
135    
136     initialization
137     RegisterTest(TTest15);
138     end.
139