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;
    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;
  public
    constructor Create;
    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;
  protected
    property ParamData: PParamBlockItemData read FParamData;
  public
     constructor Create(AOwner: TParamBlock; Data: PParamBlockItemData);
  public
     function getAsInteger: integer;
     function getParamType: byte;
     function getAsString: AnsiString;
     function getAsByte: byte;
     procedure addByte(aValue: byte);
     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;

  { TDPBItem }

  TDPBItem = class(TParamBlockItem,IDPBItem);

  { TTPBItem }

  TTPBItem = class(TParamBlockItem,ITPBItem);

  { TSPBItem }

  TSPBItem = class(TParamBlockItem,ISPBItem);

  { 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;

  { 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 Find(ParamType: byte): _IItem;
    function GetItems(index: integer): _IItem;
  end;

  { TDPB }

  TDPB = class (TCustomParamBlock<TDPBItem,IDPBItem>, IDPB)
  public
    constructor Create;
  end;

  { TTPB }

  TTPB = class (TCustomParamBlock<TTPBItem,ITPBItem>, ITPB)
  public
    constructor Create;
  end;

  { TSPB }

  TSPB = class (TCustomParamBlock<TSPBItem,ISPBItem>, ISPB)
  public
   constructor Create;
  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;
  end;

implementation

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

const
  MaxBufferSize = 65535;

{ 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 FirebirdClientAPI 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;
  FOwnerIntf := AOwner;
  FParamData := Data;
end;

function TParamBlockItem.getAsInteger: integer;
begin
  with FirebirdClientAPI, 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.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 FirebirdClientAPI do
        len := DecodeInteger(FBufPtr+1,2);
      SetString(Result,PAnsiChar(FBufPtr+3),len);
    end;
  dtString0:
      Result := strpas(PAnsiChar(FBufPtr+1));
    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.addShortInteger(aValue: integer);
var len: integer;
    P: PByte;
begin
  with FParamData^ do
  begin
    P := FBufPtr + FBufLength;
    len := FBufLength + 2;
    FOwner.UpdateRequestItemSize(self,len);
    with FirebirdClientAPI 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 FirebirdClientAPI 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 FirebirdClientAPI 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 FirebirdClientAPI 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 FirebirdClientAPI 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 FirebirdClientAPI 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 FirebirdClientAPI 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;
begin
  inherited Create;
  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.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,': ');
  for i := 0 to getDataLength - 1 do
    write(Format('%x ',[byte(FBuffer[i])]));
  writeln
end;

{ TCustomParamBlock }

{$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}

{ TDPB }

constructor TDPB.Create;
begin
  inherited Create;
  FDataLength := 1;
  FBuffer^ := isc_dpb_version1;
end;

{ TTPB }

constructor TTPB.Create;
begin
  inherited Create;
  FDataLength := 1;
  FBuffer^ := isc_tpb_version3;
end;

{ TSPB }

constructor TSPB.Create;
begin
  inherited Create;
  FDataLength := 2;
  FBuffer^ := isc_spb_version;
  (FBuffer+1)^ := isc_spb_current_version;
end;

{ TBPB }

constructor TBPB.Create;
begin
  inherited Create;
  FDataLength := 1;
  FBuffer^ := isc_bpb_version1;
end;

end.

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