freepascal.compiler/fcl/db/db.pp

{
    $Id$
    This file is part of the Free Pascal run time library.
    Copyright (c) 1999-2000 by Michael Van Canneyt, member of the
    Free Pascal development team


    DB header file with interface section.

    See the file COPYING.FPC, included in this distribution,
    for details about the copyright.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

 **********************************************************************}
unit db;

{$mode objfpc}
{$h+}

interface

uses Classes,Sysutils;

const

  dsMaxBufferCount = MAXINT div 8;
  dsMaxStringSize = 8192;

  // Used in AsBoolean for string fields to determine
  // whether it's true or false.
  YesNoChars : Array[Boolean] of char = ('Y','N');

type

{ Auxiliary type }
  TStringFieldBuffer = Array[0..dsMaxStringSize] of Char;

{ Misc Dataset types }

  TDataSetState = (dsInactive, dsBrowse, dsEdit, dsInsert, dsSetKey,
    dsCalcFields, dsFilter, dsNewValue, dsOldValue, dsCurValue);

  TDataEvent = (deFieldChange, deRecordChange, deDataSetChange,
    deDataSetScroll, deLayoutChange, deUpdateRecord, deUpdateState,
    deCheckBrowseMode, dePropertyChange, deFieldListChange, deFocusControl);

  TUpdateStatus = (usUnmodified, usModified, usInserted, usDeleted);

{ Forward declarations }

  TFieldDef = class;
  TFieldDefs = class;
  TField = class;
  TFields = Class;
  TDataSet = class;
  TDataBase = Class;

{ Exception classes }

  EDatabaseError = class(Exception);

{ TFieldDef }

  TFieldClass = class of TField;

  TFieldType = (ftUnknown, ftString, ftSmallint, ftInteger, ftWord,
    ftBoolean, ftFloat, ftDate, ftTime, ftDateTime,
    ftBytes, ftVarBytes, ftAutoInc, ftBlob, ftMemo, ftGraphic,
    ftFmtMemo, ftParadoxOle, ftDBaseOle, ftTypedBinary, ftCursor);

  TFieldDef = class(TComponent)
  Private
    FDataType : TFieldType;
    FFieldNo : Longint;
    FInternalCalcField : Boolean;
    FPrecision : Longint;
    FRequired : Boolean;
    FSize : Word;
    FName : String;
    Function GetFieldClass : TFieldClass;
  public
    constructor Create(AOwner: TFieldDefs; const AName: string;
      ADataType: TFieldType; ASize: Word; ARequired: Boolean; AFieldNo: Longint);
    destructor Destroy; override;
    function CreateField(AOwner: TComponent): TField;
    property InternalCalcField: Boolean read FInternalCalcField write FInternalCalcField;
    property DataType: TFieldType read FDataType;
    property FieldClass: TFieldClass read GetFieldClass;
    property FieldNo: Longint read FFieldNo;
    property Name: string read FName;
    property Precision: Longint read FPrecision write FPrecision;
    property Required: Boolean read FRequired;
    property Size: Word read FSize;
  end;

{ TFieldDefs }

  TFieldDefs = class(TComponent)
  private
    FDataSet: TDataSet;
    FItems: TList;
    FUpdated: Boolean;
    function GetCount: Longint;
    function GetItem(Index: Longint): TFieldDef;
  public
    constructor Create(ADataSet: TDataSet);
    destructor Destroy; override;
    procedure Add(const AName: string; ADataType: TFieldType; ASize: Word;
      ARequired: Boolean);
    procedure Assign(FieldDefs: TFieldDefs);
    procedure Clear;
    function Find(const AName: string): TFieldDef;
    function IndexOf(const AName: string): Longint;
    procedure Update;
    property Count: Longint read GetCount;
    property Items[Index: Longint]: TFieldDef read GetItem; default;
  end;

{ TField }

  TFieldKind = (fkData, fkCalculated, fkLookup, fkInternalCalc);
  TFieldKinds = Set of TFieldKind;

  TFieldNotifyEvent = procedure(Sender: TField) of object;
  TFieldGetTextEvent = procedure(Sender: TField; var Text: string;
    DisplayText: Boolean) of object;
  TFieldSetTextEvent = procedure(Sender: TField; const Text: string) of object;
  TFieldRef = ^TField;
  TFieldChars = set of Char;
  { TAlignment may need to come from somewhere else }
  TAlignMent = (taLeftjustify,taCenter,taRightJustify);

  TField = class(TComponent)
  Private
    FAlignMent : TAlignment;
    FAttributeSet : String;
    FBuffers : ppchar;
    FCalculated : Boolean;
    FCanModify : Boolean;
    FConstraintErrorMessage : String;
    FCustomConstraint : String;
    FDataSet : TDataSet;
    FDataSize : Word;
    FDataType : TFieldType;
    FDefaultExpression : String;
    FDisplayLabel : String;
    FDisplayWidth : Longint;
    FEditText : String;
    FFieldKind : TFieldKind;
    FFieldName : String;
    FFieldNo : Longint;
    FFields : TFields;
    FHasConstraints : Boolean;
    FImportedConstraint : String;
    FIsIndexField : Boolean;
    FKeyFields : String;
    FLookupCache : Boolean;
    FLookupDataSet : TDataSet;
    FLookupKeyfields : String;
    FLookupresultField : String;
    FOffset : Word;
    FOnChange : TFieldNotifyEvent;
    FOnGetText: TFieldGetTextEvent;
    FOnSetText: TFieldSetTextEvent;
    FOnValidate: TFieldNotifyEvent;
    FOrigin : String;
    FReadOnly : Boolean;
    FRequired : Boolean;
    FSize : Word;
    FValidChars : TFieldChars;
    FValueBuffer : Pointer;
    FValidating : Boolean;
    FVisible : Boolean;
    Function GetIndex : longint;
    Procedure SetDataset(VAlue : TDataset);
  protected
    function AccessError(const TypeName: string): EDatabaseError;
    procedure CheckInactive;
    class procedure CheckTypeSize(AValue: Longint); virtual;
    procedure Change; virtual;
    procedure DataChanged;
    procedure FreeBuffers; virtual;
    function GetAsBoolean: Boolean; virtual;
    function GetAsDateTime: TDateTime; virtual;
    function GetAsFloat: Extended; virtual;
    function GetAsLongint: Longint; virtual;
    function GetAsString: string; virtual;
    function GetCanModify: Boolean; virtual;
    function GetDataSize: Word; virtual;
    function GetDefaultWidth: Longint; virtual;
    function GetDisplayName : String; 
    function GetIsNull: Boolean; virtual;
    function GetParentComponent: TComponent; override;
    procedure GetText(var AText: string; ADisplayText: Boolean); virtual;
    function HasParent: Boolean; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure PropertyChanged(LayoutAffected: Boolean);
    procedure ReadState(Reader: TReader); override;
    procedure SetAsBoolean(AValue: Boolean); virtual;
    procedure SetAsDateTime(AValue: TDateTime); virtual;
    procedure SetAsFloat(AValue: Extended); virtual;
    procedure SetAsLongint(AValue: Longint); virtual;
    procedure SetAsString(const AValue: string); virtual;
    procedure SetDataType(AValue: TFieldType);
    procedure SetSize(AValue: Word); virtual;
    procedure SetParentComponent(AParent: TComponent); override;
    procedure SetText(const AValue: string); virtual;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    procedure Clear; virtual;
    procedure FocusControl;
    function GetData(Buffer: Pointer): Boolean;
    class function IsBlob: Boolean; virtual;
    function IsValidChar(InputChar: Char): Boolean; virtual;
    procedure SetData(Buffer: Pointer);
    procedure SetFieldType(AValue: TFieldType); virtual;
    procedure Validate(Buffer: Pointer);
    property AsBoolean: Boolean read GetAsBoolean write SetAsBoolean;
    property AsDateTime: TDateTime read GetAsDateTime write SetAsDateTime;
    property AsFloat: Extended read GetAsFloat write SetAsFloat;
    property AsLongint: Longint read GetAsLongint write SetAsLongint;
    property AsString: string read GetAsString write SetAsString;
    property AttributeSet: string read FAttributeSet write FAttributeSet;
    property Calculated: Boolean read FCalculated write FCalculated;
    property CanModify: Boolean read FCanModify;
    property DataSet: TDataSet read FDataSet write SetDataSet;
    property DataSize: Word read GetDataSize;
    property DataType: TFieldType read FDataType;
    property FieldNo: Longint read FFieldNo;
    property IsIndexField: Boolean read FIsIndexField;
    property IsNull: Boolean read GetIsNull;
    property Offset: word read FOffset;
    property Size: Word read FSize write FSize;
    property Text: string read FEditText write FEditText;
    property ValidChars : TFieldChars Read FValidChars;
  published
    property AlignMent : TAlignMent Read FAlignMent write FAlignment;
    property CustomConstraint: string read FCustomConstraint write FCustomConstraint;
    property ConstraintErrorMessage: string read FConstraintErrorMessage write FConstraintErrorMessage;
    property DefaultExpression: string read FDefaultExpression write FDefaultExpression;
    property DisplayLabel : string read FDisplayLabel write FDisplayLabel;
    property DisplayName : String Read GetDisplayName; 
    property DisplayWidth: Longint read FDisplayWidth write FDisplayWidth;
    property FieldKind: TFieldKind read FFieldKind write FFieldKind;
    property FieldName: string read FFieldName write FFieldName;
    property HasConstraints: Boolean read FHasConstraints;
    property Index: Longint read GetIndex;
    property ImportedConstraint: string read FImportedConstraint write FImportedConstraint;
    property LookupDataSet: TDataSet read FLookupDataSet write FLookupDataSet;
    property LookupKeyFields: string read FLookupKeyFields write FLookupKeyFields;
    property LookupResultField: string read FLookupResultField write FLookupResultField;
    property KeyFields: string read FKeyFields write FKeyFields;
    property LookupCache: Boolean read FLookupCache write FLookupCache;
    property Origin: string read FOrigin write FOrigin;
    property ReadOnly: Boolean read FReadOnly write FReadOnly;
    property Required: Boolean read FRequired write FRequired;
    property Visible: Boolean read FVisible write FVisible;
    property OnChange: TFieldNotifyEvent read FOnChange write FOnChange;
    property OnGetText: TFieldGetTextEvent read FOnGetText write FOnGetText;
    property OnSetText: TFieldSetTextEvent read FOnSetText write FOnSetText;
    property OnValidate: TFieldNotifyEvent read FOnValidate write FOnValidate;
  end;

{ TStringField }

  TStringField = class(TField)
  protected
    class procedure CheckTypeSize(AValue: Longint); override;
    function GetAsBoolean: Boolean; override;
    function GetAsDateTime: TDateTime; override;
    function GetAsFloat: Extended; override;
    function GetAsLongint: Longint; override;
    function GetAsString: string; override;
    function GetDataSize: Word; override;
    function GetDefaultWidth: Longint; override;
    procedure GetText(var AText: string; DisplayText: Boolean); override;
    function GetValue(var AValue: string): Boolean;
    procedure SetAsBoolean(AValue: Boolean); override;
    procedure SetAsDateTime(AValue: TDateTime); override;
    procedure SetAsFloat(AValue: Extended); override;
    procedure SetAsLongint(AValue: Longint); override;
    procedure SetAsString(const AValue: string); override;
  public
    constructor Create(AOwner: TComponent); override;
    property Value: string read GetAsString write SetAsString;
  published
    property Size default 20;
  end;

{ TNumericField }
  TNumericField = class(TField)
  Private
    FDisplayFormat : String;
    FEditFormat : String;
  protected
    procedure RangeError(AValue, Min, Max: Extended);
    procedure SetDisplayFormat(const AValue: string);
    procedure SetEditFormat(const AValue: string);
  public
    constructor Create(AOwner: TComponent); override;
  published
    property DisplayFormat: string read FDisplayFormat write SetDisplayFormat;
    property EditFormat: string read FEditFormat write SetEditFormat;
  end;

{ TLongintField }

  TLongintField = class(TNumericField)
  private
    FMinValue,
    FMaxValue,
    FMinRange,
    FMAxRange  : Longint;
    Procedure SetMinValue (AValue : longint);
    Procedure SetMaxValue (AValue : longint);
  protected
    function GetAsFloat: Extended; override;
    function GetAsLongint: Longint; override;
    function GetAsString: string; override;
    function GetDataSize: Word; override;
    procedure GetText(var AText: string; DisplayText: Boolean); override;
    function GetValue(var AValue: Longint): Boolean;
    procedure SetAsFloat(AValue: Extended); override;
    procedure SetAsLongint(AValue: Longint); override;
    procedure SetAsString(const AValue: string); override;
  public
    constructor Create(AOwner: TComponent); override;
    Function CheckRange(AValue : longint) : Boolean;
    property Value: Longint read GetAsLongint write SetAsLongint;
  published
    property MaxValue: Longint read FMaxValue write SetMaxValue default 0;
    property MinValue: Longint read FMinValue write SetMinValue default 0;
  end;
  TIntegerField = TLongintField;

{ TSmallintField }

  TSmallintField = class(TLongintField)
  protected
    function GetDataSize: Word; override;
  public
    constructor Create(AOwner: TComponent); override;
  end;

{ TWordField }

  TWordField = class(TLongintField)
  protected
    function GetDataSize: Word; override;
  public
    constructor Create(AOwner: TComponent); override;
  end;

{ TAutoIncField }

  TAutoIncField = class(TLongintField)
  Protected
    Procedure SetAsLongInt(AValue : Longint); override;
  public
    constructor Create(AOwner: TComponent); override;
  end;

{ TFloatField }

  TFloatField = class(TNumericField)
  private
    FMaxValue : Extended;
    FMinValue : Extended;
    FPrecision : Longint;
  protected
    function GetAsFloat: Extended; override;
    function GetAsLongint: Longint; override;
    function GetAsString: string; override;
    function GetDataSize: Word; override;
    procedure GetText(var theText: string; DisplayText: Boolean); override;
    procedure SetAsFloat(AValue: Extended); override;
    procedure SetAsLongint(AValue: Longint); override;
    procedure SetAsString(const AValue: string); override;
  public
    constructor Create(AOwner: TComponent); override;
    Function CheckRange(AValue : Extended) : Boolean;
    property Value: Extended read GetAsFloat write SetAsFloat;

  published
    property MaxValue: Extended read FMaxValue write FMaxValue;
    property MinValue: Extended read FMinValue write FMinValue;
    property Precision: Longint read FPrecision write FPrecision default 15;
  end;


{ TBooleanField }

  TBooleanField = class(TField)
  private
    FDisplayValues : String;
    // First byte indicates uppercase or not.
    FDisplays : Array[Boolean,Boolean] of string;
    Procedure SetDisplayValues(AValue : String);
  protected
    function GetAsBoolean: Boolean; override;
    function GetAsString: string; override;
    function GetDataSize: Word; override;
    function GetDefaultWidth: Longint; override;
    procedure SetAsBoolean(AValue: Boolean); override;
    procedure SetAsString(const AValue: string); override;
  public
    constructor Create(AOwner: TComponent); override;
    property Value: Boolean read GetAsBoolean write SetAsBoolean;
  published
    property DisplayValues: string read FDisplayValues write SetDisplayValues;
  end;

{ TDateTimeField }

  TDateTimeField = class(TField)
  private
    FDisplayFormat : String;
  protected
    function GetAsDateTime: TDateTime; override;
    function GetAsFloat: Extended; override;
    function GetAsString: string; override;
    function GetDataSize: Word; override;
    procedure GetText(var theText: string; DisplayText: Boolean); override;
    procedure SetAsDateTime(AValue: TDateTime); override;
    procedure SetAsFloat(AValue: Extended); override;
    procedure SetAsString(const AValue: string); override;
  public
    constructor Create(AOwner: TComponent); override;
    property Value: TDateTime read GetAsDateTime write SetAsDateTime;
  published
    property DisplayFormat: string read FDisplayFormat write FDisplayFormat;
  end;

{ TDateField }

  TDateField = class(TDateTimeField)
  protected
    function GetDataSize: Word; override;
  public
    constructor Create(AOwner: TComponent); override;
  end;

{ TTimeField }

  TTimeField = class(TDateTimeField)
  protected
    function GetDataSize: Word; override;
  public
    constructor Create(AOwner: TComponent); override;
  end;

{ TBinaryField }

  TBinaryField = class(TField)
  protected
    class procedure CheckTypeSize(AValue: Longint); override;
    function GetAsString: string; override;
    procedure GetText(var TheText: string; DisplayText: Boolean); override;
    procedure SetAsString(const AValue: string); override;
    procedure SetText(const AValue: string); override;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property Size default 16;
  end;

{ TBytesField }

  TBytesField = class(TBinaryField)
  protected
    function GetDataSize: Word; override;
  public
    constructor Create(AOwner: TComponent); override;
  end;

{ TVarBytesField }

  TVarBytesField = class(TBytesField)
  protected
    function GetDataSize: Word; override;
  public
    constructor Create(AOwner: TComponent); override;
  end;

{ TBCDField }

  TBCDField = class(TNumericField)
  private
  protected
    class procedure CheckTypeSize(AValue: Longint); override;
    function GetAsFloat: Extended; override;
    function GetAsLongint: Longint; override;
    function GetAsString: string; override;
    function GetDataSize: Word; override;
    function GetDefaultWidth: Longint; override;
    procedure GetText(var TheText: string; DisplayText: Boolean); override;
    procedure SetAsFloat(AValue: Extended); override;
    procedure SetAsLongint(AValue: Longint); override;
    procedure SetAsString(const AValue: string); override;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property Size default 4;
  end;

{ TBlobField }
  TBlobStreamMode = (bmRead, bmWrite, bmReadWrite);
  TBlobType = ftBlob..ftTypedBinary;

  TBlobField = class(TField)
  private
    FBlobSize : Longint;
    FBlobType : TBlobType;
    FModified : Boolean;
    FTransliterate : Boolean;
    Function GetBlobStream (Mode : TBlobStreamMode) : TStream;
  protected
    procedure AssignTo(Dest: TPersistent); override;
    procedure FreeBuffers; override;
    function GetAsString: string; override;
    function GetBlobSize: Longint; virtual;
    function GetIsNull: Boolean; override;
    procedure GetText(var TheText: string; DisplayText: Boolean); override;
    procedure SetAsString(const AValue: string); override;
    procedure SetText(const AValue: string); override;
  public
    constructor Create(AOwner: TComponent); override;
    procedure Assign(Source: TPersistent); override;
    procedure Clear; override;
    class function IsBlob: Boolean; override;
    procedure LoadFromFile(const FileName: string);
    procedure LoadFromStream(Stream: TStream);
    procedure SaveToFile(const FileName: string);
    procedure SaveToStream(Stream: TStream);
    procedure SetFieldType(AValue: TFieldType); override;
    property BlobSize: Longint read FBlobSize;
    property Modified: Boolean read FModified write FModified;
    property Value: string read GetAsString write SetAsString;
    property Transliterate: Boolean read FTransliterate write FTransliterate;
  published
    property BlobType: TBlobType read FBlobType write FBlobType;
    property Size default 0;
  end;

{ TMemoField }

  TMemoField = class(TBlobField)
  public
    constructor Create(AOwner: TComponent); override;
  published
    property Transliterate default True;
  end;

{ TGraphicField }

  TGraphicField = class(TBlobField)
  public
    constructor Create(AOwner: TComponent); override;
  end;

{ TIndexDef }

  TIndexDefs = class;

  TIndexOptions = set of (ixPrimary, ixUnique, ixDescending,
    ixCaseInsensitive, ixExpression);

  TIndexDef = class
  Private
    FExpression : String;
    FFields : String;
    FName : String;
    FOptions : TIndexOptions;
    FSource : String;
  public
    constructor Create(Owner: TIndexDefs; const AName, TheFields: string;
      TheOptions: TIndexOptions);
    destructor Destroy; override;
    property Expression: string read FExpression;
    property Fields: string read FFields;
    property Name: string read FName;
    property Options: TIndexOptions read FOptions;
    property Source: string read FSource write FSource;
  end;

{ TIndexDefs }

  TIndexDefs = class
  Private
    FCount : Longint;
    FUpDated : Boolean;
    Function GetItem (Index : longint) : TindexDef;
  public
    constructor Create(DataSet: TDataSet);
    destructor Destroy; override;
    procedure Add(const Name, Fields: string; Options: TIndexOptions);
    procedure Assign(IndexDefs: TIndexDefs);
    procedure Clear;
    function FindIndexForFields(const Fields: string): TIndexDef;
    function GetIndexForFields(const Fields: string;
      CaseInsensitive: Boolean): TIndexDef;
    function IndexOf(const Name: string): Longint;
    procedure Update;
    property Count: Longint read FCount;
    property Items[Index: Longint]: TIndexDef read GetItem; default;
    property Updated: Boolean read FUpdated write FUpdated;
  end;

{ TCheckConstraint }

  TCheckConstraint = class(TCollectionItem)
  Private
    FCustomConstraint : String;
    FErrorMessage : String;
    FFromDictionary : Boolean;
    FImportedConstraint : String;
  public
    procedure Assign(Source: TPersistent); override;
  //  function GetDisplayName: string; override;
  published
    property CustomConstraint: string read FCustomConstraint write FCustomConstraint;
    property ErrorMessage: string read FErrorMessage write FErrorMessage;
    property FromDictionary: Boolean read FFromDictionary write FFromDictionary;
    property ImportedConstraint: string read FImportedConstraint write FImportedConstraint;
  end;

{ TCheckConstraints }

  TCheckConstraints = class(TCollection)
  Private
   Function GetItem(Index : Longint) : TCheckConstraint;
   Procedure SetItem(index : Longint; Value : TCheckConstraint);
  protected
    function GetOwner: TPersistent; override;
  public
    constructor Create(Owner: TPersistent);
    function Add: TCheckConstraint;
    property Items[Index: Longint]: TCheckConstraint read GetItem write SetItem; default;
  end;

{ TFields }

  Tfields = Class(TObject)
    Private
      FDataset : TDataset;
      FFieldList : TList;
      FOnChange : TNotifyEvent;
      FValidFieldKinds : TFieldKinds;
    Protected
      Procedure Changed;
      Procedure CheckfieldKind(Fieldkind : TFieldKind; Field : TField);
      Function GetCount : Longint;
      Function GetField (Index : longint) : TField;
      Procedure SetFieldIndex (Field : TField;Value : Integer);
      Property OnChange : TNotifyEvent Read FOnChange Write FOnChange;
      Property ValidFieldKinds : TFieldKinds Read FValidFieldKinds;
    Public
      Constructor Create(ADataset : TDataset);
      Destructor Destroy;override;
      Procedure Add(Field : TField);
      Procedure CheckFieldName (Const Value : String);
      Procedure CheckFieldNames (Const Value : String);
      Procedure Clear;
      Function FindField (Const Value : String) : TField;
      Function FieldByName (Const Value : String) : TField;
      Function FieldByNumber(FieldNo : Integer) : TField;
      Procedure GetFieldNames (Values : TStrings);
      Function IndexOf(Field : TField) : Longint;
      procedure Remove(Value : TField);
      Property Count : Integer Read GetCount;
      Property Dataset : TDataset Read FDataset;
      Property Fields [Index : Integer] : TField Read GetField; default;
    end;


{ TDataSet }

  TBookmark = Pointer;
  TBookmarkStr = string;

  PBookmarkFlag = ^TBookmarkFlag;
  TBookmarkFlag = (bfCurrent, bfBOF, bfEOF, bfInserted);

  PBufferList = ^TBufferList;
  TBufferList = array[0..dsMaxBufferCount - 1] of PChar;

  TGetMode = (gmCurrent, gmNext, gmPrior);

  TGetResult = (grOK, grBOF, grEOF, grError);

  TResyncMode = set of (rmExact, rmCenter);

  TDataAction = (daFail, daAbort, daRetry);

  TUpdateKind = (ukModify, ukInsert, ukDelete);


  TLocateOption = (loCaseInsensitive, loPartialKey);
  TLocateOptions = set of TLocateOption;

  TDataOperation = procedure of object;

  TDataSetNotifyEvent = procedure(DataSet: TDataSet) of object;
  TDataSetErrorEvent = procedure(DataSet: TDataSet; E: EDatabaseError;
    var Action: TDataAction) of object;

  TFilterOption = (foCaseInsensitive, foNoPartialCompare);
  TFilterOptions = set of TFilterOption;

  TFilterRecordEvent = procedure(DataSet: TDataSet;
    var Accept: Boolean) of object;

  TDatasetClass = Class of TDataset;
  TBufferArray = ^pchar;

  TDataSet = class(TComponent)
  Private
    FActive: Boolean;
    FActiveRecord: Longint;
    FAfterCancel: TDataSetNotifyEvent;
    FAfterClose: TDataSetNotifyEvent;
    FAfterDelete: TDataSetNotifyEvent;
    FAfterEdit: TDataSetNotifyEvent;
    FAfterInsert: TDataSetNotifyEvent;
    FAfterOpen: TDataSetNotifyEvent;
    FAfterPost: TDataSetNotifyEvent;
    FAfterScroll: TDataSetNotifyEvent;
    FAutoCalcFields: Boolean;
    FBOF: Boolean;
    FBeforeCancel: TDataSetNotifyEvent;
    FBeforeClose: TDataSetNotifyEvent;
    FBeforeDelete: TDataSetNotifyEvent;
    FBeforeEdit: TDataSetNotifyEvent;
    FBeforeInsert: TDataSetNotifyEvent;
    FBeforeOpen: TDataSetNotifyEvent;
    FBeforePost: TDataSetNotifyEvent;
    FBeforeScroll: TDataSetNotifyEvent;
    FBlobFieldCount: Longint;
    FBookmark: TBookmarkStr;
    FBookmarkSize: Longint;
    FBuffers : TBufferArray;
    FBufferCount: Longint;
    FCalcBuffer: PChar;
    FCalcFieldsSize: Longint;
    FCanModify: Boolean;
    FConstraints: TCheckConstraints;
    FCurrentRecord: Longint;
    FDefaultFields: Boolean;
    FEOF: Boolean;
    FFieldList : TFields;
    FFieldCount : Longint;
    FFieldDefs: TFieldDefs;
    FFilterOptions: TFilterOptions;
    FFilterText: string;
    FFiltered: Boolean;
    FFound: Boolean;
    FInternalCalcFields: Boolean;
    FModified: Boolean;
    FOnCalcFields: TDataSetNotifyEvent;
    FOnDeleteError: TDataSetErrorEvent;
    FOnEditError: TDataSetErrorEvent;
    FOnFilterRecord: TFilterRecordEvent;
    FOnNewRecord: TDataSetNotifyEvent;
    FOnPostError: TDataSetErrorEvent;
    FRecNo: Longint;
    FRecordCount: Longint;
    FRecordSize: Word;
    FState: TDataSetState;
    Procedure DoInsertAppend(DoAppend : Boolean);
    Procedure DoInternalOpen;
    Procedure DoInternalClose;
    Function  GetBuffer (Index : longint) : Pchar;
    Function  GetField (Index : Longint) : TField;
    Procedure RemoveField (Field : TField);
    Procedure SetActive (Value : Boolean);
    Procedure SetField (Index : Longint;Value : TField);
    Procedure ShiftBuffers (Offset,Distance : Longint);
    Function  TryDoing (P : TDataOperation; Ev : TDatasetErrorEvent) : Boolean;
    Procedure UpdateFieldDefs;
  protected
    procedure ActivateBuffers; virtual;
    procedure BindFields(Binding: Boolean);
    function  BookmarkAvailable: Boolean;
    procedure CalculateFields(Buffer: PChar); virtual;
    procedure CheckActive; virtual;
    procedure CheckInactive; virtual;
    procedure ClearBuffers; virtual;
    procedure ClearCalcFields(Buffer: PChar); virtual;
    procedure CloseBlob(Field: TField); virtual;
    procedure CloseCursor; virtual;
    procedure CreateFields;
    procedure DataEvent(Event: TDataEvent; Info: Longint); virtual;
    procedure DestroyFields; virtual;
    procedure DoAfterCancel; virtual;
    procedure DoAfterClose; virtual;
    procedure DoAfterDelete; virtual;
    procedure DoAfterEdit; virtual;
    procedure DoAfterInsert; virtual;
    procedure DoAfterOpen; virtual;
    procedure DoAfterPost; virtual;
    procedure DoAfterScroll; virtual;
    procedure DoBeforeCancel; virtual;
    procedure DoBeforeClose; virtual;
    procedure DoBeforeDelete; virtual;
    procedure DoBeforeEdit; virtual;
    procedure DoBeforeInsert; virtual;
    procedure DoBeforeOpen; virtual;
    procedure DoBeforePost; virtual;
    procedure DoBeforeScroll; virtual;
    procedure DoOnCalcFields; virtual;
    procedure DoOnNewRecord; virtual;
    function  FieldByNumber(FieldNo: Longint): TField;
    function  FindRecord(Restart, GoForward: Boolean): Boolean; virtual;
    procedure FreeFieldBuffers; virtual;
    function  GetBookmarkStr: TBookmarkStr; virtual;
    procedure GetCalcFields(Buffer: PChar); virtual;
    function  GetCanModify: Boolean; virtual;
    procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
    function  GetFieldClass(FieldType: TFieldType): TFieldClass; virtual;
    Function  GetfieldCount : Integer;
    function  GetIsIndexField(Field: TField): Boolean; virtual;
    function  GetNextRecords: Longint; virtual;
    function  GetNextRecord: Boolean; virtual;
    function  GetPriorRecords: Longint; virtual;
    function  GetPriorRecord: Boolean; virtual;
    function  GetRecordCount: Longint; virtual;
    function  GetRecNo: Longint; virtual;
    procedure InitFieldDefs; virtual;
    procedure InitRecord(Buffer: PChar); virtual;
    procedure InternalCancel; virtual;
    procedure InternalEdit; virtual;
    procedure InternalRefresh; virtual;
    procedure Loaded; override;
    procedure OpenCursor(InfoQuery: Boolean); virtual;
    procedure RefreshInternalCalcFields(Buffer: PChar); virtual;
    Function  RequiredBuffers : longint;
    procedure RestoreState(const Value: TDataSetState);
    procedure SetBookmarkStr(const Value: TBookmarkStr); virtual;
    procedure SetBufListSize(Value: Longint);
    procedure SetChildOrder(Component: TComponent; Order: Longint); override;
    procedure SetCurrentRecord(Index: Longint); virtual;
    procedure SetFiltered(Value: Boolean); virtual;
    procedure SetFilterOptions(Value: TFilterOptions); virtual;
    procedure SetFilterText(const Value: string); virtual;
    procedure SetFound(const Value: Boolean);
    procedure SetModified(Value: Boolean);
    procedure SetName(const Value: TComponentName); override;
    procedure SetOnFilterRecord(const Value: TFilterRecordEvent); virtual;
    procedure SetRecNo(Value: Longint); virtual;
    procedure SetState(Value: TDataSetState);
    function SetTempState(const Value: TDataSetState): TDataSetState;
    function TempBuffer: PChar;
    procedure UpdateIndexDefs; virtual;
    property ActiveRecord: Longint read FActiveRecord;
    property CurrentRecord: Longint read FCurrentRecord;
    property BlobFieldCount: Longint read FBlobFieldCount;
    property BookmarkSize: Longint read FBookmarkSize write FBookmarkSize;
    property Buffers[Index: Longint]: PChar read GetBuffer;
    property BufferCount: Longint read FBufferCount;
    property CalcBuffer: PChar read FCalcBuffer;
    property CalcFieldsSize: Longint read FCalcFieldsSize;
    property InternalCalcFields: Boolean read FInternalCalcFields;
    property Constraints: TCheckConstraints read FConstraints write FConstraints;
  protected { abstract methods }
    function AllocRecordBuffer: PChar; virtual; abstract;
    procedure FreeRecordBuffer(var Buffer: PChar); virtual; abstract;
    procedure GetBookmarkData(Buffer: PChar; Data: Pointer); virtual; abstract;
    function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; virtual; abstract;
    function GetFieldData(Field: TField; Buffer: Pointer): Boolean; virtual; abstract;
    function GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; virtual; abstract;
    function GetRecordSize: Word; virtual; abstract;
    procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); virtual; abstract;
    procedure InternalClose; virtual; abstract;
    procedure InternalDelete; virtual; abstract;
    procedure InternalFirst; virtual; abstract;
    procedure InternalGotoBookmark(ABookmark: Pointer); virtual; abstract;
    procedure InternalHandleException; virtual; abstract;
    procedure InternalInitFieldDefs; virtual; abstract;
    procedure InternalInitRecord(Buffer: PChar); virtual; abstract;
    procedure InternalLast; virtual; abstract;
    procedure InternalOpen; virtual; abstract;
    procedure InternalPost; virtual; abstract;
    procedure InternalSetToRecord(Buffer: PChar); virtual; abstract;
    function IsCursorOpen: Boolean; virtual; abstract;
    procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); virtual; abstract;
    procedure SetBookmarkData(Buffer: PChar; Data: Pointer); virtual; abstract;
    procedure SetFieldData(Field: TField; Buffer: Pointer); virtual; abstract;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function ActiveBuffer: PChar;
    procedure Append;
    procedure AppendRecord(const Values: array of const);
    function BookmarkValid(ABookmark: TBookmark): Boolean; virtual;
    procedure Cancel; virtual;
    procedure CheckBrowseMode;
    procedure ClearFields;
    procedure Close;
    function  ControlsDisabled: Boolean;
    function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Longint; virtual;
    function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; virtual;
    procedure CursorPosChanged;
    procedure Delete;
    procedure DisableControls;
    procedure Edit;
    procedure EnableControls;
    function FieldByName(const FieldName: string): TField;
    function FindField(const FieldName: string): TField;
    function FindFirst: Boolean;
    function FindLast: Boolean;
    function FindNext: Boolean;
    function FindPrior: Boolean;
    procedure First;
    procedure FreeBookmark(ABookmark: TBookmark); virtual;
    function GetBookmark: TBookmark; virtual;
    function GetCurrentRecord(Buffer: PChar): Boolean; virtual;
    procedure GetFieldList(List: TList; const FieldNames: string);
    procedure GetFieldNames(List: TStrings);
    procedure GotoBookmark(ABookmark: TBookmark);
    procedure Insert;
    procedure InsertRecord(const Values: array of const);
    function IsEmpty: Boolean;
    function IsSequenced: Boolean; virtual;
    procedure Last;
    function MoveBy(Distance: Longint): Longint;
    procedure Next;
    procedure Open;
    procedure Post; virtual;
    procedure Prior;
    procedure Refresh;
    procedure Resync(Mode: TResyncMode); virtual;
    procedure SetFields(const Values: array of const);
    procedure Translate(Src, Dest: PChar; ToOem: Boolean); virtual;
    procedure UpdateCursorPos;
    procedure UpdateRecord;
    property BOF: Boolean read FBOF;
    property Bookmark: TBookmarkStr read GetBookmarkStr write SetBookmarkStr;
    property CanModify: Boolean read GetCanModify;
    property DefaultFields: Boolean read FDefaultFields;
    property EOF: Boolean read FEOF;
    property FieldCount: Longint read GetFieldCount;
    property FieldDefs: TFieldDefs read FFieldDefs write FFieldDefs;
    property Fields[Index: Longint]: TField read GetField write SetField;
    property Found: Boolean read FFound;
    property Modified: Boolean read FModified;
    property RecordCount: Longint read GetRecordCount;
    property RecNo: Longint read FRecNo write FRecNo;
    property RecordSize: Word read FRecordSize;
    property State: TDataSetState read FState;
    property Fields : TFields Read FFieldList;
    property Filter: string read FFilterText write FFilterText;
    property Filtered: Boolean read FFiltered write FFiltered default False;
    property FilterOptions: TFilterOptions read FFilterOptions write FFilterOptions;
    property Active: Boolean read FActive write SetActive default False;
    property AutoCalcFields: Boolean read FAutoCalcFields write FAutoCalcFields;
    property BeforeOpen: TDataSetNotifyEvent read FBeforeOpen write FBeforeOpen;
    property AfterOpen: TDataSetNotifyEvent read FAfterOpen write FAfterOpen;
    property BeforeClose: TDataSetNotifyEvent read FBeforeClose write FBeforeClose;
    property AfterClose: TDataSetNotifyEvent read FAfterClose write FAfterClose;
    property BeforeInsert: TDataSetNotifyEvent read FBeforeInsert write FBeforeInsert;
    property AfterInsert: TDataSetNotifyEvent read FAfterInsert write FAfterInsert;
    property BeforeEdit: TDataSetNotifyEvent read FBeforeEdit write FBeforeEdit;
    property AfterEdit: TDataSetNotifyEvent read FAfterEdit write FAfterEdit;
    property BeforePost: TDataSetNotifyEvent read FBeforePost write FBeforePost;
    property AfterPost: TDataSetNotifyEvent read FAfterPost write FAfterPost;
    property BeforeCancel: TDataSetNotifyEvent read FBeforeCancel write FBeforeCancel;
    property AfterCancel: TDataSetNotifyEvent read FAfterCancel write FAfterCancel;
    property BeforeDelete: TDataSetNotifyEvent read FBeforeDelete write FBeforeDelete;
    property AfterDelete: TDataSetNotifyEvent read FAfterDelete write FAfterDelete;
    property BeforeScroll: TDataSetNotifyEvent read FBeforeScroll write FBeforeScroll;
    property AfterScroll: TDataSetNotifyEvent read FAfterScroll write FAfterScroll;
    property OnCalcFields: TDataSetNotifyEvent read FOnCalcFields write FOnCalcFields;
    property OnDeleteError: TDataSetErrorEvent read FOnDeleteError write FOnDeleteError;
    property OnEditError: TDataSetErrorEvent read FOnEditError write FOnEditError;
    property OnFilterRecord: TFilterRecordEvent read FOnFilterRecord write SetOnFilterRecord;
    property OnNewRecord: TDataSetNotifyEvent read FOnNewRecord write FOnNewRecord;
    property OnPostError: TDataSetErrorEvent read FOnPostError write FOnPostError;
  end;

 { TDBDataset }

  TDBDatasetClass = Class of TDBDataset;
  TDBDataset = Class(TDataset)
    Private
      FDatabase : TDatabase;
      Procedure SetDatabase (Value : TDatabase);
    Published
      Property DataBase : TDatabase Read FDatabase Write SetDatabase;
    end;

  { TDatabase }

  TLoginEvent = procedure(Database: TDatabase;
    LoginParams: TStrings) of object;

  TDatabaseClass = Class Of TDatabase;

  TDatabase = class(TComponent)
  private
    FConnected : Boolean;
    FDataBaseName : String;
    FDataSets : TList;
    FDirectOry : String;
    FKeepConnection : Boolean;
    FLoginPrompt : Boolean;
    FOnLogin : TLoginEvent;
    FParams : TStrings;
    FSQLBased : Boolean;
    Function GetDataSetCount : Longint;
    Function GetDataset(Index : longint) : TDBDataset;
    procedure SetConnected (Value : boolean);
    procedure RegisterDataset (DS : TDBDataset);
    procedure UnRegisterDataset (DS : TDBDataset);
    procedure RemoveDataSets;
  protected
    Procedure CheckConnected;
    Procedure CheckDisConnected;
    procedure Loaded; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    Procedure DoInternalConnect; Virtual;Abstract;
    Procedure DoInternalDisConnect; Virtual;Abstract;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Close;
    procedure Open;
    procedure CloseDataSets;
    procedure StartTransaction; virtual; abstract;
    procedure EndTransaction; virtual; abstract;
    property DataSetCount: Longint read GetDataSetCount;
    property DataSets[Index: Longint]: TDBDataSet read GetDataSet;
    property Directory: string read FDirectory write FDirectory;
    property IsSQLBased: Boolean read FSQLBased;
  published
    property Connected: Boolean read FConnected write SetConnected;
    property DatabaseName: string read FDatabaseName write FDatabaseName;
    property KeepConnection: Boolean read FKeepConnection write FKeepConnection;
    property LoginPrompt: Boolean read FLoginPrompt write FLoginPrompt;
    property Params : TStrings read FParams Write FParams;
    property OnLogin: TLoginEvent read FOnLogin write FOnLogin;
  end;

Const
  Fieldtypenames : Array [TFieldType] of String[15] =
    ( 'Unknown',
      'String',
      'Smallint',
      'Integer',
      'Word',
      'Boolean',
      'Float',
      'Date',
      'Time',
      'DateTime',
      'Bytes',
      'VarBytes',
      'AutoInc',
      'Blob',
      'Memo',
      'Graphic',
      'FmtMemo',
      'ParadoxOle',
      'DBaseOle',
      'TypedBinary',
      'Cursor'
    );
{ Auxiliary functions }

Procedure DatabaseError (Const Msg : String);
Procedure DatabaseError (Const Msg : String; Comp : TComponent);
Procedure DatabaseErrorFmt (Const Fmt : String; Args : Array Of Const);
Procedure DatabaseErrorFmt (Const Fmt : String; Args : Array Of const;
                            Comp : TComponent);

implementation

{ ---------------------------------------------------------------------
    Auxiliary functions
  ---------------------------------------------------------------------}



Procedure DatabaseError (Const Msg : String);

begin
  Raise EDataBaseError.Create(Msg);
end;

Procedure DatabaseError (Const Msg : String; Comp : TComponent);

begin
  Raise EDatabaseError.CreateFmt('%s : %s',[Comp.Name,Msg]);
end;

Procedure DatabaseErrorFmt (Const Fmt : String; Args : Array Of Const);

begin
  Raise EDatabaseError.CreateFmt(Fmt,Args);
end;

Procedure DatabaseErrorFmt (Const Fmt : String; Args : Array Of const;
                            Comp : TComponent);
begin
  Raise EDatabaseError.CreateFmt(Format('%s : %s',[Comp.Name,Fmt]),Args);
end;


{$i dbs.inc}

{ TIndexDef }

constructor TIndexDef.Create(Owner: TIndexDefs; const AName, TheFields: string;
      TheOptions: TIndexOptions);

begin
  //!! To be implemented
end;



destructor TIndexDef.Destroy;

begin
  //!! To be implemented
end;


{ TIndexDefs }

Function TIndexDefs.GetItem (Index : longint) : TindexDef;

begin
  //!! To be implemented
end;


constructor TIndexDefs.Create(DataSet: TDataSet);

begin
  //!! To be implemented
end;


destructor TIndexDefs.Destroy;

begin
  //!! To be implemented
end;


procedure TIndexDefs.Add(const Name, Fields: string; Options: TIndexOptions);

begin
  //!! To be implemented
end;


procedure TIndexDefs.Assign(IndexDefs: TIndexDefs);

begin
  //!! To be implemented
end;


procedure TIndexDefs.Clear;

begin
  //!! To be implemented
end;


function TIndexDefs.FindIndexForFields(const Fields: string): TIndexDef;

begin
  //!! To be implemented
end;


function TIndexDefs.GetIndexForFields(const Fields: string;
  CaseInsensitive: Boolean): TIndexDef;

begin
  //!! To be implemented
end;


function TIndexDefs.IndexOf(const Name: string): Longint;

begin
  //!! To be implemented
end;


procedure TIndexDefs.Update;

begin
  //!! To be implemented
end;



{ TCheckConstraint }

procedure TCheckConstraint.Assign(Source: TPersistent);

begin
  //!! To be implemented
end;



{ TCheckConstraints }

Function TCheckConstraints.GetItem(Index : Longint) : TCheckConstraint;

begin
  //!! To be implemented
end;


Procedure TCheckConstraints.SetItem(index : Longint; Value : TCheckConstraint);

begin
  //!! To be implemented
end;


function TCheckConstraints.GetOwner: TPersistent;

begin
  //!! To be implemented
end;


constructor TCheckConstraints.Create(Owner: TPersistent);

begin
  //!! To be implemented
end;


function TCheckConstraints.Add: TCheckConstraint;

begin
  //!! To be implemented
end;



{$i dataset.inc}
{$i fields.inc}
{$i database.inc}

end.

{
  $Log$
  Revision 1.8  2000-01-07 01:24:32  peter
    * updated copyright to 2000

  Revision 1.7  2000/01/06 01:20:32  peter
    * moved out of packages/ back to topdir

  Revision 1.1  2000/01/03 19:33:05  peter
    * moved to packages dir

  Revision 1.5  1999/11/12 22:53:32  michael
  + Added append() insert() tested append. Datetime as string works now

  Revision 1.4  1999/11/11 17:31:09  michael
  + Added Checks for all simple field types.
  + Initial implementation of Insert/Append

  Revision 1.3  1999/11/09 13:33:47  peter
    * reallocmem fixes

  Revision 1.2  1999/10/24 17:07:54  michael
  + Added copyright header

}