sdengine.pas

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

{$ENDIF}
    property DatabaseName: string read FDatabaseName write SetDatabaseName;
    property DesignOptions: TSDDesignDBOptions read FDesignOptions write SetDesignOptions default [ddoStoreConnected];
    property IdleTimeOut: Integer read GetIdleTimeOut write SetIdleTimeOut;
    property KeepConnection: Boolean read FKeepConnection write SetKeepConnection default True;
    property Params: TStrings read FParams write SetParams;
    property RemoteDatabase: string read FRemoteDatabase write SetRemoteDatabase;
    property ServerType: TSDServerType read FServerType write SetServerType default stSQLBase;
    property SessionName: string read FSessionName write SetSessionName;
    property TransIsolation: TSDTransIsolation read FTransIsolation write SetTransIsolation default tiReadCommitted;
    property AfterConnect;
    property AfterDisconnect;
    property BeforeConnect;
    property BeforeDisconnect;
    property OnLogin: TSDLoginEvent read FOnLogin write FOnLogin;
  end;

{ TSDResultSet }

  PCacheRecInfo = ^TCacheRecInfo;
  TCacheRecInfo = record
    Applied: Boolean;
    CurRec: TSDRecordBuffer;
    OldRec: TSDRecordBuffer;
  end;

  TSDResultSet = class(TList)
  private
    FDataSet: TSDDataSet;
    FIsBlobs: Boolean;
    FPosition: Integer;		// current record index, zero-based
    FDeletedCount: Integer;	// number of rescords, which are marked as deleted
    FAllInCache: Boolean;
    function GetAppliedRecords(Index: Integer): Boolean;
    function GetCacheItem(Index: Integer): TCacheRecInfo;
    function GetCurRecords(Index: Integer): TSDRecordBuffer;
    function GetOldRecords(Index: Integer): TSDRecordBuffer;
    function GetUpdateStatusRecords(Index: Integer): TUpdateStatus;
    function GetFilterActivated: Boolean;
    function GetRecordCount: Integer;
    function GetIndexOfRecord(ARecNumber: Integer): Integer;
    function GetNewRecordNumber(AInsertedRecIndex: Integer): Integer;
    procedure SetAppliedRecords(Index: Integer; Value: Boolean);
    procedure SetCacheItem(Index: Integer; Value: TCacheRecInfo);
    procedure SetCurRecords(Index: Integer; Value: TSDRecordBuffer);
    procedure SetOldRecords(Index: Integer; Value: TSDRecordBuffer);
    procedure SetUpdateStatusRecords(Index: Integer; Value: TUpdateStatus);
  private
    function AddRecord(RecBuf: TSDRecordBuffer): Integer;
    procedure CopyRecBuf(const Source, Dest: TSDRecordBuffer);
    procedure ClearCacheItem(Index: Integer);
    procedure DeleteCacheItem(Index: Integer);
    function FetchRecord: Boolean;
    function GetCurrRecord: Boolean;
    function GetNextRecord: Boolean;
    function GetPriorRecord: Boolean;
    function GetRecord(Buffer: TSDRecordBuffer; GetMode: TGetMode): Boolean;
    function GotoNextRecord: Boolean;
    function IsVisibleRecord(Index: Integer): Boolean;
    function DeleteRecord(RecBuf: TSDRecordBuffer): Integer;
    function IsInsertedRecord(Index: Integer): Boolean;
    function InsertRecord(RecBuf: TSDRecordBuffer; Append, SetCurrent: Boolean): Integer;
    procedure ModifyRecord(RecBuf: TSDRecordBuffer);
    procedure ModifyBlobData(Field: TField; RecBuf: TSDRecordBuffer; const Value: TSDBlobData);
    function RecordFilter(RecBuf: TSDRecordBuffer): Boolean;
    function UpdatesCancel: Integer;
    function UpdatesCancelCurrent: Integer;
    function UpdatesCommit: Integer;
    function UpdatesPrepare: Integer;
    function UpdatesRollback: Integer;
  public
    constructor Create(ADataSet: TSDDataSet; IsBlobs: Boolean);
    destructor Destroy; override;
    procedure Clear; {$IFDEF SD_VCL4} override; {$ENDIF} {$IFDEF SD_C3} override; {$ENDIF}
    function UpdatesCommitRecord(Index: Integer): Boolean;
    procedure ExchangeRecords(Index1, Index2: Integer);
    procedure FetchAll;
    function FindNextRecord: Boolean;
    function FindPriorRecord: Boolean;
    procedure SetToBegin;
    procedure SetToEnd;
    function IndexOfRecord(RecBuf: TSDRecordBuffer): Integer;
    property AllInCache: Boolean read FAllInCache;
    property AppliedRecords[Index: Integer]: Boolean read GetAppliedRecords write SetAppliedRecords;
    property CacheItems[Index: Integer]: TCacheRecInfo read GetCacheItem write SetCacheItem;
    property CurRecords[Index: Integer]: TSDRecordBuffer read GetCurRecords write SetCurRecords; default;
    property OldRecords[Index: Integer]: TSDRecordBuffer read GetOldRecords write SetOldRecords;
    property DataSet: TSDDataSet read FDataSet;
    property UpdateStatusRecords[Index: Integer]: TUpdateStatus read GetUpdateStatusRecords write SetUpdateStatusRecords;
    property CurrentIndex: Integer read FPosition write FPosition;
    property RecordCount: Integer read GetRecordCount;
    property FilterActivated: Boolean read GetFilterActivated;
  end;

{ TSDDataSet }
  TSDRecInfo = packed record
    RecordNumber: LongInt;		// it is set after fetch from a database, starts from 0 (and = RecNo-1)
    UpdateStatus: TUpdateStatus; 	// (usUnmodified, usModified, usInserted, usDeleted)
    BookmarkFlag: TBookmarkFlag;
  end;
  PSDRecInfo = ^TSDRecInfo;

  TFieldIsNotNull = Boolean;		// 1-st byte of a field buffer
  PFieldIsNotNull = ^TFieldIsNotNull;

  TDelayedUpdCmd = (                 { Op types for Delayed Update cursor }
    DelayedUpdCommit,                { Commit the updates }
    DelayedUpdCancel,                { Cancel the updates (all record changes) }
    DelayedUpdCancelCurrent,         { Cancel the Current Rec Change }
    DelayedUpdPrepare,               { Phase1 of 2 phase commit }
    DelayedUpdRollback               { Rollback the updates, but keep the changes: Phase2 of 2 phase rollback }
  );

  TDSFlags = set of 0..15;		{ set of TSDDataSet flags}

{$IFNDEF SD_VCL5}	// to exclude ambiguous reference in BCB5+, when set OnUpdateRecord event handler
  TUpdateAction = (uaFail, uaAbort, uaSkip, uaRetry, uaApplied);
{$ENDIF}
{$IFNDEF SD_VCL4}
  TUpdateMode = (upWhereAll, upWhereChanged, upWhereKeyOnly);
{$ENDIF}
  TUpdateKinds	= set of TUpdateKind;
  TUpdateRecordTypes = set of (rtModified, rtInserted, rtDeleted, rtUnmodified);
  TUpdateErrorEvent = procedure(DataSet: TDataSet; E: EDatabaseError;
    UpdateKind: TUpdateKind; var UpdateAction: TUpdateAction) of object;
  TUpdateRecordEvent = procedure(DataSet: TDataSet; UpdateKind: TUpdateKind;
    var UpdateAction: TUpdateAction) of object;

  TSDDataSetUpdateObject = class(TComponent)
  protected
    function GetDataSet: TSDDataSet; virtual; abstract;
    procedure SetDataSet(ADataSet: TSDDataSet); virtual; abstract;
  public
    procedure Apply(UpdateKind: TUpdateKind); virtual; abstract;
    property DataSet: TSDDataSet read GetDataSet write SetDataSet;
  end;


  TSDDataSet = class(TDataSet)
  private
    FAutoRefresh: Boolean;
    FDSFlags: TDSFlags;
    FDatabase: TSDDatabase;
    FDatabaseName: string;
    FSessionName: string;
    FSqlCmd: TISqlCommand;
    FRecCache: TSDResultSet;
    FFieldBufOffs: TIntArray;		// Offsets to field's buffer in a record buffer
    FClearFieldDefsOnClose: Boolean;    // if a result set was activated using OpenEmpty method and FieldDefs initializes from persistent Fields
    FCachedUpdates: Boolean;
    FCacheBlobs: Boolean;
    FUniDirectional: Boolean;
    FDetachOnFetchAll: Boolean;		// drop a server cursor, when entire result set is on client side, to minimize server resources
    FFilterBuffer: TSDRecordBuffer;
    FForceClosing: Boolean;		// hide database exceptions in this case
    FGetNextResultSet: Boolean;		// in process of getting NextResultSet
    FRecordSize: Integer;  		// record size (without additional info and BLOB-pointers)
    FRecBufSize: Integer;  		// record size with additional info
    FBlobCacheOffs: Integer;		// BLOB-cache offset in record buffer
    FRecInfoOffs: Integer; 		// TSDRecInfo offset in record buffer
    FBookmarkOffs: Integer;             // TBookmark offset in record buffer
    FEnableUpdateKinds: TUpdateKinds;	// what updates(modify, insert, delete) are enabled
    FUpdateMode: TUpdateMode;
    FUpdateObject: TSDDataSetUpdateObject;
    FUpdateRecordTypes: TUpdateRecordTypes;	// set of record types, which are visible in a dataset in CachedUpdates mode
    FOnUpdateError: TUpdateErrorEvent;
    FOnUpdateRecord: TUpdateRecordEvent;
    procedure CheckDBSessionName;
    procedure ClearBlobCache(RecBuf: TSDRecordBuffer);
    procedure DoInternalOpen(IsExec: Boolean);    
    procedure InitBlobCache(RecBuf: TSDRecordBuffer);
    function FieldIsNull(FieldBuf: TSDPtr): Boolean;
    procedure FieldSetNull(FieldBuf: TSDPtr; bNull: Boolean);
    function GetActiveRecBuf(var RecBuf: TSDRecordBuffer): Boolean;
    function GetBlobData(Field: TField; Buffer: TSDRecordBuffer): TSDBlobData;
    function GetBlobDataSize(Field: TField; Buffer: TSDRecordBuffer): Integer;
    function GetHandle: PSDCursor;
    function GetOldRecord: TSDRecordBuffer;
    function GetServerType: TSDServerType;
    function GetDBSession: TSDSession;
    function GetEnableUpdateKinds: TUpdateKinds;
    function GetUpdatesPending: Boolean;
    function GetUpdateRecordSet: TUpdateRecordTypes;
    procedure InitBufferPointers;
    function RecordFilter(RecBuf: TSDRecordBuffer): Boolean;
    procedure SetAutoRefresh(const Value: Boolean);
    procedure SetBlobData(Field: TField; Buffer: TSDRecordBuffer; Value: TSDBlobData);
    procedure SetDatabaseName(const Value: string);
    procedure SetDetachOnFetchAll(Value: Boolean);
    procedure SetSessionName(const Value: string);
    procedure SetEnableUpdateKinds(Value: TUpdateKinds);
    procedure SetUniDirectional(const Value: Boolean);
    procedure SetUpdateMode(const Value: TUpdateMode); virtual;
    procedure SetUpdateRecordSet(RecordTypes: TUpdateRecordTypes);
    procedure SetUpdateObject(Value: TSDDataSetUpdateObject);
  protected
    property RecCache: TSDResultSet read FRecCache;
    property SqlCmd: TISqlCommand read FSqlCmd;
  	{ The following methods use TISqlComand object }
    function ISqlCmdCreate: TISqlCommand; virtual;
    procedure ISqlCloseResultSet;
    procedure ISqlCnvtFieldData(ASqlCmd: TISqlCommand; AFieldDesc: TSDFieldDesc;
    				Buffer: TSDRecordBuffer; AField: TField);
    procedure ISqlCnvtFieldsBuffer(Buffer: TSDRecordBuffer);
    function ISqlConnected: Boolean;
    procedure ISqlDetach;
    procedure ISqlExecDirect(Value: string);
    procedure ISqlExecute;
    function ISqlFetch: Boolean;
    procedure ISqlInitFieldDefs;
    procedure ISqlPrepare(Value: string);
    function ISqlPrepared: Boolean;
    function ISqlGetRowsAffected: Integer;
    function ISqlWriteBlob(FieldNo: Integer; const Buffer: TSDValueBuffer; Count: Longint): Longint;
    function ISqlWriteBlobByName(Name: string; const Buffer: TSDValueBuffer; Count: Longint): Longint;
  private
    procedure CacheInit;
    procedure CacheDone;
{$IFDEF SD_VCL4}
    function CacheTempBuffer: TSDRecordBuffer;	// it's used in BlockReadNext method only(now)
{$ENDIF}
  protected
{$IFDEF SD_VCL5}
    FExprFilter: TSDExprParser;
    function CreateExprFilter(const Text: string; Options: TFilterOptions): TSDExprParser;
    { IProviderSupport }
    procedure PSEndTransaction(Commit: Boolean); override;
    function PSExecuteStatement(const ASQL: string; AParams: TParams; {$IFDEF SD_CLR} var ResultSet: TObject {$ELSE} ResultSet: TSDPtr = nil {$ENDIF}): Integer; override;
    function PSGetQuoteChar: string; override;
    function PSGetUpdateException(E: Exception; Prev: EUpdateError): EUpdateError; override;
    function PSInTransaction: Boolean; override;
    function PSIsSQLBased: Boolean; override;
    function PSIsSQLSupported: Boolean; override;
    procedure PSReset; override;
    procedure PSStartTransaction; override;
    function PSUpdateRecord(UpdateKind: TUpdateKind; Delta: TDataSet): Boolean; override;
{$ENDIF}
    function AllocRecordBuffer: TSDRecordBuffer; override;
    procedure DestroySqlCommand(Force: Boolean);
    procedure ForceClose;
    procedure FreeRecordBuffer(var Buffer: TSDRecordBuffer); override;
{$IFNDEF SD_VCL5}
    function BCDToCurr(BCD: TSDPtr; var Curr: Currency): Boolean; override;
    function CurrToBCD(const Curr: Currency; BCD: TSDPtr; Precision, Decimals: Integer): Boolean; override;
    procedure SetDefaultFields(const Value: Boolean);
    procedure UpdateBufferCount;
{$ENDIF}
    procedure CheckCachedUpdateMode;
    procedure CheckCanModify;
    procedure CheckDatabaseName;
    procedure ClearCalcFields(Buffer: TSDRecordBuffer); override;
    procedure CloseCursor; override;
    procedure ClearFieldDefs;
    procedure CreateHandle; virtual; abstract;
    procedure DataEvent(Event: TDataEvent; Info: {$IFDEF SD_CLR} TObject {$ELSE} Longint {$ENDIF}); override;
    procedure DestroyHandle; virtual;
    function FindRecord(Restart, GoForward: Boolean): Boolean; override;
    procedure GetBookmarkData(Buffer: TSDRecordBuffer; {$IFDEF SD_CLR} var Data: TBookmark {$ELSE} Data: TSDPtr {$ENDIF}); override;
    function GetBookmarkFlag(Buffer: TSDRecordBuffer): TBookmarkFlag; override;
    function GetBufferCount: Integer;
    function GetCanModify: Boolean; override;
    function GetFieldBuffer(AFieldNo: Integer; RecBuf: TSDRecordBuffer): TSDValueBuffer;
    function GetFieldDataSize(Field: TField): Integer;
{$IFNDEF SD_VCL4}
    function GetFieldData(Field: TField; Buffer: TSDValueBuffer): Boolean; override;
{$ENDIF}
    function GetRecNo: Integer; override;
    function GetRecord(Buffer: TSDRecordBuffer; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override;
    function GetRecordCount: LongInt; override;
    function GetRecordSize: Word; override;
    function GetRecordUpdateStatus: TUpdateStatus;
    procedure SetRecordUpdateStatus(Value: TUpdateStatus);
    procedure InitRecord(Buffer: TSDRecordBuffer); override;
    procedure InitResultSet;
    procedure InternalAddRecord(Buffer: TSDPtr; Append: Boolean); override;
    procedure InternalClose; override;
    procedure InternalDelete; override;
    procedure InternalFirst; override;
    procedure InternalGotoBookmark({$IFDEF SD_CLR} const {$ENDIF} Bookmark: TBookmark); override;
    procedure InternalHandleException; override;
    procedure InternalInitFieldDefs; override;
    procedure InternalInitRecord(Buffer: TSDRecordBuffer); override;
    procedure InternalLast; override;
    procedure InternalOpen; override;
    procedure InternalPost; override;
    procedure InternalRefresh; override;
    procedure InternalSetToRecord(Buffer: TSDRecordBuffer); override;
    function IsCursorOpen: Boolean; override;
    procedure DoneResultSet;
    function DoLocateRecord(const KeyFields: string; const KeyValues: Variant;
      Options: TLocateOptions; SyncCursor, NextLocate: Boolean): Integer;
    procedure DoRefreshRecord(const ARefreshSQL: string); virtual;
    procedure DoSortRecords(AFields: array of Integer; AscOrder, CaseSensitive: array of Boolean); virtual;
    procedure LiveApplyRecord(OpMode: TUpdateStatus; const ASQL, ATableName, ARefreshSQL: string);
    procedure LiveInternalPost(IsDelete: Boolean; const ASQL, ATableName: string);
    function MapsToIndex(Fields: TList; CaseInsensitive: Boolean): Boolean;
    procedure SetConnectionState(IsBusy: Boolean);
    procedure SetBookmarkData(Buffer: TSDRecordBuffer; {$IFDEF SD_CLR} const Data: TBookmark {$ELSE} Data: TSDPtr {$ENDIF}); override;
    procedure SetBookmarkFlag(Buffer: TSDRecordBuffer; Value: TBookmarkFlag); override;
{$IFDEF SD_VCL4}
    procedure BlockReadNext; override;
    procedure SetBlockReadSize(Value: Integer); override;
{$ENDIF}
    procedure SetFieldData(Field: TField; Buffer: TSDPtr); override;
    procedure SetFilterData(const Text: string; Options: TFilterOptions);
    procedure SetFiltered(Value: Boolean); override;
    procedure SetFilterOptions(Value: TFilterOptions); override;
    procedure SetFilterText(const Value: string); override;
    procedure SetRecNo(Value: Integer); override;
    procedure OpenCursor(InfoQuery: Boolean); override;
    procedure ExecuteCursor; virtual;
    function ProcessUpdates(UpdCmd: TDelayedUpdCmd): Integer;
    function SetDSFlag(Flag: Integer; Value: Boolean): Boolean; virtual;
    procedure SetOnFilterRecord(const Value: TFilterRecordEvent); override;
    property CachedUpdates: Boolean read FCachedUpdates write FCachedUpdates;
    property DSFlags: TDSFlags read FDSFlags;
    property ServerType: TSDServerType read GetServerType;
    property UpdateMode: TUpdateMode read FUpdateMode write SetUpdateMode default upWhereAll;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Disconnect; virtual;
    procedure ApplyUpdates;
    procedure CancelUpdates;
    procedure CommitUpdates;
    procedure RollbackUpdates;
    function BookmarkValid({$IFDEF SD_CLR} const {$ENDIF} Bookmark: TBookmark): Boolean; override;
    function CompareBookmarks({$IFDEF SD_CLR} const {$ENDIF} Bookmark1, Bookmark2: TBookmark): Integer; override;
    function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override;
    procedure Detach;
    procedure FetchAll;