ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/testsuite/Test10.pas
Revision: 315
Committed: Thu Feb 25 11:56:36 2021 UTC (3 years, 2 months ago) by tony
Content type: text/x-pascal
File size: 2241 byte(s)
Log Message:
Updated for IBX 4 release

File Contents

# Content
1 unit Test10;
2
3 {$mode objfpc}{$H+}
4
5 {Test 10: Create Database from SQL Script and Extract SQL}
6
7
8 interface
9
10 uses
11 Classes, SysUtils, TestApplication, IBXTestbase, IB, IBExtract, IBDatabase;
12
13 const
14 aTestID = '10';
15 aTestTitle = 'Create Database from SQL Script and Extract SQL';
16
17 type
18
19 { TTest10 }
20
21 TTest10 = class(TIBXTestBase)
22 private
23 FExtract: TIBExtract;
24 procedure HandleExtractLine(Sender: TObject; start, count: integer);
25 protected
26 procedure CreateObjects(Application: TTestApplication); override;
27 function GetTestID: AnsiString; override;
28 function GetTestTitle: AnsiString; override;
29 procedure InitTest; override;
30 procedure InitialiseDatabase(aDatabase: TIBDatabase); override;
31 public
32 procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
33 end;
34
35
36 implementation
37
38 { TTest10 }
39
40 procedure TTest10.HandleExtractLine(Sender: TObject; start, count: integer);
41 var i: integer;
42 begin
43 for i := 0 to count - 1 do
44 writeln(OutFile,FExtract.Items[start + i]);
45 end;
46
47 procedure TTest10.CreateObjects(Application: TTestApplication);
48 begin
49 inherited CreateObjects(Application);
50 FExtract := TIBExtract.Create(Application);
51 FExtract.Database := IBDatabase;
52 FExtract.Transaction := IBTransaction;
53 FExtract.OnExtractLines := @HandleExtractLine;
54 end;
55
56 function TTest10.GetTestID: AnsiString;
57 begin
58 Result := aTestID;
59 end;
60
61 function TTest10.GetTestTitle: AnsiString;
62 begin
63 Result := aTestTitle;
64 end;
65
66 procedure TTest10.InitTest;
67 begin
68 ReadWriteTransaction;
69 IBDatabase.DatabaseName := Owner.GetNewDatabaseName;
70 IBDatabase.CreateIfNotExists := true;
71 end;
72
73 procedure TTest10.InitialiseDatabase(aDatabase: TIBDatabase);
74 begin
75 IBXScriptObj.StopOnFirstError := false;
76 inherited InitialiseDatabase(aDatabase);
77 end;
78
79 procedure TTest10.RunTest(CharSet: AnsiString; SQLDialect: integer);
80 begin
81 IBDatabase.Connected := true;
82 writeln(OutFile);
83 writeln(OutFile,'Extracting Database Schema and Data');
84 FExtract.ExtractObject(eoDatabase,'',[etData,etGrantsToUser]);
85 WriteStrings(FExtract.Items);
86 FExtract.Items.SaveToFile(GetOutFile);
87 writeln(OutFile,'Schema written to ',GetOutFile);
88 IBDatabase.DropDatabase;
89 end;
90
91 initialization
92 RegisterTest(TTest10);
93
94 end.
95