fbintf/client/FBParamBlock.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 FBParamBlock;
{$IFDEF MSWINDOWS} 
{$DEFINE WINDOWS} 
{$ENDIF}

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

interface

{Provides common handling for the DPB, TPB, SPB and Service Request Block (SRB)}

uses
  Classes, SysUtils, IB, FBClientAPI, FBActivityMonitor;

type
  TParamDataType = (dtString, dtString2, dtString0, dtByte, dtByte2, dtInteger,  dtInteger1,
                    dtInteger2,  dtShortInteger,dtTinyInteger,dtnone);

  PParamBlockItemData = ^TParamBlockItemData;
  TParamBlockItemData = record
    {Describes a Clumplet in the buffer. FBufPtr always points to the clumplet id
     the rest of the clumplet up to the FBufLength is data. The data format is
     given by FDataType}
    FBufPtr: PByte;
    FBuflength: integer;
    FDataType: TParamDataType;
  end;

  TParamBlockItem = class;

  { TParamBlock }

  TParamBlock = class(TFBInterfacedObject)
  private
    FItems: array of PParamBlockItemData;
    FBufferSize: integer;
    FFirebirdClientAPI: TFBClientAPI;
    procedure AdjustBuffer;
    procedure MoveBy(Item: PParamBlockItemData; delta: integer);
    procedure UpdateRequestItemSize(Item: TParamBlockItem; NewSize: integer);
  protected
    FBuffer: PByte;
    FDataLength: integer;
    function Add(ParamType: byte): PParamBlockItemData;
    function Find(ParamType: byte): PParamBlockItemData;
    function GetItems(index: integer): PParamBlockItemData;
    function LookupItemType(ParamTypeName: AnsiString): byte; virtual;
  public
    constructor Create(api: TFBClientAPI);
    destructor Destroy; override;
    function getBuffer: PByte;
    function getDataLength: integer;
    function AvailableBufferSpace: integer;

  public
    function getCount: integer;
    procedure Remove(ParamType: byte);
    procedure PrintBuf;
  end;

  { TParamBlockItem }

  TParamBlockItem = class(TFBInterfacedObject)
  private
     FOwner: TParamBlock;
     FOwnerIntf: IUnknown;
     FParamData: PParamBlockItemData;
     FFirebirdClientAPI: TFBClientAPI;
  protected
    property ParamData: PParamBlockItemData read FParamData;
  public
     constructor Create(AOwner: TParamBlock; Data: PParamBlockItemData);
  public
     function getAsInteger: integer;
     function getParamType: byte;
     function getParamTypeName: AnsiString; virtual;
     function getAsString: AnsiString;
     function getAsByte: byte;
     procedure addByte(aValue: byte);
     procedure addShortInt(aValue: ShortInt);
     procedure addShortInteger(aValue: integer);
     procedure setAsByte(aValue: byte);
     procedure setAsByte2(aValue: byte);
     procedure SetAsInteger(aValue: integer);
     procedure SetAsInteger1(aValue: integer);
     procedure SetAsInteger2(aValue: integer);
     procedure SetAsShortInteger(aValue: integer);
     procedure SetAsTinyInteger(aValue: integer);
     procedure SetAsString(aValue: AnsiString);
     procedure SetAsString2(aValue: AnsiString);
     procedure SetAsString0(aValue: AnsiString);
  end;

  { TSRBItem }

  TSRBItem = class(TParamBlockItem,ISRBItem)
  public
    {$IFDEF FPC}
    procedure ISRBItem.SetAsString = SetAsString2;
    procedure ISRBItem.SetAsByte = SetAsByte2;
    {$ELSE}
    procedure SetAsString(aValue: AnsiString) ;
    procedure SetAsByte(aValue: byte);
    {$ENDIF}
  end;

  { TSQPBItem }

  TSQPBItem = class(TParamBlockItem,ISQPBItem)
  public
   function CopyFrom(source: TStream; count: integer): integer;
   {$IFDEF FPC}
   procedure ISQPBItem.SetAsInteger = SetAsInteger2;
   procedure ISQPBItem.SetAsString = SetAsString2;
   {$ELSE}
   procedure SetAsString(aValue: AnsiString) ;
   procedure SetAsInteger(aValue: integer);
   {$ENDIF}
  end;

  { TBPBItem }

  TBPBItem =  class(TParamBlockItem,IBPBItem)
  public
   {$IFDEF FPC}
    procedure IBPBItem.SetAsInteger = SetAsInteger1;
   {$ELSE}
    procedure SetAsInteger(aValue: integer);
   {$ENDIF}
  end;

  { TDIRBItem }

  TDIRBItem = class(TParamBlockItem,IDIRBItem)
  public
   {$IFDEF FPC}
    procedure IDIRBItem.SetAsInteger = SetAsInteger2;
   {$ELSE}
    procedure SetAsInteger(aValue: integer);
   {$ENDIF}
  end;

  { TCustomParamBlock }

{$IFDEF FPC}
  TCustomParamBlock<_TItem, _IItem> = class(TParamBlock)
{$ELSE}
  TParamBlockItemClass = class of TParamBlockItem;
  TCustomParamBlock<_TItem: TParamBlockItem;  _IItem: IParameterBlockItem> = class(TParamBlock)
{$ENDIF}
  public
    function Add(ParamType: byte): _IItem;
    function AddByTypeName(ParamTypeName: AnsiString): _IItem;
    function Find(ParamType: byte): _IItem;
    function GetItems(index: integer): _IItem;
  end;

  { TSRB }

  TSRB = class (TCustomParamBlock<TSRBItem,ISRBItem>, ISRB);

  { TSQPB }

  TSQPB = class (TCustomParamBlock<TSQPBItem,ISQPBItem>, ISQPB);

  { TBPB }

  TBPB = class (TCustomParamBlock<TBPBItem,IBPBItem>, IBPB)
  public
   constructor Create(api: TFBClientAPI);
  end;

  TDIRB = class (TCustomParamBlock<TDIRBItem,IDIRBItem>, IDIRB);

implementation

uses FBMessages {$IFNDEF FPC} , TypInfo {$ENDIF};

const
  MaxBufferSize = 65535;

{ TDIRBItem }
{$IFNDEF FPC}
procedure TDIRBItem.SetAsInteger(aValue: integer);
begin
  SetAsInteger2(aValue);
end;
{$ENDIF}

{ TBPBItem }
{$IFNDEF FPC}
procedure TBPBItem.SetAsInteger(aValue: integer);
begin
  SetAsInteger1(aValue);
end;
{$ENDIF}

{ TSRBItem }

{$IFNDEF FPC}
procedure TSRBItem.SetAsString(aValue: AnsiString);
begin
  SetAsString2(aValue);
end;

procedure TSRBItem.SetAsByte(aValue: byte);
begin
  SetAsByte2(aValue);
end;
{$ENDIF}

{ TSQPBItem }

function TSQPBItem.CopyFrom(source: TStream; count: integer): integer;
begin
  if count > (FOwner.AvailableBufferSpace - 4) then
    count := FOwner.AvailableBufferSpace - 4;
    with FParamData^ do
    begin
      FOwner.UpdateRequestItemSize(self,count + 4);
      Result := source.Read((FBufPtr+3)^,count);
      with FFirebirdClientAPI do
        EncodeInteger(Result,2,FBufPtr+1);
      (FBufPtr+Result + 3)^ := isc_info_end;
      if Result <> count then
        FOwner.UpdateRequestItemSize(self,Result + 4);
      FDataType := dtString2;
    end;
end;

{$IFNDEF FPC}
procedure TSQPBItem.SetAsString(aValue: AnsiString);
begin
  SetAsString2(aValue);
end;

procedure TSQPBItem.SetAsInteger(aValue: integer);
begin
  SetAsInteger2(aValue);
end;
{$ENDIF}

{ TParamBlockItem }

constructor TParamBlockItem.Create(AOwner: TParamBlock;
  Data: PParamBlockItemData);
begin
  inherited Create;
  FOwner := AOwner;
  FFirebirdClientAPI := AOwner.FFirebirdClientAPI;
  FOwnerIntf := AOwner;
  FParamData := Data;
end;

function TParamBlockItem.getAsInteger: integer;
begin
  with FFirebirdClientAPI, FParamData^ do
  case FDataType of
  dtInteger:
    Result := DecodeInteger(FBufPtr+1,4);
  dtShortInteger:
    Result := DecodeInteger(FBufPtr+1,2);
  dtTinyInteger:
    Result := DecodeInteger(FBufPtr+1,1);
  dtInteger1:
    Result := DecodeInteger(FBufPtr+2,2);
  dtInteger2:
    Result := DecodeInteger(FBufPtr+3,4);
  else
    IBError(ibxePBParamTypeError,[nil]);
  end;
end;

function TParamBlockItem.getParamType: byte;
begin
  Result := byte(FParamData^.FBufPtr^);
end;

function TParamBlockItem.getParamTypeName: AnsiString;
begin
  Result := '';
end;

function TParamBlockItem.getAsString: AnsiString;
var len: byte;
begin
  Result := '';

  with FParamData^ do
  case FDataType of
  dtInteger,
  dtInteger1,
  dtInteger2,
  dtShortInteger,
  dtTinyInteger:
    Result := IntToStr(getAsInteger);
  dtByte,
  dtByte2:
    Result := IntToStr(getAsByte);
  dtString:
    begin
      len := (FBufPtr+1)^;
      SetString(Result,PAnsiChar(FBufPtr+2),len);
    end;
  dtString2:
    begin
      with FFirebirdClientAPI do
        len := DecodeInteger(FBufPtr+1,2);
      SetString(Result,PAnsiChar(FBufPtr+3),len);
    end;
  dtString0:
      Result := strpas(PAnsiChar(FBufPtr+1));
  dtNone:
      Result := '';
  else
    IBError(ibxeOutputBlockTypeError,[nil]);
  end;
end;

function TParamBlockItem.getAsByte: byte;
begin
  with FParamData^ do
  if FDataType = dtByte then
    Result := byte((FBufPtr+2)^)
  else
  if FDataType = dtByte2 then
    Result := byte((FBufPtr+1)^)
  else
    IBError(ibxePBParamTypeError,[nil]);
end;

procedure TParamBlockItem.addByte(aValue: byte);
var len: integer;
    P: PByte;
begin
  with FParamData^ do
  begin
    P := FBufPtr + FBufLength;
    len := FBufLength + 1;
    FOwner.UpdateRequestItemSize(self,len);
    P^ := aValue;
  end;
end;

procedure TParamBlockItem.addShortInt(aValue: ShortInt);
var len: integer;
    P: PByte;
begin
  with FParamData^ do
  begin
    P := FBufPtr + FBufLength;
    len := FBufLength + 1;
    FOwner.UpdateRequestItemSize(self,len);
    PShortInt(P)^ := aValue;
  end;
end;

procedure TParamBlockItem.addShortInteger(aValue: integer);
var len: integer;
    P: PByte;
begin
  with FParamData^ do
  begin
    P := FBufPtr + FBufLength;
    len := FBufLength + 2;
    FOwner.UpdateRequestItemSize(self,len);
    with FFirebirdClientAPI do
      EncodeInteger(aValue,2,P);
  end;
end;

procedure TParamBlockItem.setAsByte(aValue: byte);
begin
  with FParamData^ do
  begin
    if FBufLength <> 3 then
      FOwner.UpdateRequestItemSize(self,3);
    FDataType := dtByte;
    (FBufPtr+1)^ := $1;
    (FBufPtr+2)^ := aValue;
  end;
end;

procedure TParamBlockItem.setAsByte2(aValue: byte);
begin
  with FParamData^ do
  begin
    if FBufLength <> 2 then
      FOwner.UpdateRequestItemSize(self,2);
    FDataType := dtByte2;
    (FBufPtr+1)^ := aValue;
  end;
end;

{Four byte integer - no length}

procedure TParamBlockItem.SetAsInteger(aValue: integer);
begin
  with FParamData^ do
  begin
    if FBufLength <> 5 then
      FOwner.UpdateRequestItemSize(self,5);
    with FFirebirdClientAPI do
      EncodeInteger(aValue,4,FBufPtr+1);
    FDataType := dtInteger;
  end;
end;

{Four byte integer - length byte}

procedure TParamBlockItem.SetAsInteger1(aValue: integer);
begin
  with FParamData^ do
  begin
    if FBufLength <> 6 then
      FOwner.UpdateRequestItemSize(self,6);
    (FBufPtr+1)^ := $4;
    with FFirebirdClientAPI do
      EncodeInteger(aValue,4,FBufPtr+2);
    FDataType := dtInteger1;
  end;
end;

{Four byte integer - 2 byte length}

procedure TParamBlockItem.SetAsInteger2(aValue: integer);
begin
  with FParamData^ do
  begin
    if FBufLength <> 7 then
      FOwner.UpdateRequestItemSize(self,7);
    with FFirebirdClientAPI do
    begin
      EncodeInteger(4,2,FBufPtr+1); {Encode length as two bytes}
      EncodeInteger(aValue,4,FBufPtr+3);
    end;
    FDataType := dtInteger2
  end;
end;

procedure TParamBlockItem.SetAsShortInteger(aValue: integer);
begin
  with FParamData^ do
  begin
    if FBufLength <> 3 then
      FOwner.UpdateRequestItemSize(self,3);
    with FFirebirdClientAPI do
      EncodeInteger(aValue,2,FBufPtr+1);
    FDataType := dtShortInteger;
  end;
end;

procedure TParamBlockItem.SetAsTinyInteger(aValue: integer);
begin
  with FParamData^ do
  begin
    if FBufLength <> 2 then
      FOwner.UpdateRequestItemSize(self,2);
    with FFirebirdClientAPI do
      EncodeInteger(aValue,1,FBufPtr+1);
    FDataType := dtTinyInteger;
  end;
end;

{Short string encoding}

procedure TParamBlockItem.SetAsString(aValue: AnsiString);
var len: integer;
begin
  with FParamData^ do
  begin
    len := Length(aValue);
    if len > 255 then
      IBError(ibxStringTooLong,[aValue,255]);
    FOwner.UpdateRequestItemSize(self,len+2);
    (FBufPtr+1)^ := len;
    if len > 0 then
      Move(aValue[1],(FBufPtr+2)^,len);
    FDataType := dtString;
  end;
end;

{Long string up to 65535 encoding}

procedure TParamBlockItem.SetAsString2(aValue: AnsiString);
var len: integer;
begin
  with FParamData^ do
  begin
    len := Length(aValue);
    if len > 65535 then
      IBError(ibxStringTooLong,[aValue,65535]);
    FOwner.UpdateRequestItemSize(self,len + 3);
    with FFirebirdClientAPI do
      EncodeInteger(len,2,FBufPtr+1);
    if len > 0 then
      Move(aValue[1],(FBufPtr+3)^,len);
    FDataType := dtString2;
  end;
end;

{Zero byte terminated string encoding}

procedure TParamBlockItem.SetAsString0(aValue: AnsiString);
var len: integer;
begin
  with FParamData^ do
  begin
    len := Length(aValue);
    FOwner.UpdateRequestItemSize(self,len+2);
    if len > 0 then
      Move(aValue[1],(FBufPtr+1)^,len);
    (FBufPtr+len+1)^ := 0;
    FDataType := dtString0;
  end;
end;

{ TParamBlock }

procedure TParamBlock.AdjustBuffer;
var P: PByte;
    i: integer;
    headerLen: integer;
begin
  if FDataLength > FBufferSize then
  begin
    if Length(FItems) > 0 then
      headerLen := FItems[0]^.FBufPtr - FBuffer
    else
      headerLen := 0;
    FBufferSize := 2*FDataLength;
    ReallocMem(FBuffer,FBufferSize);
    P := FBuffer + headerLen;
    for i := 0 to Length(FItems) - 1 do
    begin
      FItems[i]^.FBufPtr := P;
      Inc(P,FItems[i]^.FBuflength);
    end;
  end;
end;

procedure TParamBlock.MoveBy(Item: PParamBlockItemData; delta: integer);
var src, dest: PByte;
  i: integer;
begin
  with Item^ do
  begin
    src := FBufptr;
    dest := FBufptr + delta ;
    if delta > 0 then
    begin
      for i := FBufLength - 1 downto 0 do
        (dest +i)^ := (src+i)^;
    end
    else
    begin
      for i := 0 to FBufLength - 1 do
      (dest +i)^ := (src+i)^;
    end;
    FBufPtr := FBufPtr + delta;
  end;
end;

procedure TParamBlock.UpdateRequestItemSize(Item: TParamBlockItem;
  NewSize: integer);
var i, delta: integer;
begin
  delta := NewSize - Item.FParamData^.FBufLength;
  Item.FParamData^.FBufLength := NewSize;
  if delta > 0 then
  begin
    if FDataLength + delta > MaxBufferSize then
      IBError(ibxeParamBufferOverflow,[nil]);
    FDataLength := FDataLength + delta;
    AdjustBuffer;
    i := Length(FItems) - 1;
    while i >= 0  do
    begin
      if FItems[i]  = Item.FParamData then
        break; {we're done}
      Moveby(FItems[i],delta);
      Dec(i);
    end;
  end
  else
  begin
    i := 0;
    while i < Length(FItems) do
    begin
      if FItems[i] = Item.FParamData then
        break; {we're done}
      Inc(i);
    end;
    Inc(i);
    while i < Length(FItems) do
    begin
      Moveby(FItems[i],delta);
      Inc(i);
    end;
    FDataLength := FDataLength + delta;
  end;
end;

constructor TParamBlock.Create(api: TFBClientAPI);
begin
  inherited Create;
  FFirebirdClientAPI := api;
  GetMem(FBuffer,128);
  if FBuffer = nil then
    OutOfMemoryError;
  FBufferSize := 128;
  FDataLength := 0;
end;

destructor TParamBlock.Destroy;
var i: integer;
begin
  for i := 0 to Length(FItems) -1 do
    dispose(FItems[i]);
  Freemem(FBuffer);
  inherited Destroy;
end;

function TParamBlock.getBuffer: PByte;
begin
  if FDataLength = 0 then
    Result := nil
  else
    Result := FBuffer;
end;

function TParamBlock.getDataLength: integer;
begin
  Result :=  FDataLength;
end;

function TParamBlock.AvailableBufferSpace: integer;
begin
  Result := MaxBufferSize - FDataLength;
end;

function TParamBlock.Add(ParamType: byte): PParamBlockItemData;
begin
  new(Result);
  Result^.FBufPtr := FBuffer + FDataLength;
  Result^.FBufLength := 1;
  Result^.FBufPtr^ := ParamType;
  Result^.FDataType := dtnone; {default}
  Inc(FDataLength,1);
  AdjustBuffer;
  SetLength(FItems,Length(FItems)+1);
  FItems[Length(FItems) - 1 ] := Result;
end;

function TParamBlock.Find(ParamType: byte): PParamBlockItemData;
var i: integer;
begin
  Result := nil;
  for i := 0 to getCount - 1 do
    if byte(FItems[i]^.FBufPtr^) = ParamType then
    begin
      Result := FItems[i];
      Exit;
    end;
end;

function TParamBlock.GetItems(index: integer): PParamBlockItemData;
begin
  if (index >= 0 ) and (index < Length(FItems)) then
   Result := FItems[index]
 else
   IBError(ibxePBIndexError,[index]);
end;

function TParamBlock.LookupItemType(ParamTypeName: AnsiString): byte;
begin
  IBError(ibxeNotSupported,[]);
end;

function TParamBlock.getCount: integer;
begin
  Result := Length(FItems);
end;

procedure TParamBlock.Remove(ParamType: byte);
var P: PParamBlockItemData;
    i, j: integer;
begin
  P := nil;
  for i := 0 to getCount - 1 do
    if byte(FItems[i]^.FBufPtr^) = ParamType then
    begin
      P := FItems[i];
      for j := i + 1 to getCount - 1 do
      begin
        MoveBy(FItems[j],-P^.FBufLength);
        FItems[j - 1] := FItems[j];
      end;
      FDataLength := FDataLength - P^.FBufLength;
      dispose(P);
      SetLength(FItems,Length(FItems)-1);
      Exit;
    end;
end;

procedure TParamBlock.PrintBuf;
var i: integer;
begin
  write(ClassName,': (',getDataLength,') ');
  for i := 0 to getDataLength - 1 do
    write(Format('%x ',[byte(FBuffer[i])]));
  writeln
end;

{ TCustomParamBlock }

function TCustomParamBlock<_TItem, _IItem>.AddByTypeName(ParamTypeName: AnsiString
  ): _IItem;
var ParamType: byte;
begin
  ParamType := LookupItemType(ParamTypeName);
  if ParamType = 0 then
    IBError(ibxeUnknownParamTypeName,[ClassName,ParamTypeName]);
  Result := Add(ParamType);
end;

{$IFDEF FPC}
function TCustomParamBlock<_TItem, _IItem>.Add(ParamType: byte): _IItem;
var Item: PParamBlockItemData;
begin
  Item := inherited Add(ParamType);
  Result := _TItem.Create(self,Item);
end;

function TCustomParamBlock<_TItem, _IItem>.Find(ParamType: byte): _IItem;
var Item: PParamBlockItemData;
begin
  Result := nil;
  Item := inherited Find(ParamType);
  if Item <> nil then
    Result := _TItem.Create(self,Item);
end;

function TCustomParamBlock<_TItem, _IItem>.GetItems(index: integer): _IItem;
var Item: PParamBlockItemData;
begin
  Item := inherited getItems(index);
  Result := _TItem.Create(self,Item);
end;

{$ELSE}
function TCustomParamBlock<_TItem, _IItem>.Add(ParamType: byte): _IItem;
var Item: PParamBlockItemData;
    Obj: TParamBlockItem;
begin
  Item := inherited Add(ParamType);
  Obj := TParamBlockItemClass(_TItem).Create(self,Item);
  if Obj.QueryInterface(GetTypeData(TypeInfo(_IItem))^.Guid,Result) <> 0 then
    IBError(ibxeInterfaceNotSupported,[GuidToString(GetTypeData(TypeInfo(_IItem))^.Guid)]);
end;

function TCustomParamBlock<_TItem, _IItem>.Find(ParamType: byte): _IItem;
var Item: PParamBlockItemData;
    Obj: TParamBlockItem;
begin
  FillChar(Result,sizeof(Result),0); {workaround for older versions of Delphi}
  Item := inherited Find(ParamType);
  if Item <> nil then
  begin
    Obj := TParamBlockItemClass(_TItem).Create(self,Item);
    if Obj.QueryInterface(GetTypeData(TypeInfo(_IItem))^.Guid,Result) <> 0 then
      IBError(ibxeInterfaceNotSupported,[GuidToString(GetTypeData(TypeInfo(_IItem))^.Guid)]);
  end;
end;

function TCustomParamBlock<_TItem, _IItem>.GetItems(index: integer): _IItem;
var Item: PParamBlockItemData;
    Obj: TParamBlockItem;
begin
  Item := inherited getItems(index);
  Obj := TParamBlockItemClass(_TItem).Create(self,Item);
  if Obj.QueryInterface(GetTypeData(TypeInfo(_IItem))^.Guid,Result) <> 0 then
    IBError(ibxeInterfaceNotSupported,[GuidToString(GetTypeData(TypeInfo(_IItem))^.Guid)]);
end;
{$ENDIF}

{ TBPB }

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

end.

Revision:	362
Committed:	Tue Dec 7 13:27:39 2021 UTC (3 years ago) by tony
Content type:	text/x-pascal
File size:	19899 byte(s)
Log Message:	initiate test release
#	Content
1	(*
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 FBParamBlock;
28	{$IFDEF MSWINDOWS}
29	{$DEFINE WINDOWS}
30	{$ENDIF}
31
32	{$IFDEF FPC}
33	{$mode delphi}
34	{$interfaces COM}
35	{$ENDIF}
36
37	interface
38
39	{Provides common handling for the DPB, TPB, SPB and Service Request Block (SRB)}
40
41	uses
42	Classes, SysUtils, IB, FBClientAPI, FBActivityMonitor;
43
44	type
45	TParamDataType = (dtString, dtString2, dtString0, dtByte, dtByte2, dtInteger, dtInteger1,
46	dtInteger2, dtShortInteger,dtTinyInteger,dtnone);
47
48	PParamBlockItemData = ^TParamBlockItemData;
49	TParamBlockItemData = record
50	{Describes a Clumplet in the buffer. FBufPtr always points to the clumplet id
51	the rest of the clumplet up to the FBufLength is data. The data format is
52	given by FDataType}
53	FBufPtr: PByte;
54	FBuflength: integer;
55	FDataType: TParamDataType;
56	end;
57
58	TParamBlockItem = class;
59
60	{ TParamBlock }
61
62	TParamBlock = class(TFBInterfacedObject)
63	private
64	FItems: array of PParamBlockItemData;
65	FBufferSize: integer;
66	FFirebirdClientAPI: TFBClientAPI;
67	procedure AdjustBuffer;
68	procedure MoveBy(Item: PParamBlockItemData; delta: integer);
69	procedure UpdateRequestItemSize(Item: TParamBlockItem; NewSize: integer);
70	protected
71	FBuffer: PByte;
72	FDataLength: integer;
73	function Add(ParamType: byte): PParamBlockItemData;
74	function Find(ParamType: byte): PParamBlockItemData;
75	function GetItems(index: integer): PParamBlockItemData;
76	function LookupItemType(ParamTypeName: AnsiString): byte; virtual;
77	public
78	constructor Create(api: TFBClientAPI);
79	destructor Destroy; override;
80	function getBuffer: PByte;
81	function getDataLength: integer;
82	function AvailableBufferSpace: integer;
83
84	public
85	function getCount: integer;
86	procedure Remove(ParamType: byte);
87	procedure PrintBuf;
88	end;
89
90	{ TParamBlockItem }
91
92	TParamBlockItem = class(TFBInterfacedObject)
93	private
94	FOwner: TParamBlock;
95	FOwnerIntf: IUnknown;
96	FParamData: PParamBlockItemData;
97	FFirebirdClientAPI: TFBClientAPI;
98	protected
99	property ParamData: PParamBlockItemData read FParamData;
100	public
101	constructor Create(AOwner: TParamBlock; Data: PParamBlockItemData);
102	public
103	function getAsInteger: integer;
104	function getParamType: byte;
105	function getParamTypeName: AnsiString; virtual;
106	function getAsString: AnsiString;
107	function getAsByte: byte;
108	procedure addByte(aValue: byte);
109	procedure addShortInt(aValue: ShortInt);
110	procedure addShortInteger(aValue: integer);
111	procedure setAsByte(aValue: byte);
112	procedure setAsByte2(aValue: byte);
113	procedure SetAsInteger(aValue: integer);
114	procedure SetAsInteger1(aValue: integer);
115	procedure SetAsInteger2(aValue: integer);
116	procedure SetAsShortInteger(aValue: integer);
117	procedure SetAsTinyInteger(aValue: integer);
118	procedure SetAsString(aValue: AnsiString);
119	procedure SetAsString2(aValue: AnsiString);
120	procedure SetAsString0(aValue: AnsiString);
121	end;
122
123	{ TSRBItem }
124
125	TSRBItem = class(TParamBlockItem,ISRBItem)
126	public
127	{$IFDEF FPC}
128	procedure ISRBItem.SetAsString = SetAsString2;
129	procedure ISRBItem.SetAsByte = SetAsByte2;
130	{$ELSE}
131	procedure SetAsString(aValue: AnsiString) ;
132	procedure SetAsByte(aValue: byte);
133	{$ENDIF}
134	end;
135
136	{ TSQPBItem }
137
138	TSQPBItem = class(TParamBlockItem,ISQPBItem)
139	public
140	function CopyFrom(source: TStream; count: integer): integer;
141	{$IFDEF FPC}
142	procedure ISQPBItem.SetAsInteger = SetAsInteger2;
143	procedure ISQPBItem.SetAsString = SetAsString2;
144	{$ELSE}
145	procedure SetAsString(aValue: AnsiString) ;
146	procedure SetAsInteger(aValue: integer);
147	{$ENDIF}
148	end;
149
150	{ TBPBItem }
151
152	TBPBItem = class(TParamBlockItem,IBPBItem)
153	public
154	{$IFDEF FPC}
155	procedure IBPBItem.SetAsInteger = SetAsInteger1;
156	{$ELSE}
157	procedure SetAsInteger(aValue: integer);
158	{$ENDIF}
159	end;
160
161	{ TDIRBItem }
162
163	TDIRBItem = class(TParamBlockItem,IDIRBItem)
164	public
165	{$IFDEF FPC}
166	procedure IDIRBItem.SetAsInteger = SetAsInteger2;
167	{$ELSE}
168	procedure SetAsInteger(aValue: integer);
169	{$ENDIF}
170	end;
171
172	{ TCustomParamBlock }
173
174	{$IFDEF FPC}
175	TCustomParamBlock<_TItem, _IItem> = class(TParamBlock)
176	{$ELSE}
177	TParamBlockItemClass = class of TParamBlockItem;
178	TCustomParamBlock<_TItem: TParamBlockItem; _IItem: IParameterBlockItem> = class(TParamBlock)
179	{$ENDIF}
180	public
181	function Add(ParamType: byte): _IItem;
182	function AddByTypeName(ParamTypeName: AnsiString): _IItem;
183	function Find(ParamType: byte): _IItem;
184	function GetItems(index: integer): _IItem;
185	end;
186
187	{ TSRB }
188
189	TSRB = class (TCustomParamBlock<TSRBItem,ISRBItem>, ISRB);
190
191	{ TSQPB }
192
193	TSQPB = class (TCustomParamBlock<TSQPBItem,ISQPBItem>, ISQPB);
194
195	{ TBPB }
196
197	TBPB = class (TCustomParamBlock<TBPBItem,IBPBItem>, IBPB)
198	public
199	constructor Create(api: TFBClientAPI);
200	end;
201
202	TDIRB = class (TCustomParamBlock<TDIRBItem,IDIRBItem>, IDIRB);
203
204	implementation
205
206	uses FBMessages {$IFNDEF FPC} , TypInfo {$ENDIF};
207
208	const
209	MaxBufferSize = 65535;
210
211	{ TDIRBItem }
212	{$IFNDEF FPC}
213	procedure TDIRBItem.SetAsInteger(aValue: integer);
214	begin
215	SetAsInteger2(aValue);
216	end;
217	{$ENDIF}
218
219	{ TBPBItem }
220	{$IFNDEF FPC}
221	procedure TBPBItem.SetAsInteger(aValue: integer);
222	begin
223	SetAsInteger1(aValue);
224	end;
225	{$ENDIF}
226
227	{ TSRBItem }
228
229	{$IFNDEF FPC}
230	procedure TSRBItem.SetAsString(aValue: AnsiString);
231	begin
232	SetAsString2(aValue);
233	end;
234
235	procedure TSRBItem.SetAsByte(aValue: byte);
236	begin
237	SetAsByte2(aValue);
238	end;
239	{$ENDIF}
240
241	{ TSQPBItem }
242
243	function TSQPBItem.CopyFrom(source: TStream; count: integer): integer;
244	begin
245	if count > (FOwner.AvailableBufferSpace - 4) then
246	count := FOwner.AvailableBufferSpace - 4;
247	with FParamData^ do
248	begin
249	FOwner.UpdateRequestItemSize(self,count + 4);
250	Result := source.Read((FBufPtr+3)^,count);
251	with FFirebirdClientAPI do
252	EncodeInteger(Result,2,FBufPtr+1);
253	(FBufPtr+Result + 3)^ := isc_info_end;
254	if Result <> count then
255	FOwner.UpdateRequestItemSize(self,Result + 4);
256	FDataType := dtString2;
257	end;
258	end;
259
260	{$IFNDEF FPC}
261	procedure TSQPBItem.SetAsString(aValue: AnsiString);
262	begin
263	SetAsString2(aValue);
264	end;
265
266	procedure TSQPBItem.SetAsInteger(aValue: integer);
267	begin
268	SetAsInteger2(aValue);
269	end;
270	{$ENDIF}
271
272	{ TParamBlockItem }
273
274	constructor TParamBlockItem.Create(AOwner: TParamBlock;
275	Data: PParamBlockItemData);
276	begin
277	inherited Create;
278	FOwner := AOwner;
279	FFirebirdClientAPI := AOwner.FFirebirdClientAPI;
280	FOwnerIntf := AOwner;
281	FParamData := Data;
282	end;
283
284	function TParamBlockItem.getAsInteger: integer;
285	begin
286	with FFirebirdClientAPI, FParamData^ do
287	case FDataType of
288	dtInteger:
289	Result := DecodeInteger(FBufPtr+1,4);
290	dtShortInteger:
291	Result := DecodeInteger(FBufPtr+1,2);
292	dtTinyInteger:
293	Result := DecodeInteger(FBufPtr+1,1);
294	dtInteger1:
295	Result := DecodeInteger(FBufPtr+2,2);
296	dtInteger2:
297	Result := DecodeInteger(FBufPtr+3,4);
298	else
299	IBError(ibxePBParamTypeError,[nil]);
300	end;
301	end;
302
303	function TParamBlockItem.getParamType: byte;
304	begin
305	Result := byte(FParamData^.FBufPtr^);
306	end;
307
308	function TParamBlockItem.getParamTypeName: AnsiString;
309	begin
310	Result := '';
311	end;
312
313	function TParamBlockItem.getAsString: AnsiString;
314	var len: byte;
315	begin
316	Result := '';
317
318	with FParamData^ do
319	case FDataType of
320	dtInteger,
321	dtInteger1,
322	dtInteger2,
323	dtShortInteger,
324	dtTinyInteger:
325	Result := IntToStr(getAsInteger);
326	dtByte,
327	dtByte2:
328	Result := IntToStr(getAsByte);
329	dtString:
330	begin
331	len := (FBufPtr+1)^;
332	SetString(Result,PAnsiChar(FBufPtr+2),len);
333	end;
334	dtString2:
335	begin
336	with FFirebirdClientAPI do
337	len := DecodeInteger(FBufPtr+1,2);
338	SetString(Result,PAnsiChar(FBufPtr+3),len);
339	end;
340	dtString0:
341	Result := strpas(PAnsiChar(FBufPtr+1));
342	dtNone:
343	Result := '';
344	else
345	IBError(ibxeOutputBlockTypeError,[nil]);
346	end;
347	end;
348
349	function TParamBlockItem.getAsByte: byte;
350	begin
351	with FParamData^ do
352	if FDataType = dtByte then
353	Result := byte((FBufPtr+2)^)
354	else
355	if FDataType = dtByte2 then
356	Result := byte((FBufPtr+1)^)
357	else
358	IBError(ibxePBParamTypeError,[nil]);
359	end;
360
361	procedure TParamBlockItem.addByte(aValue: byte);
362	var len: integer;
363	P: PByte;
364	begin
365	with FParamData^ do
366	begin
367	P := FBufPtr + FBufLength;
368	len := FBufLength + 1;
369	FOwner.UpdateRequestItemSize(self,len);
370	P^ := aValue;
371	end;
372	end;
373
374	procedure TParamBlockItem.addShortInt(aValue: ShortInt);
375	var len: integer;
376	P: PByte;
377	begin
378	with FParamData^ do
379	begin
380	P := FBufPtr + FBufLength;
381	len := FBufLength + 1;
382	FOwner.UpdateRequestItemSize(self,len);
383	PShortInt(P)^ := aValue;
384	end;
385	end;
386
387	procedure TParamBlockItem.addShortInteger(aValue: integer);
388	var len: integer;
389	P: PByte;
390	begin
391	with FParamData^ do
392	begin
393	P := FBufPtr + FBufLength;
394	len := FBufLength + 2;
395	FOwner.UpdateRequestItemSize(self,len);
396	with FFirebirdClientAPI do
397	EncodeInteger(aValue,2,P);
398	end;
399	end;
400
401	procedure TParamBlockItem.setAsByte(aValue: byte);
402	begin
403	with FParamData^ do
404	begin
405	if FBufLength <> 3 then
406	FOwner.UpdateRequestItemSize(self,3);
407	FDataType := dtByte;
408	(FBufPtr+1)^ := $1;
409	(FBufPtr+2)^ := aValue;
410	end;
411	end;
412
413	procedure TParamBlockItem.setAsByte2(aValue: byte);
414	begin
415	with FParamData^ do
416	begin
417	if FBufLength <> 2 then
418	FOwner.UpdateRequestItemSize(self,2);
419	FDataType := dtByte2;
420	(FBufPtr+1)^ := aValue;
421	end;
422	end;
423
424	{Four byte integer - no length}
425
426	procedure TParamBlockItem.SetAsInteger(aValue: integer);
427	begin
428	with FParamData^ do
429	begin
430	if FBufLength <> 5 then
431	FOwner.UpdateRequestItemSize(self,5);
432	with FFirebirdClientAPI do
433	EncodeInteger(aValue,4,FBufPtr+1);
434	FDataType := dtInteger;
435	end;
436	end;
437
438	{Four byte integer - length byte}
439
440	procedure TParamBlockItem.SetAsInteger1(aValue: integer);
441	begin
442	with FParamData^ do
443	begin
444	if FBufLength <> 6 then
445	FOwner.UpdateRequestItemSize(self,6);
446	(FBufPtr+1)^ := $4;
447	with FFirebirdClientAPI do
448	EncodeInteger(aValue,4,FBufPtr+2);
449	FDataType := dtInteger1;
450	end;
451	end;
452
453	{Four byte integer - 2 byte length}
454
455	procedure TParamBlockItem.SetAsInteger2(aValue: integer);
456	begin
457	with FParamData^ do
458	begin
459	if FBufLength <> 7 then
460	FOwner.UpdateRequestItemSize(self,7);
461	with FFirebirdClientAPI do
462	begin
463	EncodeInteger(4,2,FBufPtr+1); {Encode length as two bytes}
464	EncodeInteger(aValue,4,FBufPtr+3);
465	end;
466	FDataType := dtInteger2
467	end;
468	end;
469
470	procedure TParamBlockItem.SetAsShortInteger(aValue: integer);
471	begin
472	with FParamData^ do
473	begin
474	if FBufLength <> 3 then
475	FOwner.UpdateRequestItemSize(self,3);
476	with FFirebirdClientAPI do
477	EncodeInteger(aValue,2,FBufPtr+1);
478	FDataType := dtShortInteger;
479	end;
480	end;
481
482	procedure TParamBlockItem.SetAsTinyInteger(aValue: integer);
483	begin
484	with FParamData^ do
485	begin
486	if FBufLength <> 2 then
487	FOwner.UpdateRequestItemSize(self,2);
488	with FFirebirdClientAPI do
489	EncodeInteger(aValue,1,FBufPtr+1);
490	FDataType := dtTinyInteger;
491	end;
492	end;
493
494	{Short string encoding}
495
496	procedure TParamBlockItem.SetAsString(aValue: AnsiString);
497	var len: integer;
498	begin
499	with FParamData^ do
500	begin
501	len := Length(aValue);
502	if len > 255 then
503	IBError(ibxStringTooLong,[aValue,255]);
504	FOwner.UpdateRequestItemSize(self,len+2);
505	(FBufPtr+1)^ := len;
506	if len > 0 then
507	Move(aValue[1],(FBufPtr+2)^,len);
508	FDataType := dtString;
509	end;
510	end;
511
512	{Long string up to 65535 encoding}
513
514	procedure TParamBlockItem.SetAsString2(aValue: AnsiString);
515	var len: integer;
516	begin
517	with FParamData^ do
518	begin
519	len := Length(aValue);
520	if len > 65535 then
521	IBError(ibxStringTooLong,[aValue,65535]);
522	FOwner.UpdateRequestItemSize(self,len + 3);
523	with FFirebirdClientAPI do
524	EncodeInteger(len,2,FBufPtr+1);
525	if len > 0 then
526	Move(aValue[1],(FBufPtr+3)^,len);
527	FDataType := dtString2;
528	end;
529	end;
530
531	{Zero byte terminated string encoding}
532
533	procedure TParamBlockItem.SetAsString0(aValue: AnsiString);
534	var len: integer;
535	begin
536	with FParamData^ do
537	begin
538	len := Length(aValue);
539	FOwner.UpdateRequestItemSize(self,len+2);
540	if len > 0 then
541	Move(aValue[1],(FBufPtr+1)^,len);
542	(FBufPtr+len+1)^ := 0;
543	FDataType := dtString0;
544	end;
545	end;
546
547	{ TParamBlock }
548
549	procedure TParamBlock.AdjustBuffer;
550	var P: PByte;
551	i: integer;
552	headerLen: integer;
553	begin
554	if FDataLength > FBufferSize then
555	begin
556	if Length(FItems) > 0 then
557	headerLen := FItems[0]^.FBufPtr - FBuffer
558	else
559	headerLen := 0;
560	FBufferSize := 2*FDataLength;
561	ReallocMem(FBuffer,FBufferSize);
562	P := FBuffer + headerLen;
563	for i := 0 to Length(FItems) - 1 do
564	begin
565	FItems[i]^.FBufPtr := P;
566	Inc(P,FItems[i]^.FBuflength);
567	end;
568	end;
569	end;
570
571	procedure TParamBlock.MoveBy(Item: PParamBlockItemData; delta: integer);
572	var src, dest: PByte;
573	i: integer;
574	begin
575	with Item^ do
576	begin
577	src := FBufptr;
578	dest := FBufptr + delta ;
579	if delta > 0 then
580	begin
581	for i := FBufLength - 1 downto 0 do
582	(dest +i)^ := (src+i)^;
583	end
584	else
585	begin
586	for i := 0 to FBufLength - 1 do
587	(dest +i)^ := (src+i)^;
588	end;
589	FBufPtr := FBufPtr + delta;
590	end;
591	end;
592
593	procedure TParamBlock.UpdateRequestItemSize(Item: TParamBlockItem;
594	NewSize: integer);
595	var i, delta: integer;
596	begin
597	delta := NewSize - Item.FParamData^.FBufLength;
598	Item.FParamData^.FBufLength := NewSize;
599	if delta > 0 then
600	begin
601	if FDataLength + delta > MaxBufferSize then
602	IBError(ibxeParamBufferOverflow,[nil]);
603	FDataLength := FDataLength + delta;
604	AdjustBuffer;
605	i := Length(FItems) - 1;
606	while i >= 0 do
607	begin
608	if FItems[i] = Item.FParamData then
609	break; {we're done}
610	Moveby(FItems[i],delta);
611	Dec(i);
612	end;
613	end
614	else
615	begin
616	i := 0;
617	while i < Length(FItems) do
618	begin
619	if FItems[i] = Item.FParamData then
620	break; {we're done}
621	Inc(i);
622	end;
623	Inc(i);
624	while i < Length(FItems) do
625	begin
626	Moveby(FItems[i],delta);
627	Inc(i);
628	end;
629	FDataLength := FDataLength + delta;
630	end;
631	end;
632
633	constructor TParamBlock.Create(api: TFBClientAPI);
634	begin
635	inherited Create;
636	FFirebirdClientAPI := api;
637	GetMem(FBuffer,128);
638	if FBuffer = nil then
639	OutOfMemoryError;
640	FBufferSize := 128;
641	FDataLength := 0;
642	end;
643
644	destructor TParamBlock.Destroy;
645	var i: integer;
646	begin
647	for i := 0 to Length(FItems) -1 do
648	dispose(FItems[i]);
649	Freemem(FBuffer);
650	inherited Destroy;
651	end;
652
653	function TParamBlock.getBuffer: PByte;
654	begin
655	if FDataLength = 0 then
656	Result := nil
657	else
658	Result := FBuffer;
659	end;
660
661	function TParamBlock.getDataLength: integer;
662	begin
663	Result := FDataLength;
664	end;
665
666	function TParamBlock.AvailableBufferSpace: integer;
667	begin
668	Result := MaxBufferSize - FDataLength;
669	end;
670
671	function TParamBlock.Add(ParamType: byte): PParamBlockItemData;
672	begin
673	new(Result);
674	Result^.FBufPtr := FBuffer + FDataLength;
675	Result^.FBufLength := 1;
676	Result^.FBufPtr^ := ParamType;
677	Result^.FDataType := dtnone; {default}
678	Inc(FDataLength,1);
679	AdjustBuffer;
680	SetLength(FItems,Length(FItems)+1);
681	FItems[Length(FItems) - 1 ] := Result;
682	end;
683
684	function TParamBlock.Find(ParamType: byte): PParamBlockItemData;
685	var i: integer;
686	begin
687	Result := nil;
688	for i := 0 to getCount - 1 do
689	if byte(FItems[i]^.FBufPtr^) = ParamType then
690	begin
691	Result := FItems[i];
692	Exit;
693	end;
694	end;
695
696	function TParamBlock.GetItems(index: integer): PParamBlockItemData;
697	begin
698	if (index >= 0 ) and (index < Length(FItems)) then
699	Result := FItems[index]
700	else
701	IBError(ibxePBIndexError,[index]);
702	end;
703
704	function TParamBlock.LookupItemType(ParamTypeName: AnsiString): byte;
705	begin
706	IBError(ibxeNotSupported,[]);
707	end;
708
709	function TParamBlock.getCount: integer;
710	begin
711	Result := Length(FItems);
712	end;
713
714	procedure TParamBlock.Remove(ParamType: byte);
715	var P: PParamBlockItemData;
716	i, j: integer;
717	begin
718	P := nil;
719	for i := 0 to getCount - 1 do
720	if byte(FItems[i]^.FBufPtr^) = ParamType then
721	begin
722	P := FItems[i];
723	for j := i + 1 to getCount - 1 do
724	begin
725	MoveBy(FItems[j],-P^.FBufLength);
726	FItems[j - 1] := FItems[j];
727	end;
728	FDataLength := FDataLength - P^.FBufLength;
729	dispose(P);
730	SetLength(FItems,Length(FItems)-1);
731	Exit;
732	end;
733	end;
734
735	procedure TParamBlock.PrintBuf;
736	var i: integer;
737	begin
738	write(ClassName,': (',getDataLength,') ');
739	for i := 0 to getDataLength - 1 do
740	write(Format('%x ',[byte(FBuffer[i])]));
741	writeln
742	end;
743
744	{ TCustomParamBlock }
745
746	function TCustomParamBlock<_TItem, _IItem>.AddByTypeName(ParamTypeName: AnsiString
747	): _IItem;
748	var ParamType: byte;
749	begin
750	ParamType := LookupItemType(ParamTypeName);
751	if ParamType = 0 then
752	IBError(ibxeUnknownParamTypeName,[ClassName,ParamTypeName]);
753	Result := Add(ParamType);
754	end;
755
756	{$IFDEF FPC}
757	function TCustomParamBlock<_TItem, _IItem>.Add(ParamType: byte): _IItem;
758	var Item: PParamBlockItemData;
759	begin
760	Item := inherited Add(ParamType);
761	Result := _TItem.Create(self,Item);
762	end;
763
764	function TCustomParamBlock<_TItem, _IItem>.Find(ParamType: byte): _IItem;
765	var Item: PParamBlockItemData;
766	begin
767	Result := nil;
768	Item := inherited Find(ParamType);
769	if Item <> nil then
770	Result := _TItem.Create(self,Item);
771	end;
772
773	function TCustomParamBlock<_TItem, _IItem>.GetItems(index: integer): _IItem;
774	var Item: PParamBlockItemData;
775	begin
776	Item := inherited getItems(index);
777	Result := _TItem.Create(self,Item);
778	end;
779
780	{$ELSE}
781	function TCustomParamBlock<_TItem, _IItem>.Add(ParamType: byte): _IItem;
782	var Item: PParamBlockItemData;
783	Obj: TParamBlockItem;
784	begin
785	Item := inherited Add(ParamType);
786	Obj := TParamBlockItemClass(_TItem).Create(self,Item);
787	if Obj.QueryInterface(GetTypeData(TypeInfo(_IItem))^.Guid,Result) <> 0 then
788	IBError(ibxeInterfaceNotSupported,[GuidToString(GetTypeData(TypeInfo(_IItem))^.Guid)]);
789	end;
790
791	function TCustomParamBlock<_TItem, _IItem>.Find(ParamType: byte): _IItem;
792	var Item: PParamBlockItemData;
793	Obj: TParamBlockItem;
794	begin
795	FillChar(Result,sizeof(Result),0); {workaround for older versions of Delphi}
796	Item := inherited Find(ParamType);
797	if Item <> nil then
798	begin
799	Obj := TParamBlockItemClass(_TItem).Create(self,Item);
800	if Obj.QueryInterface(GetTypeData(TypeInfo(_IItem))^.Guid,Result) <> 0 then
801	IBError(ibxeInterfaceNotSupported,[GuidToString(GetTypeData(TypeInfo(_IItem))^.Guid)]);
802	end;
803	end;
804
805	function TCustomParamBlock<_TItem, _IItem>.GetItems(index: integer): _IItem;
806	var Item: PParamBlockItemData;
807	Obj: TParamBlockItem;
808	begin
809	Item := inherited getItems(index);
810	Obj := TParamBlockItemClass(_TItem).Create(self,Item);
811	if Obj.QueryInterface(GetTypeData(TypeInfo(_IItem))^.Guid,Result) <> 0 then
812	IBError(ibxeInterfaceNotSupported,[GuidToString(GetTypeData(TypeInfo(_IItem))^.Guid)]);
813	end;
814	{$ENDIF}
815
816	{ TBPB }
817
818	constructor TBPB.Create(api: TFBClientAPI);
819	begin
820	inherited Create(api);
821	FDataLength := 1;
822	FBuffer^ := isc_bpb_version1;
823	end;
824
825	end.
826