fbintf/client/FBBlob.pas

(*
 *  Firebird Interface (fbintf). The fbintf components provide a set of
 *  Pascal language bindings for the Firebird API. Although predominantly
 *  a new development they include source code taken from IBX and may be
 *  considered a derived product. This software thus also includes the copyright
 *  notice and license conditions from IBX.
 *
 *  Except for those parts dervied from IBX, contents of this file are subject
 *  to the Initial Developer's Public License Version 1.0 (the "License"); you
 *  may not use this file except in compliance with the License. You may obtain a
 *  copy of the License here:
 *
 *    http://www.firebirdsql.org/index.php?op=doc&id=idpl
 *
 *  Software distributed under the License is distributed on an "AS
 *  IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
 *  implied. See the License for the specific language governing rights
 *  and limitations under the License.
 *
 *  The Initial Developer of the Original Code is Tony Whyman.
 *
 *  The Original Code is (C) 2016 Tony Whyman, MWA Software
 *  (http://www.mwasoftware.co.uk).
 *
 *  All Rights Reserved.
 *
 *  Contributor(s): ______________________________________.
 *
*)
unit FBBlob;

{$IFDEF FPC}
{$mode objfpc}{$H+}
{$interfaces COM}
{$ENDIF}

interface

uses
  Classes, SysUtils, IB, FBActivityMonitor, FBTransaction, FBClientAPI;

type

  { TFBBlobMetaData }

  TFBBlobMetaData  = class(TActivityReporter)
  private
    FRelationName: string;
    FColumnName: string;
  protected
    FUnconfirmedCharacterSet: boolean;
    FHasSubType: boolean;
    FSubType: integer;
    FCharSetID: cardinal;
    FSegmentSize: cardinal;
    procedure NeedFullMetadata; virtual; abstract;
    procedure NeedSubType;
  public
    constructor Create(Transaction: TFBTransaction; RelationName, ColumnName: string
      );

  public
    {IBlobMetaData}
   function GetSubType: integer;
   function GetCharSetID: cardinal;
   function GetCodePage: TSystemCodePage;
   function GetSegmentSize: cardinal;
   function GetRelationName: string;
   function GetColumnName: string;
   function GetUnconfirmedCharacterSet: boolean;
  end;

  TFBBlob = class(TActivityReporter)
  private
    FMetaData: IBlobMetaData;
    FAttachment: IAttachment;
    FTransaction: ITransaction;
    FBPB: IBPB;
    FStringData: rawbytestring;
    FStringCached: boolean;
  protected
    FCreating: boolean;
    FBlobID: TISC_QUAD;
    procedure CheckReadable; virtual; abstract;
    procedure CheckWritable; virtual; abstract;
    procedure ClearStringCache;
    function GetIntf: IBlob; virtual; abstract;
    procedure InternalClose(Force: boolean); virtual; abstract;
    procedure InternalCancel(Force: boolean); virtual; abstract;
  public
    constructor Create(Attachment: IAttachment; Transaction: TFBTransaction;
                       MetaData: IBlobMetaData; BPB: IBPB); overload;
    constructor Create(Attachment: IAttachment; Transaction: TFBTransaction;
                       MetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB); overload;
    destructor Destroy; override;
    procedure TransactionEnding(aTransaction: TFBTransaction; Force: boolean);

  public
    {IBlobMetaData}
   function GetSubType: integer;
   function GetCharSetID: cardinal;
   function GetCodePage: TSystemCodePage;
   function GetSegmentSize: cardinal;
   function GetRelationName: string;
   function GetColumnName: string;
   function GetUnconfirmedCharacterSet: boolean;

   {IBlob}
    function GetBPB: IBPB;
    procedure Cancel;
    procedure Close;
    function GetBlobSize: Int64;
    procedure GetInfo(var NumSegments: Int64; var MaxSegmentSize, TotalSize: Int64;
      var BlobType: TBlobType); virtual; abstract;
    function GetBlobID: TISC_QUAD;
    function GetBlobMode: TFBBlobMode;
    function Read(var Buffer; Count: Longint): Longint; virtual; abstract;
    function Write(const Buffer; Count: Longint): Longint;  virtual; abstract;
    function LoadFromFile(Filename: string): IBlob;
    function LoadFromStream(S: TStream) : IBlob;
    function SaveToFile(Filename: string): IBlob;
    function SaveToStream(S: TStream): IBlob;
    function GetAttachment: IAttachment;
    function GetTransaction: ITransaction;
    function GetAsString: rawbytestring;
    procedure SetAsString(aValue: rawbytestring);
    function SetString(aValue: rawbytestring): IBlob;
  end;


implementation

uses FBMessages;

{ TFBBlob }

procedure TFBBlob.ClearStringCache;
begin
  FStringData := '';
  FStringCached := false;
end;

constructor TFBBlob.Create(Attachment: IAttachment;
  Transaction: TFBTransaction; MetaData: IBlobMetaData; BPB: IBPB);
begin
  inherited Create(Transaction);
  FAttachment := Attachment;
  FTransaction := Transaction;
  FMetaData := MetaData;
  FBPB := BPB;
  FCreating := true;
end;

constructor TFBBlob.Create(Attachment: IAttachment;
  Transaction: TFBTransaction; MetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB);
begin
  Create(Attachment,Transaction,MetaData,BPB);
  FBlobID := BlobID;
  FCreating := false;
end;

destructor TFBBlob.Destroy;
begin
  if FCreating then
    Cancel
  else
    Close;
  inherited Destroy;
end;

procedure TFBBlob.TransactionEnding(aTransaction: TFBTransaction;
  Force: boolean);
begin
  if aTransaction <> FTransaction then
    Exit;
  if FCreating then
    InternalCancel(Force)
  else
    InternalClose(Force);
end;

function TFBBlob.GetSubType: integer;
begin
  Result := FMetaData.GetSubType;
end;

function TFBBlob.GetCharSetID: cardinal;
begin
  Result := FMetaData.GetCharSetID;
end;

function TFBBlob.GetCodePage: TSystemCodePage;
begin
  Result := FMetaData.GetCodePage;
end;

function TFBBlob.GetSegmentSize: cardinal;
begin
  Result := FMetaData.GetSegmentSize;
end;

function TFBBlob.GetRelationName: string;
begin
  Result := FMetaData.GetRelationName;
end;

function TFBBlob.GetColumnName: string;
begin
  Result := FMetaData.GetColumnName;
end;

function TFBBlob.GetUnconfirmedCharacterSet: boolean;
begin
  Result := (FMetadata as TFBBlobMetadata).GetUnconfirmedCharacterSet;
end;

function TFBBlob.GetBPB: IBPB;
begin
  Result := FBPB;
end;

procedure TFBBlob.Cancel;
begin
  InternalCancel(false);
end;

procedure TFBBlob.Close;
begin
  InternalClose(false);
end;

function TFBBlob.GetBlobSize: Int64;
var NumSegments: Int64;
    MaxSegmentSize: Int64;
    BlobType: TBlobType;
begin
  GetInfo(NumSegments,MaxSegmentSize,Result,BlobType);
end;

function TFBBlob.GetBlobID: TISC_QUAD;
begin
  Result := FBlobID;
end;

function TFBBlob.GetBlobMode: TFBBlobMode;
begin
  if FCreating then
    Result := fbmWrite
  else
    Result := fbmRead;
end;

function TFBBlob.LoadFromFile(Filename: string): IBlob;
var
  Stream: TStream;
begin
  Stream := TFileStream.Create(FileName, fmOpenRead);
  try
    Result := LoadFromStream(Stream);
  finally
    Stream.Free;
  end;
end;

const BufSize = 8 * 1024;

function TFBBlob.LoadFromStream(S: TStream): IBlob;
var Buffer: array [0..BufSize-1] of char;
    BytesRead: integer;
begin
  CheckWritable;
  S.Position := 0;
  repeat
    BytesRead := S.Read(Buffer,BufSize);
    Write(Buffer,BytesRead);
  until BytesRead = 0;
  Close;
  Result := GetIntf;
end;

function TFBBlob.SaveToFile(Filename: string): IBlob;
var
  Stream: TStream;
begin
  Stream := TFileStream.Create(FileName, fmCreate);
  try
    Result := SaveToStream(Stream);
  finally
    Stream.Free;
  end;
end;

function TFBBlob.SaveToStream(S: TStream): IBlob;
var Buffer: array [0..BufSize-1] of char;
    BytesRead: integer;
begin
  CheckReadable;
  repeat
    BytesRead := Read(Buffer,BufSize);
    S.Write(Buffer,BytesRead);
  until BytesRead = 0;
  Close;
  Result := GetIntf;
end;

function TFBBlob.GetAttachment: IAttachment;
begin
  Result := FAttachment;
end;

function TFBBlob.GetTransaction: ITransaction;
begin
   Result := FTransaction;
end;

function TFBBlob.GetAsString: rawbytestring;
var ss: TStringStream;
begin
  if FStringCached then
  begin
    Result := FStringData;
    Exit;
  end;

  ss := TStringStream.Create('');
  try
    SaveToStream(ss);
    Result :=  ss.DataString;
    if (GetSubType = 1) and (FBPB = nil) then
      SetCodePage(Result,GetCodePage,false);
  finally
    ss.Free;
  end;
  FStringData := Result;
  FStringCached := true;
end;

procedure TFBBlob.SetAsString(aValue: rawbytestring);
var
  ss: TStringStream;
begin
  {if GetUnconfirmedCharacterSet then
    IBError(ibxeNoDefaultCharacterSet,[nil]);}

  if (GetSubType = 1) and  (StringCodePage(aValue) <> GetCodePage) and
           (GetCodePage <> CP_NONE) and (FBPB = nil) then
    SetCodePage(aValue,GetCodePage,true);
  ss := TStringStream.Create(aValue);
  try
    LoadFromStream(ss);
  finally
    ss.Free;
  end;
  FStringData := aValue;
  FStringCached := true;
end;

function TFBBlob.SetString(aValue: rawbytestring): IBlob;
begin
  SetAsString(aValue);
  Result := GetIntf;
end;

{TFBBlobMetaData}

procedure TFBBlobMetaData.NeedSubType;
begin
  if not FHasSubType then
  begin
    NeedFullMetadata;
    FHasSubType := true;
  end;
end;

constructor TFBBlobMetaData.Create(Transaction: TFBTransaction; RelationName,
  ColumnName: string);
begin
  inherited Create(Transaction);
//  if (RelationName = '') or (ColumnName = '') then
 //   IBError(ibxeMissingColumnName,[]);
  FRelationName := RelationName;
  FColumnName := ColumnName;
  FSegmentSize := 80;
end;

function TFBBlobMetaData.GetSubType: integer;
begin
  NeedSubType;
  Result := FSubType;
end;

function TFBBlobMetaData.GetCharSetID: cardinal;
begin
  NeedFullMetadata;
  Result := FCharSetID;
end;

function TFBBlobMetaData.GetCodePage: TSystemCodePage;
begin
  FirebirdClientAPI.CharSetID2CodePage(GetCharSetID,Result);
end;

function TFBBlobMetaData.GetSegmentSize: cardinal;
begin
  NeedFullMetadata;
  Result := FSegmentSize;
end;

function TFBBlobMetaData.GetRelationName: string;
begin
  Result := FRelationName;
end;

function TFBBlobMetaData.GetColumnName: string;
begin
  Result := FColumnName;
end;

function TFBBlobMetaData.GetUnconfirmedCharacterSet: boolean;
begin
  NeedFullMetadata;
  Result := FUnconfirmedCharacterSet;
end;


end.

Revision:	45
Committed:	Tue Dec 6 10:33:46 2016 UTC (7 years, 11 months ago) by tony
Content type:	text/x-pascal
File size:	10081 byte(s)
Log Message:	Committing updates for Release R2-0-0
#	User	Rev	Content
1	tony	45	(*
2			* Firebird Interface (fbintf). The fbintf components provide a set of
3			* Pascal language bindings for the Firebird API. Although predominantly
4			* a new development they include source code taken from IBX and may be
5			* considered a derived product. This software thus also includes the copyright
6			* notice and license conditions from IBX.
7			*
8			* Except for those parts dervied from IBX, contents of this file are subject
9			* to the Initial Developer's Public License Version 1.0 (the "License"); you
10			* may not use this file except in compliance with the License. You may obtain a
11			* copy of the License here:
12			*
13			* http://www.firebirdsql.org/index.php?op=doc&id=idpl
14			*
15			* Software distributed under the License is distributed on an "AS
16			* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
17			* implied. See the License for the specific language governing rights
18			* and limitations under the License.
19			*
20			* The Initial Developer of the Original Code is Tony Whyman.
21			*
22			* The Original Code is (C) 2016 Tony Whyman, MWA Software
23			* (http://www.mwasoftware.co.uk).
24			*
25			* All Rights Reserved.
26			*
27			* Contributor(s): ______________________________________.
28			*
29			*)
30			unit FBBlob;
31
32			{$IFDEF FPC}
33			{$mode objfpc}{$H+}
34			{$interfaces COM}
35			{$ENDIF}
36
37			interface
38
39			uses
40			Classes, SysUtils, IB, FBActivityMonitor, FBTransaction, FBClientAPI;
41
42			type
43
44			{ TFBBlobMetaData }
45
46			TFBBlobMetaData = class(TActivityReporter)
47			private
48			FRelationName: string;
49			FColumnName: string;
50			protected
51			FUnconfirmedCharacterSet: boolean;
52			FHasSubType: boolean;
53			FSubType: integer;
54			FCharSetID: cardinal;
55			FSegmentSize: cardinal;
56			procedure NeedFullMetadata; virtual; abstract;
57			procedure NeedSubType;
58			public
59			constructor Create(Transaction: TFBTransaction; RelationName, ColumnName: string
60			);
61
62			public
63			{IBlobMetaData}
64			function GetSubType: integer;
65			function GetCharSetID: cardinal;
66			function GetCodePage: TSystemCodePage;
67			function GetSegmentSize: cardinal;
68			function GetRelationName: string;
69			function GetColumnName: string;
70			function GetUnconfirmedCharacterSet: boolean;
71			end;
72
73			TFBBlob = class(TActivityReporter)
74			private
75			FMetaData: IBlobMetaData;
76			FAttachment: IAttachment;
77			FTransaction: ITransaction;
78			FBPB: IBPB;
79			FStringData: rawbytestring;
80			FStringCached: boolean;
81			protected
82			FCreating: boolean;
83			FBlobID: TISC_QUAD;
84			procedure CheckReadable; virtual; abstract;
85			procedure CheckWritable; virtual; abstract;
86			procedure ClearStringCache;
87			function GetIntf: IBlob; virtual; abstract;
88			procedure InternalClose(Force: boolean); virtual; abstract;
89			procedure InternalCancel(Force: boolean); virtual; abstract;
90			public
91			constructor Create(Attachment: IAttachment; Transaction: TFBTransaction;
92			MetaData: IBlobMetaData; BPB: IBPB); overload;
93			constructor Create(Attachment: IAttachment; Transaction: TFBTransaction;
94			MetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB); overload;
95			destructor Destroy; override;
96			procedure TransactionEnding(aTransaction: TFBTransaction; Force: boolean);
97
98			public
99			{IBlobMetaData}
100			function GetSubType: integer;
101			function GetCharSetID: cardinal;
102			function GetCodePage: TSystemCodePage;
103			function GetSegmentSize: cardinal;
104			function GetRelationName: string;
105			function GetColumnName: string;
106			function GetUnconfirmedCharacterSet: boolean;
107
108			{IBlob}
109			function GetBPB: IBPB;
110			procedure Cancel;
111			procedure Close;
112			function GetBlobSize: Int64;
113			procedure GetInfo(var NumSegments: Int64; var MaxSegmentSize, TotalSize: Int64;
114			var BlobType: TBlobType); virtual; abstract;
115			function GetBlobID: TISC_QUAD;
116			function GetBlobMode: TFBBlobMode;
117			function Read(var Buffer; Count: Longint): Longint; virtual; abstract;
118			function Write(const Buffer; Count: Longint): Longint; virtual; abstract;
119			function LoadFromFile(Filename: string): IBlob;
120			function LoadFromStream(S: TStream) : IBlob;
121			function SaveToFile(Filename: string): IBlob;
122			function SaveToStream(S: TStream): IBlob;
123			function GetAttachment: IAttachment;
124			function GetTransaction: ITransaction;
125			function GetAsString: rawbytestring;
126			procedure SetAsString(aValue: rawbytestring);
127			function SetString(aValue: rawbytestring): IBlob;
128			end;
129
130
131
132			implementation
133
134			uses FBMessages;
135
136			{ TFBBlob }
137
138			procedure TFBBlob.ClearStringCache;
139			begin
140			FStringData := '';
141			FStringCached := false;
142			end;
143
144			constructor TFBBlob.Create(Attachment: IAttachment;
145			Transaction: TFBTransaction; MetaData: IBlobMetaData; BPB: IBPB);
146			begin
147			inherited Create(Transaction);
148			FAttachment := Attachment;
149			FTransaction := Transaction;
150			FMetaData := MetaData;
151			FBPB := BPB;
152			FCreating := true;
153			end;
154
155			constructor TFBBlob.Create(Attachment: IAttachment;
156			Transaction: TFBTransaction; MetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB);
157			begin
158			Create(Attachment,Transaction,MetaData,BPB);
159			FBlobID := BlobID;
160			FCreating := false;
161			end;
162
163			destructor TFBBlob.Destroy;
164			begin
165			if FCreating then
166			Cancel
167			else
168			Close;
169			inherited Destroy;
170			end;
171
172			procedure TFBBlob.TransactionEnding(aTransaction: TFBTransaction;
173			Force: boolean);
174			begin
175			if aTransaction <> FTransaction then
176			Exit;
177			if FCreating then
178			InternalCancel(Force)
179			else
180			InternalClose(Force);
181			end;
182
183			function TFBBlob.GetSubType: integer;
184			begin
185			Result := FMetaData.GetSubType;
186			end;
187
188			function TFBBlob.GetCharSetID: cardinal;
189			begin
190			Result := FMetaData.GetCharSetID;
191			end;
192
193			function TFBBlob.GetCodePage: TSystemCodePage;
194			begin
195			Result := FMetaData.GetCodePage;
196			end;
197
198			function TFBBlob.GetSegmentSize: cardinal;
199			begin
200			Result := FMetaData.GetSegmentSize;
201			end;
202
203			function TFBBlob.GetRelationName: string;
204			begin
205			Result := FMetaData.GetRelationName;
206			end;
207
208			function TFBBlob.GetColumnName: string;
209			begin
210			Result := FMetaData.GetColumnName;
211			end;
212
213			function TFBBlob.GetUnconfirmedCharacterSet: boolean;
214			begin
215			Result := (FMetadata as TFBBlobMetadata).GetUnconfirmedCharacterSet;
216			end;
217
218			function TFBBlob.GetBPB: IBPB;
219			begin
220			Result := FBPB;
221			end;
222
223			procedure TFBBlob.Cancel;
224			begin
225			InternalCancel(false);
226			end;
227
228			procedure TFBBlob.Close;
229			begin
230			InternalClose(false);
231			end;
232
233			function TFBBlob.GetBlobSize: Int64;
234			var NumSegments: Int64;
235			MaxSegmentSize: Int64;
236			BlobType: TBlobType;
237			begin
238			GetInfo(NumSegments,MaxSegmentSize,Result,BlobType);
239			end;
240
241			function TFBBlob.GetBlobID: TISC_QUAD;
242			begin
243			Result := FBlobID;
244			end;
245
246			function TFBBlob.GetBlobMode: TFBBlobMode;
247			begin
248			if FCreating then
249			Result := fbmWrite
250			else
251			Result := fbmRead;
252			end;
253
254			function TFBBlob.LoadFromFile(Filename: string): IBlob;
255			var
256			Stream: TStream;
257			begin
258			Stream := TFileStream.Create(FileName, fmOpenRead);
259			try
260			Result := LoadFromStream(Stream);
261			finally
262			Stream.Free;
263			end;
264			end;
265
266			const BufSize = 8 * 1024;
267
268			function TFBBlob.LoadFromStream(S: TStream): IBlob;
269			var Buffer: array [0..BufSize-1] of char;
270			BytesRead: integer;
271			begin
272			CheckWritable;
273			S.Position := 0;
274			repeat
275			BytesRead := S.Read(Buffer,BufSize);
276			Write(Buffer,BytesRead);
277			until BytesRead = 0;
278			Close;
279			Result := GetIntf;
280			end;
281
282			function TFBBlob.SaveToFile(Filename: string): IBlob;
283			var
284			Stream: TStream;
285			begin
286			Stream := TFileStream.Create(FileName, fmCreate);
287			try
288			Result := SaveToStream(Stream);
289			finally
290			Stream.Free;
291			end;
292			end;
293
294			function TFBBlob.SaveToStream(S: TStream): IBlob;
295			var Buffer: array [0..BufSize-1] of char;
296			BytesRead: integer;
297			begin
298			CheckReadable;
299			repeat
300			BytesRead := Read(Buffer,BufSize);
301			S.Write(Buffer,BytesRead);
302			until BytesRead = 0;
303			Close;
304			Result := GetIntf;
305			end;
306
307			function TFBBlob.GetAttachment: IAttachment;
308			begin
309			Result := FAttachment;
310			end;
311
312			function TFBBlob.GetTransaction: ITransaction;
313			begin
314			Result := FTransaction;
315			end;
316
317			function TFBBlob.GetAsString: rawbytestring;
318			var ss: TStringStream;
319			begin
320			if FStringCached then
321			begin
322			Result := FStringData;
323			Exit;
324			end;
325
326			ss := TStringStream.Create('');
327			try
328			SaveToStream(ss);
329			Result := ss.DataString;
330			if (GetSubType = 1) and (FBPB = nil) then
331			SetCodePage(Result,GetCodePage,false);
332			finally
333			ss.Free;
334			end;
335			FStringData := Result;
336			FStringCached := true;
337			end;
338
339			procedure TFBBlob.SetAsString(aValue: rawbytestring);
340			var
341			ss: TStringStream;
342			begin
343			{if GetUnconfirmedCharacterSet then
344			IBError(ibxeNoDefaultCharacterSet,[nil]);}
345
346			if (GetSubType = 1) and (StringCodePage(aValue) <> GetCodePage) and
347			(GetCodePage <> CP_NONE) and (FBPB = nil) then
348			SetCodePage(aValue,GetCodePage,true);
349			ss := TStringStream.Create(aValue);
350			try
351			LoadFromStream(ss);
352			finally
353			ss.Free;
354			end;
355			FStringData := aValue;
356			FStringCached := true;
357			end;
358
359			function TFBBlob.SetString(aValue: rawbytestring): IBlob;
360			begin
361			SetAsString(aValue);
362			Result := GetIntf;
363			end;
364
365			{TFBBlobMetaData}
366
367			procedure TFBBlobMetaData.NeedSubType;
368			begin
369			if not FHasSubType then
370			begin
371			NeedFullMetadata;
372			FHasSubType := true;
373			end;
374			end;
375
376			constructor TFBBlobMetaData.Create(Transaction: TFBTransaction; RelationName,
377			ColumnName: string);
378			begin
379			inherited Create(Transaction);
380			// if (RelationName = '') or (ColumnName = '') then
381			// IBError(ibxeMissingColumnName,[]);
382			FRelationName := RelationName;
383			FColumnName := ColumnName;
384			FSegmentSize := 80;
385			end;
386
387			function TFBBlobMetaData.GetSubType: integer;
388			begin
389			NeedSubType;
390			Result := FSubType;
391			end;
392
393			function TFBBlobMetaData.GetCharSetID: cardinal;
394			begin
395			NeedFullMetadata;
396			Result := FCharSetID;
397			end;
398
399			function TFBBlobMetaData.GetCodePage: TSystemCodePage;
400			begin
401			FirebirdClientAPI.CharSetID2CodePage(GetCharSetID,Result);
402			end;
403
404			function TFBBlobMetaData.GetSegmentSize: cardinal;
405			begin
406			NeedFullMetadata;
407			Result := FSegmentSize;
408			end;
409
410			function TFBBlobMetaData.GetRelationName: string;
411			begin
412			Result := FRelationName;
413			end;
414
415			function TFBBlobMetaData.GetColumnName: string;
416			begin
417			Result := FColumnName;
418			end;
419
420			function TFBBlobMetaData.GetUnconfirmedCharacterSet: boolean;
421			begin
422			NeedFullMetadata;
423			Result := FUnconfirmedCharacterSet;
424			end;
425
426
427			end.
428