|
@@ -0,0 +1,1238 @@
|
|
|
+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 : TNotifyEvent;
|
|
|
+ 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 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 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 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 (Distance : Longint);
|
|
|
+ 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.
|