sdcommon.pas

SQLDirect Component Library is a light-weight Borland Database Engine replacement for Borland Delphi

{*******************************************************}
{							}
{       Delphi SQLDirect Component Library		}
{       SQLDirect Common Data Access Code  		}
{                                                       }
{       Copyright (c) 1997,2005 by Yuri Sheino		}
{                                                       }
{*******************************************************}
{$I SqlDir.inc}
unit SDCommon {$IFDEF SD_CLR} platform {$ENDIF};

interface

uses
  Windows, Messages, Forms,
  SysUtils, Classes,
  Db, TypInfo,
{$IFDEF SD_VCL5}
  DbCommon,
{$ENDIF}
{$IFDEF SD_VCL6}
  FmtBcd, Variants, StrUtils,
{$ENDIF}
{$IFDEF SD_CLR}
  System.Text, System.Runtime.InteropServices,
{$ENDIF}
  SDConsts;

const
  MAXFIELDNAMELEN	= 50;	// max field name length, which is stored by SQLDirect components
  DEFMAXCHARPARAMLEN	= 255;	// default maximum size of a buffer for string parameters
  DEFMAXFIELDSTRINGSIZE	= 255;	// default max size of a string field, it's equal or less dsMaxStringSize

  DEF_BLOB_PIECE_SIZE 	= $7FF0;// default size of read/write blob piece, which must be less < $8000 (32768), for example, for SQLBase. To exclude an alignment problems size is ended by 0
  MAX_BCDFIELD_PREC	= 20;
  MAX_BCDFIELD_SCALE	= 4;

  MAX_INTFIELD_PREC	= 10;	// 10 is limit in BDE for ftInteger
  MAX_SINTFIELD_PREC	= 5;	// 5 is limit in BDE for ftSmallInt


  { Field status codes (see TSDFieldInfo.FetchStatus) }
  indTRUNC	= -2;                   { Value has been truncated }
  indNULL	= -1;                   { Value is NULL }
  indVALUE	= 0;

  { BLOB subtypes }
  fldstUNKNOWN	= $00;
  fldstMEMO	= $10;              	{ Text Memo }
  fldstBINARY	= $11;              	{ Binary data }
  fldstHMEMO	= $12;              	{ CLOB }
  fldstHBINARY	= $13;              	{ BLOB }
  fldstHCFILE	= $14;              	{ CFILE }
  fldstHBFILE	= $15;              	{ BFILE }

  ServerDelimiters	= ':@';		{ server delimiters for TSDDatabase.RemoteDatabase property }

        // = TGuidField.Size, it include 36 characters and 2 brackets. ODBC uses escape sequences for GUID literals: {xxx...xxx}
  SizeOfGuidString = 38;
  SizeOfGuidBinary = 16;        // guid in a binary format = SizeOf(TGUID)
  
type
{$IFDEF SD_CLR}
  PInteger      = IntPtr;
  PLongInt      = IntPtr;
  TSDPtr        = IntPtr;
  TSDCharPtr    = IntPtr;
  TSDObjectPtr  = TObject;
  TSDValueBuffer= IntPtr;
  TSDRecordBuffer=IntPtr;
{$ELSE}
  TBytes        = array of Byte;
  TObjectList   = TList;
  TSDPtr        = Pointer;
  TSDCharPtr    = PChar;
  TSDObjectPtr  = Pointer;
  TSDValueBuffer= PChar;
  TSDRecordBuffer=PChar;
{$ENDIF}

{$IFDEF SD_D4}
  TInt64        = Int64;   { 64 bit signed  }
{$ELSE}
  TInt64        = Comp;    { 64 bit signed - Delphi 3 has Comp type for a 64-bit integer }
{$ENDIF}

  PDateTimeRec = ^TDateTimeRec;
  
	{ Cursor types }
  PSDCursor	= TSDPtr;

  TSDEResult	= SmallInt;         // result of the C/API-functions

  TSDBlobData 		= TBytes;
  TSDBlobDataArray 	= array[0..0] of TSDBlobData;
  PSDBlobDataArray 	= ^TSDBlobDataArray;

	// internal transaction isolation types. It corresponds to TSDTransIsolation
  TISqlTransIsolation	= (itiDirtyRead, itiReadCommitted, itiRepeatableRead);
       // it is equal to TSDServerType (SDEngine unit is invisible for the current unit)
  TISqlServerType = (istSQLBase, istOracle, istSQLServer, istSybase,
  		   istDB2, istInformix, istODBC, istInterbase, istFirebird,
                   istMySQL, istPostgreSQL {$IFDEF DEBUG_OLEDB}, istOLEDB{$ENDIF});
const
  ServerTypeNames: array[TISqlServerType] of string = ('SQLBase', 'Oracle', 'SQLServer', 'Sybase',
  		   'DB2', 'Informix', 'ODBC', 'Interbase', 'Firebird',
                   'MySQL', 'PostgreSQL' {$IFDEF DEBUG_OLEDB}, 'OLEDB' {$ENDIF});
	// helper library to convert stdcall callback to cdecl callback functions, which is not supported by Delphi 8
        // it is used MS SQLServer and Oracle8 connections
  CLRHelperDLL  = 'SQLDIRHN.DLL';
  
type
//  TSDFieldDescList 	= class;

  TISqlDatabase 	= class;
  TISqlCommand 		= class;

  TInitSqlDatabaseProc	= function (ADbParams: TStrings): TISqlDatabase;
        // the variable record, where the first byte is ServerType (TISqlServerType),
        //other fields depend from connection type and declared in the corresponded units
  TSDHandleRec	= record
    SrvType: Byte;
//  further fields, which depends from server connection
  end;

  PSDHandleRec	= ^TSDHandleRec;

  TSDSchemaType = (stTables, stSysTables, stProcedures, stColumns,
    	stProcedureParams, stIndexes, stPackages);

  TSDDatabaseParam = (spMaxBindName, spMaxClientName, spMaxConnectString,
  	spMaxDatabaseName, spMaxErrorMessage, spMaxErrorText, spMaxExtErrorMessage,
        spMaxJoinedTables, spLongIdentifiers, spShortIdentifiers,
        spMaxUserName, spMaxPasswordString, spMaxServerName,
        spMaxFieldName, spMaxTableName, spMaxSPName, spMaxFullTableName, spMaxFullSPName);


  ESDSqlLibError = class(EDatabaseError);

{ ESDEngineError }

  ESDEngineError = class(EDatabaseError)
  private
    FNativeError,
    FErrorCode,
    FErrorPos: LongInt;
  public
    constructor Create(AErrorCode, ANativeError: LongInt; const Msg: string; AErrorPos: LongInt);
    constructor CreateDefPos(AErrorCode, ANativeError: LongInt; const Msg: string); virtual;
    property ErrorCode:   LongInt read FErrorCode;
    property NativeError: LongInt read FNativeError;
    property ErrorPos: LongInt read FErrorPos;
  end;

  ESDEngineErrorClass = class of ESDEngineError;

{	abstract server API	}

{ In contrast to abstract methods empty methods with unconditional asserts }
{ show what method is called, but is not overrided }

//  TISqlDatabaseClass = class of TISqlDatabase;
  TISqlCommandClass = class of TISqlCommand;

{ TISqlDatabase }

  { property Commands[] - purposes: set autocommit for SQLBase ???
  }

  TISqlDatabase = class(TObject)
  private
    FAcquiredHandle: Boolean;			// if a Handle is not belonged to the current object; it has to be set in SetHandle method
    FIsEnableBCD: Boolean;
    FIsRTrimChar: Boolean;		        // whether to trim trailing spaces in the output of CHAR datatype ?
    FIsSingleConn: Boolean;		        // Whether or not a szSINGLECONN parameter is set on (a database Handle is used for activated TISqlCommand)
    FMaxFieldNameLen: Integer;
    FMaxStringSize: Integer;			// max size of a string field (TStringField), if field size is more then it will be TBlob/MemoField
    FBlobPieceSize: Integer;                    // size of Blob piece, when it is used to read/write Blob value
    FPrefetchRows: Integer; 			// it's possible to add TSDDataSet.PrefetchRows to override this value
    FDbParams: TStrings;
    FTransIsolation: TISqlTransIsolation;
    FInTransaction: Boolean;
    FResetBusyState: TNotifyEvent;
    FResetIdleTimeOut: TNotifyEvent;
  protected
    FAutoCommitDef: Boolean;			// whether autocommit option is present in TSDDatabase.Params
    FAutoCommit	  : Boolean;
    FCursorPreservedOnCommit,
    FCursorPreservedOnRollback: Boolean;	// whether a server preserves all cursor in the same position after COMMIT, ROLLBACK
    FTransSupported: Boolean;			// default, True
    FProcSupportsCursor: Boolean;		// procedure supports cursor parameters (default, False)
    FProcSupportsCursors: Boolean;		// procedure can return one or more result sets (default, False)
    procedure DoResetBusyState; virtual;
    procedure DoResetIdleTimeOut; virtual;

    procedure DoConnect(const sDatabaseName, sUserName, sPassword: string); virtual; abstract;
    procedure DoDisconnect(Force: Boolean); virtual; abstract;

    procedure DoCommit; virtual; abstract;
    procedure DoRollback; virtual; abstract;
    procedure DoStartTransaction; virtual; abstract;

    function GetHandle: TSDPtr; virtual;
    procedure SetAutoCommitOption(Value: Boolean); virtual;
    procedure SetHandle(AHandle: TSDPtr); virtual;
  public
    constructor Create(ADbParams: TStrings); virtual;
    destructor Destroy; override;

    function CreateSqlCommand: TISqlCommand; virtual; abstract;

    function GetAutoIncSQL: string; virtual;
    function GetClientVersion: LongInt; virtual; abstract;
    function GetServerVersion: LongInt; virtual; abstract;
    function GetVersionString: string; virtual; abstract;
    procedure GetStoredProcNames(List: TStrings); virtual;
    procedure GetTableNames(Pattern: string; SystemTables: Boolean; List: TStrings); virtual;
    procedure GetFieldNames(const TableName: string; List: TStrings); virtual;
    function GetSchemaInfo(ASchemaType: TSDSchemaType; AObjectName: string): TISqlCommand; virtual;

    procedure Connect(const sDatabaseName, sUserName, sPassword: string); virtual;
    procedure Disconnect(Force: Boolean); virtual;
    function TestConnected: Boolean; virtual; abstract;

    procedure Commit; virtual;
    procedure Rollback; virtual;
    procedure StartTransaction; virtual;

    function ParamValue(Value: TSDDatabaseParam): Integer; virtual;
    procedure SetTransIsolation(Value: TISqlTransIsolation); virtual;
    function SPDescriptionsAvailable: Boolean; virtual;

    procedure ResetBusyState;
    procedure ResetIdleTimeOut;

    property AcquiredHandle: Boolean read FAcquiredHandle;
    property AutoCommit: Boolean read FAutoCommit;
    property AutoCommitDef: Boolean read FAutoCommitDef;
    property IsEnableBCD: Boolean read FIsEnableBCD;
    property IsRTrimChar: Boolean read FIsRTrimChar;
    property IsSingleConn: Boolean read FIsSingleConn;
    property Handle: TSDPtr read GetHandle write SetHandle;
    property BlobPieceSize: Integer read FBlobPieceSize;
    property CursorPreservedOnCommit: Boolean read FCursorPreservedOnCommit;
    property CursorPreservedOnRollback: Boolean read FCursorPreservedOnRollback;
    property InTransaction: Boolean read FInTransaction;
    property MaxFieldNameLen: Integer read FMaxFieldNameLen;
    property MaxStringSize: Integer read FMaxStringSize;
    property PrefetchRows: Integer read FPrefetchRows;
    property Params: TStrings read FDbParams;
    property ProcSupportsCursor: Boolean read FProcSupportsCursor;
    property ProcSupportsCursors: Boolean read FProcSupportsCursors;
    property TransIsolation: TISqlTransIsolation read FTransIsolation write FTransIsolation;
    property TransSupported: Boolean read FTransSupported;
    property OnResetBusyState: TNotifyEvent read FResetBusyState write FResetBusyState;
    property OnResetIdleTimeOut: TNotifyEvent read FResetIdleTimeOut write FResetIdleTimeOut;
  end;

{ TSDBufferList }

  TSDBufferList = class
  private
    FList: TList;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Clear;
    function StringToPtr(S: string): TSDPtr;
  end;

  { TSDFieldDescList }
  TSDFieldDesc = class(TObject) // converted from a record for compatibility with D8
  public
    FieldName: string[MAXFIELDNAMELEN];	// Field name or alias (for example, <select F as Alias...>)
    FieldNo : Integer;			// Field number (=i+1, where i=0,1,..)
    FieldType: TFieldType;		// Field type (ftInteger...), which is equal TField.DataType
    DataType: SmallInt;			// Native field type (can be negative)
    DataSize: Integer;			// Native size in bytes (with null-termnator for string), i.e. size for select buffer (for string types, including zero-terminator). This value can exceed 32KB.
    Offset: Integer;			// for blob fields: indicates position in a blob array inside a select buffer
    Precision: SmallInt;		// total number of digits
    Scale: SmallInt;                    // digits after point for BCD
    Required: Boolean;			// is not Null
  end;

  TSDFieldDescList = class(TList)
  private
    function GetFieldDescs(Index: Integer): TSDFieldDesc;
//    function GetPFieldDescs(Index: Integer): PSDFieldDesc;
  public
    destructor Destroy; override;
    procedure Clear; {$IFDEF SD_VCL4} override; {$ENDIF} {$IFDEF SD_C3} override; {$ENDIF}
    function AddFieldDesc: TSDFieldDesc;
    procedure ArrangeFieldNames;
    function FieldDescByName(const AFieldName: string): TSDFieldDesc;
    function FieldDescByNumber(AFieldNo: Integer): TSDFieldDesc;
    property FieldDescs[Index: Integer]: TSDFieldDesc read GetFieldDescs; default;
//    property PFieldDescs[Index: Integer]: PSDFieldDesc read GetPFieldDescs;
  end;

  	// it's used in select buffer
  TSDFieldInfo = packed record          // ??? -> TSDFieldDataInfo
    FetchStatus:Longint;		{ Fetch Status Code of field (sometimes, signed 16-bit) }
    DataSize: 	Longint;		{ Length of the data received (for Oracle, it uses for BLOB-field) }
  end;
  PSDFieldInfo = ^TSDFieldInfo;

  TIntArray	= array of Integer;

{$IFDEF SD_VCL4}
  TSDHelperParam  	= TParam;
  TSDHelperParams  	= TParams;
  TSDHelperParamType  	= TParamType;
{$ELSE}
  TSDParam  	= class;
  TSDParams  	= class;
  TSDParamType	= (ptUnknown, ptInput, ptOutput, ptInputOutput, ptResult);

  TSDHelperParam  	= TSDParam;
  TSDHelperParams  	= TSDParams;
  TSDHelperParamType  	= TSDParamType;
{$ENDIF}

{ TISqlCommand - union of command and cursor interfaces }
  // add method to send a message to monitor component
  TSDCommandType = (ctQuery, ctTable, ctStoredProc);
  	// if SaveRes is True, it is necessary to call FetchAll or GetResults methods
  TSDReleaseHandleEvent = procedure(SaveRes: Boolean) of object;

  TISqlCommand = class(TObject)
  private
    FCommandType: TSDCommandType;
    FCommandText: string;		// an original SQL command
    FNativeCommand: string;		// modified SQL command, which is sent to a database, i.e. the command is prepared
    FBlobFieldCount: Integer;
    FFieldDescs: TSDFieldDescList;
    FParamsRef: TSDHelperParams;	// it's a reference to TParams component, which does not belong to the current component (could not be destroyed)
    FParamsBuffer: TSDRecordBuffer;	// bind buffer    
    FFieldsBuffer: TSDRecordBuffer;	// select buffer
    FBlobCacheOffs: Integer;           	// offset to blob data in a select buffer
    FFieldBufOffs: TIntArray;		// Offsets to field's buffer in a select buffer FFieldsBuffer
    FMaxCharParamSize: Integer;
    FBufList: TSDBufferList;            // list of memory buffers (now it is used in D8 implementation)

    FSqlDatabase: TISqlDatabase;
    FReleaseHandle: TSDReleaseHandleEvent;	// release handle, which is acquired from TISqlDatabase (MSS, Sybase, ODBC)