sdengine.pas

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

    DescFields	:string;       // list of descending fields
    iFldsInKey  :Word;         // Fields in the key
    bPrimary    :WordBool;     // True, if primary index
    bUnique     :WordBool;     // True, if unique keys
  end;
  TIndexDescArray = array {$IFNDEF SD_VCL4}[0..0]{$ENDIF} of TIndexDesc;      // Delphi 3 does not support dynamic arrays

  TSDTable = class(TSDDataSet)
{$IFDEF SD_VCL5}
  private
    FTableName: string;
    FOrderByFields: string;
    FWhereText: string;
    FFieldsIndex: Boolean; 	// FFieldsIndex is True, if IndexName is activated else IndexFieldNames is active
    FDefaultIndex: Boolean;
    FIndexDefs: TIndexDefs;
    FMasterLink: TMasterDataLink;
    FIndexName: string;
    FIndexDescs: TIndexDescArray;	// index descriptions
    FIndexFieldMap: array of Integer;	// FIndexFieldMap[Field Index in the current index] = FieldNo
    FIndexFieldCount: Integer;
    FStoreDefs: Boolean;
    FReadOnly: Boolean;
    FParams: TSDHelperParams;
    FQuoteIdent: Boolean;

    procedure CheckMasterRange;
    function FieldDefsStored: Boolean;
    function GetExists: Boolean;
    function GetIndexFieldNames: string;
    function GetIndexName: string;
    function GetFieldListWithDesc(const AFields, ADescFields: string): string;
    function GetMasterFields: string;
    function ReplaceSemicolon2Comma(const AStr: string): string;
    function IndexDefsStored: Boolean;
    procedure MasterChanged(Sender: TObject);
    procedure MasterDisabled(Sender: TObject);
    procedure RefreshParams;
    procedure ReleaseHandle(SaveRes: Boolean);
    procedure SetDataSource(Value: TDataSource);
    procedure SetIndexField(Index: Integer; Value: TField);
    procedure SetIndexDefs(Value: TIndexDefs);
    procedure SetIndexFieldNames(const Value: string);
    procedure SetIndex(const Value: string; FieldsIndex: Boolean);
    procedure SetIndexName(const Value: string);
    procedure SetMasterFields(const Value: string);
    procedure SetReadOnly(Value: Boolean);
    procedure SetTableName(const Value: string);
    procedure SetLinkRanges(MasterFields: TList);
    procedure SetParamsFromMasterDataSet;
    procedure ApplyRange;
    procedure CancelRange;
    procedure UpdateRange;
  protected
    { IProviderSupport }
{    function PSGetDefaultOrder: TIndexDef; override;
    function PSGetKeyFields: string; override;
    function PSGetTableName: string; override;
    function PSGetIndexDefs(IndexTypes: TIndexOptions): TIndexDefs; override;
    procedure PSSetCommandText(const CommandText: string); override;
    procedure PSSetParams(AParams: TParams); override;}
  protected
    function ISqlCmdCreate: TISqlCommand; override;
    procedure ISqlDeleteTable;
    procedure ISqlEmptyTable;

    procedure CreateHandle; override;
    procedure ExecuteCursor; override;
    procedure DataEvent(Event: TDataEvent; Info: {$IFDEF SD_CLR} TObject {$ELSE} Longint {$ENDIF}); override;
    procedure DoOnNewRecord; override;    
    function GenOrderBy: string;
    function GetCanModify: Boolean; override;
    function GetCurrentIndex: Integer;
    function GetDataSource: TDataSource; override;
    function GetIndexField(Index: Integer): TField;
    function GetIndexFieldCount: Integer;
    function GetIsIndexField(Field: TField): Boolean; override;
    function GetSQLText: string;
    procedure InternalClose; override;
    procedure InternalDelete; override;
    procedure InternalPost; override;
    procedure InternalOpen; override;
    procedure SwitchToIndex;
    procedure ClearIndexDescs;
    procedure UpdateIndexDescs;
    procedure UpdateIndexDefs; override;
    property MasterLink: TMasterDataLink read FMasterLink;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure CreateTable;
    procedure DeleteTable;
    procedure EmptyTable;
    procedure GetIndexNames(List: TStrings);
    property Exists: Boolean read GetExists;
    property IndexFieldCount: Integer read GetIndexFieldCount;
    property IndexFields[Index: Integer]: TField read GetIndexField write SetIndexField;
  published
    property DefaultIndex: Boolean read FDefaultIndex write FDefaultIndex default True;
    property FieldDefs stored FieldDefsStored;
    property IndexDefs: TIndexDefs read FIndexDefs write SetIndexDefs stored IndexDefsStored;
    property IndexFieldNames: string read GetIndexFieldNames write SetIndexFieldNames;
    property IndexName: string read GetIndexName write SetIndexName;
    property MasterFields: string read GetMasterFields write SetMasterFields;
    property MasterSource: TDataSource read GetDataSource write SetDataSource;
    property ReadOnly: Boolean read FReadOnly write SetReadOnly default False;
    property StoreDefs: Boolean read FStoreDefs write FStoreDefs default False;
    property TableName: string read FTableName write  SetTableName;    
{$ENDIF}
  published
    property UpdateMode;
    property UpdateObject;
  end;

{ TSDScript }
  TSDScript = class(TComponent)
  private
    FSQL: TStrings;                     // statements with expanded macros
    FSQLPattern: TStrings;		// (unexpanded) statements with macros
    FParamCheck: Boolean;
    FParams: TSDHelperParams;
    FQuery: TSDQuery;
    FIgnoreParams: Boolean;             // parameters of query are not assigned
    FTermChar: Char;
    FMacroChar: Char;
    FMacros: TSDHelperParams;
    FMacroCheck: Boolean;             // do not parse macros
    FTransaction: Boolean;
    FBeforeExecute: TNotifyEvent;
    FAfterExecute: TNotifyEvent;
    function GetDatabase: TSDDatabase;
    function GetDatabaseName: string;
    function GetMacros: TSDHelperParams;
    function GetMacroCount: Word;
    function GetParamsCount: Integer;
    function GetDBSession: TSDSession;
    function GetSessionName: string;
    function GetText: string;
    procedure CreateMacros;
    procedure PatternChanged(Sender: TObject);
    procedure SetDatabaseName(const Value: string);
    procedure SetMacroChar(const Value: Char);
    procedure SetMacros(const Value: TSDHelperParams);
    procedure SetParamsList(const Value: TSDHelperParams);
    procedure SetQuery(const Value: TStrings);
    procedure SetSessionName(const Value: string);
{$IFDEF SD_VCL4}
  private
    procedure ReadParamData(Reader: TReader);
    procedure WriteParamData(Writer: TWriter);
    procedure ReadMacroData(Reader: TReader);
    procedure WriteMacroData(Writer: TWriter);
  protected
    procedure DefineProperties(Filer: TFiler); override;
{$ENDIF}
  protected
    procedure CheckExecQuery(LineNo, StatementNo: Integer);
    procedure ExecuteScript(StatementNo: Integer); virtual;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure ExecSQL;
    procedure ExpandMacros;
    function MacroByName(const MacroName: string): TSDHelperParam;
    function ParamByName(const Value: string): TSDHelperParam;
    property DBSession: TSDSession read GetDBSession;
    property Database: TSDDatabase read GetDatabase;
    property ParamCount: Integer read GetParamsCount;
    property Text: string read GetText;
  published
    property DatabaseName: string read GetDatabaseName write SetDatabaseName;
    property IgnoreParams: Boolean read FIgnoreParams write FIgnoreParams default False;
    property MacroChar: Char read FMacroChar write SetMacroChar default DefaultQueryMacroChar;
    property MacroCheck: Boolean read FMacroCheck write FMacroCheck default True;
    property MacroCount: Word read GetMacroCount;
    property Macros: TSDHelperParams read GetMacros write SetMacros {$IFDEF SD_VCL4} stored False {$ENDIF};
    property TermChar: Char read FTermChar write FTermChar default DefaultScriptTermChar;
    property SessionName: string read GetSessionName write SetSessionName;
    property SQL: TStrings read FSQLPattern write SetQuery;
    property ParamCheck: Boolean read FParamCheck write FParamCheck default True;
    property Params: TSDHelperParams read FParams write SetParamsList {$IFDEF SD_VCL4} stored False {$ENDIF};
    property Transaction: Boolean read FTransaction write FTransaction;
    property BeforeExecute: TNotifyEvent read FBeforeExecute write FBeforeExecute;
    property AfterExecute: TNotifyEvent read FAfterExecute write FAfterExecute;
  end;

{ Error and exception handling routines }
procedure SDEError(ErrorCode: TSDEResult);
procedure SDECheck(Status: TSDEResult);

function UpdateKindToStatus(UpdateKind: TUpdateKind): TUpdateStatus;

procedure SetBusyState;
procedure ResetBusyState;

var
  DefDatabase: TSDDatabase;	// default database component in design time
  Session: TSDSession;
  Sessions: TSDSessionList;

  InitSqlDatabaseProcs: array[TSDServerType] of TInitSqlDatabaseProc;

implementation

uses
  DBConsts, DBLogDlg,
{$IFDEF EVAL}SDRemind,{$ENDIF}

{$IFDEF stSQLBase}      SDCsb,{$ENDIF}
{$IFDEF stOracle}       SDOra,{$ENDIF}
{$IFDEF stSQLServer}    SDMss,{$ENDIF}
{$IFDEF stSybase}       SDSyb,{$ENDIF}
{$IFDEF stDB2}          SDDb2,{$ENDIF}
{$IFDEF stInformix}     SDInf,{$ENDIF}
{$IFDEF stODBC}         SDOdbc,{$ENDIF}
{$IFDEF stInterbase}    SDInt,{$ENDIF}
{$IFDEF stFirebird}     SDFib,{$ENDIF}
{$IFDEF stMySQL}        SDMySQL,{$ENDIF}
{$IFDEF stPostgreSQL}   SDPgSQL,{$ENDIF}
{$IFDEF stOLEDB}        SDOleDb,{$ENDIF}

{$IFDEF CLR}
  System.Text, System.Threading,
{$ENDIF}
  TypInfo;

const
  DefaultParamPrefix		= ':';
  OldFieldValuePrefix		= 'OLD_';

type

  { TBookmarkRec }
  PBookmarkRec = ^TBookmarkRec;
  TBookmarkRec = packed record		{ Bookmark structure }
    iPos   : Longint;               { Position in given order - position in the cache(FRecCache), starting from 0 }
{    iState : Integer;               { State of cursor }
//    iRecNo : Integer;               { Physical Record number }
{    iSeqNo : Integer;               { Version number of order }
{    iOrderID : Integer;             { Defines Order }
  end;

  { TDBParams - remote database parameters that stored in the Session object }
  TDBParams	= class(TObject)
    RemoteDatabase: string;
    ServerType: TSDServerType;
    Params: TStrings;
  end;

{ Busy state cursor function }
var
  BusyCount: Integer;
  SaveCursor: TCursor;
  FCSect: TRTLCriticalSection;


procedure SetBusyState;
begin
{$IFDEF SD_CLR}
  if Thread.CurrentThread <> MainThread then
{$ELSE}
  if GetCurrentThreadID <> MainThreadID then
{$ENDIF}
    Exit;
	// if main thread, that change cursor
  if Session.FSQLHourGlass then begin
    if BusyCount = 0 then begin
      SaveCursor := Screen.Cursor;
      Screen.Cursor := Session.FSQLWaitCursor;
    end;
    Inc(BusyCount);
  end;
end;

procedure ResetBusyState;
begin
  if Session.FSQLHourGlass then
    if BusyCount > 0 then begin
      Dec(BusyCount);
      if BusyCount = 0 then
        Screen.Cursor := SaveCursor;
    end;
end;

function UpdateKindToStatus(UpdateKind: TUpdateKind): TUpdateStatus;
begin
  Result := TUpdateStatus( Ord(UpdateKind)+1 );
end;

// Returns False if the field value differs from the parameter value
function CompareParamValue(Param: TSDHelperParam; Field: TField): Boolean;
begin
  Result := False;
  if not Assigned( Field ) then
    Exit;
  if (Param.IsNull xor Field.IsNull) or
     (Param.DataType <> Field.DataType)
  then
    Exit;
  Result := (Param.IsNull and Field.IsNull) or
            (Param.Value = Field.Value);
end;

function DateTimeRecToDateTime(DataType: TFieldType; DateTimeRec: TDateTimeRec): TDateTime;
var
  TimeStamp: TTimeStamp;
begin
  case DataType of
    ftDate:
      begin
        TimeStamp.Time := 0;
        TimeStamp.Date := DateTimeRec.Date;
      end;
    ftTime:
      begin
        TimeStamp.Time := DateTimeRec.Time;
        TimeStamp.Date := DateDelta;
      end;
    ftDateTime:
      try
        TimeStamp := MSecsToTimeStamp({$IFDEF SD_CLR} Trunc(DateTimeRec.DateTime) {$ELSE} DateTimeRec.DateTime {$ENDIF});
      except
        TimeStamp.Time := 0;
        TimeStamp.Date := 0;
      end;
    else
      raise Exception.Create('Unknown data type in function DateTimeRecToDateTime');
    end;
  Result := TimeStampToDateTime(TimeStamp);
end;