home *** CD-ROM | disk | FTP | other *** search
/ DOS/V Power Report 1997 August / VPR9708A.ISO / D3TRIAL / INSTALL / DATA.Z / DB.INT < prev    next >
Text File  |  1997-03-21  |  36KB  |  989 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Delphi Visual Component Library                 }
  5. {       Core Database                                   }
  6. {                                                       }
  7. {       Copyright (c) 1995,97 Borland International     }
  8. {                                                       }
  9. {*******************************************************}
  10.  
  11. unit Db;
  12.  
  13. {$R-}
  14.  
  15. interface
  16.  
  17. uses Windows, SysUtils, Classes, Graphics;
  18.  
  19. const
  20.  
  21. { TDataSet maximum number of record buffers }
  22.  
  23.   dsMaxBufferCount = MAXINT div 8;
  24.  
  25. { Maximum string field size }
  26.  
  27.   dsMaxStringSize = 8192;
  28.  
  29. type
  30.  
  31. { Misc Dataset types }
  32.  
  33.   TDataSetState = (dsInactive, dsBrowse, dsEdit, dsInsert, dsSetKey,
  34.     dsCalcFields, dsFilter, dsNewValue, dsOldValue, dsCurValue);
  35.  
  36.   TDataEvent = (deFieldChange, deRecordChange, deDataSetChange,
  37.     deDataSetScroll, deLayoutChange, deUpdateRecord, deUpdateState,
  38.     deCheckBrowseMode, dePropertyChange, deFieldListChange, deFocusControl);
  39.  
  40.   TUpdateStatus = (usUnmodified, usModified, usInserted, usDeleted);
  41.  
  42. { Forward declarations }
  43.  
  44.   TFieldDef = class;
  45.   TFieldDefs = class;
  46.   TField = class;
  47.   TDataLink = class;
  48.   TDataSource = class;
  49.   TDataSet = class;
  50.  
  51. { Exception classes }
  52.  
  53.   EDatabaseError = class(Exception);
  54.  
  55. { TFieldDef }
  56.  
  57.   TFieldClass = class of TField;
  58.  
  59.   TFieldType = (ftUnknown, ftString, ftSmallint, ftInteger, ftWord,
  60.     ftBoolean, ftFloat, ftCurrency, ftBCD, ftDate, ftTime, ftDateTime,
  61.     ftBytes, ftVarBytes, ftAutoInc, ftBlob, ftMemo, ftGraphic,
  62.     ftFmtMemo, ftParadoxOle, ftDBaseOle, ftTypedBinary, ftCursor);
  63.  
  64.   TFieldDef = class
  65.   public
  66.     constructor Create(Owner: TFieldDefs; const Name: string;
  67.       DataType: TFieldType; Size: Word; Required: Boolean; FieldNo: Integer);
  68.     destructor Destroy; override;
  69.     function CreateField(Owner: TComponent): TField;
  70.     property InternalCalcField: Boolean;
  71.     property DataType: TFieldType;
  72.     property FieldClass: TFieldClass;
  73.     property FieldNo: Integer;
  74.     property Name: string;
  75.     property Precision: Integer; 
  76.     property Required: Boolean;
  77.     property Size: Word;
  78.   end;
  79.  
  80. { TFieldDefs }
  81.  
  82.   TFieldDefs = class
  83.   public
  84.     constructor Create(DataSet: TDataSet);
  85.     destructor Destroy; override;
  86.     procedure Add(const Name: string; DataType: TFieldType; Size: Word;
  87.       Required: Boolean);
  88.     procedure Assign(FieldDefs: TFieldDefs);
  89.     procedure Clear;
  90.     function Find(const Name: string): TFieldDef;
  91.     function IndexOf(const Name: string): Integer;
  92.     procedure Update;
  93.     property Count: Integer;
  94.     property Items[Index: Integer]: TFieldDef; default;
  95.   end;
  96.  
  97. { TField }
  98.  
  99.   TFieldKind = (fkData, fkCalculated, fkLookup, fkInternalCalc);
  100.  
  101.   TFieldNotifyEvent = procedure(Sender: TField) of object;
  102.   TFieldGetTextEvent = procedure(Sender: TField; var Text: string;
  103.     DisplayText: Boolean) of object;
  104.   TFieldSetTextEvent = procedure(Sender: TField; const Text: string) of object;
  105.   TFieldRef = ^TField;
  106.   TFieldChars = set of Char;
  107.  
  108.   PLookupListEntry = ^TLookupListEntry;
  109.   TLookupListEntry = record
  110.     Key: Variant;
  111.     Value: Variant;
  112.   end;
  113.  
  114.   TLookupList = class(TObject)
  115.   public
  116.     constructor Create;
  117.     destructor Destroy; override;
  118.     procedure Add(const AKey, AValue: Variant);
  119.     procedure Clear;
  120.     function ValueOfKey(const AKey: Variant): Variant;
  121.   end;
  122.  
  123.   TField = class(TComponent)
  124.   protected
  125.     function AccessError(const TypeName: string): EDatabaseError; dynamic;
  126.     procedure CheckInactive;
  127.     class procedure CheckTypeSize(Value: Integer); virtual;
  128.     procedure Change; virtual;
  129.     procedure DataChanged;
  130.     procedure DefineProperties(Filer: TFiler); override;
  131.     procedure FreeBuffers; virtual;
  132.     function GetAsBoolean: Boolean; virtual;
  133.     function GetAsCurrency: Currency; virtual;
  134.     function GetAsDateTime: TDateTime; virtual;
  135.     function GetAsFloat: Double; virtual;
  136.     function GetAsInteger: Longint; virtual;
  137.     function GetAsString: string; virtual;
  138.     function GetAsVariant: Variant; virtual;
  139.     function GetCanModify: Boolean; virtual;
  140.     function GetDataSize: Word; virtual;
  141.     function GetDefaultWidth: Integer; virtual;
  142.     function GetIsNull: Boolean; virtual;
  143.     function GetParentComponent: TComponent; override;
  144.     procedure GetText(var Text: string; DisplayText: Boolean); virtual;
  145.     function HasParent: Boolean; override;
  146.     procedure Notification(AComponent: TComponent;
  147.       Operation: TOperation); override;
  148.     procedure PropertyChanged(LayoutAffected: Boolean);
  149.     procedure ReadState(Reader: TReader); override;
  150.     procedure SetAsBoolean(Value: Boolean); virtual;
  151.     procedure SetAsCurrency(Value: Currency); virtual;
  152.     procedure SetAsDateTime(Value: TDateTime); virtual;
  153.     procedure SetAsFloat(Value: Double); virtual;
  154.     procedure SetAsInteger(Value: Longint); virtual;
  155.     procedure SetAsString(const Value: string); virtual;
  156.     procedure SetAsVariant(const Value: Variant); virtual;
  157.     procedure SetDataType(Value: TFieldType);
  158.     procedure SetSize(Value: Word); virtual;
  159.     procedure SetParentComponent(AParent: TComponent); override;
  160.     procedure SetText(const Value: string); virtual;
  161.     procedure SetVarValue(const Value: Variant); virtual;
  162.   public
  163.     constructor Create(AOwner: TComponent); override;
  164.     destructor Destroy; override;
  165.     procedure Assign(Source: TPersistent); override;
  166.     procedure AssignValue(const Value: TVarRec);
  167.     procedure Clear; virtual;
  168.     procedure FocusControl;
  169.     function GetData(Buffer: Pointer): Boolean;
  170.     class function IsBlob: Boolean; virtual;
  171.     function IsValidChar(InputChar: Char): Boolean; virtual;
  172.     procedure RefreshLookupList;
  173.     procedure SetData(Buffer: Pointer);
  174.     procedure SetFieldType(Value: TFieldType); virtual;
  175.     procedure Validate(Buffer: Pointer);
  176.     property AsBoolean: Boolean;
  177.     property AsCurrency: Currency;
  178.     property AsDateTime: TDateTime;
  179.     property AsFloat: Double;
  180.     property AsInteger: Longint;
  181.     property AsString: string;
  182.     property AsVariant: Variant;
  183.     property AttributeSet: string;
  184.     property Calculated: Boolean default False;
  185.     property CanModify: Boolean;
  186.     property CurValue: Variant;
  187.     property DataSet: TDataSet;
  188.     property DataSize: Word;
  189.     property DataType: TFieldType;
  190.     property DisplayName: string;
  191.     property DisplayText: string;
  192.     property EditMask: string;
  193.     property EditMaskPtr: string;
  194.     property FieldNo: Integer;
  195.     property IsIndexField: Boolean;
  196.     property IsNull: Boolean;
  197.     property Lookup: Boolean;
  198.     property LookupList: TLookupList;
  199.     property NewValue: Variant;
  200.     property Offset: word;
  201.     property OldValue: Variant;
  202.     property Size: Word;
  203.     property Text: string;
  204.     property ValidChars: TFieldChars;
  205.     property Value: Variant;
  206.   published
  207.     property Alignment: TAlignment default taLeftJustify;
  208.     property CustomConstraint: string;
  209.     property ConstraintErrorMessage: string;
  210.     property DefaultExpression: string;
  211.     property DisplayLabel: string;
  212.     property DisplayWidth: Integer;
  213.     property FieldKind: TFieldKind;
  214.     property FieldName: string;
  215.     property HasConstraints: Boolean;
  216.     property Index: Integer;
  217.     property ImportedConstraint: string;
  218.     property LookupDataSet: TDataSet;
  219.     property LookupKeyFields: string;
  220.     property LookupResultField: string;
  221.     property KeyFields: string;
  222.     property LookupCache: Boolean default False;
  223.     property Origin: string;
  224.     property ReadOnly: Boolean default False;
  225.     property Required: Boolean default False;
  226.     property Visible: Boolean default True;
  227.     property OnChange: TFieldNotifyEvent;
  228.     property OnGetText: TFieldGetTextEvent;
  229.     property OnSetText: TFieldSetTextEvent;
  230.     property OnValidate: TFieldNotifyEvent;
  231.   end;
  232.  
  233. { TStringField }
  234.  
  235.   TStringField = class(TField)
  236.   protected
  237.     class procedure CheckTypeSize(Value: Integer); override;
  238.     function GetAsBoolean: Boolean; override;
  239.     function GetAsDateTime: TDateTime; override;
  240.     function GetAsFloat: Double; override;
  241.     function GetAsInteger: Longint; override;
  242.     function GetAsString: string; override;
  243.     function GetAsVariant: Variant; override;
  244.     function GetDataSize: Word; override;
  245.     function GetDefaultWidth: Integer; override;
  246.     procedure GetText(var Text: string; DisplayText: Boolean); override;
  247.     function GetValue(var Value: string): Boolean;
  248.     procedure SetAsBoolean(Value: Boolean); override;
  249.     procedure SetAsDateTime(Value: TDateTime); override;
  250.     procedure SetAsFloat(Value: Double); override;
  251.     procedure SetAsInteger(Value: Longint); override;
  252.     procedure SetAsString(const Value: string); override;
  253.     procedure SetVarValue(const Value: Variant); override;
  254.   public
  255.     constructor Create(AOwner: TComponent); override;
  256.     property Value: string;
  257.   published
  258.     property EditMask;
  259.     property Size default 20;
  260.     property Transliterate: Boolean default True;
  261.   end;
  262.  
  263. { TNumericField }
  264.  
  265.   TNumericField = class(TField)
  266.   protected
  267.     procedure RangeError(Value, Min, Max: Extended);
  268.     procedure SetDisplayFormat(const Value: string);
  269.     procedure SetEditFormat(const Value: string);
  270.   public
  271.     constructor Create(AOwner: TComponent); override;
  272.   published
  273.     property Alignment default taRightJustify;
  274.     property DisplayFormat: string;
  275.     property EditFormat: string;
  276.   end;
  277.  
  278. { TIntegerField }
  279.  
  280.   TIntegerField = class(TNumericField)
  281.   protected
  282.     function GetAsFloat: Double; override;
  283.     function GetAsInteger: Longint; override;
  284.     function GetAsString: string; override;
  285.     function GetAsVariant: Variant; override;
  286.     function GetDataSize: Word; override;
  287.     procedure GetText(var Text: string; DisplayText: Boolean); override;
  288.     function GetValue(var Value: Longint): Boolean;
  289.     procedure SetAsFloat(Value: Double); override;
  290.     procedure SetAsInteger(Value: Longint); override;
  291.     procedure SetAsString(const Value: string); override;
  292.     procedure SetVarValue(const Value: Variant); override;
  293.   public
  294.     constructor Create(AOwner: TComponent); override;
  295.     property Value: Longint;
  296.   published
  297.     property MaxValue: Longint default 0;
  298.     property MinValue: Longint default 0;
  299.   end;
  300.  
  301. { TSmallintField }
  302.  
  303.   TSmallintField = class(TIntegerField)
  304.   protected
  305.     function GetDataSize: Word; override;
  306.   public
  307.     constructor Create(AOwner: TComponent); override;
  308.   end;
  309.  
  310. { TWordField }
  311.  
  312.   TWordField = class(TIntegerField)
  313.   protected
  314.     function GetDataSize: Word; override;
  315.   public
  316.     constructor Create(AOwner: TComponent); override;
  317.   end;
  318.  
  319. { TAutoIncField }
  320.  
  321.   TAutoIncField = class(TIntegerField)
  322.   public
  323.     constructor Create(AOwner: TComponent); override;
  324.   end;
  325.  
  326. { TFloatField }
  327.  
  328.   TFloatField = class(TNumericField)
  329.   protected
  330.     function GetAsFloat: Double; override;
  331.     function GetAsInteger: Longint; override;
  332.     function GetAsString: string; override;
  333.     function GetAsVariant: Variant; override;
  334.     function GetDataSize: Word; override;
  335.     procedure GetText(var Text: string; DisplayText: Boolean); override;
  336.     procedure SetAsFloat(Value: Double); override;
  337.     procedure SetAsInteger(Value: Longint); override;
  338.     procedure SetAsString(const Value: string); override;
  339.     procedure SetVarValue(const Value: Variant); override;
  340.   public
  341.     constructor Create(AOwner: TComponent); override;
  342.     property Value: Double;
  343.   published
  344.     property Currency: Boolean default False;
  345.     property MaxValue: Double;
  346.     property MinValue: Double;
  347.     property Precision: Integer default 15;
  348.   end;
  349.  
  350. { TCurrencyField }
  351.  
  352.   TCurrencyField = class(TFloatField)
  353.   public
  354.     constructor Create(AOwner: TComponent); override;
  355.   published
  356.     property Currency default True;
  357.   end;
  358.  
  359. { TBooleanField }
  360.  
  361.   TBooleanField = class(TField)
  362.   protected
  363.     function GetAsBoolean: Boolean; override;
  364.     function GetAsString: string; override;
  365.     function GetAsVariant: Variant; override;
  366.     function GetDataSize: Word; override;
  367.     function GetDefaultWidth: Integer; override;
  368.     procedure SetAsBoolean(Value: Boolean); override;
  369.     procedure SetAsString(const Value: string); override;
  370.     procedure SetVarValue(const Value: Variant); override;
  371.   public
  372.     constructor Create(AOwner: TComponent); override;
  373.     property Value: Boolean;
  374.   published
  375.     property DisplayValues: string;
  376.   end;
  377.  
  378. { TDateTimeField }
  379.  
  380.   TDateTimeField = class(TField)
  381.   protected
  382.     function GetAsDateTime: TDateTime; override;
  383.     function GetAsFloat: Double; override;
  384.     function GetAsString: string; override;
  385.     function GetAsVariant: Variant; override;
  386.     function GetDataSize: Word; override;
  387.     procedure GetText(var Text: string; DisplayText: Boolean); override;
  388.     procedure SetAsDateTime(Value: TDateTime); override;
  389.     procedure SetAsFloat(Value: Double); override;
  390.     procedure SetAsString(const Value: string); override;
  391.     procedure SetVarValue(const Value: Variant); override;
  392.   public
  393.     constructor Create(AOwner: TComponent); override;
  394.     property Value: TDateTime;
  395.   published
  396.     property DisplayFormat: string;
  397.     property EditMask;
  398.   end;
  399.  
  400. { TDateField }
  401.  
  402.   TDateField = class(TDateTimeField)
  403.   protected
  404.     function GetDataSize: Word; override;
  405.   public
  406.     constructor Create(AOwner: TComponent); override;
  407.   end;
  408.  
  409. { TTimeField }
  410.  
  411.   TTimeField = class(TDateTimeField)
  412.   protected
  413.     function GetDataSize: Word; override;
  414.   public
  415.     constructor Create(AOwner: TComponent); override;
  416.   end;
  417.  
  418. { TBinaryField }
  419.  
  420.   TBinaryField = class(TField)
  421.   protected
  422.     class procedure CheckTypeSize(Value: Integer); override;
  423.     function GetAsString: string; override;
  424.     procedure GetText(var Text: string; DisplayText: Boolean); override;
  425.     function GetAsVariant: Variant; override;
  426.     procedure SetAsString(const Value: string); override;
  427.     procedure SetText(const Value: string); override;
  428.     procedure SetVarValue(const Value: Variant); override;
  429.   public
  430.     constructor Create(AOwner: TComponent); override;
  431.   published
  432.     property Size default 16;
  433.   end;
  434.  
  435. { TBytesField }
  436.  
  437.   TBytesField = class(TBinaryField)
  438.   protected
  439.     function GetDataSize: Word; override;
  440.   public
  441.     constructor Create(AOwner: TComponent); override;
  442.   end;
  443.  
  444. { TVarBytesField }
  445.  
  446.   TVarBytesField = class(TBytesField)
  447.   protected
  448.     function GetDataSize: Word; override;
  449.   public
  450.     constructor Create(AOwner: TComponent); override;
  451.   end;
  452.  
  453. { TBCDField }
  454.  
  455.   TBCDField = class(TNumericField)
  456.   protected
  457.     class procedure CheckTypeSize(Value: Integer); override;
  458.     function GetAsCurrency: Currency; override;
  459.     function GetAsFloat: Double; override;
  460.     function GetAsInteger: Longint; override;
  461.     function GetAsString: string; override;
  462.     function GetAsVariant: Variant; override;
  463.     function GetDataSize: Word; override;
  464.     function GetDefaultWidth: Integer; override;
  465.     procedure GetText(var Text: string; DisplayText: Boolean); override;
  466.     function GetValue(var Value: Currency): Boolean;
  467.     procedure SetAsCurrency(Value: Currency); override;
  468.     procedure SetAsFloat(Value: Double); override;
  469.     procedure SetAsInteger(Value: Longint); override;
  470.     procedure SetAsString(const Value: string); override;
  471.     procedure SetVarValue(const Value: Variant); override;
  472.   public
  473.     constructor Create(AOwner: TComponent); override;
  474.     property Value: Currency;
  475.   published
  476.     property Currency: Boolean default False;
  477.     property MaxValue: Currency;
  478.     property MinValue: Currency;
  479.     property Size default 4;
  480.   end;
  481.  
  482. { TBlobField }
  483.  
  484.   TBlobType = ftBlob..ftTypedBinary;
  485.  
  486.   TBlobField = class(TField)
  487.   protected
  488.     procedure AssignTo(Dest: TPersistent); override;
  489.     procedure FreeBuffers; override;
  490.     function GetAsString: string; override;
  491.     function GetAsVariant: Variant; override;
  492.     function GetBlobSize: Integer; virtual;
  493.     function GetIsNull: Boolean; override;
  494.     procedure GetText(var Text: string; DisplayText: Boolean); override;
  495.     procedure SetAsString(const Value: string); override;
  496.     procedure SetText(const Value: string); override;
  497.     procedure SetVarValue(const Value: Variant); override;
  498.   public
  499.     constructor Create(AOwner: TComponent); override;
  500.     procedure Assign(Source: TPersistent); override;
  501.     procedure Clear; override;
  502.     class function IsBlob: Boolean; override;
  503.     procedure LoadFromFile(const FileName: string);
  504.     procedure LoadFromStream(Stream: TStream);
  505.     procedure SaveToFile(const FileName: string);
  506.     procedure SaveToStream(Stream: TStream);
  507.     procedure SetFieldType(Value: TFieldType); override;
  508.     property BlobSize: Integer;
  509.     property Modified: Boolean;
  510.     property Value: string;
  511.     property Transliterate: Boolean;
  512.   published
  513.     property BlobType: TBlobType;
  514.     property Size default 0;
  515.   end;
  516.  
  517. { TMemoField }
  518.  
  519.   TMemoField = class(TBlobField)
  520.   public
  521.     constructor Create(AOwner: TComponent); override;
  522.   published
  523.     property Transliterate default True;
  524.   end;
  525.  
  526. { TGraphicField }
  527.  
  528.   TGraphicField = class(TBlobField)
  529.   public
  530.     constructor Create(AOwner: TComponent); override;
  531.   end;
  532.  
  533. { TIndexDef }
  534.  
  535.   TIndexDefs = class;
  536.  
  537.   TIndexOptions = set of (ixPrimary, ixUnique, ixDescending,
  538.     ixCaseInsensitive, ixExpression);
  539.  
  540.   TIndexDef = class
  541.   public
  542.     constructor Create(Owner: TIndexDefs; const Name, Fields: string;
  543.       Options: TIndexOptions);
  544.     destructor Destroy; override;
  545.     property Expression: string;
  546.     property Fields: string;
  547.     property Name: string;
  548.     property Options: TIndexOptions;
  549.     property Source: string;
  550.   end;
  551.  
  552. { TIndexDefs }
  553.  
  554.   TIndexDefs = class
  555.   public
  556.     constructor Create(DataSet: TDataSet);
  557.     destructor Destroy; override;
  558.     procedure Add(const Name, Fields: string; Options: TIndexOptions);
  559.     procedure Assign(IndexDefs: TIndexDefs);
  560.     procedure Clear;
  561.     function FindIndexForFields(const Fields: string): TIndexDef;
  562.     function GetIndexForFields(const Fields: string;
  563.       CaseInsensitive: Boolean): TIndexDef;
  564.     function IndexOf(const Name: string): Integer;
  565.     procedure Update;
  566.     property Count: Integer;
  567.     property Items[Index: Integer]: TIndexDef; default;
  568.     property Updated: Boolean;
  569.   end;
  570.  
  571. { TDataLink }
  572.  
  573.   TDataLink = class(TPersistent)
  574.   protected
  575.     procedure ActiveChanged; virtual;
  576.     procedure CheckBrowseMode; virtual;
  577.     procedure DataSetChanged; virtual;
  578.     procedure DataSetScrolled(Distance: Integer); virtual;
  579.     procedure FocusControl(Field: TFieldRef); virtual;
  580.     procedure EditingChanged; virtual;
  581.     procedure LayoutChanged; virtual;
  582.     procedure RecordChanged(Field: TField); virtual;
  583.     procedure UpdateData; virtual;
  584.   public
  585.     constructor Create;
  586.     destructor Destroy; override;
  587.     function Edit: Boolean;
  588.     procedure UpdateRecord;
  589.     property Active: Boolean;
  590.     property ActiveRecord: Integer;
  591.     property BufferCount: Integer;
  592.     property DataSet: TDataSet;
  593.     property DataSource: TDataSource;
  594.     property DataSourceFixed: Boolean;
  595.     property Editing: Boolean;
  596.     property ReadOnly: Boolean;
  597.     property RecordCount: Integer;
  598.   end;
  599.  
  600. { TDataSource }
  601.  
  602.   TDataChangeEvent = procedure(Sender: TObject; Field: TField) of object;
  603.  
  604.   TDataSource = class(TComponent)
  605.   public
  606.     constructor Create(AOwner: TComponent); override;
  607.     destructor Destroy; override;
  608.     procedure Edit;
  609.     function IsLinkedTo(DataSet: TDataSet): Boolean;
  610.     property State: TDataSetState;
  611.   published
  612.     property AutoEdit: Boolean default True;
  613.     property DataSet: TDataSet;
  614.     property Enabled: Boolean default True;
  615.     property OnStateChange: TNotifyEvent;
  616.     property OnDataChange: TDataChangeEvent;
  617.     property OnUpdateData: TNotifyEvent;
  618.   end;
  619.  
  620. { TDataSetDesigner }
  621.  
  622.   TDataSetDesigner = class(TObject)
  623.   public
  624.     constructor Create(DataSet: TDataSet);
  625.     destructor Destroy; override;
  626.     procedure BeginDesign;
  627.     procedure DataEvent(Event: TDataEvent; Info: Longint); virtual;
  628.     procedure EndDesign;
  629.     property DataSet: TDataSet;
  630.   end;
  631.  
  632. { TCheckConstraint }
  633.  
  634.   TCheckConstraint = class(TCollectionItem)
  635.   public
  636.     procedure Assign(Source: TPersistent); override;
  637.     function GetDisplayName: string; override;
  638.   published
  639.     property CustomConstraint: string;
  640.     property ErrorMessage: string;
  641.     property FromDictionary: Boolean;
  642.     property ImportedConstraint: string;
  643.   end;
  644.  
  645. { TCheckConstraints }
  646.  
  647.   TCheckConstraints = class(TCollection)
  648.   protected
  649.     function GetOwner: TPersistent; override;
  650.   public
  651.     constructor Create(Owner: TPersistent);
  652.     function Add: TCheckConstraint;
  653.     property Items[Index: Integer]: TCheckConstraint; default;
  654.   end;
  655.  
  656. { TDataSet }
  657.  
  658.   TBookmark = Pointer;
  659.   TBookmarkStr = string;
  660.  
  661.   PBookmarkFlag = ^TBookmarkFlag;
  662.   TBookmarkFlag = (bfCurrent, bfBOF, bfEOF, bfInserted);
  663.  
  664.   PBufferList = ^TBufferList;
  665.   TBufferList = array[0..dsMaxBufferCount - 1] of PChar;
  666.  
  667.   TGetMode = (gmCurrent, gmNext, gmPrior);
  668.  
  669.   TGetResult = (grOK, grBOF, grEOF, grError);
  670.  
  671.   TResyncMode = set of (rmExact, rmCenter);
  672.  
  673.   TDataAction = (daFail, daAbort, daRetry);
  674.  
  675.   TUpdateKind = (ukModify, ukInsert, ukDelete);
  676.  
  677.   TBlobStreamMode = (bmRead, bmWrite, bmReadWrite);
  678.  
  679.   TLocateOption = (loCaseInsensitive, loPartialKey);
  680.   TLocateOptions = set of TLocateOption;
  681.  
  682.   TDataOperation = procedure of object;
  683.  
  684.   TDataSetNotifyEvent = procedure(DataSet: TDataSet) of object;
  685.   TDataSetErrorEvent = procedure(DataSet: TDataSet; E: EDatabaseError;
  686.     var Action: TDataAction) of object;
  687.  
  688.   TFilterOption = (foCaseInsensitive, foNoPartialCompare);
  689.   TFilterOptions = set of TFilterOption;
  690.  
  691.   TFilterRecordEvent = procedure(DataSet: TDataSet;
  692.     var Accept: Boolean) of object;
  693.  
  694.   TDataSet = class(TComponent)
  695.     procedure BeginInsertAppend;
  696.     procedure CheckCanModify;
  697.     procedure CheckFieldName(const FieldName: string);
  698.     procedure CheckFieldNames(const FieldNames: string);
  699.     procedure CheckOperation(Operation: TDataOperation;
  700.       ErrorEvent: TDataSetErrorEvent);
  701.     procedure CheckRequiredFields;
  702.     procedure DoInternalOpen;
  703.     procedure DoInternalClose;
  704.     procedure EndInsertAppend;
  705.     function GetActive: Boolean;
  706.     function GetBuffer(Index: Integer): PChar;
  707.     function GetField(Index: Integer): TField;
  708.     function GetFieldCount: Integer;
  709.     function GetFieldValue(const FieldName: string): Variant;
  710.     function GetFound: Boolean;
  711.     procedure MoveBuffer(CurIndex, NewIndex: Integer);
  712.     procedure RemoveDataSource(DataSource: TDataSource);
  713.     procedure RemoveField(Field: TField);
  714.     procedure SetActive(Value: Boolean);
  715.     procedure SetBufferCount(Value: Integer);
  716.     procedure SetField(Index: Integer; Value: TField);
  717.     procedure SetFieldDefs(Value: TFieldDefs);
  718.     procedure SetFieldValue(const FieldName: string; const Value: Variant);
  719.     procedure SetConstraints(const Value: TCheckConstraints);
  720.     procedure UpdateBufferCount;
  721.     procedure UpdateFieldDefs;
  722.   protected
  723.     procedure ActivateBuffers; virtual;
  724.     procedure BindFields(Binding: Boolean);
  725.     function BookmarkAvailable: Boolean;
  726.     function BCDToCurr(BCD: Pointer; var Curr: Currency): Boolean; virtual;
  727.     function CurrToBCD(const Curr: Currency; BCD: Pointer; Precision,
  728.       Decimals: Integer): Boolean; virtual;
  729.     procedure CalculateFields(Buffer: PChar); virtual;
  730.     procedure CheckActive; virtual;
  731.     procedure CheckInactive; virtual;
  732.     procedure ClearBuffers; virtual;
  733.     procedure ClearCalcFields(Buffer: PChar); virtual;
  734.     procedure CloseBlob(Field: TField); virtual;
  735.     procedure CloseCursor; virtual;
  736.     procedure CreateFields;
  737.     procedure DataEvent(Event: TDataEvent; Info: Longint); virtual;
  738.     procedure DestroyFields; virtual;
  739.     procedure DoAfterCancel; virtual;
  740.     procedure DoAfterClose; virtual;
  741.     procedure DoAfterDelete; virtual;
  742.     procedure DoAfterEdit; virtual;
  743.     procedure DoAfterInsert; virtual;
  744.     procedure DoAfterOpen; virtual;
  745.     procedure DoAfterPost; virtual;
  746.     procedure DoAfterScroll; virtual;
  747.     procedure DoBeforeCancel; virtual;
  748.     procedure DoBeforeClose; virtual;
  749.     procedure DoBeforeDelete; virtual;
  750.     procedure DoBeforeEdit; virtual;
  751.     procedure DoBeforeInsert; virtual;
  752.     procedure DoBeforeOpen; virtual;
  753.     procedure DoBeforePost; virtual;
  754.     procedure DoBeforeScroll; virtual;
  755.     procedure DoOnCalcFields; virtual;
  756.     procedure DoOnNewRecord; virtual;
  757.     function FieldByNumber(FieldNo: Integer): TField;
  758.     function FindRecord(Restart, GoForward: Boolean): Boolean; virtual;
  759.     procedure FreeFieldBuffers; virtual;
  760.     function GetBookmarkStr: TBookmarkStr; virtual;
  761.     procedure GetCalcFields(Buffer: PChar); virtual;
  762.     function GetCanModify: Boolean; virtual;
  763.     procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
  764.     function GetDataSource: TDataSource; virtual;
  765.     function GetFieldClass(FieldType: TFieldType): TFieldClass; virtual;
  766.     function GetStateFieldValue(State: TDataSetState; Field: TField): Variant; virtual;
  767.     function GetIsIndexField(Field: TField): Boolean; virtual;
  768.     function GetNextRecords: Integer; virtual;
  769.     function GetNextRecord: Boolean; virtual;
  770.     function GetPriorRecords: Integer; virtual;
  771.     function GetPriorRecord: Boolean; virtual;
  772.     function GetRecordCount: Integer; virtual;
  773.     function GetRecNo: Integer; virtual;
  774.     procedure InitFieldDefs; virtual;
  775.     procedure InitRecord(Buffer: PChar); virtual;
  776.     procedure InternalCancel; virtual;
  777.     procedure InternalEdit; virtual;
  778.     procedure InternalRefresh; virtual;
  779.     procedure Loaded; override;
  780.     procedure OpenCursor(InfoQuery: Boolean); virtual;
  781.     procedure RefreshInternalCalcFields(Buffer: PChar); virtual;
  782.     procedure RestoreState(const Value: TDataSetState);
  783.     procedure SetBookmarkStr(const Value: TBookmarkStr); virtual;
  784.     procedure SetBufListSize(Value: Integer);
  785.     procedure SetChildOrder(Component: TComponent; Order: Integer); override;
  786.     procedure SetCurrentRecord(Index: Integer); virtual;
  787.     procedure SetFiltered(Value: Boolean); virtual;
  788.     procedure SetFilterOptions(Value: TFilterOptions); virtual;
  789.     procedure SetFilterText(const Value: string); virtual;
  790.     procedure SetFound(const Value: Boolean);
  791.     procedure SetModified(Value: Boolean);
  792.     procedure SetName(const Value: TComponentName); override;
  793.     procedure SetStateFieldValue(State: TDataSetState; Field: TField; Value: Variant); virtual;
  794.     procedure SetOnFilterRecord(const Value: TFilterRecordEvent); virtual;
  795.     procedure SetRecNo(Value: Integer); virtual;
  796.     procedure SetState(Value: TDataSetState);
  797.     function SetTempState(const Value: TDataSetState): TDataSetState;
  798.     function TempBuffer: PChar;
  799.     procedure UpdateIndexDefs; virtual;
  800.     property ActiveRecord: Integer;
  801.     property CurrentRecord: Integer;
  802.     property BlobFieldCount: Integer;
  803.     property BookmarkSize: Integer;
  804.     property Buffers[Index: Integer]: PChar;
  805.     property BufferCount: Integer;
  806.     property CalcBuffer: PChar;
  807.     property CalcFieldsSize: Integer;
  808.     property InternalCalcFields: Boolean;
  809.     property Constraints: TCheckConstraints;
  810.   protected { abstract methods }
  811.     function AllocRecordBuffer: PChar; virtual; abstract;
  812.     procedure FreeRecordBuffer(var Buffer: PChar); virtual; abstract;
  813.     procedure GetBookmarkData(Buffer: PChar; Data: Pointer); virtual; abstract;
  814.     function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; virtual; abstract;
  815.     function GetFieldData(Field: TField; Buffer: Pointer): Boolean; virtual; abstract;
  816.     function GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; virtual; abstract;
  817.     function GetRecordSize: Word; virtual; abstract;
  818.     procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); virtual; abstract;
  819.     procedure InternalClose; virtual; abstract;
  820.     procedure InternalDelete; virtual; abstract;
  821.     procedure InternalFirst; virtual; abstract;
  822.     procedure InternalGotoBookmark(Bookmark: Pointer); virtual; abstract;
  823.     procedure InternalHandleException; virtual; abstract;
  824.     procedure InternalInitFieldDefs; virtual; abstract;
  825.     procedure InternalInitRecord(Buffer: PChar); virtual; abstract;
  826.     procedure InternalLast; virtual; abstract;
  827.     procedure InternalOpen; virtual; abstract;
  828.     procedure InternalPost; virtual; abstract;
  829.     procedure InternalSetToRecord(Buffer: PChar); virtual; abstract;
  830.     function IsCursorOpen: Boolean; virtual; abstract;
  831.     procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); virtual; abstract;
  832.     procedure SetBookmarkData(Buffer: PChar; Data: Pointer); virtual; abstract;
  833.     procedure SetFieldData(Field: TField; Buffer: Pointer); virtual; abstract;
  834.   public
  835.     constructor Create(AOwner: TComponent); override;
  836.     destructor Destroy; override;
  837.     function ActiveBuffer: PChar;
  838.     procedure Append;
  839.     procedure AppendRecord(const Values: array of const);
  840.     function BookmarkValid(Bookmark: TBookmark): Boolean; virtual;
  841.     procedure Cancel; virtual;
  842.     procedure CheckBrowseMode;
  843.     procedure ClearFields;
  844.     procedure Close;
  845.     function  ControlsDisabled: Boolean;
  846.     function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer; virtual;
  847.     function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; virtual;
  848.     procedure CursorPosChanged;
  849.     procedure Delete;
  850.     procedure DisableControls;
  851.     procedure Edit;
  852.     procedure EnableControls;
  853.     function FieldByName(const FieldName: string): TField;
  854.     function FindField(const FieldName: string): TField;
  855.     function FindFirst: Boolean;
  856.     function FindLast: Boolean;
  857.     function FindNext: Boolean;
  858.     function FindPrior: Boolean;
  859.     procedure First;
  860.     procedure FreeBookmark(Bookmark: TBookmark); virtual;
  861.     function GetBookmark: TBookmark; virtual;
  862.     function GetCurrentRecord(Buffer: PChar): Boolean; virtual;
  863.     procedure GetFieldList(List: TList; const FieldNames: string);
  864.     procedure GetFieldNames(List: TStrings);
  865.     procedure GotoBookmark(Bookmark: TBookmark);
  866.     procedure Insert;
  867.     procedure InsertRecord(const Values: array of const);
  868.     function IsEmpty: Boolean;
  869.     function IsLinkedTo(DataSource: TDataSource): Boolean;
  870.     function IsSequenced: Boolean; virtual;
  871.     procedure Last;
  872.     function Locate(const KeyFields: string; const KeyValues: Variant;
  873.       Options: TLocateOptions): Boolean; virtual;
  874.     function Lookup(const KeyFields: string; const KeyValues: Variant;
  875.       const ResultFields: string): Variant; virtual;
  876.     function MoveBy(Distance: Integer): Integer;
  877.     procedure Next;
  878.     procedure Open;
  879.     procedure Post; virtual;
  880.     procedure Prior;
  881.     procedure Refresh;
  882.     procedure Resync(Mode: TResyncMode); virtual;
  883.     procedure SetFields(const Values: array of const);
  884.     procedure Translate(Src, Dest: PChar; ToOem: Boolean); virtual;
  885.     procedure UpdateCursorPos;
  886.     procedure UpdateRecord;
  887.     property BOF: Boolean;
  888.     property Bookmark: TBookmarkStr;
  889.     property CanModify: Boolean;
  890.     property DataSource: TDataSource;
  891.     property DefaultFields: Boolean;
  892.     property Designer: TDataSetDesigner;
  893.     property EOF: Boolean;
  894.     property FieldCount: Integer;
  895.     property FieldDefs: TFieldDefs;
  896.     property Fields[Index: Integer]: TField;
  897.     property FieldValues[const FieldName: string]: Variant; default;
  898.     property Found: Boolean;
  899.     property Modified: Boolean;
  900.     property RecordCount: Integer;
  901.     property RecNo: Integer;
  902.     property RecordSize: Word;
  903.     property State: TDataSetState;
  904.     property Filter: string;
  905.     property Filtered: Boolean default False;
  906.     property FilterOptions: TFilterOptions default [];
  907.     property Active: Boolean default False;
  908.     property AutoCalcFields: Boolean default True;
  909.     property BeforeOpen: TDataSetNotifyEvent;
  910.     property AfterOpen: TDataSetNotifyEvent;
  911.     property BeforeClose: TDataSetNotifyEvent;
  912.     property AfterClose: TDataSetNotifyEvent;
  913.     property BeforeInsert: TDataSetNotifyEvent;
  914.     property AfterInsert: TDataSetNotifyEvent;
  915.     property BeforeEdit: TDataSetNotifyEvent;
  916.     property AfterEdit: TDataSetNotifyEvent;
  917.     property BeforePost: TDataSetNotifyEvent;
  918.     property AfterPost: TDataSetNotifyEvent;
  919.     property BeforeCancel: TDataSetNotifyEvent;
  920.     property AfterCancel: TDataSetNotifyEvent;
  921.     property BeforeDelete: TDataSetNotifyEvent;
  922.     property AfterDelete: TDataSetNotifyEvent;
  923.     property BeforeScroll: TDataSetNotifyEvent;
  924.     property AfterScroll: TDataSetNotifyEvent;
  925.     property OnCalcFields: TDataSetNotifyEvent;
  926.     property OnDeleteError: TDataSetErrorEvent;
  927.     property OnEditError: TDataSetErrorEvent;
  928.     property OnFilterRecord: TFilterRecordEvent;
  929.     property OnNewRecord: TDataSetNotifyEvent;
  930.     property OnPostError: TDataSetErrorEvent;
  931.   end;
  932.  
  933. { TDateTimeRec }
  934.   
  935. type
  936.   TDateTimeRec = record
  937.     case TFieldType of
  938.       ftDate: (Date: Longint);
  939.       ftTime: (Time: Longint);
  940.       ftDateTime: (DateTime: TDateTime);
  941.   end;
  942.  
  943. const
  944.   dsEditModes = [dsEdit, dsInsert, dsSetKey];
  945.   dsWriteModes = [dsEdit, dsInsert, dsSetKey, dsCalcFields, dsFilter, dsNewValue];
  946.  
  947.   DefaultFieldClasses: array[ftUnknown..ftTypedBinary] of TFieldClass = (
  948.     nil,                { ftUnknown }
  949.     TStringField,       { ftString }
  950.     TSmallintField,     { ftSmallint }
  951.     TIntegerField,      { ftInteger }
  952.     TWordField,         { ftWord }
  953.     TBooleanField,      { ftBoolean }
  954.     TFloatField,        { ftFloat }
  955.     TCurrencyField,     { ftCurrency }
  956.     TBCDField,          { ftBCD }
  957.     TDateField,         { ftDate }
  958.     TTimeField,         { ftTime }
  959.     TDateTimeField,     { ftDateTime }
  960.     TBytesField,        { ftBytes }
  961.     TVarBytesField,     { ftVarBytes }
  962.     TAutoIncField,      { ftAutoInc }
  963.     TBlobField,         { ftBlob }
  964.     TMemoField,         { ftMemo }
  965.     TGraphicField,      { ftGraphic }
  966.     TBlobField,         { ftFmtMemo }
  967.     TBlobField,         { ftParadoxOle }
  968.     TBlobField,         { ftDBaseOle }
  969.     TBlobField);        { ftTypedBinary }
  970.  
  971. function ExtractFieldName(const Fields: string; var Pos: Integer): string;
  972. procedure RegisterFields(const FieldClasses: array of TFieldClass);
  973.  
  974. procedure DatabaseError(const Message: string);
  975. procedure DatabaseErrorFmt(const Message: string; const Args: array of const);
  976. procedure DBError(Ident: Word);
  977. procedure DBErrorFmt(Ident: Word; const Args: array of const);
  978.  
  979. procedure DisposeMem(var Buffer; Size: Integer);
  980. function BuffersEqual(Buf1, Buf2: Pointer; Size: Integer): Boolean;
  981.  
  982. function GetFieldProperty(DataSet: TDataSet; Control: TComponent;
  983.   const FieldName: string): TField;
  984.  
  985. const
  986.   RegisterFieldsProc: procedure(const FieldClassess: array of TFieldClass) = nil;
  987.  
  988. implementation
  989.