trunk/testsuite/Test09.pas

unit Test09;

{$mode objfpc}{$H+}

{Test 9: Extract DDL from example Employee Database}

interface

uses
  Classes, SysUtils,  TestApplication, IBXTestbase, IB, IBExtract;

const
  aTestID    = '09';
  aTestTitle = 'Extract DDL from example Employee Database';

type

{ TTest09 }

  TTest09 = class(TIBXTestBase)
  private
    FExtract: TIBExtract;
    procedure HandleExtractLine(Sender: TObject; start, count: integer);
  protected
    procedure CreateObjects(Application: TTestApplication); override;
    function GetTestID: AnsiString; override;
    function GetTestTitle: AnsiString; override;
    procedure InitTest; override;
  public
    procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
  end;


implementation

{ TTest09 }

procedure TTest09.HandleExtractLine(Sender: TObject; start, count: integer);
var i: integer;
begin
  for i := 0 to count - 1 do
    writeln(OutFile,FExtract.Items[start + i]);
end;

procedure TTest09.CreateObjects(Application: TTestApplication);
begin
  inherited CreateObjects(Application);
  FExtract := TIBExtract.Create(Application);
  FExtract.Database := IBDatabase;
  FExtract.Transaction := IBTransaction;
  FExtract.OnExtractLines := @HandleExtractLine;
end;

function TTest09.GetTestID: AnsiString;
begin
  Result := aTestID;
end;

function TTest09.GetTestTitle: AnsiString;
begin
  Result := aTestTitle;
end;

procedure TTest09.InitTest;
begin
  ReadOnlyTransaction;
  IBDatabase.DatabaseName := Owner.GetEmployeeDatabaseName;
end;

procedure TTest09.RunTest(CharSet: AnsiString; SQLDialect: integer);
begin
  IBDatabase.Connected := true;
  writeln(OutFile);
  writeln(OutFile,'Extracting Database Schema and Data');
  FExtract.ExtractObject(eoDatabase,'',[etGrantsToUser]);
end;

initialization
  RegisterTest(TTest09);

end.

Revision:	315
Committed:	Thu Feb 25 11:56:36 2021 UTC (3 years, 8 months ago) by tony
Content type:	text/x-pascal
File size:	1795 byte(s)
Log Message:	Updated for IBX 4 release
#	User	Rev	Content
1	tony	315	unit Test09;
2
3			{$mode objfpc}{$H+}
4
5			{Test 9: Extract DDL from example Employee Database}
6
7			interface
8
9			uses
10			Classes, SysUtils, TestApplication, IBXTestbase, IB, IBExtract;
11
12			const
13			aTestID = '09';
14			aTestTitle = 'Extract DDL from example Employee Database';
15
16			type
17
18			{ TTest09 }
19
20			TTest09 = class(TIBXTestBase)
21			private
22			FExtract: TIBExtract;
23			procedure HandleExtractLine(Sender: TObject; start, count: integer);
24			protected
25			procedure CreateObjects(Application: TTestApplication); override;
26			function GetTestID: AnsiString; override;
27			function GetTestTitle: AnsiString; override;
28			procedure InitTest; override;
29			public
30			procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
31			end;
32
33
34			implementation
35
36			{ TTest09 }
37
38			procedure TTest09.HandleExtractLine(Sender: TObject; start, count: integer);
39			var i: integer;
40			begin
41			for i := 0 to count - 1 do
42			writeln(OutFile,FExtract.Items[start + i]);
43			end;
44
45			procedure TTest09.CreateObjects(Application: TTestApplication);
46			begin
47			inherited CreateObjects(Application);
48			FExtract := TIBExtract.Create(Application);
49			FExtract.Database := IBDatabase;
50			FExtract.Transaction := IBTransaction;
51			FExtract.OnExtractLines := @HandleExtractLine;
52			end;
53
54			function TTest09.GetTestID: AnsiString;
55			begin
56			Result := aTestID;
57			end;
58
59			function TTest09.GetTestTitle: AnsiString;
60			begin
61			Result := aTestTitle;
62			end;
63
64			procedure TTest09.InitTest;
65			begin
66			ReadOnlyTransaction;
67			IBDatabase.DatabaseName := Owner.GetEmployeeDatabaseName;
68			end;
69
70			procedure TTest09.RunTest(CharSet: AnsiString; SQLDialect: integer);
71			begin
72			IBDatabase.Connected := true;
73			writeln(OutFile);
74			writeln(OutFile,'Extracting Database Schema and Data');
75			FExtract.ExtractObject(eoDatabase,'',[etGrantsToUser]);
76			end;
77
78			initialization
79			RegisterTest(TTest09);
80
81			end.
82