jvuiblib.pas

East make Tray Icon in delphi

{******************************************************************************}
{                        UNIFIED INTERBASE (UIB)                               }
{                                                                              }
{ Project JEDI Code Library (JCL)                                              }
{                                                                              }
{ The contents of this file are subject to the Mozilla Public License Version  }
{ 1.1 (the "License"); you may not use this file except in compliance with the }
{ License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ }
{                                                                              }
{ 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 documented in the accompanying }
{ help file JCL.chm. Portions created by these individuals are Copyright (C)   }
{ 2003 of these individuals.                                                   }
{                                                                              }
{ The Initial Developer of TMemoryPool is TurboPower FlashFiler.               }
{                                                                              }
{ Unit owner:    Henri Gourvest                                                }
{ Last modified: September 21, 2003                                            }
{                                                                              }
{******************************************************************************}
{ UIB Library, class and functions helpers to use Interbase API. }

unit JvUIBLib;

{$I jvcl.inc}
{$I JvUIB.inc}

{$ALIGN ON}
{$MINENUMSIZE 4}

interface

uses
  {$IFDEF USEJVCL}
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  {$ENDIF USEJVCL}
  {$IFDEF MSWINDOWS} Windows, {$ENDIF}
  {$IFDEF COMPILER6_UP} Variants, {$ENDIF}
  {$IFDEF FPC} Variants, {$ENDIF}
  JvUIBase, JvUIBError, Classes, SysUtils;

type
  TUIBFieldType = (uftUnKnown, uftNumeric, uftChar, uftVarchar, uftCstring, uftSmallint,
    uftInteger, uftQuad, uftFloat, uftDoublePrecision, uftTimestamp, uftBlob, uftBlobId,
    uftDate, uftTime, uftInt64 {$IFDEF IB7_UP}, uftBoolean{$ENDIF});

  TScale = 1..15;

//******************************************************************************
// Errors handling
//******************************************************************************
  EUIBConvertError = class(Exception);

  EUIBError = class(Exception)
  private
    FErrorCode: Integer;
    FSQLCode  : Integer;
  public
    property ErrorCode: Integer read FErrorCode;
    property SQLCode: Integer read FSQLCode;
  end;

  EUIBException = class(EUIBError)
  private
    FNumber: Integer;
  public
    property Number: Integer read FNumber;
  end;

  EUIBGFixError    = class(EUIBError);
  EUIBDSQLError    = class(EUIBError);
  EUIBDynError     = class(EUIBError);
  EUIBGBakError    = class(EUIBError);
  EUIBGSecError    = class(EUIBError);
  EUIBLicenseError = class(EUIBError);
  EUIBGStatError   = class(EUIBError);


  EUIBExceptionClass = class of EUIBException;

  EUIBParser = class(Exception)
  private
    FLine: Integer;
    FCharacter: Integer;
  public
    // the extra parameter is a dummy parameter to force the generation of
    // a unique constructor declaration in the resulting hpp file
    // when used with BCB
    constructor Create(Line, Character: Integer; dummyForBCB : Integer = 0);
    property Line: Integer read FLine;
    property Character: Integer read FCharacter;
  end;

const
  QuadNull: TISCQuad = (gds_quad_high: 0; gds_quad_low: 0);

//******************************************************************************
// Database
//******************************************************************************

type
  TCharacterSet = (csNONE, csASCII, csBIG_5, csCYRL, csDOS437, csDOS850,
  csDOS852, csDOS857, csDOS860, csDOS861, csDOS863, csDOS865, csEUCJ_0208,
  csGB_2312, csISO8859_1, csISO8859_2, csKSC_5601, csNEXT, csOCTETS, csSJIS_0208,
  csUNICODE_FSS, csWIN1250, csWIN1251, csWIN1252, csWIN1253, csWIN1254
{$IFDEF FB15_UP}
  ,csDOS737, csDOS775, csDOS858, csDOS862, csDOS864, csDOS866, csDOS869, csWIN1255,
  csWIN1256, csWIN1257, csISO8859_3, csISO8859_4, csISO8859_5, csISO8859_6, csISO8859_7,
  csISO8859_8, csISO8859_9, csISO8859_13
{$ENDIF FB15_UP}
{$IFDEF IB71_UP}
  ,csISO8859_15 ,csKOI8R
{$ENDIF IB71_UP}
  );


const
  CharacterSetStr : array[TCharacterSet] of string = (
    'NONE', 'ASCII', 'BIG_5', 'CYRL', 'DOS437', 'DOS850', 'DOS852', 'DOS857',
    'DOS860', 'DOS861', 'DOS863', 'DOS865', 'EUCJ_0208', 'GB_2312', 'ISO8859_1',
    'ISO8859_2', 'KSC_5601', 'NEXT', 'OCTETS', 'SJIS_0208', 'UNICODE_FSS',
    'WIN1250', 'WIN1251', 'WIN1252', 'WIN1253', 'WIN1254'
{$IFDEF FB15_UP}
    ,'DOS737', 'DOS775', 'DOS858', 'DOS862', 'DOS864', 'DOS866', 'DOS869',
    'WIN1255', 'WIN1256', 'WIN1257', 'ISO8859_3', 'ISO8859_4', 'ISO8859_5',
    'ISO8859_6', 'ISO8859_7', 'ISO8859_8', 'ISO8859_9', 'ISO8859_13'
{$ENDIF FB15_UP}
{$IFDEF IB71_UP}
    ,'ISO8859_15', 'KOI8R'
{$ENDIF IB71_UP}
    );

{$IFDEF DLLREGISTRY}
  FBINSTANCES = 'SOFTWARE\Firebird Project\Firebird Server\Instances';
{$ENDIF DLLREGISTRY}

  function StrToCharacterSet(const CharacterSet: string): TCharacterSet;
  function CreateDBParams(Params: String; Delimiter: Char = ';'): string;
  function GetClientLibrary: string;

//******************************************************************************
// Transaction
//******************************************************************************

const
  // Default Transaction Parameter
  TPBDefault = isc_tpb_version3 + isc_tpb_write + isc_tpb_concurrency + isc_tpb_wait;

//******************************************************************************
//  DSQL
//******************************************************************************

  //****************************************
  // TSQLDA
  //****************************************

const
{$IFDEF IB7_UP}
  MaxParamLength = 274;
{$ELSE}
  MaxParamLength = 125;
{$ENDIF IB7_UP}

type
  PUIBSQLVar = ^TUIBSQLVar;
  TUIBSQLVar = record
    SqlType      : Smallint;
    SqlScale     : Smallint;
{$IFDEF IB7_UP}
    SqlPrecision : Smallint;
{$ENDIF IB7_UP}
    SqlSubType   : Smallint;
    SqlLen       : Smallint;
    SqlData      : Pchar;
    SqlInd       : PSmallint;
    case byte of
    // TSQLResult
    0 : ( SqlNameLength   : Smallint;
          SqlName         : array[0..METADATALENGTH-1] of char;
          RelNameLength   : Smallint;
          RelName         : array[0..METADATALENGTH-1] of char;
          OwnNameLength   : Smallint;
          OwnName         : array[0..METADATALENGTH-1] of char;
          AliasNameLength : Smallint;
          AliasName       : array[0..METADATALENGTH-1] of char;
          );
    // TSQLParam
    1 : ( Init            : boolean;
          ID              : Word;
          ParamNameLength : Smallint;
          ParamName       : array[0..MaxParamLength-1] of char;
          );
  end;

  PUIBSQLDa = ^TUIBSQLDa;
  TUIBSQLDa = record
    version : Smallint;                // version of this XSQLDA
    sqldaid : array[0..7] of char;     // XSQLDA name field          ->  RESERVED
    sqldabc : ISCLong;                 // length in bytes of SQLDA   ->  RESERVED
    sqln    : Smallint;                // number of fields allocated
    sqld    : Smallint;                // actual number of fields
    sqlvar: array[Word] of TUIBSQLVar; // first field address
  end;

  TUIBStatementType = (
    stSelect,             //  select                 SELECT
    stInsert,             //  insert                 INSERT INTO
    stUpdate,             //  update                 UPDATE
    stDelete,             //  delete                 DELETE FROM
    stDDL,                //
    stGetSegment,         //  blob                   READ BLOB
    stPutSegment,         //  blob                   INSERT BLOB
    stExecProcedure,      //  invoke_procedure       EXECUTE PROCEDURE
    stStartTrans,         //  declare                DECLARE
    stCommit,             //  commit                 COMMIT
    stRollback,           //  rollback               ROLLBACK [WORK]
    stSelectForUpdate,    //                         SELECT ... FOR UPDATE
    stSetGenerator
  {$IFDEF FB15_UP}
    ,stSavePoint          //  user_savepoint | undo_savepoint       SAVEPOINT | ROLLBACK [WORK] TO
  {$ENDIF FB15_UP}
  );

// TODO
//  alter                  ALTER              -> DDL
//  create                 CREATE
//  drop                   DROP
//  grant                  GRANT
//  recreate               RECREATE
//  replace                CREATE OR ALTER
//  revoke                 REVOKE
//  set                    SET

//******************************************************************************
//  Abstract Class
//******************************************************************************

const
  ScaleDivisor: array[-15..-1] of Int64 = (1000000000000000,100000000000000,
    10000000000000,1000000000000,100000000000,10000000000,1000000000,100000000,
    10000000,1000000,100000,10000,1000,100,10);
type
  TSQLDA = class
  private
    FXSQLDA: PUIBSQLDa;
    function GetPointer: PUIBSQLDa;
    function GetAllocatedFields: Word;
    procedure SetAllocatedFields(Fields: Word);
    function GetActualFields: Word;
    function GetFieldCount: Integer;
    function GetSQLType(const Index: Word): Smallint;
    function GetSQLLen(const Index: Word): Smallint;
    function DecodeString(const Code: Smallint; Index: Word): String; overload;
    procedure DecodeString(const Code: Smallint; Index: Word; out Str: String); overload;
    procedure DecodeWideString(const Code: Smallint; Index: Word; out Str: WideString);
  protected
    function GetSqlName(const Index: Word): string;
    function GetRelName(const Index: Word): string;
    function GetOwnName(const Index: Word): string;
    function GetAliasName(const Index: Word): string;

    function GetIsNumeric(const Index: Word): boolean;
    function GetIsBlob(const Index: Word): boolean;
    function GetIsNull(const Index: Word): boolean;
    function GetIsNullable(const Index: Word): boolean;

    function GetAsDouble(const Index: Word): Double;
    function GetAsCurrency(const Index: Word): Currency;
    function GetAsInt64(const Index: Word): Int64;
    function GetAsInteger(const Index: Word): Integer;
    function GetAsSingle(const Index: Word): Single;
    function GetAsSmallint(const Index: Word): Smallint;
    function GetAsString(const Index: Word): String; virtual;
    function GetAsWideString(const Index: Word): WideString; virtual;
    function GetAsQuad(const Index: Word): TISCQuad;
    function GetAsVariant(const Index: Word): Variant; virtual;
    function GetAsDateTime(const Index: Word): TDateTime;
    function GetAsDate(const Index: Word): Integer;
    function GetAsTime(const Index: Word): Cardinal;
    function GetAsBoolean(const Index: Word): boolean;

    function GetByNameIsNumeric(const Name: String): boolean;
    function GetByNameIsBlob(const Name: String): boolean;
    function GetByNameIsNull(const Name: String): boolean;
    function GetByNameIsNullable(const Name: String): boolean;

    function GetByNameAsDouble(const Name: String): Double;
    function GetByNameAsCurrency(const Name: String): Currency;
    function GetByNameAsInt64(const Name: String): Int64;
    function GetByNameAsInteger(const Name: String): Integer;
    function GetByNameAsSingle(const Name: String): Single;
    function GetByNameAsSmallint(const Name: String): Smallint;
    function GetByNameAsString(const Name: String): String;
    function GetByNameAsWideString(const Name: String): WideString;
    function GetByNameAsQuad(const Name: String): TISCQuad;
    function GetByNameAsVariant(const Name: String): Variant;
    function GetByNameAsDateTime(const Name: String): TDateTime;
    function GetByNameAsBoolean(const Name: String): boolean;
    function GetByNameAsDate(const Name: String): Integer;
    function GetByNameAsTime(const Name: String): Cardinal;

    function GetFieldType(const Index: Word): TUIBFieldType; virtual;
  public
    procedure CheckRange(const Index: Word);
    function GetFieldIndex(const name: String): Word; virtual;
    property Data: PUIBSQLDa read FXSQLDA;
    property IsBlob[const Index: Word]: boolean read GetIsBlob;
    property IsNull[const Index: Word]: boolean read GetIsNull;
    property IsNullable[const Index: Word]: boolean read GetIsNullable;
    property IsNumeric[const Index: Word]: boolean read GetIsNumeric;
    property AsQuad     [const Index: Word]: TISCQuad  read GetAsQuad;
    property XSQLDA: PUIBSQLDa read GetPointer;
    property FieldCount: Integer read GetFieldCount;
    property SQLType[const Index: Word]: Smallint read GetSQLType;
    property SQLLen[const Index: Word]: Smallint read GetSQLLen;