home *** CD-ROM | disk | FTP | other *** search
/ DOS/V Power Report 1996 August / VPR9608A.BIN / del20try / install / data.z / DB.INT < prev    next >
Text File  |  1996-05-08  |  31KB  |  839 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Delphi Visual Component Library                 }
  5. {                                                       }
  6. {       Copyright (c) 1995,96 Borland International     }
  7. {                                                       }
  8. {*******************************************************}
  9.  
  10. unit DB;
  11.  
  12. {$N+,P+,S-,R-}
  13.  
  14. interface
  15.  
  16. uses SysUtils, Windows, Bde, Classes;
  17.  
  18. const
  19.  
  20. { TDataSet maximum number of record buffers }
  21.  
  22.   dsMaxBufferCount = 1024;
  23.  
  24. { Maximum string field size }
  25.  
  26.   dsMaxStringSize = 8192;
  27.  
  28.  { SQL Trace buffer size }
  29.  
  30.   smTraceBufSize = 8192 + SizeOf(TraceDesc);
  31.  
  32. { TDBDataSet flags }
  33.  
  34.   dbfOpened     = 0;
  35.   dbfPrepared   = 1;
  36.   dbfExecSQL    = 2;
  37.   dbfTable      = 3;
  38.   dbfFieldList  = 4;
  39.   dbfIndexList  = 5;
  40.   dbfStoredProc = 6;
  41.   dbfExecProc   = 7;
  42.  
  43. type
  44.  
  45. { Forward declarations }
  46.  
  47.   TDBError = class;
  48.   TSession = class;
  49.   TDatabase = class;
  50.   TFieldDefs = class;
  51.   TDataSet = class;
  52.   TDBDataSet = class;
  53.   TField = class;
  54.   TDataSource = class;
  55.   TDataLink = class;
  56.  
  57. { Generic types }
  58.  
  59.   PFieldDescList = ^TFieldDescList;
  60.   TFieldDescList = array[0..1023] of FLDDesc;
  61.  
  62.   PIndexDescList = ^TIndexDescList;
  63.   TIndexDescList = array[0..63] of IDXDesc;
  64.  
  65. { Exception classes }
  66.  
  67.   EDatabaseError = class(Exception);
  68.  
  69.   EDBEngineError = class(EDatabaseError)
  70.   public
  71.     constructor Create(ErrorCode: DBIResult);
  72.     destructor Destroy; override;
  73.     property ErrorCount: Integer;
  74.     property Errors[Index: Integer]: TDBError;
  75.   end;
  76.  
  77. { BDE error information type }
  78.  
  79.   TDBError = class
  80.   public
  81.     constructor Create(Owner: EDBEngineError; ErrorCode: DBIResult;
  82.       NativeError: Longint; Message: PChar);
  83.     property Category: Byte;
  84.     property ErrorCode: DBIResult;
  85.     property SubCode: Byte;
  86.     property Message: string;
  87.     property NativeError: Longint;
  88.   end;
  89.  
  90. { TLocale }
  91.  
  92.   TLocale = Pointer;
  93.  
  94. { TBDECallback }
  95.  
  96.   TBDECallbackEvent = function(CBInfo: Pointer): CBRType of Object;
  97.  
  98.   TBDECallback = class
  99.   protected
  100.     function Invoke(CallType: CBType; CBInfo: Pointer): CBRType;
  101.   public
  102.     constructor Create(AOwner: TObject; Handle: hDBICur; CBType: CBType;
  103.       CBBuf: Pointer; CBBufSize: Integer; CallbackEvent: TBDECallbackEvent;
  104.       Chain: Boolean);
  105.     destructor Destroy; override;
  106.   end;
  107.  
  108. { TSessionList }
  109.  
  110.   TSessionList = class(TObject)
  111.   public
  112.     constructor Create;
  113.     destructor Destroy; override;
  114.     property CurrentSession: TSession;
  115.     function FindSession(const SessionName: string): TSession;
  116.     procedure GetSessionNames(List: TStrings);
  117.     function OpenSession(const SessionName: string): TSession;
  118.     property Count: Integer;
  119.     property Sessions[Index: Integer]: TSession; default;
  120.     property List[const SessionName: string]: TSession;
  121.   end;
  122.  
  123. { TSession }
  124.  
  125.   TConfigMode = (cmPersistent, cmSession, cmAll);
  126.  
  127.   TPasswordEvent = procedure(Sender: TObject; var Continue: Boolean) of Object;
  128.  
  129.   TDatabaseEvent = (dbOpen, dbClose, dbAdd, dbRemove, dbAddAlias, dbDeleteAlias);
  130.  
  131.   TDatabaseNotifyEvent = procedure(DBEvent: TDatabaseEvent; const Param) of object;
  132.  
  133.   TBDEInitProc = procedure(Session: TSession);
  134.  
  135.   TTraceFlag = (tfQPrepare, tfQExecute, tfError, tfStmt, tfConnect,
  136.     tfTransact, tfBlob, tfMisc, tfVendor);
  137.  
  138.   TTraceFlags = set of TTraceFlag;
  139.  
  140.   TWriteProc = function (Client: TObject; Data: PChar; Len: Integer): LongBool; StdCall;
  141.   TSMRegProc = function (Handle: Integer; ClientName: PChar;
  142.     var WriteProc: TWriteProc; Instance: TObject;
  143.     const SignalProc: Pointer): TObject; StdCall;
  144.  
  145.   TSession = class(TComponent)
  146.   protected
  147.     procedure Loaded; override;
  148.     property OnDBNotify: TDatabaseNotifyEvent;
  149.     property BDEOwnsLoginCbDb: Boolean;
  150.   public
  151.     constructor Create(AOwner: TComponent); override;
  152.     destructor Destroy; override;
  153.     procedure AddAlias(const Name, Driver: string; List: TStrings);
  154.     procedure AddStandardAlias(const Name, Path, DefaultDriver: string);
  155.     property ConfigMode: TConfigMode;
  156.     procedure AddPassword(const Password: string);
  157.     procedure Close;
  158.     procedure CloseDatabase(Database: TDatabase);
  159.     procedure DeleteAlias(const Name: string);
  160.     procedure DropConnections;
  161.     function FindDatabase(const DatabaseName: string): TDatabase;
  162.     procedure GetAliasNames(List: TStrings);
  163.     procedure GetAliasParams(const AliasName: string; List: TStrings);
  164.     function GetAliasDriverName(const AliasName: string): string;
  165.     procedure GetConfigParams(const Path, Section: string; List: TStrings);
  166.     procedure GetDatabaseNames(List: TStrings);
  167.     procedure GetDriverNames(List: TStrings);
  168.     procedure GetDriverParams(const DriverName: string; List: TStrings);
  169.     function GetPassword: Boolean;
  170.     procedure GetTableNames(const DatabaseName, Pattern: string;
  171.       Extensions, SystemTables: Boolean; List: TStrings);
  172.     procedure GetStoredProcNames(const DatabaseName: string; List: TStrings);
  173.     function IsAlias(const Name: string): Boolean;
  174.     procedure ModifyAlias(Name: string; List: TStrings);
  175.     procedure Open;
  176.     function OpenDatabase(const DatabaseName: string): TDatabase;
  177.     procedure RemoveAllPasswords;
  178.     procedure RemovePassword(const Password: string);
  179.     procedure SaveConfigFile;
  180.     property DatabaseCount: Integer;
  181.     property Databases[Index: Integer]: TDatabase;
  182.     property Handle: HDBISES;
  183.     property Locale: TLocale;
  184.     property TraceFlags: TTraceFlags;
  185.   published
  186.     property Active: Boolean default False;
  187.     property KeepConnections: Boolean default True;
  188.     property NetFileDir: string;
  189.     property PrivateDir: string;
  190.     property SessionName: string;
  191.     property OnPassword: TPasswordEvent;
  192.     property OnStartup: TNotifyEvent;
  193.   end;
  194.  
  195. { TParamList }
  196.  
  197.   TParamList = class(TObject)
  198.   public
  199.     constructor Create(Params: TStrings);
  200.     destructor Destroy; override;
  201.     property Buffer: PChar;
  202.     property FieldCount: Integer;
  203.     property FieldDescs: PFieldDescList;
  204.   end;
  205.  
  206. { TDatabase }
  207.  
  208.   TTransIsolation = (tiDirtyRead, tiReadCommitted, tiRepeatableRead);
  209.  
  210.   TLoginEvent = procedure(Database: TDatabase;
  211.     LoginParams: TStrings) of object;
  212.  
  213.   TDatabase = class(TComponent)
  214.   protected
  215.     procedure Loaded; override;
  216.   public
  217.     constructor Create(AOwner: TComponent); override;
  218.     destructor Destroy; override;
  219.     procedure ApplyUpdates(const DataSets: array of TDBDataSet);
  220.     procedure Close;
  221.     procedure CloseDataSets;
  222.     procedure Commit;
  223.     procedure FlushSchemaCache(const TableName: string);
  224.     procedure Open;
  225.     procedure Rollback;
  226.     procedure StartTransaction;
  227.     procedure ValidateName(const Name: string);
  228.     property DataSetCount: Integer;
  229.     property DataSets[Index: Integer]: TDBDataSet;
  230.     property Directory: string;
  231.     property Handle: HDBIDB;
  232.     property IsSQLBased: Boolean;
  233.     property InTransaction: Boolean;
  234.     property Locale: TLocale;
  235.     property Session: TSession;
  236.     property Temporary: Boolean;
  237.     property SessionAlias: Boolean;
  238.     property TraceFlags: TTraceFlags;
  239.   published
  240.     property AliasName: string;
  241.     property Connected: Boolean default False;
  242.     property DatabaseName: string;
  243.     property DriverName: string;
  244.     property KeepConnection: Boolean default True;
  245.     property LoginPrompt: Boolean default True;
  246.     property Params: TStrings;
  247.     property SessionName: string;
  248.     property TransIsolation: TTransIsolation default tiReadCommitted;
  249.     property OnLogin: TLoginEvent;
  250.   end;
  251.  
  252. { TDataSetDesigner }
  253.  
  254.   TDataEvent = (deFieldChange, deRecordChange, deDataSetChange,
  255.     deDataSetScroll, deLayoutChange, deUpdateRecord, deUpdateState,
  256.     deCheckBrowseMode, dePropertyChange, deFieldListChange,
  257.     deFocusControl);
  258.  
  259.   TDataSetDesigner = class(TObject)
  260.   public
  261.     constructor Create(DataSet: TDataSet);
  262.     destructor Destroy; override;
  263.     procedure BeginDesign;
  264.     procedure DataEvent(Event: TDataEvent; Info: Longint); virtual;
  265.     procedure EndDesign;
  266.     property DataSet: TDataSet;
  267.   end;
  268.  
  269. { TFieldDef }
  270.  
  271.   TFieldClass = class of TField;
  272.  
  273.   TFieldType = (ftUnknown, ftString, ftSmallint, ftInteger, ftWord,
  274.     ftBoolean, ftFloat, ftCurrency, ftBCD, ftDate, ftTime, ftDateTime,
  275.     ftBytes, ftVarBytes, ftAutoInc, ftBlob, ftMemo, ftGraphic,
  276.     ftFmtMemo, ftParadoxOle, ftDBaseOle, ftTypedBinary);
  277.  
  278.   TFieldDef = class
  279.   public
  280.     constructor Create(Owner: TFieldDefs; const Name: string;
  281.       DataType: TFieldType; Size: Word; Required: Boolean; FieldNo: Integer);
  282.     destructor Destroy; override;
  283.     function CreateField(Owner: TComponent): TField;
  284.     property BDECalcField: Boolean;
  285.     property DataType: TFieldType;
  286.     property FieldClass: TFieldClass;
  287.     property FieldNo: Integer;
  288.     property Name: string;
  289.     property Required: Boolean;
  290.     property Size: Word;
  291.   end;
  292.  
  293. { TFieldDefs }
  294.  
  295.   TFieldDefs = class
  296.   public
  297.     constructor Create(DataSet: TDataSet);
  298.     destructor Destroy; override;
  299.     procedure Add(const Name: string; DataType: TFieldType; Size: Word;
  300.       Required: Boolean);
  301.     procedure AddFieldDesc(FieldDesc: FLDDesc; Required: Boolean;
  302.       FieldNo: Word);
  303.     procedure Assign(FieldDefs: TFieldDefs);
  304.     procedure Clear;
  305.     function Find(const Name: string): TFieldDef;
  306.     function IndexOf(const Name: string): Integer;
  307.     procedure Update;
  308.     property Count: Integer;
  309.     property Items[Index: Integer]: TFieldDef; default;
  310.   end;
  311.  
  312. { TDataSet }
  313.  
  314.   TBookmark = Pointer;
  315.   TBookmarkStr = String;
  316.  
  317.   PBufferList = ^TBufferList;
  318.   TBufferList = array[0..dsMaxBufferCount - 1] of PChar;
  319.  
  320.   TDataSetState = (dsInactive, dsBrowse, dsEdit, dsInsert,
  321.     dsSetKey, dsCalcFields, dsUpdateNew, dsUpdateOld, dsFilter);
  322.  
  323.   TGetMode = (gmCurrent, gmNext, gmPrior);
  324.  
  325.   TFilterOption = (foCaseInsensitive, foNoPartialCompare);
  326.   TFilterOptions = set of TFilterOption;
  327.  
  328.   TLocateOption = (loCaseInsensitive, loPartialKey);
  329.   TLocateOptions = set of TLocateOption;
  330.  
  331.   TResyncMode = set of (rmExact, rmCenter);
  332.  
  333.   TKeyIndex = (kiLookup, kiRangeStart, kiRangeEnd, kiCurRangeStart,
  334.     kiCurRangeEnd, kiSave);
  335.  
  336.   PKeyBuffer = ^TKeyBuffer;
  337.   TKeyBuffer = record
  338.     Modified: Boolean;
  339.     Exclusive: Boolean;
  340.     FieldCount: Integer;
  341.     Data: record end;
  342.   end;
  343.  
  344.   TDataAction = (daFail, daAbort, daRetry);
  345.  
  346.   TDataSetNotifyEvent = procedure(DataSet: TDataSet) of object;
  347.   TDataSetErrorEvent = procedure(DataSet: TDataSet; E: EDatabaseError;
  348.     var Action: TDataAction) of object;
  349.  
  350.  
  351.   TUpdateStatus = (usUnmodified, usModified, usInserted, usDeleted);
  352.   TUpdateKind = (ukModify, ukInsert, ukDelete);
  353.   TUpdateAction = (uaFail, uaAbort, uaSkip, uaRetry, uaApplied);
  354.   TUpdateRecordTypes = set of (rtModified, rtInserted, rtDeleted, rtUnmodified);
  355.   TUpdateErrorEvent = procedure(DataSet: TDataSet; E: EDatabaseError;
  356.     UpdateKind: TUpdateKind; var UpdateAction: TUpdateAction) of object;
  357.   TUpdateRecordEvent = procedure(DataSet: TDataSet; UpdateKind: TUpdateKind;
  358.     var UpdateAction: TUpdateAction) of object;
  359.   TOnServerYieldEvent = procedure(DataSet: TDataSet; var AbortQuery: Boolean) of object;
  360.   TDataSetUpdateObject = class(TComponent)
  361.   protected
  362.     function GetDataSet: TDataSet; virtual; abstract;
  363.     procedure SetDataSet(ADataSet: TDataSet); virtual; abstract;
  364.     procedure Apply(UpdateKind: TUpdateKind); virtual; abstract;
  365.     property DataSet: TDataSet;
  366.   end;
  367.  
  368.   TFilterRecordEvent = procedure(DataSet: TDataSet;
  369.     var Accept: Boolean) of object;
  370.  
  371.   TRecNoStatus = (rnDbase, rnParadox, rnNotSupported);
  372.  
  373.   PRecInfo = ^TRecInfo;
  374.   TRecInfo = record
  375.     UpdateStatus: TUpdateStatus;
  376.     RecordNumber: Longint;
  377.   end;
  378.  
  379.   TDataOperation = function: DBIResult of object;
  380.  
  381.   TDataSet = class(TComponent)
  382.     procedure BeginInsertAppend;
  383.     procedure BindFields(Binding: Boolean);
  384.     function CachedUpdateCallBack(CBInfo: Pointer): CBRType;
  385.     procedure CalculateBDEFields;
  386.     procedure CalculateFields;
  387.     procedure CheckCanModify;
  388.     procedure CheckCachedUpdateMode;
  389.     procedure CheckFieldName(const FieldName: string);
  390.     procedure CheckFieldNames(const FieldNames: string);
  391.     procedure CheckOperation(Operation: TDataOperation;
  392.       ErrorEvent: TDataSetErrorEvent);
  393.     procedure CheckRequiredFields;
  394.     procedure CheckSetKeyMode;
  395.     procedure CopyBuffer(SourceIndex, DestIndex: Integer);
  396.     function CreateExprFilter(const Expr: string;
  397.       Options: TFilterOptions; Priority: Integer): HDBIFilter;
  398.     procedure CreateFields;
  399.     function CreateFuncFilter(FilterFunc: Pointer;
  400.       Priority: Integer): HDBIFilter;
  401.     function CreateLookupFilter(Fields: TList; const Values: Variant;
  402.       Options: TLocateOptions; Priority: Integer): HDBIFilter;
  403.     procedure DeactivateFilters;
  404.     function DeleteRecord: DBIResult;
  405.     procedure DestroyFields;
  406.     function EditRecord: DBIResult;
  407.     procedure EndInsertAppend;
  408.     function FieldByNumber(FieldNo: Integer): TField;
  409.     function FindRecord(Restart, GoForward: Boolean): Boolean;
  410.     procedure FreeFieldBuffers;
  411.     procedure FreeKeyBuffers;
  412.     function GetActive: Boolean;
  413.     function GetBookmarkStr: TBookmarkStr;
  414.     procedure GetCalcFields(Index: Integer);
  415.     function GetField(Index: Integer): TField;
  416.     function GetFieldCount: Integer;
  417.     function GetFieldValue(const FieldName: string): Variant;
  418.     procedure GetIndexInfo;
  419.     function GetNextRecord: Boolean;
  420.     function GetNextRecords: Integer;
  421.     function GetPriorRecord: Boolean;
  422.     function GetPriorRecords: Integer;
  423.     function GetRecord(Index: Integer; GetMode: TGetMode): DBIResult;
  424.     function GetRecordCount: Longint;
  425.     function GetUpdatesPending: Boolean;
  426.     function InitKeyBuffer(Buffer: PKeyBuffer): PKeyBuffer;
  427.     procedure InitRecord(Buffer: PChar);
  428.     procedure InternalClose;
  429.     procedure InternalOpen;
  430.     function LocateRecord(const KeyFields: string; const KeyValues: Variant;
  431.       Options: TLocateOptions; SyncCursor: Boolean): Boolean;
  432.     function MapsToIndex(Fields: TList; CaseInsensitive: Boolean): Boolean;
  433.     procedure MoveBuffer(CurIndex, NewIndex: Integer);
  434.     procedure PostKeyBuffer(Commit: Boolean);
  435.     function PostRecord: DBIResult;
  436.     function RecordFilter(RecBuf: Pointer; RecNo: Integer): Smallint; stdcall;
  437.     procedure RemoveDataSource(DataSource: TDataSource);
  438.     procedure RemoveField(Field: TField);
  439.     procedure SetActive(Value: Boolean);
  440.     procedure SetBookmarkStr(const Value: TBookmarkStr);
  441.     procedure SetBufferCount(Value: Integer);
  442.     procedure SetBufListSize(Value: Integer);
  443.     procedure SetCurrentRecord(Index: Integer);
  444.     procedure SetField(Index: Integer; Value: TField);
  445.     procedure SetFieldDefs(Value: TFieldDefs);
  446.     procedure SetFieldValue(const FieldName: string; const Value: Variant);
  447.     procedure SetFilterData(const Text: string; Options: TFilterOptions);
  448.     procedure SetFiltered(Value: Boolean);
  449.     procedure SetFilterHandle(var Filter: HDBIFilter; Value: HDBIFilter);
  450.     procedure SetFilterOptions(Value: TFilterOptions);
  451.     procedure SetFilterText(const Value: string);
  452.     procedure SetOnFilterRecord(const Value: TFilterRecordEvent);
  453.     procedure SetOnUpdateError(UpdateEvent: TUpdateErrorEvent);
  454.     procedure SetState(Value: TDataSetState);
  455.     procedure UpdateBufferCount;
  456.     function UpdateCallbackRequired: Boolean;
  457.     procedure UpdateFieldDefs;
  458.     function YieldCallBack(CBInfo: Pointer): CBRType;
  459.   protected
  460.     procedure CheckInactive;
  461.     procedure ClearBuffers;
  462.     procedure CloseCursor; virtual;
  463.     function CreateHandle: HDBICur; virtual;
  464.     procedure DataEvent(Event: TDataEvent; Info: Longint); virtual;
  465.     procedure DestroyHandle; virtual;
  466.     procedure DestroyLookupCursor; virtual;
  467.     procedure DoAfterCancel; virtual;
  468.     procedure DoAfterClose; virtual;
  469.     procedure DoAfterDelete; virtual;
  470.     procedure DoAfterEdit; virtual;
  471.     procedure DoAfterInsert; virtual;
  472.     procedure DoAfterOpen; virtual;
  473.     procedure DoAfterPost; virtual;
  474.     procedure DoBeforeCancel; virtual;
  475.     procedure DoBeforeClose; virtual;
  476.     procedure DoBeforeDelete; virtual;
  477.     procedure DoBeforeEdit; virtual;
  478.     procedure DoBeforeInsert; virtual;
  479.     procedure DoBeforeOpen; virtual;
  480.     procedure DoBeforePost; virtual;
  481.     procedure DoOnCalcFields; virtual;
  482.     procedure DoOnNewRecord; virtual;
  483.     function GetCanModify: Boolean; virtual;
  484.     function GetDataSource: TDataSource; virtual;
  485.     function GetIndexField(Index: Integer): TField;
  486.     function GetIndexFieldCount: Integer;
  487.     function GetKeyBuffer(KeyIndex: TKeyIndex): PKeyBuffer;
  488.     function GetKeyExclusive: Boolean;
  489.     function GetKeyFieldCount: Integer;
  490.     function GetLookupCursor(const KeyFields: string;
  491.       CaseInsensitive: Boolean): HDBICur; virtual;
  492.     function GetRecordNumber: Longint; virtual;
  493.     procedure InitFieldDefs; virtual;
  494.     procedure Loaded; override;
  495.     procedure OpenCursor; virtual;
  496.     procedure PrepareCursor; virtual;
  497.     function ResetCursorRange: Boolean;
  498.     function SetCursorRange: Boolean;
  499.     procedure SetIndexField(Index: Integer; Value: TField);
  500.     procedure SetKeyBuffer(KeyIndex: TKeyIndex; Clear: Boolean);
  501.     procedure SetKeyExclusive(Value: Boolean);
  502.     procedure SetKeyFieldCount(Value: Integer);
  503.     procedure SetKeyFields(KeyIndex: TKeyIndex; const Values: array of const);
  504.     procedure SetLinkRanges(MasterFields: TList);
  505.     procedure SetLocale(Value: TLocale);
  506.     procedure SetName(const Value: TComponentName); override;
  507.     procedure SwitchToIndex(const IndexName, TagName: string);
  508.     procedure GetChildren(Proc: TGetChildProc); override;
  509.     procedure SetChildOrder(Component: TComponent; Order: Integer); override;
  510.     property InfoQueryMode: Boolean;
  511.     procedure SetCachedUpdates(Value: Boolean);
  512.     procedure SetupCallBack(Value: Boolean);
  513.     function ProcessUpdates(UpdCmd: DBIDelayedUpdCmd): DBIResult;
  514.     function GetUpdateRecordSet: TUpdateRecordTypes;
  515.     procedure SetUpdateRecordSet(RecordTypes: TUpdateRecordTypes);
  516.     procedure SetUpdateObject(Value: TDataSetUpdateObject);
  517.     function ForceUpdateCallback: Boolean;
  518.   public
  519.     constructor Create(AOwner: TComponent); override;
  520.     destructor Destroy; override;
  521.     function ActiveBuffer: PChar;
  522.     procedure Append;
  523.     procedure AppendRecord(const Values: array of const);
  524.     procedure Cancel;
  525.     procedure CheckBrowseMode;
  526.     procedure ClearFields;
  527.     procedure Close;
  528.     function  ControlsDisabled: Boolean;
  529.     procedure CursorPosChanged;
  530.     procedure Delete;
  531.     procedure DisableControls;
  532.     procedure Edit;
  533.     procedure EnableControls;
  534.     procedure FetchAll;
  535.     function FieldByName(const FieldName: string): TField;
  536.     function FindField(const FieldName: string): TField;
  537.     function FindFirst: Boolean;
  538.     function FindLast: Boolean;
  539.     function FindNext: Boolean;
  540.     function FindPrior: Boolean;
  541.     procedure First;
  542.     procedure FreeBookmark(Bookmark: TBookmark);
  543.     function GetBookmark: TBookmark;
  544.     function GetCurrentRecord(Buffer: PChar): Boolean;
  545.     procedure GetFieldList(List: TList; const FieldNames: string);
  546.     procedure GetFieldNames(List: TStrings);
  547.     procedure GotoBookmark(Bookmark: TBookmark);
  548.     procedure Insert;
  549.     procedure InsertRecord(const Values: array of const);
  550.     function IsLinkedTo(DataSource: TDataSource): Boolean;
  551.     procedure Last;
  552.     function Locate(const KeyFields: string; const KeyValues: Variant;
  553.       Options: TLocateOptions): Boolean;
  554.     function Lookup(const KeyFields: string; const KeyValues: Variant;
  555.       const ResultFields: string): Variant;
  556.     function MoveBy(Distance: Integer): Integer;
  557.     procedure Next;
  558.     procedure Open;
  559.     procedure Post;
  560.     procedure Prior;
  561.     procedure Refresh;
  562.     procedure Resync(Mode: TResyncMode);
  563.     procedure SetFields(const Values: array of const);
  564.     procedure SetDetailFields(MasterFields: TList);
  565.     procedure UpdateCursorPos;
  566.     procedure UpdateRecord;
  567.     procedure ApplyUpdates;
  568.     procedure CommitUpdates;
  569.     procedure CancelUpdates;
  570.     procedure RevertRecord;
  571.     function UpdateStatus: TUpdateStatus;
  572.     property BOF: Boolean;
  573.     property Bookmark: TBookmarkStr;
  574.     property CanModify: Boolean;
  575.     property DataSource: TDataSource;
  576.     property DefaultFields: Boolean;
  577.     property Designer: TDataSetDesigner;
  578.     property EOF: Boolean;
  579.     property ExpIndex: Boolean;
  580.     property FieldCount: Integer;
  581.     property FieldDefs: TFieldDefs;
  582.     property Fields[Index: Integer]: TField;
  583.     property FieldValues[const FieldName: string]: Variant; default;
  584.     property Found: Boolean;
  585.     property Handle: HDBICur;
  586.     property KeySize: Word;
  587.     property Locale: TLocale;
  588.     property Modified: Boolean;
  589.     property RecordCount: Longint;
  590.     property RecNo: Longint;
  591.     property RecordSize: Word;
  592.     property State: TDataSetState;
  593.     property UpdateObject: TDataSetUpdateObject;
  594.     property UpdateRecordTypes: TUpdateRecordTypes;
  595.     property UpdatesPending: Boolean;
  596.   published
  597.     property Active: Boolean default False;
  598.     property AutoCalcFields: Boolean default True;
  599.     property CachedUpdates: Boolean default False;
  600.     property Filter: string;
  601.     property Filtered: Boolean default False;
  602.     property FilterOptions: TFilterOptions default [];
  603.     property BeforeOpen: TDataSetNotifyEvent;
  604.     property AfterOpen: TDataSetNotifyEvent;
  605.     property BeforeClose: TDataSetNotifyEvent;
  606.     property AfterClose: TDataSetNotifyEvent;
  607.     property BeforeInsert: TDataSetNotifyEvent;
  608.     property AfterInsert: TDataSetNotifyEvent;
  609.     property BeforeEdit: TDataSetNotifyEvent;
  610.     property AfterEdit: TDataSetNotifyEvent;
  611.     property BeforePost: TDataSetNotifyEvent;
  612.     property AfterPost: TDataSetNotifyEvent;
  613.     property BeforeCancel: TDataSetNotifyEvent;
  614.     property AfterCancel: TDataSetNotifyEvent;
  615.     property BeforeDelete: TDataSetNotifyEvent;
  616.     property AfterDelete: TDataSetNotifyEvent;
  617.     property OnNewRecord: TDataSetNotifyEvent;
  618.     property OnCalcFields: TDataSetNotifyEvent;
  619.     property OnFilterRecord: TFilterRecordEvent;
  620.     property OnServerYield: TOnServerYieldEvent;
  621.     property OnUpdateError: TUpdateErrorEvent;
  622.     property OnUpdateRecord: TUpdateRecordEvent;
  623.     property OnEditError: TDataSetErrorEvent;
  624.     property OnPostError: TDataSetErrorEvent;
  625.     property OnDeleteError: TDataSetErrorEvent;
  626.   end;
  627.  
  628. { TDBDataSet }
  629.  
  630.   TUpdateMode = (upWhereAll, upWhereChanged, upWhereKeyOnly);
  631.   TDBFlags = set of 0..15;
  632.  
  633.   TDBDataSet = class(TDataSet)
  634.   protected
  635.     procedure CloseCursor; override;
  636.     procedure Disconnect; virtual;
  637.     procedure OpenCursor; override;
  638.     procedure SetDBFlag(Flag: Integer; Value: Boolean); virtual;
  639.     property DBFlags: TDBFlags;
  640.     property UpdateMode: TUpdateMode default upWhereAll;
  641.   public
  642.     function CheckOpen(Status: DBIResult): Boolean;
  643.     property Database: TDatabase;
  644.     property DBHandle: HDBIDB;
  645.     property DBLocale: TLocale;
  646.     property DBSession: TSession;
  647.   published
  648.     property DatabaseName: string;
  649.     property SessionName: string;
  650.   end;
  651.  
  652. { TDataSource }
  653.  
  654.   TDataChangeEvent = procedure(Sender: TObject; Field: TField) of object;
  655.  
  656.   TDataSource = class(TComponent)
  657.   public
  658.     constructor Create(AOwner: TComponent); override;
  659.     destructor Destroy; override;
  660.     procedure Edit;
  661.     function IsLinkedTo(DataSet: TDataSet): Boolean;
  662.     property State: TDataSetState;
  663.   published
  664.     property AutoEdit: Boolean default True;
  665.     property DataSet: TDataSet;
  666.     property Enabled: Boolean default True;
  667.     property OnStateChange: TNotifyEvent;
  668.     property OnDataChange: TDataChangeEvent;
  669.     property OnUpdateData: TNotifyEvent;
  670.   end;
  671.  
  672. { TField }
  673.  
  674.   TFieldKind = (fkData, fkCalculated, fkLookup);
  675.  
  676.   TFieldNotifyEvent = procedure(Sender: TField) of object;
  677.   TFieldGetTextEvent = procedure(Sender: TField; var Text: string;
  678.     DisplayText: Boolean) of object;
  679.   TFieldSetTextEvent = procedure(Sender: TField; const Text: string) of object;
  680.   TFieldRef = ^TField;
  681.  
  682.   TField = class(TComponent)
  683.   protected
  684.     procedure AccessError(const TypeName: string);
  685.     procedure CheckInactive;
  686.     procedure Change; virtual;
  687.     procedure DataChanged;
  688.     procedure DefineProperties(Filer: TFiler); override;
  689.     procedure FreeBuffers; virtual;
  690.     function GetAsBoolean: Boolean; virtual;
  691.     function GetAsCurrency: Currency; virtual;
  692.     function GetAsDateTime: TDateTime; virtual;
  693.     function GetAsFloat: Double; virtual;
  694.     function GetAsInteger: Longint; virtual;
  695.     function GetAsString: string; virtual;
  696.     function GetAsVariant: Variant; virtual;
  697.     function GetCanModify: Boolean;
  698.     function GetDefaultWidth: Integer; virtual;
  699.     function GetParentComponent: TComponent; override;
  700.     procedure GetText(var Text: string; DisplayText: Boolean); virtual;
  701.     function HasParent: Boolean; override;
  702.     procedure Notification(AComponent: TComponent;
  703.       Operation: TOperation); override;
  704.     procedure PropertyChanged(LayoutAffected: Boolean);
  705.     procedure ReadState(Reader: TReader); override;
  706.     procedure SetAsBoolean(Value: Boolean); virtual;
  707.     procedure SetAsCurrency(Value: Currency); virtual;
  708.     procedure SetAsDateTime(Value: TDateTime); virtual;
  709.     procedure SetAsFloat(Value: Double); virtual;
  710.     procedure SetAsInteger(Value: Longint); virtual;
  711.     procedure SetAsString(const Value: string); virtual;
  712.     procedure SetAsVariant(const Value: Variant); virtual;
  713.     procedure SetDataType(Value: TFieldType);
  714.     procedure SetSize(Value: Word);
  715.     procedure SetParentComponent(AParent: TComponent); override;
  716.     procedure SetText(const Value: string); virtual;
  717.     procedure SetVarValue(const Value: Variant); virtual;
  718.   public
  719.     constructor Create(AOwner: TComponent); override;
  720.     destructor Destroy; override;
  721.     procedure Assign(Source: TPersistent); override;
  722.     procedure AssignValue(const Value: TVarRec);
  723.     procedure Clear; virtual;
  724.     procedure FocusControl;
  725.     function GetData(Buffer: Pointer): Boolean;
  726.     function IsValidChar(InputChar: Char): Boolean; virtual;
  727.     procedure SetData(Buffer: Pointer);
  728.     procedure SetFieldType(Value: TFieldType); virtual;
  729.     property AsBoolean: Boolean;
  730.     property AsCurrency: Currency;
  731.     property AsDateTime: TDateTime;
  732.     property AsFloat: Double;
  733.     property AsInteger: Longint;
  734.     property AsString: string;
  735.     property AsVariant: Variant;
  736.     property AttributeSet: string;
  737.     property BDECalcField: Boolean;
  738.     property CanModify: Boolean;
  739.     property DataSet: TDataSet;
  740.     property DataSize: Word;
  741.     property DataType: TFieldType;
  742.     property DisplayName: string;
  743.     property DisplayText: string;
  744.     property EditMask: string;
  745.     property EditMaskPtr: string;
  746.     property FieldKind: TFieldKind;
  747.     property FieldNo: Integer;
  748.     property IsIndexField: Boolean;
  749.     property IsNull: Boolean;
  750.     property Size: Word;
  751.     property Text: string;
  752.     property Value: Variant;
  753.     property NewValue: Variant;
  754.     property OldValue: Variant;
  755.   published
  756.     property Alignment: TAlignment default taLeftJustify;
  757.     property Calculated: Boolean default False;
  758.     property DisplayLabel: string;
  759.     property DisplayWidth: Integer;
  760.     property FieldName: string;
  761.     property Index: Integer;
  762.     property Lookup: Boolean default False;
  763.     property LookupDataSet: TDataSet;
  764.     property LookupKeyFields: string;
  765.     property LookupResultField: string;
  766.     property KeyFields: string;
  767.     property ReadOnly: Boolean default False;
  768.     property Required: Boolean default False;
  769.     property Visible: Boolean default True;
  770.     property OnChange: TFieldNotifyEvent;
  771.     property OnGetText: TFieldGetTextEvent;
  772.     property OnSetText: TFieldSetTextEvent;
  773.     property OnValidate: TFieldNotifyEvent;
  774.   end;
  775.  
  776. { TDataLink }
  777.  
  778.   TDataLink = class(TPersistent)
  779.   protected
  780.     procedure ActiveChanged; virtual;
  781.     procedure CheckBrowseMode; virtual;
  782.     procedure DataSetChanged; virtual;
  783.     procedure DataSetScrolled(Distance: Integer); virtual;
  784.     procedure FocusControl(Field: TFieldRef); virtual;
  785.     procedure EditingChanged; virtual;
  786.     procedure LayoutChanged; virtual;
  787.     procedure RecordChanged(Field: TField); virtual;
  788.     procedure UpdateData; virtual;
  789.   public
  790.     constructor Create;
  791.     destructor Destroy; override;
  792.     function Edit: Boolean;
  793.     procedure UpdateRecord;
  794.     property Active: Boolean;
  795.     property ActiveRecord: Integer;
  796.     property BufferCount: Integer;
  797.     property DataSet: TDataSet;
  798.     property DataSource: TDataSource;
  799.     property DataSourceFixed: Boolean;
  800.     property Editing: Boolean;
  801.     property ReadOnly: Boolean;
  802.     property RecordCount: Integer;
  803.   end;
  804.  
  805. const
  806.   dsEditModes = [dsEdit, dsInsert, dsSetKey];
  807.  
  808. function AnsiToNative(Locale: TLocale; const AnsiStr: string;
  809.   NativeStr: PChar; MaxLen: Integer): PChar;
  810. procedure NativeToAnsi(Locale: TLocale; NativeStr: PChar;
  811.   var AnsiStr: string);
  812. procedure AnsiToNativeBuf(Locale: TLocale; Source, Dest: PChar; Len: Integer);
  813. procedure NativeToAnsiBuf(Locale: TLocale; Source, Dest: PChar; Len: Integer);
  814.  
  815. function NativeCompareStr(Locale: TLocale; const S1, S2: string; Len: Integer): Integer;
  816. function NativeCompareStrBuf(Locale: TLocale; const S1, S2: PChar; Len: Integer): Integer;
  817. function NativeCompareText(Locale: TLocale; const S1, S2: string; Len: Integer): Integer;
  818. function NativeCompareTextBuf(Locale: TLocale; const S1, S2: PChar; Len: Integer): Integer;
  819.  
  820. function ExtractFieldName(const Fields: string; var Pos: Integer): string;
  821.  
  822. procedure RegisterFields(const FieldClasses: array of TFieldClass);
  823.  
  824. procedure DatabaseError(const Message: string);
  825. procedure DBError(Ident: Word);
  826. procedure DBErrorFmt(Ident: Word; const Args: array of const);
  827. procedure DbiError(ErrorCode: DBIResult);
  828. procedure Check(Status: DBIResult);
  829. procedure RegisterBDEInitProc(const InitProc: TBDEInitProc);
  830.  
  831. var
  832.   Session: TSession;
  833.   Sessions: TSessionList;
  834.  
  835. const
  836.   RegisterFieldsProc: procedure(const FieldClassess: array of TFieldClass) = nil;
  837.  
  838. implementation
  839.