1 |
unit Test05;
|
2 |
|
3 |
{$mode objfpc}{$H+}
|
4 |
|
5 |
{Test 5: Firebird 4 Data Types}
|
6 |
|
7 |
interface
|
8 |
|
9 |
uses
|
10 |
Classes, SysUtils, TestApplication, IBXTestBase, DB, IB, IBCustomDataSet,
|
11 |
IBDatabase, IBExtract;
|
12 |
|
13 |
const
|
14 |
aTestID = '05';
|
15 |
aTestTitle = 'Firebird 4 Data Types';
|
16 |
|
17 |
type
|
18 |
|
19 |
{ TTest05 }
|
20 |
|
21 |
TTest05 = class(TIBXTestBase)
|
22 |
private
|
23 |
FDataSet: TIBDataSet;
|
24 |
FExtract: TIBExtract;
|
25 |
procedure HandleExtractLine(Sender: TObject; start, count: integer);
|
26 |
procedure HandleAfterInsert(DataSet: TDataSet);
|
27 |
protected
|
28 |
procedure CreateObjects(Application: TTestApplication); override;
|
29 |
function GetTestID: AnsiString; override;
|
30 |
function GetTestTitle: AnsiString; override;
|
31 |
procedure InitTest; override;
|
32 |
procedure InitialiseDatabase(aDatabase: TIBDatabase) override;
|
33 |
function SkipTest: boolean; override;
|
34 |
public
|
35 |
procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
|
36 |
end;
|
37 |
|
38 |
|
39 |
implementation
|
40 |
|
41 |
uses FmtBCD, IBUtils;
|
42 |
|
43 |
{ TTest05 }
|
44 |
|
45 |
procedure TTest05.HandleExtractLine(Sender: TObject; start, count: integer);
|
46 |
var i: integer;
|
47 |
begin
|
48 |
for i := 0 to count - 1 do
|
49 |
writeln(OutFile,FExtract.Items[start + i]);
|
50 |
end;
|
51 |
|
52 |
procedure TTest05.HandleAfterInsert(DataSet: TDataSet);
|
53 |
begin
|
54 |
with DataSet do
|
55 |
begin
|
56 |
(FieldByName('F1') as TIBDateTimeField).SetAsDateTimeTZ(EncodeDate(1918,11,11) + FBEncodeTime(0,11,0,1111),'CET'); ;
|
57 |
(FieldByName('f2') as TIBTimeField).SetAsDateTimeTZ(EncodeTime(22,02,10,5),'America/Los_Angeles');
|
58 |
FieldByName('F3').AsCurrency := 12345678912.12;
|
59 |
FieldByName('f4').AsBCD := StrToBCD('64100000000.011');
|
60 |
FieldByName('F5').AsBCD := StrToBCD('123456123456123456123456.123456');
|
61 |
FieldByName('F6').AsBCD := StrToBCD('123456789123456789');
|
62 |
end;
|
63 |
end;
|
64 |
|
65 |
procedure TTest05.CreateObjects(Application: TTestApplication);
|
66 |
begin
|
67 |
inherited CreateObjects(Application);
|
68 |
FDataSet := TIBDataSet.Create(Application);
|
69 |
with FDataSet do
|
70 |
begin
|
71 |
Database := IBDatabase;
|
72 |
SelectSQL.Text := 'Select * From IBXTEST A';
|
73 |
InsertSQL.Text :=
|
74 |
'Insert Into IBXTEST(TABLEKEY, F1, F2, F3, F4, F5, F6) Values(:TABLEKEY, :F1, :F2, :F3, :F4, :F5, :F6)';
|
75 |
RefreshSQL.Text :=
|
76 |
'Select * From IBXTEST A '+
|
77 |
'Where A.TABLEKEY = :TABLEKEY';
|
78 |
ModifySQL.Text :=
|
79 |
'Update IBXTEST A Set ' +
|
80 |
' A.F1 = :F1,' +
|
81 |
' A.F2 = :F2,' +
|
82 |
' A.F3 = :F3,' +
|
83 |
' A.F4 = :F4,' +
|
84 |
' A.F5 = :F5,' +
|
85 |
' A.F6 = :F6 ' +
|
86 |
'Where A.TABLEKEY = :OLD_TABLEKEY';
|
87 |
DeleteSQL.Text :=
|
88 |
'Delete From IBXTEST A '+
|
89 |
'Where A.TABLEKEY = :OLD_TABLEKEY';
|
90 |
DataSetCloseAction := dcSaveChanges;
|
91 |
AutoCommit := acCommitRetaining;
|
92 |
GeneratorField.Generator := 'IBXGEN';
|
93 |
GeneratorField.Field := 'TABLEKEY';
|
94 |
GeneratorField.ApplyOnEvent := gaeOnNewRecord;
|
95 |
AfterInsert := @HandleAfterInsert;
|
96 |
end;
|
97 |
FExtract := TIBExtract.Create(Application);
|
98 |
FExtract.Database := IBDatabase;
|
99 |
FExtract.Transaction := IBTransaction;
|
100 |
FExtract.OnExtractLines := @HandleExtractLine;
|
101 |
end;
|
102 |
|
103 |
function TTest05.GetTestID: AnsiString;
|
104 |
begin
|
105 |
Result := aTestID;
|
106 |
end;
|
107 |
|
108 |
function TTest05.GetTestTitle: AnsiString;
|
109 |
begin
|
110 |
Result := aTestTitle;
|
111 |
end;
|
112 |
|
113 |
procedure TTest05.InitTest;
|
114 |
begin
|
115 |
IBDatabase.DatabaseName := Owner.GetNewDatabaseName;
|
116 |
IBDatabase.CreateIfNotExists := true;
|
117 |
ReadWriteTransaction;
|
118 |
end;
|
119 |
|
120 |
procedure TTest05.InitialiseDatabase(aDatabase: TIBDatabase);
|
121 |
begin
|
122 |
if aDatabase.attachment.GetODSMajorVersion < 13 then
|
123 |
begin
|
124 |
aDatabase.DropDatabase;
|
125 |
raise ESkipException.Create('This test requires Firebird 4');
|
126 |
end;
|
127 |
inherited InitialiseDatabase(aDatabase);
|
128 |
end;
|
129 |
|
130 |
function TTest05.SkipTest: boolean;
|
131 |
begin
|
132 |
Result := FirebirdAPI.GetClientMajor < 4;
|
133 |
if Result then
|
134 |
writeln(OutFile,'Skipping ',TestTitle);
|
135 |
end;
|
136 |
|
137 |
procedure TTest05.RunTest(CharSet: AnsiString; SQLDialect: integer);
|
138 |
var OldDefaultFormatSettings: TFormatSettings;
|
139 |
begin
|
140 |
OldDefaultFormatSettings := DefaultFormatSettings;
|
141 |
IBDatabase.Connected := true;
|
142 |
try
|
143 |
DefaultFormatSettings.LongTimeFormat := 'HH:MM:SS.zzzz';
|
144 |
IBTransaction.Active := true;
|
145 |
FDataSet.Active := true;
|
146 |
writeln(OutFile,'Extracting Database Schema');
|
147 |
FExtract.ExtractObject(eoDatabase,'',[etGrantsToUser]);
|
148 |
writeln(OutFile);
|
149 |
writeln(OutFile,'Add a record');
|
150 |
FDataSet.Append;
|
151 |
FDataSet.Post;
|
152 |
PrintDataSet(FDataSet);
|
153 |
writeln(OutFile,'F1 in UTC Time = ', DateTimeToStr((FDataSet.FieldByName('F1') as TIBDateTimeField).GetAsUTCDateTime));
|
154 |
writeln(OutFile,'F2 in UTC Time = ', FBFormatDateTime('HH:MM:SS.zzzz',(FDataSet.FieldByName('F2') as TIBDateTimeField).GetAsUTCDateTime));
|
155 |
writeln(Outfile,'TZ Text Option = GMT');
|
156 |
FDataset.TZTextOption := tzGMT;
|
157 |
PrintDataSet(FDataSet);
|
158 |
writeln(Outfile,'TZ Text Option = Original format');
|
159 |
FDataset.TZTextOption := tzOriginalID;
|
160 |
PrintDataSet(FDataSet);
|
161 |
writeln(Outfile,'TZ Text Option = offset with Default time zone date of 2020/7/1');
|
162 |
FDataset.Active := false;
|
163 |
FDataset.TZTextOption := tzOffset;
|
164 |
FDataset.DefaultTZDate := EncodeDate(2020,7,1);
|
165 |
FDataset.Active := true;
|
166 |
PrintDataSet(FDataSet);
|
167 |
writeln(Outfile,'Update a record with a non default time zone date');
|
168 |
FDataset.Edit;
|
169 |
(FDataSet.FieldByName('F2') as TIBDateTimeField).SetAsDateTimeTZ(EncodeTime(11,02,10,15),'America/New_York');
|
170 |
FDataSet.Post;
|
171 |
PrintDataSet(FDataSet);
|
172 |
writeln(Outfile,'Restore original default time zone date');
|
173 |
FDataset.Active := false;
|
174 |
FDataset.DefaultTZDate := EncodeDate(2020,1,1);
|
175 |
FDataset.Active := true;
|
176 |
PrintDataSet(FDataSet);
|
177 |
finally
|
178 |
DefaultFormatSettings := OldDefaultFormatSettings;
|
179 |
IBDatabase.DropDatabase;
|
180 |
end;
|
181 |
end;
|
182 |
|
183 |
initialization
|
184 |
RegisterTest(TTest05);
|
185 |
|
186 |
end.
|
187 |
|