sdengine.pas

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

    procedure OpenEmpty;
    function OpenDatabase: TSDDatabase;
    procedure CloseDatabase(Database: TSDDatabase);
    procedure GetFieldInfoFromSQL(const ASQL: string; FldInfo, TblInfo: TStrings);
    function GetCurrentRecord(Buffer: TSDRecordBuffer): Boolean; override;
{$IFDEF SD_VCL4}
    function GetFieldData(Field: TField; Buffer: TSDPtr): Boolean; overload; override;
{$ENDIF}
    function IsSequenced: Boolean; override;
    function Locate(const KeyFields: string; const KeyValues: Variant;
      Options: TLocateOptions): Boolean; override;
    function LocateNext(const KeyFields: string; const KeyValues: Variant;
      Options: TLocateOptions): Boolean;
    function Lookup(const KeyFields: string; const KeyValues: Variant;
      const ResultFields: string): Variant; override;
    procedure RefreshRecord; virtual;
    procedure RefreshRecordEx(const ARefreshSQL: string); virtual;
    procedure RevertRecord;
    procedure SortRecords(AFields: array of const; AscOrder, ACaseSensitive: array of Boolean); overload;
    procedure SortRecords(const AFields, AscOrder, ACaseSensitive: string); overload;
    function UpdateStatus: TUpdateStatus; {$IFDEF SD_VCL4} override; {$ENDIF}
    property CacheBlobs: Boolean read FCacheBlobs write FCacheBlobs default True;
    property Database: TSDDatabase read FDatabase;
    property DBSession: TSDSession read GetDBSession;
    property EnableUpdateKinds: TUpdateKinds read GetEnableUpdateKinds write SetEnableUpdateKinds;
    property Handle: PSDCursor read GetHandle;
    property UniDirectional: Boolean read FUniDirectional write SetUniDirectional default False;
    property UpdateObject: TSDDataSetUpdateObject read FUpdateObject write SetUpdateObject;
    property UpdatesPending: Boolean read GetUpdatesPending;
    property UpdateRecordTypes: TUpdateRecordTypes read GetUpdateRecordSet write SetUpdateRecordSet;
  published
    property AutoRefresh: Boolean read FAutoRefresh write SetAutoRefresh default False;
    property DatabaseName: string read FDatabaseName write SetDatabaseName;
    property DetachOnFetchAll: Boolean read FDetachOnFetchAll write SetDetachOnFetchAll default False;
    property SessionName: string read FSessionName write SetSessionName;
    property OnUpdateError: TUpdateErrorEvent read FOnUpdateError write FOnUpdateError;
    property OnUpdateRecord: TUpdateRecordEvent read FOnUpdateRecord write FOnUpdateRecord;
  published
    property Active;
    property AutoCalcFields;
    property Filter;
    property Filtered;
    property FilterOptions;
    property BeforeOpen;
    property AfterOpen;
    property BeforeClose;
    property AfterClose;
    property BeforeInsert;
    property AfterInsert;
    property BeforeEdit;
    property AfterEdit;
    property BeforePost;
    property AfterPost;
    property BeforeCancel;
    property AfterCancel;
    property BeforeDelete;
    property AfterDelete;
    property BeforeScroll;
    property AfterScroll;
    property OnCalcFields;
    property OnDeleteError;
    property OnEditError;
    property OnFilterRecord;
    property OnNewRecord;
    property OnPostError;
  end;

{ TSDQuery }

  TSDQuery = class(TSDDataSet)
  private
    FDataLink: TDataLink;
    FParams: TSDHelperParams;
    FPrepared: Boolean;
    FExecCmd: Boolean;          // to exclude repeated execution in ExecuteCursor after CreateHandle call
    FSQL: TStrings;
    FText: string;		// it's assigned to FSQL.Text in QueryChanged
    FParamCheck: Boolean;
    FRowsAffected: Integer;
    FRequestLive: Boolean;	// query must be single table w/o <group by> and <union> clauses
    FTableName: string;		// RequestLive mode
    FIndexFields: TStrings;	// field list of unique index
    function GetRowsAffected: Integer;
    procedure QueryChanged(Sender: TObject);
    procedure ReleaseHandle(SaveRes: Boolean);
    procedure RefreshParams;
    procedure SetDataSource(Value: TDataSource);
    procedure SetParamsFromCursor;
    procedure SetParamsList(Value: TSDHelperParams);
    procedure SetPrepareCmd(Value, GenCursor: Boolean);
    procedure SetPrepared(Value: Boolean);
    procedure SetRequestLive(Value: Boolean);
    procedure SetUpdateMode(const Value: TUpdateMode); override;
{$IFDEF SD_VCL4}
  private
    procedure ReadParamData(Reader: TReader);
    procedure WriteParamData(Writer: TWriter);
  protected
    procedure DefineProperties(Filer: TFiler); override;
{$ENDIF}
  protected
    function ISqlCmdCreate: TISqlCommand; override;
  protected
{$IFDEF SD_VCL5}
    { IProviderSupport }
    procedure PSExecute; override;
    function PSGetParams: TParams; override;
    function PSGetTableName: string; override;
    procedure PSSetCommandText(const CommandText: string); override;
    procedure PSSetParams(AParams: TParams); override;
{$ENDIF}
    procedure CreateHandle; override;
    procedure DoBeforeOpen; override;
    function GetCanModify: Boolean; override;
    function GetDataSource: TDataSource; override;
    function GetIsIndexField(Field: TField): Boolean; override;
    function GetParamsCount: Word;
    procedure InternalDelete; override;
    procedure InternalOpen; override;
    procedure InternalPost; override;
    function IsExecDirect: Boolean;
    procedure ExecuteCursor; override;
    function SetDSFlag(Flag: Integer; Value: Boolean): Boolean; override;
    procedure SetQuery(Value: TStrings); virtual;
    procedure UpdateUniqueIndexInfo;
    procedure SetSqlCmd(Value: TISqlCommand);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Disconnect; override;
    procedure ExecSQL;
{$IFDEF SD_VCL4}
    procedure GetDetailLinkFields(MasterFields, DetailFields: TObjectList); override;
{$ENDIF}
    function ParamByName(const Value: string): TSDHelperParam;
    procedure Prepare;
    procedure UnPrepare;
    procedure RefreshRecord; override;
    property Prepared: Boolean read FPrepared write SetPrepared;
    property ParamCount: Word read GetParamsCount;
    property Text: string read FText;
    property RowsAffected: Integer read GetRowsAffected;
  published
    property DataSource: TDataSource read GetDataSource write SetDataSource;
    property ParamCheck: Boolean read FParamCheck write FParamCheck default True;
    property Params: TSDHelperParams read FParams write SetParamsList {$IFDEF SD_VCL4} stored False {$ENDIF};
    property RequestLive: Boolean read FRequestLive write SetRequestLive default False;
    property SQL: TStrings read FSQL write SetQuery;
    property UniDirectional;
    property UpdateMode;
    property UpdateObject;
  end;

{ TSDMacroQuery }
  TSDMacroQuery = class(TSDQuery)
  private
    FMacroChar: Char;
    FMacros: TSDHelperParams;
    FMacrosExpanding: Boolean;
    FSQLPattern: TStrings;		// (unexpanded) statement with macros
    FSaveQueryChanged: TNotifyEvent;
    function GetMacros: TSDHelperParams;
    function GetMacroCount: Word;
    procedure PatternChanged(Sender: TObject);
    procedure QueryChanged(Sender: TObject);
    procedure CreateMacros;
    procedure SetMacroChar(const Value: Char);
    procedure SetMacros(const Value: TSDHelperParams);
{$IFDEF SD_VCL4}
  private
    procedure ReadMacroData(Reader: TReader);
    procedure WriteMacroData(Writer: TWriter);
  protected
    procedure DefineProperties(Filer: TFiler); override;
{$ENDIF}
  protected
    function SetDSFlag(Flag: Integer; Value: Boolean): Boolean; override;
    procedure SetQuery(Value: TStrings); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure ExpandMacros;
    function MacroByName(const MacroName: string): TSDHelperParam;
  published
    property MacroChar: Char read FMacroChar write SetMacroChar default DefaultQueryMacroChar;
    property MacroCount: Word read GetMacroCount;
    property Macros: TSDHelperParams read GetMacros write SetMacros {$IFDEF SD_VCL4} stored False {$ENDIF};
    property SQL: TStrings read FSQLPattern write SetQuery;
  end;

{ TSDUpdateSQL }

  TSDUpdateSQL = class(TSDDataSetUpdateObject)
  private
    FDataSet: TSDDataSet;
    FQueries: array[TUpdateStatus] of TSDQuery;
    FSQLText: array[TUpdateStatus] of TStrings;
    function GetSQL(StmtKind: TUpdateStatus): TStrings;
    function GetSQLIndex(Index: Integer): TStrings;
    procedure SetSQL(StmtKind: TUpdateStatus; Value: TStrings);
    procedure SetSQLIndex(Index: Integer; Value: TStrings);
  protected
    function GetDataSet: TSDDataSet; override;
    function GetQuery(UpdateKind: TUpdateKind): TSDQuery;
    function GetQueryEx(StmtKind: TUpdateStatus): TSDQuery; virtual;
    procedure SetDataSet(ADataSet: TSDDataSet); override;
    procedure SQLChanged(Sender: TObject);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Apply(UpdateKind: TUpdateKind); override;
    procedure ExecSQL(UpdateKind: TUpdateKind);
    procedure SetParams(UpdateKind: TUpdateKind);
    property DataSet;
    property Query[UpdateKind: TUpdateKind]: TSDQuery read GetQuery;
    property SQL[StmtKind: TUpdateStatus]: TStrings read GetSQL write SetSQL;
    property QueryEx[StmtKind: TUpdateStatus]: TSDQuery read GetQueryEx;    
  published
    property RefreshSQL:TStrings index 0 read GetSQLIndex write SetSQLIndex;
    property ModifySQL: TStrings index 1 read GetSQLIndex write SetSQLIndex;
    property InsertSQL: TStrings index 2 read GetSQLIndex write SetSQLIndex;
    property DeleteSQL: TStrings index 3 read GetSQLIndex write SetSQLIndex;
  end;


{ TSDBlobStream }

  TSDBlobStream = class(TStream)
  private
    FField: TBlobField;
    FDataSet: TSDDataSet;
    FBuffer: TSDRecordBuffer;    		// record buffer
    FMode: TBlobStreamMode;
    FFieldNo: Integer;
    FOpened: Boolean;
    FModified: Boolean;
    FPosition: LongInt;
    FBlobData: TSDBlobData;
    FBlobSize: LongInt;
    FCached: Boolean;		// if BLOB into memory
    FCacheSize: LongInt;
    function GetBlobSize: LongInt;
  protected
    procedure SetSize(NewSize: {$IFDEF SD_CLR}Int64 {$ELSE} Longint {$ENDIF}); override;
  public
    constructor Create(Field: TBlobField; Mode: TBlobStreamMode);
    destructor Destroy; override;
    function Read(var Buffer {$IFDEF SD_CLR} :TBytes; Offset,{$ELSE}; {$ENDIF} Count: Longint): Longint; override;
    function Write(const Buffer {$IFDEF SD_CLR} :TBytes; Offset,{$ELSE}; {$ENDIF} Count: Longint): Longint; override;
{$IFDEF SD_CLR}
    function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override;
{$ELSE}
    function Seek(Offset: Longint; Origin: Word): Longint; override;
{$ENDIF}
    procedure Truncate;
  end;

{ TSDStoredProc }

  TSDStoredProc = class(TSDDataSet)
  private
    FProcName: string;
    FParams: TSDHelperParams;
    FOverLoad: Word;
    FPrepared: Boolean;
    FQueryMode: Boolean;
    FExecCmd: Boolean;          // to exclude repeated execution in ExecuteCursor after CreateHandle call    
    procedure ReleaseHandle(SaveRes: Boolean);    
    procedure SetParamsList(Value: TSDHelperParams);
{$IFDEF SD_VCL4}
  private
    procedure ReadParamData(Reader: TReader);
    procedure WriteParamData(Writer: TWriter);
  protected
    procedure DefineProperties(Filer: TFiler); override;
{$ENDIF}
  protected
{$IFDEF SD_VCL5}
    { IProviderSupport }
    procedure PSExecute; override;
    function PSGetTableName: string; override;
    function PSGetParams: TParams; override;
    procedure PSSetCommandText(const CommandText: string); override;
    procedure PSSetParams(AParams: TParams); override;
{$ENDIF}
    procedure BindParams;
    procedure CreateHandle; override;
    procedure CreateParamDesc;
    procedure CloseCursor; override;
    procedure ExecuteCursor; override;
    procedure InternalOpen; override;
    function IsExecDirect: Boolean;
    function GetParamsCount: Word;
    function SetDSFlag(Flag: Integer; Value: Boolean): Boolean; override;
    procedure SetOverLoad(Value: Word);
    procedure SetProcName(const Value: string);
    procedure SetPrepared(Value: Boolean);
    procedure SetPrepareCmd(Value, GenCursor: Boolean);
  protected
    function ISqlCmdCreate: TISqlCommand; override;
    function ISqlDescriptionsAvailable: Boolean;
    function ISqlNextResultSet: Boolean;
    procedure ISqlPrepareProc;
    procedure ISqlExecProc;
    procedure ISqlExecProcDirect;
    procedure ISqlGetResults;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Disconnect; override;
    procedure CopyParams(Value: TSDHelperParams);
    function DescriptionsAvailable: Boolean;
    procedure ExecProc;
    procedure GetResults;
    function NextResultSet: Boolean;
    function ParamByName(const Value: string): TSDHelperParam;
    procedure Prepare;
    procedure UnPrepare;
    property ParamCount: Word read GetParamsCount;
    property Prepared: Boolean read FPrepared write SetPrepared;
  published
    property StoredProcName: string read FProcName write SetProcName;
    property Overload: Word read FOverload write SetOverload default 0;
    property Params: TSDHelperParams read FParams write SetParamsList {$IFDEF SD_VCL4} stored False {$ENDIF};
    property UpdateObject;
  end;

{ TSDTable }
  TIndexDesc = record
    Name   	:string;       // Index name
    Fields	:string;       // list of all fields in the key