client/3.0/FB30Array.pas

(*
 *  Firebird Interface (fbintf). The fbintf components provide a set of
 *  Pascal language bindings for the Firebird API.
 *
 *  The 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 FB30Array;
{$IFDEF MSWINDOWS} 
{$DEFINE WINDOWS} 
{$ENDIF}

{$IFDEF FPC}
{$mode delphi}
{$codepage UTF8}
{$interfaces COM}
{$ENDIF}

interface

uses
  Classes, SysUtils, Firebird, IB, FBArray, IBHeader, FB30Attachment, FBClientAPI,
  FB30Transaction, FBParamBlock, FB30ClientAPI;

type

  ISDLItem = interface(IParameterBlockItem)
    ['{a34b6064-5ae9-4fc1-85c3-f145f069b607}']
    procedure addByte(aValue: byte);
    procedure addShortInt(aValue: ShortInt);
    procedure addShortInteger(aValue: integer);
    procedure SetAsShortInteger(aValue: integer);
    procedure SetAsTinyInteger(aValue: integer);
  end;

  ISDL = interface(IParameterBlock<ISDLItem>)
    ['{52ae1f5f-657b-4b14-81aa-7b3658454f4c}']
  end;

  { TFB30ArrayMetaData }

  TFB30ArrayMetaData = class(TFBArrayMetaData,IArrayMetaData)
  private
    FCodePage: TSystemCodePage;
    FCharSetWidth: integer;
  protected
    procedure LoadMetaData(aAttachment: IAttachment; aTransaction: ITransaction;
                   relationName, columnName: AnsiString); override;
  public
    function GetCharSetID: cardinal; override;
    function GetCodePage: TSystemCodePage; override;
    function GetCharSetWidth: integer; override;
  end;

  { TFB30Array }

  TFB30Array = class(TFBArray,IArray)
  private
    FAttachmentIntf: Firebird.IAttachment;
    FTransactionIntf: Firebird.ITransaction;
    FFirebird30ClientAPI: TFB30ClientAPI;
    FSDL: ISDL;
    procedure GenerateSDL;
  protected
    procedure AllocateBuffer; override;
    procedure InternalGetSlice; override;
    procedure InternalPutSlice(Force: boolean); override;
  public
    constructor Create(aAttachment: TFB30Attachment; aTransaction: TFB30Transaction; aField: IArrayMetaData); overload;
    constructor Create(aAttachment: TFB30Attachment; aTransaction: TFB30Transaction; aField: IArrayMetaData; ArrayID: TISC_QUAD); overload;
  end;

  TSDLItem = class(TParamBlockItem,ISDLItem);

  { TSDLBlock }

  TSDLBlock = class (TCustomParamBlock<TSDLItem,ISDLItem>, ISDL)
  public
    constructor Create(api: TFBClientAPI);
  end;

implementation

uses FBAttachment, FB30Statement;

const
  sGetArrayMetaData = 'Select F.RDB$FIELD_LENGTH, F.RDB$FIELD_SCALE, F.RDB$FIELD_TYPE, '+
                      'F.RDB$DIMENSIONS, FD.RDB$DIMENSION, FD.RDB$LOWER_BOUND, FD.RDB$UPPER_BOUND, '+
                      'F.RDB$CHARACTER_SET_ID '+
                      'From RDB$FIELDS F JOIN RDB$RELATION_FIELDS RF '+
                      'On F.RDB$FIELD_NAME = RF.RDB$FIELD_SOURCE JOIN RDB$FIELD_DIMENSIONS FD '+
                      'On FD.RDB$FIELD_NAME = F.RDB$FIELD_NAME ' +
                      'Where RF.RDB$RELATION_NAME = ? and RF.RDB$FIELD_NAME = ? ' +
                      'UNION '+
                      'Select F.RDB$FIELD_LENGTH, F.RDB$FIELD_SCALE, F.RDB$FIELD_TYPE, '+
                      'F.RDB$DIMENSIONS, FD.RDB$DIMENSION, FD.RDB$LOWER_BOUND, FD.RDB$UPPER_BOUND, '+
                      'F.RDB$CHARACTER_SET_ID '+
                      'From RDB$FIELDS F JOIN RDB$PROCEDURE_PARAMETERS PP '+
                      'On F.RDB$FIELD_NAME = PP.RDB$FIELD_SOURCE JOIN RDB$FIELD_DIMENSIONS FD '+
                      'On FD.RDB$FIELD_NAME = F.RDB$FIELD_NAME ' +
                      'Where PP.RDB$PROCEDURE_NAME = ? and PP.RDB$PARAMETER_NAME = ? '+
                      'Order by 5 asc';


{ TFB30ArrayMetaData }

{Assemble the array descriptor from the System Tables}

procedure TFB30ArrayMetaData.LoadMetaData(aAttachment: IAttachment;
  aTransaction: ITransaction; relationName, columnName: AnsiString);
var stmt: IStatement;
    CharWidth: integer;
begin
  CharWidth := 0;
  RelationName := AnsiUpperCase(RelationName);
  ColumnName := AnsiUpperCase(ColumnName);
  stmt := TFB30Statement.Create(aAttachment as TFB30Attachment,aTransaction,
                               sGetArrayMetaData ,aAttachment.GetSQLDialect);
  with stmt do
  begin
    SQLParams[0].AsString := RelationName;
    SQLParams[1].AsString := ColumnName;
    SQLParams[2].AsString := RelationName;
    SQLParams[3].AsString := ColumnName;
    with OpenCursor do
    if FetchNext then
    begin
      FillChar(FArrayDesc.array_desc_field_name,sizeof(FArrayDesc.array_desc_field_name),' ');
      FillChar(FArrayDesc.array_desc_relation_name,sizeof(FArrayDesc.array_desc_relation_name),' ');
      Move(columnName[1],FArrayDesc.array_desc_field_name,Length(columnName));
      Move(relationName[1],FArrayDesc.array_desc_relation_name,length(relationName));
      FArrayDesc.array_desc_length := Data[0].AsInteger;
      FArrayDesc.array_desc_scale := Data[1].AsInteger;
      FArrayDesc.array_desc_dtype := Data[2].AsInteger;
      FArrayDesc.array_desc_dimensions := Data[3].AsInteger;
      FArrayDesc.array_desc_flags := 0; {row major}
      FCharSetID := Data[7].AsInteger;
      if (FCharSetID > 1) and (aAttachment as TFB30Attachment).HasDefaultCharSet then
        FCharSetID := (aAttachment as TFB30Attachment).CharSetID;
      FCodePage := CP_NONE;
      FAttachment.CharSetID2CodePage(FCharSetID,FCodePage);
      FCharSetWidth := 1;
      FAttachment.CharSetWidth(FCharSetID,FCharSetWidth);
      if (FArrayDesc.array_desc_dtype in [blr_text,blr_cstring, blr_varying]) and
        (FCharSetID = 0) then {This really shouldn't be necessary - but it is :(}
      with aAttachment as TFBAttachment do
      begin
        if HasDefaultCharSet  and FAttachment.CharSetWidth(CharSetID,CharWidth) then
          FArrayDesc.array_desc_length := FArrayDesc.array_desc_length * CharWidth;
      end;
      repeat
        with FArrayDesc.array_desc_bounds[Data[4].AsInteger] do
        begin
          array_bound_lower := Data[5].AsInteger;
          array_bound_upper := Data[6].AsInteger;
        end;
      until not FetchNext;
    end;
  end;
end;

function TFB30ArrayMetaData.GetCharSetID: cardinal;
begin
  Result := FCharSetID;
end;

function TFB30ArrayMetaData.GetCodePage: TSystemCodePage;
begin
  Result := FCodePage;
end;

function TFB30ArrayMetaData.GetCharSetWidth: integer;
begin
  Result := FCharSetWidth;
end;

{ TFB30Array }

procedure TFB30Array.GenerateSDL;

  procedure AddVarInteger(aValue: integer);
  begin
    if (aValue >= -128) and (aValue <= 127) then
      FSDL.Add(isc_sdl_tiny_integer).SetAsTinyInteger(aValue)
    else
    if (aValue >= -32768) and (aValue <= 32767) then
      FSDL.Add(isc_sdl_short_integer).SetAsShortInteger(aValue)
    else
      FSDL.Add(isc_sdl_long_integer).SetAsInteger(aValue);
  end;

var i: integer;
    SDLItem: ISDLItem;
begin
  FSDL := TSDLBlock.Create(FFirebird30ClientAPI);
  with GetArrayDesc^ do
  {The following is based on gen_SDL from Firebird src/dsql/array.cpp}
  begin
    SDLItem := FSDL.Add(isc_sdl_struct);
    SDLItem.SetAsByte(array_desc_dtype);

    case array_desc_dtype of
    blr_short,blr_long,
    blr_int64,blr_quad,
    blr_int128:
        SDLItem.AddShortInt(array_desc_scale);

    blr_text,blr_cstring, blr_varying:
        SDLItem.addShortInteger(array_desc_length);
    end;

    FSDL.Add(isc_sdl_relation).SetAsString(array_desc_relation_name);
    FSDL.Add(isc_sdl_field).SetAsString(array_desc_field_name);

    for i := 0 to array_desc_dimensions - 1 do
    begin
      if array_desc_bounds[i].array_bound_lower = 1 then
        FSDL.Add(isc_sdl_do1).SetAsTinyInteger(i)
      else
      begin
        FSDL.Add(isc_sdl_do2).SetAsTinyInteger(i);
        AddVarInteger(array_desc_bounds[i].array_bound_lower);
      end;
      AddVarInteger(array_desc_bounds[i].array_bound_upper);
    end;

    SDLItem := FSDL.Add(isc_sdl_element);
    SDLItem.AddByte(1);
    SDLItem := FSDL.Add(isc_sdl_scalar);
    SDLItem.AddByte(0);
    SDLItem.AddByte(array_desc_dimensions);
    for i := 0 to array_desc_dimensions - 1 do
    begin
      SDLItem := FSDL.Add(isc_sdl_variable);
      SDLItem.AddByte(i);
    end;
    FSDL.Add(isc_sdl_eoc);
  end;
end;

procedure TFB30Array.AllocateBuffer;

begin
  inherited AllocateBuffer;
  {Now set up the SDL}
  GenerateSDL;
end;

procedure TFB30Array.InternalGetSlice;
begin
  with FFirebird30ClientAPI do
  begin
    FAttachmentIntf.getSlice(StatusIntf,FTransactionIntf,
                          @FArrayID,
                          (FSDL as TSDLBlock).getDataLength,
                          BytePtr((FSDL as TSDLBlock).getBuffer),
                          0,nil,
                          FBufSize,BytePtr(FBuffer)
                          );
    Check4DataBaseError;
  end;
  SignalActivity;
end;

procedure TFB30Array.InternalPutSlice(Force: boolean);
begin
  with FFirebird30ClientAPI do
  begin
    FAttachmentIntf.putSlice(StatusIntf,FTransactionIntf, @FArrayID,
                          (FSDL as TSDLBlock).getDataLength,
                          BytePtr((FSDL as TSDLBlock).getBuffer),
                          0,nil,
                          FBufSize,BytePtr(FBuffer)
                          );
    if not Force then
      Check4DataBaseError;
  end;
  SignalActivity;
end;

constructor TFB30Array.Create(aAttachment: TFB30Attachment;
  aTransaction: TFB30Transaction; aField: IArrayMetaData);
begin
  inherited Create(aAttachment,aTransaction,aField);
  FAttachmentIntf := aAttachment.AttachmentIntf;
  FTransactionIntf := aTransaction.TransactionIntf;
  FFirebird30ClientAPI := aAttachment.Firebird30ClientAPI;
end;

constructor TFB30Array.Create(aAttachment: TFB30Attachment;
  aTransaction: TFB30Transaction; aField: IArrayMetaData; ArrayID: TISC_QUAD);
begin
  inherited Create(aAttachment,aTransaction,aField,ArrayID);
  FAttachmentIntf := aAttachment.AttachmentIntf;
  FTransactionIntf := aTransaction.TransactionIntf;
  FFirebird30ClientAPI := aAttachment.Firebird30ClientAPI;
end;

{ TSDLBlock }

constructor TSDLBlock.Create(api: TFBClientAPI);
begin
  inherited Create(api);
  FDataLength := 1;
  FBuffer^ := isc_sdl_version1;
end;

end.

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:	10731 byte(s)
Log Message:	Updated for IBX 4 release
#	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.
4			*
5			* The contents of this file are subject to the Initial Developer's
6			* Public License Version 1.0 (the "License"); you may not use this
7			* file except in compliance with the License. You may obtain a copy
8			* of the License here:
9			*
10			* http://www.firebirdsql.org/index.php?op=doc&id=idpl
11			*
12			* Software distributed under the License is distributed on an "AS
13			* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
14			* implied. See the License for the specific language governing rights
15			* and limitations under the License.
16			*
17			* The Initial Developer of the Original Code is Tony Whyman.
18			*
19			* The Original Code is (C) 2016 Tony Whyman, MWA Software
20			* (http://www.mwasoftware.co.uk).
21			*
22			* All Rights Reserved.
23			*
24			* Contributor(s): ______________________________________.
25			*
26			*)
27			unit FB30Array;
28	tony	56	{$IFDEF MSWINDOWS}
29			{$DEFINE WINDOWS}
30			{$ENDIF}
31	tony	45
32			{$IFDEF FPC}
33	tony	56	{$mode delphi}
34	tony	45	{$codepage UTF8}
35			{$interfaces COM}
36			{$ENDIF}
37
38			interface
39
40			uses
41			Classes, SysUtils, Firebird, IB, FBArray, IBHeader, FB30Attachment, FBClientAPI,
42	tony	263	FB30Transaction, FBParamBlock, FB30ClientAPI;
43	tony	45
44			type
45
46	tony	56	ISDLItem = interface(IParameterBlockItem)
47			['{a34b6064-5ae9-4fc1-85c3-f145f069b607}']
48	tony	45	procedure addByte(aValue: byte);
49	tony	308	procedure addShortInt(aValue: ShortInt);
50	tony	45	procedure addShortInteger(aValue: integer);
51			procedure SetAsShortInteger(aValue: integer);
52			procedure SetAsTinyInteger(aValue: integer);
53			end;
54
55	tony	56	ISDL = interface(IParameterBlock<ISDLItem>)
56			['{52ae1f5f-657b-4b14-81aa-7b3658454f4c}']
57	tony	45	end;
58
59			{ TFB30ArrayMetaData }
60
61			TFB30ArrayMetaData = class(TFBArrayMetaData,IArrayMetaData)
62			private
63			FCodePage: TSystemCodePage;
64	tony	309	FCharSetWidth: integer;
65	tony	45	protected
66			procedure LoadMetaData(aAttachment: IAttachment; aTransaction: ITransaction;
67	tony	56	relationName, columnName: AnsiString); override;
68	tony	45	public
69			function GetCharSetID: cardinal; override;
70			function GetCodePage: TSystemCodePage; override;
71	tony	309	function GetCharSetWidth: integer; override;
72	tony	45	end;
73
74			{ TFB30Array }
75
76			TFB30Array = class(TFBArray,IArray)
77			private
78			FAttachmentIntf: Firebird.IAttachment;
79			FTransactionIntf: Firebird.ITransaction;
80	tony	263	FFirebird30ClientAPI: TFB30ClientAPI;
81	tony	45	FSDL: ISDL;
82	tony	315	procedure GenerateSDL;
83	tony	45	protected
84			procedure AllocateBuffer; override;
85			procedure InternalGetSlice; override;
86			procedure InternalPutSlice(Force: boolean); override;
87			public
88			constructor Create(aAttachment: TFB30Attachment; aTransaction: TFB30Transaction; aField: IArrayMetaData); overload;
89			constructor Create(aAttachment: TFB30Attachment; aTransaction: TFB30Transaction; aField: IArrayMetaData; ArrayID: TISC_QUAD); overload;
90	tony	315	end;
91	tony	45
92			TSDLItem = class(TParamBlockItem,ISDLItem);
93
94			{ TSDLBlock }
95
96	tony	56	TSDLBlock = class (TCustomParamBlock<TSDLItem,ISDLItem>, ISDL)
97	tony	45	public
98	tony	263	constructor Create(api: TFBClientAPI);
99	tony	45	end;
100
101			implementation
102
103	tony	263	uses FBAttachment, FB30Statement;
104	tony	45
105			const
106			sGetArrayMetaData = 'Select F.RDB$FIELD_LENGTH, F.RDB$FIELD_SCALE, F.RDB$FIELD_TYPE, '+
107			'F.RDB$DIMENSIONS, FD.RDB$DIMENSION, FD.RDB$LOWER_BOUND, FD.RDB$UPPER_BOUND, '+
108			'F.RDB$CHARACTER_SET_ID '+
109			'From RDB$FIELDS F JOIN RDB$RELATION_FIELDS RF '+
110			'On F.RDB$FIELD_NAME = RF.RDB$FIELD_SOURCE JOIN RDB$FIELD_DIMENSIONS FD '+
111			'On FD.RDB$FIELD_NAME = F.RDB$FIELD_NAME ' +
112	tony	113	'Where RF.RDB$RELATION_NAME = ? and RF.RDB$FIELD_NAME = ? ' +
113			'UNION '+
114			'Select F.RDB$FIELD_LENGTH, F.RDB$FIELD_SCALE, F.RDB$FIELD_TYPE, '+
115			'F.RDB$DIMENSIONS, FD.RDB$DIMENSION, FD.RDB$LOWER_BOUND, FD.RDB$UPPER_BOUND, '+
116			'F.RDB$CHARACTER_SET_ID '+
117			'From RDB$FIELDS F JOIN RDB$PROCEDURE_PARAMETERS PP '+
118			'On F.RDB$FIELD_NAME = PP.RDB$FIELD_SOURCE JOIN RDB$FIELD_DIMENSIONS FD '+
119			'On FD.RDB$FIELD_NAME = F.RDB$FIELD_NAME ' +
120			'Where PP.RDB$PROCEDURE_NAME = ? and PP.RDB$PARAMETER_NAME = ? '+
121			'Order by 5 asc';
122	tony	45
123
124			{ TFB30ArrayMetaData }
125
126			{Assemble the array descriptor from the System Tables}
127
128			procedure TFB30ArrayMetaData.LoadMetaData(aAttachment: IAttachment;
129	tony	56	aTransaction: ITransaction; relationName, columnName: AnsiString);
130	tony	45	var stmt: IStatement;
131	tony	47	CharWidth: integer;
132	tony	45	begin
133	tony	263	CharWidth := 0;
134	tony	45	RelationName := AnsiUpperCase(RelationName);
135			ColumnName := AnsiUpperCase(ColumnName);
136			stmt := TFB30Statement.Create(aAttachment as TFB30Attachment,aTransaction,
137			sGetArrayMetaData ,aAttachment.GetSQLDialect);
138			with stmt do
139			begin
140			SQLParams[0].AsString := RelationName;
141			SQLParams[1].AsString := ColumnName;
142	tony	113	SQLParams[2].AsString := RelationName;
143			SQLParams[3].AsString := ColumnName;
144	tony	45	with OpenCursor do
145			if FetchNext then
146			begin
147			FillChar(FArrayDesc.array_desc_field_name,sizeof(FArrayDesc.array_desc_field_name),' ');
148	tony	47	FillChar(FArrayDesc.array_desc_relation_name,sizeof(FArrayDesc.array_desc_relation_name),' ');
149	tony	45	Move(columnName[1],FArrayDesc.array_desc_field_name,Length(columnName));
150			Move(relationName[1],FArrayDesc.array_desc_relation_name,length(relationName));
151			FArrayDesc.array_desc_length := Data[0].AsInteger;
152	tony	56	FArrayDesc.array_desc_scale := Data[1].AsInteger;
153	tony	45	FArrayDesc.array_desc_dtype := Data[2].AsInteger;
154			FArrayDesc.array_desc_dimensions := Data[3].AsInteger;
155			FArrayDesc.array_desc_flags := 0; {row major}
156			FCharSetID := Data[7].AsInteger;
157			if (FCharSetID > 1) and (aAttachment as TFB30Attachment).HasDefaultCharSet then
158			FCharSetID := (aAttachment as TFB30Attachment).CharSetID;
159			FCodePage := CP_NONE;
160	tony	60	FAttachment.CharSetID2CodePage(FCharSetID,FCodePage);
161	tony	309	FCharSetWidth := 1;
162			FAttachment.CharSetWidth(FCharSetID,FCharSetWidth);
163	tony	47	if (FArrayDesc.array_desc_dtype in [blr_text,blr_cstring, blr_varying]) and
164			(FCharSetID = 0) then {This really shouldn't be necessary - but it is :(}
165			with aAttachment as TFBAttachment do
166			begin
167	tony	60	if HasDefaultCharSet and FAttachment.CharSetWidth(CharSetID,CharWidth) then
168	tony	56	FArrayDesc.array_desc_length := FArrayDesc.array_desc_length * CharWidth;
169	tony	47	end;
170	tony	45	repeat
171			with FArrayDesc.array_desc_bounds[Data[4].AsInteger] do
172			begin
173			array_bound_lower := Data[5].AsInteger;
174			array_bound_upper := Data[6].AsInteger;
175			end;
176			until not FetchNext;
177			end;
178			end;
179			end;
180
181			function TFB30ArrayMetaData.GetCharSetID: cardinal;
182			begin
183			Result := FCharSetID;
184			end;
185
186			function TFB30ArrayMetaData.GetCodePage: TSystemCodePage;
187			begin
188			Result := FCodePage;
189			end;
190
191	tony	309	function TFB30ArrayMetaData.GetCharSetWidth: integer;
192			begin
193			Result := FCharSetWidth;
194			end;
195
196	tony	45	{ TFB30Array }
197
198	tony	315	procedure TFB30Array.GenerateSDL;
199	tony	45
200			procedure AddVarInteger(aValue: integer);
201			begin
202			if (aValue >= -128) and (aValue <= 127) then
203			FSDL.Add(isc_sdl_tiny_integer).SetAsTinyInteger(aValue)
204			else
205			if (aValue >= -32768) and (aValue <= 32767) then
206			FSDL.Add(isc_sdl_short_integer).SetAsShortInteger(aValue)
207			else
208			FSDL.Add(isc_sdl_long_integer).SetAsInteger(aValue);
209			end;
210
211			var i: integer;
212			SDLItem: ISDLItem;
213			begin
214	tony	263	FSDL := TSDLBlock.Create(FFirebird30ClientAPI);
215	tony	45	with GetArrayDesc^ do
216			{The following is based on gen_SDL from Firebird src/dsql/array.cpp}
217			begin
218			SDLItem := FSDL.Add(isc_sdl_struct);
219			SDLItem.SetAsByte(array_desc_dtype);
220
221			case array_desc_dtype of
222			blr_short,blr_long,
223	tony	315	blr_int64,blr_quad,
224			blr_int128:
225			SDLItem.AddShortInt(array_desc_scale);
226	tony	45
227			blr_text,blr_cstring, blr_varying:
228			SDLItem.addShortInteger(array_desc_length);
229			end;
230
231	tony	47	FSDL.Add(isc_sdl_relation).SetAsString(array_desc_relation_name);
232			FSDL.Add(isc_sdl_field).SetAsString(array_desc_field_name);
233	tony	45
234			for i := 0 to array_desc_dimensions - 1 do
235			begin
236			if array_desc_bounds[i].array_bound_lower = 1 then
237			FSDL.Add(isc_sdl_do1).SetAsTinyInteger(i)
238			else
239			begin
240			FSDL.Add(isc_sdl_do2).SetAsTinyInteger(i);
241			AddVarInteger(array_desc_bounds[i].array_bound_lower);
242			end;
243			AddVarInteger(array_desc_bounds[i].array_bound_upper);
244			end;
245
246			SDLItem := FSDL.Add(isc_sdl_element);
247			SDLItem.AddByte(1);
248			SDLItem := FSDL.Add(isc_sdl_scalar);
249			SDLItem.AddByte(0);
250			SDLItem.AddByte(array_desc_dimensions);
251			for i := 0 to array_desc_dimensions - 1 do
252			begin
253			SDLItem := FSDL.Add(isc_sdl_variable);
254			SDLItem.AddByte(i);
255			end;
256			FSDL.Add(isc_sdl_eoc);
257			end;
258			end;
259
260	tony	315	procedure TFB30Array.AllocateBuffer;
261
262			begin
263			inherited AllocateBuffer;
264			{Now set up the SDL}
265			GenerateSDL;
266			end;
267
268	tony	45	procedure TFB30Array.InternalGetSlice;
269			begin
270	tony	263	with FFirebird30ClientAPI do
271	tony	45	begin
272			FAttachmentIntf.getSlice(StatusIntf,FTransactionIntf,
273			@FArrayID,
274			(FSDL as TSDLBlock).getDataLength,
275			BytePtr((FSDL as TSDLBlock).getBuffer),
276			0,nil,
277			FBufSize,BytePtr(FBuffer)
278			);
279			Check4DataBaseError;
280			end;
281			SignalActivity;
282			end;
283
284			procedure TFB30Array.InternalPutSlice(Force: boolean);
285			begin
286	tony	263	with FFirebird30ClientAPI do
287	tony	45	begin
288			FAttachmentIntf.putSlice(StatusIntf,FTransactionIntf, @FArrayID,
289			(FSDL as TSDLBlock).getDataLength,
290			BytePtr((FSDL as TSDLBlock).getBuffer),
291			0,nil,
292			FBufSize,BytePtr(FBuffer)
293			);
294			if not Force then
295			Check4DataBaseError;
296			end;
297			SignalActivity;
298			end;
299
300			constructor TFB30Array.Create(aAttachment: TFB30Attachment;
301			aTransaction: TFB30Transaction; aField: IArrayMetaData);
302			begin
303			inherited Create(aAttachment,aTransaction,aField);
304			FAttachmentIntf := aAttachment.AttachmentIntf;
305			FTransactionIntf := aTransaction.TransactionIntf;
306	tony	263	FFirebird30ClientAPI := aAttachment.Firebird30ClientAPI;
307	tony	45	end;
308
309			constructor TFB30Array.Create(aAttachment: TFB30Attachment;
310			aTransaction: TFB30Transaction; aField: IArrayMetaData; ArrayID: TISC_QUAD);
311			begin
312			inherited Create(aAttachment,aTransaction,aField,ArrayID);
313			FAttachmentIntf := aAttachment.AttachmentIntf;
314			FTransactionIntf := aTransaction.TransactionIntf;
315	tony	263	FFirebird30ClientAPI := aAttachment.Firebird30ClientAPI;
316	tony	45	end;
317
318			{ TSDLBlock }
319
320	tony	263	constructor TSDLBlock.Create(api: TFBClientAPI);
321	tony	45	begin
322	tony	263	inherited Create(api);
323	tony	45	FDataLength := 1;
324	tony	56	FBuffer^ := isc_sdl_version1;
325	tony	45	end;
326
327			end.
328