pfibarray.pas

FIBPlus is a component suite intended for work with InterBase. It is direct, fast and flexible Inter

{***************************************************************}
{ FIBPlus - component library for direct access to Firebird and }
{ InterBase databases                                           }
{                                                               }
{    FIBPlus is based in part on the product                    }
{    Free IB Components, written by Gregory H. Deatz for        }
{    Hoagland, Longo, Moran, Dunst & Doukas Company.            }
{    mailto:[e-mail]                                    }
{                                                               }
{    Copyright (c) 1998-2007 Devrace Ltd.                       }
{    Written by Serge Buzadzhy ([e-mail])               }
{                                                               }
{ ------------------------------------------------------------- }
{    FIBPlus home page: http://www.fibplus.com/                 }
{    FIBPlus support  : http://www.devrace.com/support/         }
{ ------------------------------------------------------------- }
{                                                               }
{  Please see the file License.txt for full license information }
{***************************************************************}



unit pFIBArray;
{$I FIBPlus.inc}

interface

uses
 {$IFDEF WINDOWS}
  Windows, SysUtils, Classes, ibase,IB_Intf, ib_externals,
  DB, fib, FIBDatabase, StdFuncs
  {$IFDEF D6+}, Variants{$ENDIF}
  ;

 {$ENDIF}
 {$IFDEF LINUX}
  Types, SysUtils, Classes, ibase,IB_Intf, IB_Externals,
  DB, fib, FIBDatabase,  StdFuncs,
   Variants;

 {$ENDIF}

 type TpFIBArray=class
      private
       FClientLibrary:IIBClientLibrary;
       FXSQLVAR:PXSQLVAR;
       FArrayType:TFieldType;
       FTableName:string;
       FFieldName:string;
       vISC_ARRAY_DESC:TISC_ARRAY_DESC;
       function GetDimensionCount:Integer;
       function GetDimension(Index: Integer): TISC_ARRAY_BOUND;
       function GetSliceSize(aISC_ARRAY_DESC:TISC_ARRAY_DESC):integer;
       function GetArraySize:integer;
       procedure VariantToBuffer(Value:Variant;var ToBuffer:PChar);
       procedure PutArrayBuf(var Buffer,ToBuffer:PChar;
        DBHandle:PISC_DB_HANDLE;TRHandle: PISC_TR_HANDLE
       );
       function GetElementBuf(Buffer:PChar;
         aISC_ARRAY_DESC:TISC_ARRAY_DESC;
         DBHandle:PISC_DB_HANDLE;TRHandle: PISC_TR_HANDLE
       ):Variant;
       procedure PutElementBuf(Value:Variant;var ToBuffer:PChar;
        aISC_ARRAY_DESC:TISC_ARRAY_DESC;
        DBHandle:PISC_DB_HANDLE;TRHandle: PISC_TR_HANDLE
       );

       function GetFieldData(Field:TField;var ToBuffer:PChar):boolean;
       function GetScale: Byte;

      public
       constructor Create(ClientLibrary:IIBClientLibrary;aFXSQLVAR:PXSQLVAR;
        DBHandle: PISC_DB_HANDLE;
        TRHandle: PISC_TR_HANDLE;
        const ATableName,AFieldName:string
       ); overload;

       destructor Destroy; override;
       function GetArrayValues(bufData:PChar;
         DBHandle:PISC_DB_HANDLE;TRHandle: PISC_TR_HANDLE
       ):Variant;                         // for Internal use from FibQuery
       procedure SetArrayValue(Value:Variant;var ToBuffer:PChar;
         DBHandle:PISC_DB_HANDLE;TRHandle: PISC_TR_HANDLE
       );                                // for Internal use from FibQuery
       function GetFieldArrayValues(Field:TField;
         DBHandle:PISC_DB_HANDLE;TRHandle: PISC_TR_HANDLE
       ):Variant;  // for Internal use from DataSet
       procedure SetFieldArrayValue(Value:Variant;Field:TField;
         DBHandle:PISC_DB_HANDLE;TRHandle: PISC_TR_HANDLE
       );        // for Internal use  from DataSet

       function GetElementFromField(
        Field:TField;Indexes:array of integer;
        DBHandle:PISC_DB_HANDLE;TRHandle: PISC_TR_HANDLE
       ):Variant;        // for Internal use  from DataSet

       procedure PutElementToField(Field:TField;Value:Variant;
        Indexes:array of integer;
        DBHandle:PISC_DB_HANDLE;TRHandle: PISC_TR_HANDLE
       );        // for Internal use  from DataSet


      public
       property ArrayType:TFieldType read FArrayType;

       property TableName:string read FTableName;
       property FieldName:string read FFieldName;

       property DimensionCount:Integer read GetDimensionCount;
       property Dimension[Index: Integer]: TISC_ARRAY_BOUND read GetDimension;
       property ArraySize:Integer read GetArraySize;
       property Scale:Byte read GetScale;       
      end;

implementation

uses FIBDataSet,VariantRtn,StrUtil;
{
type

 TTraceArr=array [0..1] of  INT64;
 PTraceArr=^TTraceArr;


var
 TraceArr:TTraceArr;
}

{$IFNDEF D6+}
 type
  PComp=^Comp;
{$ENDIF}

const MaxDimCount=64;


 threadvar
 // vars for Callback functions from VariantRtn
   glBufArField:PChar;
   glArrayType :TFieldType;
   glScale     :integer;
   glErrInt    :byte;
   glISC_ARRAY_DESC:TISC_ARRAY_DESC;
   glCount     :Integer;
   glBufIsNull :boolean;
   TracePChar  :PChar;
   CurIBLib    :IIBClientLibrary;

constructor TpFIBArray.Create(ClientLibrary:IIBClientLibrary;aFXSQLVAR:PXSQLVAR;
        DBHandle: PISC_DB_HANDLE;
        TRHandle: PISC_TR_HANDLE;

        const ATableName,AFieldName:string

);
begin
 inherited Create;
 FClientLibrary :=ClientLibrary;
 with FClientLibrary do
 try
   FXSQLVAR       :=aFXSQLVAR;
   FTableName     :=ATableName;
   FFieldName     :=AFieldName;

   isc_array_lookup_bounds(StatusVector, DBHandle, TRHandle,
      PChar(FTableName), PChar(FFieldName), @vISC_ARRAY_DESC
   );
    with vISC_ARRAY_DESC do
    begin
    //髓