API tools faq
paste
Guest User

Untitled

a guest
Sep 11th, 2013
94
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Pascal 118.02 KB | None | 0 0
raw download clone embed print report
  1. {
  2.     This file is part of the Free Pascal run time library.
  3.     Copyright (c) 1999-2013 by Joost van der Sluis and other members of the
  4.     Free Pascal development team
  5.  
  6.     BufDataset implementation
  7.  
  8.     See the file COPYING.FPC, included in this distribution,
  9.     for details about the copyright.
  10.  
  11.     This program is distributed in the hope that it will be useful,
  12.     but WITHOUT ANY WARRANTY; without even the implied warranty of
  13.     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  14.  
  15.  **********************************************************************}
  16.  
  17. unit BufDataset;
  18.  
  19. {$mode objfpc}
  20. {$h+}
  21.  
  22. interface
  23.  
  24. uses Classes,Sysutils,db,bufdataset_parser;
  25.  
  26. type
  27.   TCustomBufDataset = Class;
  28.  
  29.   TResolverErrorEvent = procedure(Sender: TObject; DataSet: TCustomBufDataset; E: EUpdateError;
  30.     UpdateKind: TUpdateKind; var Response: TResolverResponse) of object;
  31.  
  32.   { TBufBlobStream }
  33.  
  34.   PBlobBuffer = ^TBlobBuffer;
  35.   TBlobBuffer = record
  36.     FieldNo : integer;
  37.     OrgBufID: integer;
  38.     Buffer  : pointer;
  39.     Size    : ptrint;
  40.   end;
  41.  
  42.   TBufBlobStream = class(TStream)
  43.   private
  44.     FBlobBuffer : PBlobBuffer;
  45.     FPosition   : ptrint;
  46.     FDataset    : TCustomBufDataset;
  47.   protected
  48.     function Read(var Buffer; Count: Longint): Longint; override;
  49.     function Write(const Buffer; Count: Longint): Longint; override;
  50.     function Seek(Offset: Longint; Origin: Word): Longint; override;
  51.   public
  52.     constructor Create(Field: TBlobField; Mode: TBlobStreamMode);
  53.   end;
  54.  
  55.   { TCustomBufDataset }
  56.  
  57.   PBufRecLinkItem = ^TBufRecLinkItem;
  58.   TBufRecLinkItem = record
  59.     prior   : PBufRecLinkItem;
  60.     next    : PBufRecLinkItem;
  61.   end;
  62.  
  63.   PBufBookmark = ^TBufBookmark;
  64.   TBufBookmark = record
  65.     BookmarkData : PBufRecLinkItem;
  66.     BookmarkInt  : integer;
  67.     BookmarkFlag : TBookmarkFlag;
  68.   end;
  69.  
  70.   TRecUpdateBuffer = record
  71.     UpdateKind         : TUpdateKind;
  72. {  BookMarkData:
  73.      - Is -1 if the update has canceled out. For example: an appended record has been deleted again
  74.      - If UpdateKind is ukInsert, it contains a bookmark to the newly created record
  75.      - If UpdateKind is ukModify, it contains a bookmark to the record with the new data
  76.      - If UpdateKind is ukDelete, it contains a bookmark to the deleted record (ie: the record is still there)
  77. }
  78.     BookmarkData       : TBufBookmark;
  79. {  NextBookMarkData:
  80.      - If UpdateKind is ukDelete, it contains a bookmark to the record just after the deleted record
  81. }
  82.     NextBookmarkData   : TBufBookmark;
  83. {  OldValuesBuffer:
  84.      - If UpdateKind is ukModify, it contains a record buffer which contains the old data
  85.      - If UpdateKind is ukDelete, it contains a record buffer with the data of the deleted record
  86. }
  87.     OldValuesBuffer    : TRecordBuffer;
  88.   end;
  89.   TRecordsUpdateBuffer = array of TRecUpdateBuffer;
  90.  
  91.   PBufBlobField = ^TBufBlobField;
  92.   TBufBlobField = record
  93.     ConnBlobBuffer : array[0..11] of byte; // DB specific data is stored here
  94.     BlobBuffer     : PBlobBuffer;
  95.   end;
  96.  
  97.   TCompareFunc = function(subValue, aValue: pointer; options: TLocateOptions): int64;
  98.  
  99.   TDBCompareRec = record
  100.                    Comparefunc : TCompareFunc;
  101.                    Off1,Off2   : PtrInt;
  102.                    FieldInd1,
  103.                    FieldInd2   : longint;
  104.                    NullBOff1,
  105.                    NullBOff2   : PtrInt;
  106.                    Options     : TLocateOptions;
  107.                    Desc        : Boolean;
  108.                   end;
  109.   TDBCompareStruct = array of TDBCompareRec;
  110.  
  111.   { TBufIndex }
  112.  
  113.   TBufIndex = class(TObject)
  114.   private
  115.     FDataset : TCustomBufDataset;
  116.   protected
  117.     function GetBookmarkSize: integer; virtual; abstract;
  118.     function GetCurrentBuffer: Pointer; virtual; abstract;
  119.     function GetCurrentRecord: TRecordBuffer; virtual; abstract;
  120.     function GetIsInitialized: boolean; virtual; abstract;
  121.     function GetSpareBuffer: TRecordBuffer; virtual; abstract;
  122.     function GetSpareRecord: TRecordBuffer; virtual; abstract;
  123.   public
  124.     DBCompareStruct : TDBCompareStruct;
  125.     Name            : String;
  126.     FieldsName      : String;
  127.     CaseinsFields   : String;
  128.     DescFields      : String;
  129.     Options         : TIndexOptions;
  130.     IndNr           : integer;
  131.     constructor Create(const ADataset : TCustomBufDataset); virtual;
  132.     function ScrollBackward : TGetResult; virtual; abstract;
  133.     function ScrollForward : TGetResult;  virtual; abstract;
  134.     function GetCurrent : TGetResult;  virtual; abstract;
  135.     function ScrollFirst : TGetResult;  virtual; abstract;
  136.     procedure ScrollLast; virtual; abstract;
  137.  
  138.     procedure SetToFirstRecord; virtual; abstract;
  139.     procedure SetToLastRecord; virtual; abstract;
  140.  
  141.     procedure StoreCurrentRecord;  virtual; abstract;
  142.     procedure RestoreCurrentRecord;  virtual; abstract;
  143.  
  144.     function CanScrollForward : Boolean;  virtual; abstract;
  145.     procedure DoScrollForward;  virtual; abstract;
  146.  
  147.     procedure StoreCurrentRecIntoBookmark(const ABookmark: PBufBookmark);  virtual; abstract;
  148.     procedure StoreSpareRecIntoBookmark(const ABookmark: PBufBookmark);  virtual; abstract;
  149.     procedure GotoBookmark(const ABookmark : PBufBookmark); virtual; abstract;
  150.     function BookmarkValid(const ABookmark: PBufBookmark): boolean; virtual;
  151.  
  152.     procedure InitialiseIndex; virtual; abstract;
  153.  
  154.     procedure InitialiseSpareRecord(const ASpareRecord : TRecordBuffer); virtual; abstract;
  155.     procedure ReleaseSpareRecord; virtual; abstract;
  156.  
  157.     procedure BeginUpdate; virtual; abstract;
  158.     // Adds a record to the end of the index as the new last record (spare record)
  159.     // Normally only used in GetNextPacket
  160.     procedure AddRecord; virtual; abstract;
  161.     // Inserts a record before the current record, or if the record is sorted,
  162.     // inserts it in the proper position
  163.     procedure InsertRecordBeforeCurrentRecord(Const ARecord : TRecordBuffer); virtual; abstract;
  164.     procedure RemoveRecordFromIndex(const ABookmark : TBufBookmark); virtual; abstract;
  165.     procedure OrderCurrentRecord; virtual; abstract;
  166.     procedure EndUpdate; virtual; abstract;
  167.  
  168.     function CompareBookmarks(const ABookmark1, ABookmark2 : PBufBookmark) : boolean; virtual;
  169.     Function GetRecNo(const ABookmark : PBufBookmark) : integer; virtual; abstract;
  170.  
  171.     property SpareRecord : TRecordBuffer read GetSpareRecord;
  172.     property SpareBuffer : TRecordBuffer read GetSpareBuffer;
  173.     property CurrentRecord : TRecordBuffer read GetCurrentRecord;
  174.     property CurrentBuffer : Pointer read GetCurrentBuffer;
  175.     property IsInitialized : boolean read GetIsInitialized;
  176.     property BookmarkSize : integer read GetBookmarkSize;
  177.   end;
  178.  
  179.   { TDoubleLinkedBufIndex }
  180.  
  181.   TDoubleLinkedBufIndex = class(TBufIndex)
  182.   private
  183.     FCursOnFirstRec : boolean;
  184.  
  185.     FStoredRecBuf  : PBufRecLinkItem;
  186.     FCurrentRecBuf  : PBufRecLinkItem;
  187.   protected
  188.     function GetBookmarkSize: integer; override;
  189.     function GetCurrentBuffer: Pointer; override;
  190.     function GetCurrentRecord: TRecordBuffer; override;
  191.     function GetIsInitialized: boolean; override;
  192.     function GetSpareBuffer: TRecordBuffer; override;
  193.     function GetSpareRecord: TRecordBuffer; override;
  194.   public
  195.     FLastRecBuf     : PBufRecLinkItem;
  196.     FFirstRecBuf    : PBufRecLinkItem;
  197.     FNeedScroll     : Boolean;
  198.     function ScrollBackward : TGetResult; override;
  199.     function ScrollForward : TGetResult; override;
  200.     function GetCurrent : TGetResult; override;
  201.     function ScrollFirst : TGetResult; override;
  202.     procedure ScrollLast; override;
  203.  
  204.     procedure SetToFirstRecord; override;
  205.     procedure SetToLastRecord; override;
  206.  
  207.     procedure StoreCurrentRecord; override;
  208.     procedure RestoreCurrentRecord; override;
  209.  
  210.     function CanScrollForward : Boolean; override;
  211.     procedure DoScrollForward; override;
  212.  
  213.     procedure StoreCurrentRecIntoBookmark(const ABookmark: PBufBookmark); override;
  214.     procedure StoreSpareRecIntoBookmark(const ABookmark: PBufBookmark); override;
  215.     procedure GotoBookmark(const ABookmark : PBufBookmark); override;
  216.  
  217.     procedure InitialiseIndex; override;
  218.  
  219.     procedure InitialiseSpareRecord(const ASpareRecord : TRecordBuffer); override;
  220.     procedure ReleaseSpareRecord; override;
  221.  
  222.     Function GetRecNo(const ABookmark : PBufBookmark) : integer; override;
  223.  
  224.     procedure BeginUpdate; override;
  225.     procedure AddRecord; override;
  226.     procedure InsertRecordBeforeCurrentRecord(Const ARecord : TRecordBuffer); override;
  227.     procedure RemoveRecordFromIndex(const ABookmark : TBufBookmark); override;
  228.     procedure OrderCurrentRecord; override;
  229.     procedure EndUpdate; override;
  230.   end;
  231.  
  232.   { TUniDirectionalBufIndex }
  233.  
  234.   TUniDirectionalBufIndex = class(TBufIndex)
  235.   private
  236.     FSPareBuffer:  TRecordBuffer;
  237.   protected
  238.     function GetBookmarkSize: integer; override;
  239.     function GetCurrentBuffer: Pointer; override;
  240.     function GetCurrentRecord: TRecordBuffer; override;
  241.     function GetIsInitialized: boolean; override;
  242.     function GetSpareBuffer: TRecordBuffer; override;
  243.     function GetSpareRecord: TRecordBuffer; override;
  244.   public
  245.     function ScrollBackward : TGetResult; override;
  246.     function ScrollForward : TGetResult; override;
  247.     function GetCurrent : TGetResult; override;
  248.     function ScrollFirst : TGetResult; override;
  249.     procedure ScrollLast; override;
  250.  
  251.     procedure SetToFirstRecord; override;
  252.     procedure SetToLastRecord; override;
  253.  
  254.     procedure StoreCurrentRecord; override;
  255.     procedure RestoreCurrentRecord; override;
  256.  
  257.     function CanScrollForward : Boolean; override;
  258.     procedure DoScrollForward; override;
  259.  
  260.     procedure StoreCurrentRecIntoBookmark(const ABookmark: PBufBookmark); override;
  261.     procedure StoreSpareRecIntoBookmark(const ABookmark: PBufBookmark); override;
  262.     procedure GotoBookmark(const ABookmark : PBufBookmark); override;
  263.  
  264.     procedure InitialiseIndex; override;
  265.     procedure InitialiseSpareRecord(const ASpareRecord : TRecordBuffer); override;
  266.     procedure ReleaseSpareRecord; override;
  267.  
  268.     Function GetRecNo(const ABookmark : PBufBookmark) : integer; override;
  269.  
  270.     procedure BeginUpdate; override;
  271.     procedure AddRecord; override;
  272.     procedure InsertRecordBeforeCurrentRecord(Const ARecord : TRecordBuffer); override;
  273.     procedure RemoveRecordFromIndex(const ABookmark : TBufBookmark); override;
  274.     procedure OrderCurrentRecord; override;
  275.     procedure EndUpdate; override;
  276.   end;
  277.  
  278.  
  279.   { TArrayBufIndex }
  280.  
  281.   TArrayBufIndex = class(TBufIndex)
  282.   private
  283.     FStoredRecBuf  : integer;
  284.  
  285.     FInitialBuffers,
  286.     FGrowBuffer     : integer;
  287.     Function GetRecordFromBookmark(ABookmark: TBufBookmark) : integer;
  288.   protected
  289.     function GetBookmarkSize: integer; override;
  290.     function GetCurrentBuffer: Pointer; override;
  291.     function GetCurrentRecord: TRecordBuffer; override;
  292.     function GetIsInitialized: boolean; override;
  293.     function GetSpareBuffer: TRecordBuffer; override;
  294.     function GetSpareRecord: TRecordBuffer; override;
  295.   public
  296.     FCurrentRecInd  : integer;
  297.     FRecordArray    : array of Pointer;
  298.     FLastRecInd     : integer;
  299.     FNeedScroll     : Boolean;
  300.     constructor Create(const ADataset: TCustomBufDataset); override;
  301.     function ScrollBackward : TGetResult; override;
  302.     function ScrollForward : TGetResult; override;
  303.     function GetCurrent : TGetResult; override;
  304.     function ScrollFirst : TGetResult; override;
  305.     procedure ScrollLast; override;
  306.  
  307.     procedure SetToFirstRecord; override;
  308.     procedure SetToLastRecord; override;
  309.  
  310.     procedure StoreCurrentRecord; override;
  311.     procedure RestoreCurrentRecord; override;
  312.  
  313.     function CanScrollForward : Boolean; override;
  314.     procedure DoScrollForward; override;
  315.  
  316.     procedure StoreCurrentRecIntoBookmark(const ABookmark: PBufBookmark); override;
  317.     procedure StoreSpareRecIntoBookmark(const ABookmark: PBufBookmark); override;
  318.     procedure GotoBookmark(const ABookmark : PBufBookmark); override;
  319.  
  320.     procedure InitialiseIndex; override;
  321.  
  322.     procedure InitialiseSpareRecord(const ASpareRecord : TRecordBuffer); override;
  323.     procedure ReleaseSpareRecord; override;
  324.  
  325.     Function GetRecNo(const ABookmark : PBufBookmark) : integer; override;
  326.  
  327.     procedure BeginUpdate; override;
  328.     procedure AddRecord; override;
  329.     procedure InsertRecordBeforeCurrentRecord(Const ARecord : TRecordBuffer); override;
  330.     procedure RemoveRecordFromIndex(const ABookmark : TBufBookmark); override;
  331.     procedure EndUpdate; override;
  332.   end;
  333.  
  334.  
  335.   { TBufDatasetReader }
  336.  
  337. type
  338.   TRowStateValue = (rsvOriginal, rsvDeleted, rsvInserted, rsvUpdated, rsvDetailUpdates);
  339.   TRowState = set of TRowStateValue;
  340.  
  341. type
  342.  
  343.   { TDataPacketReader }
  344.  
  345.   TDataPacketFormat = (dfBinary,dfXML,dfXMLUTF8,dfAny);
  346.  
  347.   TDatapacketReaderClass = class of TDatapacketReader;
  348.   TDataPacketReader = class(TObject)
  349.     FStream : TStream;
  350.   protected
  351.     class function RowStateToByte(const ARowState : TRowState) : byte;
  352.     class function ByteToRowState(const AByte : Byte) : TRowState;
  353.     class procedure RestoreBlobField(ADataset: TCustomBufDataset; AField: TField; ASource: pointer; ASize: integer);
  354.   public
  355.     constructor create(AStream : TStream); virtual;
  356.     // Load a dataset from stream:
  357.     // Load the field definitions from a stream.
  358.     procedure LoadFieldDefs(AFieldDefs : TFieldDefs; var AnAutoIncValue : integer); virtual; abstract;
  359.     // Is called before the records are loaded
  360.     procedure InitLoadRecords; virtual; abstract;
  361.     // Returns if there is at least one more record available in the stream
  362.     function GetCurrentRecord : boolean; virtual; abstract;
  363.     // Return the RowState of the current record, and the order of the update
  364.     function GetRecordRowState(out AUpdOrder : Integer) : TRowState; virtual; abstract;
  365.     // Store a record from stream in the current record buffer
  366.     procedure RestoreRecord(ADataset : TCustomBufDataset); virtual; abstract;
  367.     // Move the stream to the next record
  368.     procedure GotoNextRecord; virtual; abstract;
  369.  
  370.     // Store a dataset to stream:
  371.     // Save the field definitions to a stream.
  372.     procedure StoreFieldDefs(AFieldDefs : TFieldDefs; AnAutoIncValue : integer); virtual; abstract;
  373.     // Save a record from the current record buffer to the stream
  374.     procedure StoreRecord(ADataset : TCustomBufDataset; ARowState : TRowState; AUpdOrder : integer = 0); virtual; abstract;
  375.     // Is called after all records are stored
  376.     procedure FinalizeStoreRecords; virtual; abstract;
  377.     // Checks if the provided stream is of the right format for this class
  378.     class function RecognizeStream(AStream : TStream) : boolean; virtual; abstract;
  379.     property Stream: TStream read FStream;
  380.   end;
  381.  
  382.   { TFpcBinaryDatapacketReader }
  383.  
  384.   TFpcBinaryDatapacketReader = class(TDataPacketReader)
  385.   private
  386.     const
  387.       FpcBinaryIdent1 = 'BinBufDataset'; // Old version 1; support for transient period;
  388.       FpcBinaryIdent2 = 'BinBufDataSet';
  389.       StringFieldTypes = [ftString,ftFixedChar,ftWideString,ftFixedWideChar];
  390.       BlobFieldTypes = [ftBlob,ftMemo,ftWideMemo];
  391.       VarLenFieldTypes = StringFieldTypes + BlobFieldTypes + [ftBytes,ftVarBytes];
  392.     var
  393.       FVersion: byte;
  394.   public
  395.     procedure LoadFieldDefs(AFieldDefs : TFieldDefs; var AnAutoIncValue : integer); override;
  396.     procedure StoreFieldDefs(AFieldDefs : TFieldDefs; AnAutoIncValue : integer); override;
  397.     procedure InitLoadRecords; override;
  398.     function GetCurrentRecord : boolean; override;
  399.     function GetRecordRowState(out AUpdOrder : Integer) : TRowState; override;
  400.     procedure RestoreRecord(ADataset : TCustomBufDataset); override;
  401.     procedure GotoNextRecord; override;
  402.     procedure StoreRecord(ADataset : TCustomBufDataset; ARowState : TRowState; AUpdOrder : integer = 0); override;
  403.     procedure FinalizeStoreRecords; override;
  404.     class function RecognizeStream(AStream : TStream) : boolean; override;
  405.   end;
  406.  
  407.  
  408.   TCustomBufDataset = class(TDBDataSet)
  409.   private
  410.     FFileName: string;
  411.     FReadFromFile   : boolean;
  412.     FFileStream     : TFileStream;
  413.     FDatasetReader  : TDataPacketReader;
  414.  
  415.     FIndexes        : array of TBufIndex;
  416.     FMaxIndexesCount: integer;
  417.     FIndexesCount   : integer;
  418.     FCurrentIndex   : TBufIndex;
  419.  
  420.     FFilterBuffer   : TRecordBuffer;
  421.     FBRecordCount   : integer;
  422.     FReadOnly       : Boolean;
  423.  
  424.     FSavedState     : TDatasetState;
  425.     FPacketRecords  : integer;
  426.     FRecordSize     : Integer;
  427.     FNullmaskSize   : byte;
  428.     FOpen           : Boolean;
  429.     FUpdateBuffer   : TRecordsUpdateBuffer;
  430.     FCurrentUpdateBuffer : integer;
  431.     FAutoIncValue   : longint;
  432.     FAutoIncField   : TAutoIncField;
  433.  
  434.     FIndexDefs      : TIndexDefs;
  435.  
  436.     FParser         : TBufDatasetParser;
  437.  
  438.     FFieldBufPositions : array of longint;
  439.  
  440.     FAllPacketsFetched : boolean;
  441.     FOnUpdateError  : TResolverErrorEvent;
  442.  
  443.     FBlobBuffers      : array of PBlobBuffer;
  444.     FUpdateBlobBuffers: array of PBlobBuffer;
  445.  
  446.     procedure FetchAll;
  447.     procedure ProcessFieldsToCompareStruct(const AFields, ADescFields, ACInsFields: TList;
  448.       const AIndexOptions: TIndexOptions; const ALocateOptions: TLocateOptions; out ACompareStruct: TDBCompareStruct);
  449.     procedure BuildIndex(var AIndex : TBufIndex);
  450.     function BufferOffset: integer;
  451.     function GetIndexDefs : TIndexDefs;
  452.     function  GetCurrentBuffer: TRecordBuffer;
  453.     procedure CalcRecordSize;
  454.     function GetIndexFieldNames: String;
  455.     function GetIndexName: String;
  456.     function GetBufUniDirectional: boolean;
  457.     function GetPacketReader(const Format: TDataPacketFormat; const AStream: TStream): TDataPacketReader;
  458.     function LoadBuffer(Buffer : TRecordBuffer): TGetResult;
  459.     function GetFieldSize(FieldDef : TFieldDef) : longint;
  460.     function GetRecordUpdateBuffer(const ABookmark : TBufBookmark; IncludePrior : boolean = false; AFindNext : boolean = false) : boolean;
  461.     function GetRecordUpdateBufferCached(const ABookmark : TBufBookmark; IncludePrior : boolean = false) : boolean;
  462.     function GetActiveRecordUpdateBuffer : boolean;
  463.     procedure SetIndexFieldNames(const AValue: String);
  464.     procedure SetIndexName(AValue: String);
  465.     procedure SetMaxIndexesCount(const AValue: Integer);
  466.     procedure SetPacketRecords(aValue : integer);
  467.     function  IntAllocRecordBuffer: TRecordBuffer;
  468.     procedure ParseFilter(const AFilter: string);
  469.     procedure IntLoadFielddefsFromFile;
  470.     procedure IntLoadRecordsFromFile;
  471.     procedure CurrentRecordToBuffer(Buffer: TRecordBuffer);
  472.     procedure SetBufUniDirectional(const AValue: boolean);
  473.     procedure InitDefaultIndexes;
  474.   protected
  475.     function GetNewWriteBlobBuffer : PBlobBuffer;
  476.     procedure FreeBlobBuffer(var ABlobBuffer: PBlobBuffer);
  477.     procedure UpdateIndexDefs; override;
  478.     procedure SetRecNo(Value: Longint); override;
  479.     function  GetRecNo: Longint; override;
  480.     function GetChangeCount: integer; virtual;
  481.     function  AllocRecordBuffer: TRecordBuffer; override;
  482.     procedure FreeRecordBuffer(var Buffer: TRecordBuffer); override;
  483.     procedure ClearCalcFields(Buffer: TRecordBuffer); override;
  484.     procedure InternalInitRecord(Buffer: TRecordBuffer); override;
  485.     function  GetCanModify: Boolean; override;
  486.     function GetRecord(Buffer: TRecordBuffer; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override;
  487.     procedure DoBeforeClose; override;
  488.     procedure InternalOpen; override;
  489.     procedure InternalClose; override;
  490.     function getnextpacket : integer;
  491.     function GetRecordSize: Word; override;
  492.     procedure InternalAddIndex(const AName, AFields : string; AOptions : TIndexOptions; const ADescFields: string;
  493.       const ACaseInsFields: string); virtual;
  494.     procedure InternalPost; override;
  495.     procedure InternalCancel; Override;
  496.     procedure InternalDelete; override;
  497.     procedure InternalFirst; override;
  498.     procedure InternalLast; override;
  499.     procedure InternalSetToRecord(Buffer: TRecordBuffer); override;
  500.     procedure InternalGotoBookmark(ABookmark: Pointer); override;
  501.     procedure SetBookmarkData(Buffer: TRecordBuffer; Data: Pointer); override;
  502.     procedure SetBookmarkFlag(Buffer: TRecordBuffer; Value: TBookmarkFlag); override;
  503.     procedure GetBookmarkData(Buffer: TRecordBuffer; Data: Pointer); override;
  504.     function GetBookmarkFlag(Buffer: TRecordBuffer): TBookmarkFlag; override;
  505.     function IsCursorOpen: Boolean; override;
  506.     function  GetRecordCount: Longint; override;
  507.     procedure ApplyRecUpdate(UpdateKind : TUpdateKind); virtual;
  508.     procedure SetOnUpdateError(const aValue: TResolverErrorEvent);
  509.     procedure SetFilterText(const Value: String); override; {virtual;}
  510.     procedure SetFiltered(Value: Boolean); override; {virtual;}
  511.     procedure InternalRefresh; override;
  512.     procedure DataEvent(Event: TDataEvent; Info: Ptrint); override;
  513.     procedure BeforeRefreshOpenCursor; virtual;
  514.     procedure DoFilterRecord(out Acceptable: Boolean); virtual;
  515.     procedure SetReadOnly(AValue: Boolean); virtual;
  516.   {abstracts, must be overidden by descendents}
  517.     function Fetch : boolean; virtual;
  518.     function LoadField(FieldDef : TFieldDef;buffer : pointer; out CreateBlob : boolean) : boolean; virtual;
  519.     procedure LoadBlobIntoBuffer(FieldDef: TFieldDef;ABlobBuf: PBufBlobField); virtual; abstract;
  520.     function IsReadFromPacket : Boolean;
  521.   public
  522.     constructor Create(AOwner: TComponent); override;
  523.     function GetFieldData(Field: TField; Buffer: Pointer;
  524.       NativeFormat: Boolean): Boolean; override;
  525.     function GetFieldData(Field: TField; Buffer: Pointer): Boolean; override;
  526.     procedure SetFieldData(Field: TField; Buffer: Pointer;
  527.       NativeFormat: Boolean); override;
  528.     procedure SetFieldData(Field: TField; Buffer: Pointer); override;
  529.     procedure ApplyUpdates; virtual; overload;
  530.     procedure ApplyUpdates(MaxErrors: Integer); virtual; overload;
  531.     procedure MergeChangeLog;
  532.     procedure CancelUpdates; virtual;
  533.     destructor Destroy; override;
  534.     function Locate(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions) : boolean; override;
  535.     function Lookup(const KeyFields: string; const KeyValues: Variant; const ResultFields: string): Variant; override;
  536.     function UpdateStatus: TUpdateStatus; override;
  537.     function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override;
  538.     procedure AddIndex(const AName, AFields : string; AOptions : TIndexOptions; const ADescFields: string = '';
  539.       const ACaseInsFields: string = ''); virtual;
  540.     function GetNewBlobBuffer : PBlobBuffer;
  541.  
  542.     procedure SetDatasetPacket(AReader : TDataPacketReader);
  543.     procedure GetDatasetPacket(AWriter : TDataPacketReader);
  544.     procedure LoadFromStream(AStream : TStream; Format: TDataPacketFormat = dfAny);
  545.     procedure SaveToStream(AStream : TStream; Format: TDataPacketFormat = dfBinary);
  546.     procedure LoadFromFile(AFileName: string = ''; Format: TDataPacketFormat = dfAny);
  547.     procedure SaveToFile(AFileName: string = ''; Format: TDataPacketFormat = dfBinary);
  548.     procedure CreateDataset;
  549.     function BookmarkValid(ABookmark: TBookmark): Boolean; override;
  550.     function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Longint; override;
  551.  
  552.     property ChangeCount : Integer read GetChangeCount;
  553.     property MaxIndexesCount : Integer read FMaxIndexesCount write SetMaxIndexesCount default 2;
  554.     property ReadOnly : Boolean read FReadOnly write SetReadOnly default false;
  555.   published
  556.     property FileName : string read FFileName write FFileName;
  557.     property PacketRecords : Integer read FPacketRecords write SetPacketRecords default 10;
  558.     property OnUpdateError: TResolverErrorEvent read FOnUpdateError write SetOnUpdateError;
  559.     property IndexDefs : TIndexDefs read GetIndexDefs;
  560.     property IndexName : String read GetIndexName write SetIndexName;
  561.     property IndexFieldNames : String read GetIndexFieldNames write SetIndexFieldNames;
  562.     property UniDirectional: boolean read GetBufUniDirectional write SetBufUniDirectional default False;
  563.   end;
  564.  
  565.   TBufDataset = class(TCustomBufDataset)
  566.   published
  567.     property MaxIndexesCount;
  568.     // TDataset stuff
  569.     property FieldDefs;
  570.     Property Active;
  571.     Property AutoCalcFields;
  572.     Property Filter;
  573.     Property Filtered;
  574.     Property ReadOnly;
  575.     Property AfterCancel;
  576.     Property AfterClose;
  577.     Property AfterDelete;
  578.     Property AfterEdit;
  579.     Property AfterInsert;
  580.     Property AfterOpen;
  581.     Property AfterPost;
  582.     Property AfterScroll;
  583.     Property BeforeCancel;
  584.     Property BeforeClose;
  585.     Property BeforeDelete;
  586.     Property BeforeEdit;
  587.     Property BeforeInsert;
  588.     Property BeforeOpen;
  589.     Property BeforePost;
  590.     Property BeforeScroll;
  591.     Property OnCalcFields;
  592.     Property OnDeleteError;
  593.     Property OnEditError;
  594.     Property OnFilterRecord;
  595.     Property OnNewRecord;
  596.     Property OnPostError;
  597.   end;
  598.  
  599.  
  600. procedure RegisterDatapacketReader(ADatapacketReaderClass : TDatapacketReaderClass; AFormat : TDataPacketFormat);
  601.  
  602. implementation
  603.  
  604. uses variants, dbconst, FmtBCD;
  605.  
  606. Type TDatapacketReaderRegistration = record
  607.                                        ReaderClass : TDatapacketReaderClass;
  608.                                        Format      : TDataPacketFormat;
  609.                                      end;
  610.  
  611. var RegisteredDatapacketReaders : Array of TDatapacketReaderRegistration;
  612.  
  613. procedure RegisterDatapacketReader(ADatapacketReaderClass : TDatapacketReaderClass; AFormat : TDataPacketFormat);
  614. begin
  615.   setlength(RegisteredDatapacketReaders,length(RegisteredDatapacketReaders)+1);
  616.   with RegisteredDatapacketReaders[length(RegisteredDatapacketReaders)-1] do
  617.     begin
  618.     Readerclass := ADatapacketReaderClass;
  619.     Format      := AFormat;
  620.     end;
  621. end;
  622.  
  623. function GetRegisterDatapacketReader(AStream : TStream; AFormat : TDataPacketFormat; var ADataReaderClass : TDatapacketReaderRegistration) : boolean;
  624. var i : integer;
  625. begin
  626.   Result := False;
  627.   for i := 0 to length(RegisteredDatapacketReaders)-1 do if ((AFormat=dfAny) or (AFormat=RegisteredDatapacketReaders[i].Format)) then
  628.     begin
  629.     if (AStream=nil) or (RegisteredDatapacketReaders[i].ReaderClass.RecognizeStream(AStream)) then
  630.       begin
  631.       ADataReaderClass := RegisteredDatapacketReaders[i];
  632.       Result := True;
  633.       if (AStream <> nil) then AStream.Seek(0,soFromBeginning);
  634.       break;
  635.       end;
  636.     AStream.Seek(0,soFromBeginning);
  637.     end;
  638. end;
  639.  
  640. function DBCompareText(subValue, aValue: pointer; options: TLocateOptions): LargeInt;
  641. begin
  642.   if [loCaseInsensitive,loPartialKey]=options then
  643.     Result := AnsiStrLIComp(pchar(subValue),pchar(aValue),length(pchar(subValue)))
  644.   else if [loPartialKey] = options then
  645.     Result := AnsiStrLComp(pchar(subValue),pchar(aValue),length(pchar(subValue)))
  646.   else if [loCaseInsensitive] = options then
  647.     Result := AnsiCompareText(pchar(subValue),pchar(aValue))
  648.   else
  649.     Result := AnsiCompareStr(pchar(subValue),pchar(aValue));
  650. end;
  651.  
  652. function DBCompareWideText(subValue, aValue: pointer; options: TLocateOptions): LargeInt;
  653. begin
  654.   if [loCaseInsensitive,loPartialKey]=options then
  655.     Result := WideCompareText(pwidechar(subValue),LeftStr(pwidechar(aValue), Length(pwidechar(subValue))))
  656.   else if [loPartialKey] = options then
  657.       Result := WideCompareStr(pwidechar(subValue),LeftStr(pwidechar(aValue), Length(pwidechar(subValue))))
  658.     else if [loCaseInsensitive] = options then
  659.          Result := WideCompareText(pwidechar(subValue),pwidechar(aValue))
  660.        else
  661.          Result := WideCompareStr(pwidechar(subValue),pwidechar(aValue));
  662. end;
  663.  
  664. function DBCompareByte(subValue, aValue: pointer; options: TLocateOptions): LargeInt;
  665.  
  666. begin
  667.   Result := PByte(subValue)^-PByte(aValue)^;
  668. end;
  669.  
  670. function DBCompareSmallInt(subValue, aValue: pointer; options: TLocateOptions): LargeInt;
  671.  
  672. begin
  673.   Result := PSmallInt(subValue)^-PSmallInt(aValue)^;
  674. end;
  675.  
  676. function DBCompareInt(subValue, aValue: pointer; options: TLocateOptions): LargeInt;
  677.  
  678. begin
  679.   Result := PInteger(subValue)^-PInteger(aValue)^;
  680. end;
  681.  
  682. function DBCompareLargeInt(subValue, aValue: pointer; options: TLocateOptions): LargeInt;
  683.  
  684. begin
  685.   // A simple subtraction doesn't work, since it could be that the result
  686.   // doesn't fit into a LargeInt
  687.   if PLargeInt(subValue)^ < PLargeInt(aValue)^ then
  688.     result := -1
  689.   else if PLargeInt(subValue)^  > PLargeInt(aValue)^ then
  690.     result := 1
  691.   else
  692.     result := 0;
  693. end;
  694.  
  695. function DBCompareWord(subValue, aValue: pointer; options: TLocateOptions): LargeInt;
  696.  
  697. begin
  698.   Result := PWord(subValue)^-PWord(aValue)^;
  699. end;
  700.  
  701. function DBCompareQWord(subValue, aValue: pointer; options: TLocateOptions): LargeInt;
  702.  
  703. begin
  704.   // A simple subtraction doesn't work, since it could be that the result
  705.   // doesn't fit into a LargeInt
  706.   if PQWord(subValue)^ < PQWord(aValue)^ then
  707.     result := -1
  708.   else if PQWord(subValue)^  > PQWord(aValue)^ then
  709.     result := 1
  710.   else
  711.     result := 0;
  712. end;
  713.  
  714. function DBCompareDouble(subValue, aValue: pointer; options: TLocateOptions): LargeInt;
  715. begin
  716.   // A simple subtraction doesn't work, since it could be that the result
  717.   // doesn't fit into a LargeInt
  718.   if PDouble(subValue)^ < PDouble(aValue)^ then
  719.     result := -1
  720.   else if PDouble(subValue)^  > PDouble(aValue)^ then
  721.     result := 1
  722.   else
  723.     result := 0;
  724. end;
  725.  
  726. function DBCompareBCD(subValue, aValue: pointer; options: TLocateOptions): LargeInt;
  727. begin
  728.   result:=BCDCompare(PBCD(subValue)^, PBCD(aValue)^);
  729. end;
  730.  
  731. procedure unSetFieldIsNull(NullMask : pbyte;x : longint); //inline;
  732. begin
  733.   NullMask[x div 8] := (NullMask[x div 8]) and not (1 shl (x mod 8));
  734. end;
  735.  
  736. procedure SetFieldIsNull(NullMask : pbyte;x : longint); //inline;
  737. begin
  738.   NullMask[x div 8] := (NullMask[x div 8]) or (1 shl (x mod 8));
  739. end;
  740.  
  741. function GetFieldIsNull(NullMask : pbyte;x : longint) : boolean; //inline;
  742. begin
  743.   result := ord(NullMask[x div 8]) and (1 shl (x mod 8)) > 0
  744. end;
  745.  
  746. function IndexCompareRecords(Rec1,Rec2 : pointer; ADBCompareRecs : TDBCompareStruct) : LargeInt;
  747. var IndexFieldNr : Integer;
  748.     IsNull1, IsNull2 : boolean;
  749. begin
  750.   for IndexFieldNr:=0 to length(ADBCompareRecs)-1 do with ADBCompareRecs[IndexFieldNr] do
  751.     begin
  752.     IsNull1:=GetFieldIsNull(rec1+NullBOff1,FieldInd1);
  753.     IsNull2:=GetFieldIsNull(rec2+NullBOff2,FieldInd2);
  754.     if IsNull1 and IsNull2 then
  755.       result := 0
  756.     else if IsNull1 then
  757.       result := -1
  758.     else if IsNull2 then
  759.       result := 1
  760.     else
  761.       Result := Comparefunc(Rec1+Off1,Rec2+Off2,Options);
  762.  
  763.     if Result <> 0 then
  764.       begin
  765.       if Desc then
  766.         Result := -Result;
  767.       break;
  768.       end;
  769.     end;
  770. end;
  771.  
  772. { ---------------------------------------------------------------------
  773.     TCustomBufDataset
  774.   ---------------------------------------------------------------------}
  775.  
  776. constructor TCustomBufDataset.Create(AOwner : TComponent);
  777. begin
  778.   Inherited Create(AOwner);
  779.   FMaxIndexesCount:=2;
  780.   FIndexesCount:=0;
  781.  
  782.   FIndexDefs := TIndexDefs.Create(Self);
  783.   FAutoIncValue:=-1;
  784.  
  785.   SetLength(FUpdateBuffer,0);
  786.   SetLength(FBlobBuffers,0);
  787.   SetLength(FUpdateBlobBuffers,0);
  788.   FParser := nil;
  789.   FPacketRecords := 10;
  790. end;
  791.  
  792. procedure TCustomBufDataset.SetPacketRecords(aValue : integer);
  793. begin
  794.   if (aValue = -1) or (aValue > 0) then FPacketRecords := aValue
  795.     else DatabaseError(SInvPacketRecordsValue);
  796. end;
  797.  
  798. destructor TCustomBufDataset.Destroy;
  799.  
  800. Var
  801.   I : Integer;
  802. begin
  803.   if Active then Close;
  804.   SetLength(FUpdateBuffer,0);
  805.   SetLength(FBlobBuffers,0);
  806.   SetLength(FUpdateBlobBuffers,0);
  807.   For I:=0 to Length(FIndexes)-1 do
  808.     FreeAndNil(Findexes[I]);
  809.   SetLength(FIndexes,0);
  810.   FreeAndNil(FIndexDefs);
  811.   inherited destroy;
  812. end;
  813.  
  814. procedure TCustomBufDataset.FetchAll;
  815. begin
  816.   repeat
  817.   until (getnextpacket < FPacketRecords) or (FPacketRecords = -1);
  818. end;
  819.  
  820. {
  821. // Code to dump raw dataset data, including indexes information, useful for debugging
  822.   procedure DumpRawMem(const Data: pointer; ALength: PtrInt);
  823.   var
  824.     b: integer;
  825.     s1,s2: string;
  826.   begin
  827.     s1 := '';
  828.     s2 := '';
  829.     for b := 0 to ALength-1 do
  830.       begin
  831.       s1 := s1 + ' ' + hexStr(pbyte(Data)[b],2);
  832.       if pchar(Data)[b] in ['a'..'z','A'..'Z','1'..'9',' '..'/',':'..'@'] then
  833.         s2 := s2 + pchar(Data)[b]
  834.       else
  835.         s2 := s2 + '.';
  836.       if length(s2)=16 then
  837.         begin
  838.         write('    ',s1,'    ');
  839.         writeln(s2);
  840.         s1 := '';
  841.         s2 := '';
  842.         end;
  843.       end;
  844.     write('    ',s1,'    ');
  845.     writeln(s2);
  846.   end;
  847.  
  848.   procedure DumpRecord(Dataset: TCustomBufDataset; RecBuf: PBufRecLinkItem; RawData: boolean = false);
  849.   var ptr: pointer;
  850.       NullMask: pointer;
  851.       FieldData: pointer;
  852.       NullMaskSize: integer;
  853.       i: integer;
  854.   begin
  855.     if RawData then
  856.       DumpRawMem(RecBuf,Dataset.RecordSize)
  857.     else
  858.       begin
  859.       ptr := RecBuf;
  860.       NullMask:= ptr + (sizeof(TBufRecLinkItem)*Dataset.MaxIndexesCount);
  861.       NullMaskSize := 1+(Dataset.Fields.Count-1) div 8;
  862.       FieldData:= ptr + (sizeof(TBufRecLinkItem)*Dataset.MaxIndexesCount) +NullMaskSize;
  863.       write('record: $',hexstr(ptr),'  nullmask: $');
  864.       for i := 0 to NullMaskSize-1 do
  865.         write(hexStr(byte((NullMask+i)^),2));
  866.       write('=');
  867.       for i := 0 to NullMaskSize-1 do
  868.         write(binStr(byte((NullMask+i)^),8));
  869.       writeln('%');
  870.       for i := 0 to Dataset.MaxIndexesCount-1 do
  871.         writeln('  ','Index ',inttostr(i),' Prior rec: ' + hexstr(pointer((ptr+(i*2)*sizeof(ptr))^)) + ' Next rec: ' + hexstr(pointer((ptr+((i*2)+1)*sizeof(ptr))^)));
  872.       DumpRawMem(FieldData,Dataset.RecordSize-((sizeof(TBufRecLinkItem)*Dataset.MaxIndexesCount) +NullMaskSize));
  873.       end;
  874.   end;
  875.  
  876.   procedure DumpDataset(AIndex: TBufIndex;RawData: boolean = false);
  877.   var RecBuf: PBufRecLinkItem;
  878.   begin
  879.     writeln('Dump records, order based on index ',AIndex.IndNr);
  880.     writeln('Current record:',hexstr(AIndex.CurrentRecord));
  881.  
  882.     RecBuf:=(AIndex as TDoubleLinkedBufIndex).FFirstRecBuf;
  883.     while RecBuf<>(AIndex as TDoubleLinkedBufIndex).FLastRecBuf do
  884.       begin
  885.       DumpRecord(AIndex.FDataset,RecBuf,RawData);
  886.       RecBuf:=RecBuf[(AIndex as TDoubleLinkedBufIndex).IndNr].next;
  887.       end;
  888.   end;
  889. }
  890.  
  891. procedure TCustomBufDataset.BuildIndex(var AIndex: TBufIndex);
  892.  
  893. var PCurRecLinkItem : PBufRecLinkItem;
  894.     p,l,q           : PBufRecLinkItem;
  895.     i,k,psize,qsize : integer;
  896.     MergeAmount     : integer;
  897.     PlaceQRec       : boolean;
  898.  
  899.     IndexFields     : TList;
  900.     DescIndexFields : TList;
  901.     CInsIndexFields : TList;
  902.  
  903.     Index0,
  904.     DblLinkIndex    : TDoubleLinkedBufIndex;
  905.  
  906.   procedure PlaceNewRec(var e: PBufRecLinkItem; var esize: integer);
  907.   begin
  908.     if DblLinkIndex.FFirstRecBuf=nil then
  909.      begin
  910.      DblLinkIndex.FFirstRecBuf:=e;
  911.      e[DblLinkIndex.IndNr].prior:=nil;
  912.      l:=e;
  913.      end
  914.    else
  915.      begin
  916.      l[DblLinkIndex.IndNr].next:=e;
  917.      e[DblLinkIndex.IndNr].prior:=l;
  918.      l:=e;
  919.      end;
  920.    e := e[DblLinkIndex.IndNr].next;
  921.    dec(esize);
  922.   end;
  923.  
  924. begin
  925.   // Build the DBCompareStructure
  926.   // One AS is enough, and makes debugging easier.
  927.   DblLinkIndex:=(AIndex as TDoubleLinkedBufIndex);
  928.   Index0:=(FIndexes[0] as TDoubleLinkedBufIndex);
  929.   with DblLinkIndex do
  930.     begin
  931.     IndexFields := TList.Create;
  932.     DescIndexFields := TList.Create;
  933.     CInsIndexFields := TList.Create;
  934.     try
  935.       GetFieldList(IndexFields,FieldsName);
  936.       GetFieldList(DescIndexFields,DescFields);
  937.       GetFieldList(CInsIndexFields,CaseinsFields);
  938.       if IndexFields.Count=0 then
  939.         DatabaseError(SNoIndexFieldNameGiven);
  940.       ProcessFieldsToCompareStruct(IndexFields, DescIndexFields, CInsIndexFields, Options, [], DBCompareStruct);
  941.     finally
  942.       CInsIndexFields.Free;
  943.       DescIndexFields.Free;
  944.       IndexFields.Free;
  945.     end;
  946.     end;
  947.  
  948.   // This simply copies the index...
  949.   PCurRecLinkItem:=Index0.FFirstRecBuf;
  950.   PCurRecLinkItem[DblLinkIndex.IndNr].next := PCurRecLinkItem[0].next;
  951.   PCurRecLinkItem[DblLinkIndex.IndNr].prior := PCurRecLinkItem[0].prior;
  952.  
  953.   if PCurRecLinkItem <> Index0.FLastRecBuf then
  954.     begin
  955.     while PCurRecLinkItem^.next<>Index0.FLastRecBuf do
  956.       begin
  957.       PCurRecLinkItem:=PCurRecLinkItem^.next;
  958.  
  959.       PCurRecLinkItem[DblLinkIndex.IndNr].next := PCurRecLinkItem[0].next;
  960.       PCurRecLinkItem[DblLinkIndex.IndNr].prior := PCurRecLinkItem[0].prior;
  961.       end;
  962.     end
  963.   else
  964.     // Empty dataset
  965.     Exit;
  966.  
  967.   // Set FirstRecBuf and FCurrentRecBuf
  968.   DblLinkIndex.FFirstRecBuf:=Index0.FFirstRecBuf;
  969.   DblLinkIndex.FCurrentRecBuf:=DblLinkIndex.FFirstRecBuf;
  970.   // Link in the FLastRecBuf that belongs to this index
  971.   PCurRecLinkItem[DblLinkIndex.IndNr].next:=DblLinkIndex.FLastRecBuf;
  972.   DblLinkIndex.FLastRecBuf[DblLinkIndex.IndNr].prior:=PCurRecLinkItem;
  973.  
  974.   // Mergesort. Used the algorithm as described here by Simon Tatham
  975.   // http://www.chiark.greenend.org.uk/~sgtatham/algorithms/listsort.html
  976.   // The comments in the code are from this website.
  977.  
  978.   // In each pass, we are merging lists of size K into lists of size 2K.
  979.   // (Initially K equals 1.)
  980.   k:=1;
  981.  
  982.   repeat
  983.  
  984.   // So we start by pointing a temporary pointer p at the head of the list,
  985.   // and also preparing an empty list L which we will add elements to the end
  986.   // of as we finish dealing with them.
  987.   p := DblLinkIndex.FFirstRecBuf;
  988.   DblLinkIndex.FFirstRecBuf := nil;
  989.   q := p;
  990.   MergeAmount := 0;
  991.  
  992.   // Then:
  993.   // * If p is null, terminate this pass.
  994.   while p <> DblLinkIndex.FLastRecBuf do
  995.     begin
  996.  
  997.     //  * Otherwise, there is at least one element in the next pair of length-K
  998.     //    lists, so increment the number of merges performed in this pass.
  999.     inc(MergeAmount);
  1000.  
  1001.     //  * Point another temporary pointer, q, at the same place as p. Step q along
  1002.     //    the list by K places, or until the end of the list, whichever comes
  1003.     //    first. Let psize be the number of elements you managed to step q past.
  1004.     i:=0;
  1005.     while (i<k) and (q<>DblLinkIndex.FLastRecBuf) do
  1006.       begin
  1007.       inc(i);
  1008.       q := q[DblLinkIndex.IndNr].next;
  1009.       end;
  1010.     psize :=i;
  1011.  
  1012.     //  * Let qsize equal K. Now we need to merge a list starting at p, of length
  1013.     //    psize, with a list starting at q of length at most qsize.
  1014.     qsize:=k;
  1015.  
  1016.     //  * So, as long as either the p-list is non-empty (psize > 0) or the q-list
  1017.     //    is non-empty (qsize > 0 and q points to something non-null):
  1018.     while (psize>0) or ((qsize>0) and (q <> DblLinkIndex.FLastRecBuf)) do
  1019.       begin
  1020.       //  * Choose which list to take the next element from. If either list
  1021.       //    is empty, we must choose from the other one. (By assumption, at
  1022.       //    least one is non-empty at this point.) If both lists are
  1023.       //    non-empty, compare the first element of each and choose the lower
  1024.       //    one. If the first elements compare equal, choose from the p-list.
  1025.       //    (This ensures that any two elements which compare equal are never
  1026.       //    swapped, so stability is guaranteed.)
  1027.       if (psize=0)  then
  1028.         PlaceQRec := true
  1029.       else if (qsize=0) or (q = DblLinkIndex.FLastRecBuf) then
  1030.         PlaceQRec := False
  1031.       else if IndexCompareRecords(p,q,DblLinkIndex.DBCompareStruct) <= 0 then
  1032.         PlaceQRec := False
  1033.       else
  1034.         PlaceQRec := True;
  1035.        
  1036.       //  * Remove that element, e, from the start of its list, by advancing
  1037.       //    p or q to the next element along, and decrementing psize or qsize.
  1038.       //  * Add e to the end of the list L we are building up.
  1039.       if PlaceQRec then
  1040.         PlaceNewRec(q,qsize)
  1041.       else
  1042.         PlaceNewRec(p,psize);
  1043.       end;
  1044.      
  1045.     //  * Now we have advanced p until it is where q started out, and we have
  1046.     //    advanced q until it is pointing at the next pair of length-K lists to
  1047.     //    merge. So set p to the value of q, and go back to the start of this loop.
  1048.     p:=q;
  1049.     end;
  1050.  
  1051.   // As soon as a pass like this is performed and only needs to do one merge, the
  1052.   // algorithm terminates, and the output list L is sorted. Otherwise, double the
  1053.   // value of K, and go back to the beginning.
  1054.  
  1055.   l[DblLinkIndex.IndNr].next:=DblLinkIndex.FLastRecBuf;
  1056.  
  1057.   k:=k*2;
  1058.  
  1059.   until MergeAmount = 1;
  1060.   DblLinkIndex.FLastRecBuf[DblLinkIndex.IndNr].next:=DblLinkIndex.FFirstRecBuf;
  1061.   DblLinkIndex.FLastRecBuf[DblLinkIndex.IndNr].prior:=l;
  1062. end;
  1063.  
  1064. function TCustomBufDataset.GetIndexDefs : TIndexDefs;
  1065.  
  1066. begin
  1067.   Result := FIndexDefs;
  1068. end;
  1069.  
  1070. procedure TCustomBufDataset.UpdateIndexDefs;
  1071. var i : integer;
  1072. begin
  1073.   FIndexDefs.Clear;
  1074.   for i := 0 to high(FIndexes) do with FIndexDefs.AddIndexDef do
  1075.     begin
  1076.     Name := FIndexes[i].Name;
  1077.     Fields := FIndexes[i].FieldsName;
  1078.     DescFields:= FIndexes[i].DescFields;
  1079.     CaseInsFields:=FIndexes[i].CaseinsFields;
  1080.     Options:=FIndexes[i].Options;
  1081.     end;
  1082. end;
  1083.  
  1084. Function TCustomBufDataset.GetCanModify: Boolean;
  1085. begin
  1086.   Result:=not (UniDirectional or ReadOnly);
  1087. end;
  1088.  
  1089. function TCustomBufDataset.BufferOffset: integer;
  1090. begin
  1091.   // Returns the offset of data buffer in bufdataset record
  1092.   Result := sizeof(TBufRecLinkItem) * FMaxIndexesCount;
  1093. end;
  1094.  
  1095. function TCustomBufDataset.IntAllocRecordBuffer: TRecordBuffer;
  1096. begin
  1097.   // Note: Only the internal buffers of TDataset provide bookmark information
  1098.   result := AllocMem(FRecordSize+BufferOffset);
  1099. end;
  1100.  
  1101. function TCustomBufDataset.AllocRecordBuffer: TRecordBuffer;
  1102. begin
  1103.   result := AllocMem(FRecordSize + BookmarkSize + CalcFieldsSize);
  1104.   // The records are initialised, or else the fields of an empty, just-opened dataset
  1105.   // are not null
  1106.   InitRecord(result);
  1107. end;
  1108.  
  1109. procedure TCustomBufDataset.FreeRecordBuffer(var Buffer: TRecordBuffer);
  1110. begin
  1111.   ReAllocMem(Buffer,0);
  1112. end;
  1113.  
  1114. procedure TCustomBufDataset.ClearCalcFields(Buffer: TRecordBuffer);
  1115. begin
  1116.   if CalcFieldsSize > 0 then
  1117.     FillByte((Buffer+RecordSize)^,CalcFieldsSize,0);
  1118. end;
  1119.  
  1120. procedure TCustomBufDataset.InternalOpen;
  1121.  
  1122. var IndexNr : integer;
  1123.     i : integer;
  1124.  
  1125. begin
  1126.   FAutoIncField:=nil;
  1127.   if not Assigned(FDatasetReader) and (FileName<>'') then
  1128.     begin
  1129.     FFileStream := TFileStream.Create(FileName,fmOpenRead);
  1130.     FDatasetReader := GetPacketReader(dfAny, FFileStream);
  1131.     end;
  1132.   if assigned(FDatasetReader) then
  1133.     begin
  1134.     FReadFromFile := True;
  1135.     IntLoadFielddefsFromFile;
  1136.     end;
  1137.  
  1138.   // This is to check if the dataset is actually created (By calling CreateDataset,
  1139.   // reading from a stream in some other way implemented by a descendent)
  1140.   // If there are less fields then FieldDefs we know for sure that the dataset
  1141.   // is not (correctly) created.
  1142.  
  1143.   // If there are constant expressions in the select statement (for PostgreSQL)
  1144.   // they are of type ftUnknown (in FieldDefs), and are not created (in Fields).
  1145.   // So Fields.Count < FieldDefs.Count in this case
  1146.   // See mantis #22030
  1147.  
  1148.   //  if Fields.Count<FieldDefs.Count then
  1149.   if Fields.Count = 0 then
  1150.     DatabaseError(SErrNoDataset);
  1151.  
  1152.   // If there is a field with FieldNo=0 then the fields are not found to the
  1153.   // FieldDefs which is a sign that there is no dataset created. (Calculated and
  1154.   // lookup fields have FieldNo=-1)
  1155.   for i := 0 to Fields.Count-1 do
  1156.     if Fields[i].FieldNo=0 then
  1157.       DatabaseError(SErrNoDataset)
  1158.     else if (FAutoIncValue>-1) and (Fields[i] is TAutoIncField) and not assigned(FAutoIncField) then
  1159.       FAutoIncField := TAutoIncField(Fields[i]);
  1160.  
  1161.   InitDefaultIndexes;
  1162.   CalcRecordSize;
  1163.  
  1164.   FBRecordcount := 0;
  1165.  
  1166.   for IndexNr:=0 to FIndexesCount-1 do with FIndexes[IndexNr] do
  1167.     InitialiseSpareRecord(IntAllocRecordBuffer);
  1168.  
  1169.   FAllPacketsFetched := False;
  1170.  
  1171.   FOpen:=True;
  1172.  
  1173.   // parse filter expression
  1174.   ParseFilter(Filter);
  1175.  
  1176.   if assigned(FDatasetReader) then IntLoadRecordsFromFile;
  1177. end;
  1178.  
  1179. procedure TCustomBufDataset.InternalClose;
  1180.  
  1181. var r  : integer;
  1182.     iGetResult : TGetResult;
  1183.     pc : TRecordBuffer;
  1184.  
  1185. begin
  1186.   FOpen:=False;
  1187.   if FIndexesCount>0 then with FIndexes[0] do if IsInitialized then
  1188.     begin
  1189.     iGetResult:=ScrollFirst;
  1190.     while iGetResult = grOK do
  1191.       begin
  1192.       pc := pointer(CurrentRecord);
  1193.       iGetResult:=ScrollForward;
  1194.       FreeRecordBuffer(pc);
  1195.       end;
  1196.     end;
  1197.  
  1198.   for r := 0 to FIndexesCount-1 do with FIndexes[r] do if IsInitialized then
  1199.     begin
  1200.     pc := SpareRecord;
  1201.     ReleaseSpareRecord;
  1202.     FreeRecordBuffer(pc);
  1203.     end;
  1204.  
  1205.   if Length(FUpdateBuffer) > 0 then
  1206.     begin
  1207.     for r := 0 to length(FUpdateBuffer)-1 do with FUpdateBuffer[r] do
  1208.       begin
  1209.       if assigned(OldValuesBuffer) then
  1210.         FreeRecordBuffer(OldValuesBuffer);
  1211.       if (UpdateKind = ukDelete) and assigned(BookmarkData.BookmarkData) then
  1212.         FreeRecordBuffer(TRecordBuffer(BookmarkData.BookmarkData));
  1213.       end;
  1214.     end;
  1215.   SetLength(FUpdateBuffer,0);
  1216.  
  1217.   for r := 0 to High(FBlobBuffers) do
  1218.     FreeBlobBuffer(FBlobBuffers[r]);
  1219.   for r := 0 to High(FUpdateBlobBuffers) do
  1220.     FreeBlobBuffer(FUpdateBlobBuffers[r]);
  1221.  
  1222.   SetLength(FBlobBuffers,0);
  1223.   SetLength(FUpdateBlobBuffers,0);
  1224.  
  1225.   SetLength(FFieldBufPositions,0);
  1226.  
  1227.   FAutoIncValue:=-1;
  1228.  
  1229.   if assigned(FParser) then FreeAndNil(FParser);
  1230.   FReadFromFile:=false;
  1231. end;
  1232.  
  1233. procedure TCustomBufDataset.InternalFirst;
  1234. begin
  1235.   with FCurrentIndex do
  1236.     // if FCurrentRecBuf = FLastRecBuf then the dataset is just opened and empty
  1237.     // in which case InternalFirst should do nothing (bug 7211)
  1238.     SetToFirstRecord;
  1239. end;
  1240.  
  1241. procedure TCustomBufDataset.InternalLast;
  1242. begin
  1243.   FetchAll;
  1244.   with FCurrentIndex do
  1245.     SetToLastRecord;
  1246. end;
  1247.  
  1248. function TDoubleLinkedBufIndex.GetBookmarkSize: integer;
  1249. begin
  1250.   Result:=sizeof(TBufBookmark);
  1251. end;
  1252.  
  1253. function TDoubleLinkedBufIndex.GetCurrentBuffer: Pointer;
  1254. begin
  1255.   Result := pointer(FCurrentRecBuf) + FDataset.BufferOffset;
  1256. end;
  1257.  
  1258. function TDoubleLinkedBufIndex.GetCurrentRecord: TRecordBuffer;
  1259. begin
  1260.   Result := TRecordBuffer(FCurrentRecBuf);
  1261. end;
  1262.  
  1263. function TDoubleLinkedBufIndex.GetIsInitialized: boolean;
  1264. begin
  1265.   Result := (FFirstRecBuf<>nil);
  1266. end;
  1267.  
  1268. function TDoubleLinkedBufIndex.GetSpareBuffer: TRecordBuffer;
  1269. begin
  1270.   Result := pointer(FLastRecBuf) + FDataset.BufferOffset;
  1271. end;
  1272.  
  1273. function TDoubleLinkedBufIndex.GetSpareRecord: TRecordBuffer;
  1274. begin
  1275.   Result := TRecordBuffer(FLastRecBuf);
  1276. end;
  1277.  
  1278. constructor TBufIndex.Create(const ADataset: TCustomBufDataset);
  1279. begin
  1280.   inherited create;
  1281.   FDataset := ADataset;
  1282. end;
  1283.  
  1284. function TBufIndex.BookmarkValid(const ABookmark: PBufBookmark): boolean;
  1285. begin
  1286.   Result := assigned(ABookmark) and assigned(ABookmark^.BookmarkData);
  1287. end;
  1288.  
  1289. function TBufIndex.CompareBookmarks(const ABookmark1, ABookmark2: PBufBookmark): boolean;
  1290. begin
  1291.   result := (ABookmark1^.BookmarkData=ABookmark2^.BookmarkData);
  1292. end;
  1293.  
  1294. function TDoubleLinkedBufIndex.ScrollBackward: TGetResult;
  1295. begin
  1296.   if not assigned(FCurrentRecBuf[IndNr].prior) then
  1297.     begin
  1298.     Result := grBOF;
  1299.     end
  1300.   else
  1301.     begin
  1302.     Result := grOK;
  1303.     FCurrentRecBuf := FCurrentRecBuf[IndNr].prior;
  1304.     end;
  1305. end;
  1306.  
  1307. function TDoubleLinkedBufIndex.ScrollForward: TGetResult;
  1308. begin
  1309.   if (FCurrentRecBuf = FLastRecBuf) or // just opened
  1310.      (FCurrentRecBuf[IndNr].next = FLastRecBuf) then
  1311.     result := grEOF
  1312.   else
  1313.     begin
  1314.     FCurrentRecBuf := FCurrentRecBuf[IndNr].next;
  1315.     Result := grOK;
  1316.     end;
  1317. end;
  1318.  
  1319. function TDoubleLinkedBufIndex.GetCurrent: TGetResult;
  1320. begin
  1321.   if FFirstRecBuf = FLastRecBuf then
  1322.     Result := grError
  1323.   else
  1324.     begin
  1325.     Result := grOK;
  1326.     if FCurrentRecBuf = FLastRecBuf then
  1327.       FCurrentRecBuf:=FLastRecBuf[IndNr].prior;
  1328.     end;
  1329. end;
  1330.  
  1331. function TDoubleLinkedBufIndex.ScrollFirst: TGetResult;
  1332. begin
  1333.   FCurrentRecBuf:=FFirstRecBuf;
  1334.   if (FCurrentRecBuf = FLastRecBuf) then
  1335.     result := grEOF
  1336.   else
  1337.     result := grOK;
  1338. end;
  1339.  
  1340. procedure TDoubleLinkedBufIndex.ScrollLast;
  1341. begin
  1342.   FCurrentRecBuf:=FLastRecBuf;
  1343. end;
  1344.  
  1345. procedure TDoubleLinkedBufIndex.SetToFirstRecord;
  1346. begin
  1347.   FLastRecBuf[IndNr].next:=FFirstRecBuf;
  1348.   FCurrentRecBuf := FLastRecBuf;
  1349. end;
  1350.  
  1351. procedure TDoubleLinkedBufIndex.SetToLastRecord;
  1352. begin
  1353.   if FLastRecBuf <> FFirstRecBuf then FCurrentRecBuf := FLastRecBuf;
  1354. end;
  1355.  
  1356. procedure TDoubleLinkedBufIndex.StoreCurrentRecord;
  1357. begin
  1358.   FStoredRecBuf:=FCurrentRecBuf;
  1359. end;
  1360.  
  1361. procedure TDoubleLinkedBufIndex.RestoreCurrentRecord;
  1362. begin
  1363.   FCurrentRecBuf:=FStoredRecBuf;
  1364. end;
  1365.  
  1366. procedure TDoubleLinkedBufIndex.DoScrollForward;
  1367. begin
  1368.   FCurrentRecBuf := FCurrentRecBuf[IndNr].next;
  1369. end;
  1370.  
  1371. procedure TDoubleLinkedBufIndex.StoreCurrentRecIntoBookmark(const ABookmark: PBufBookmark);
  1372. begin
  1373.   ABookmark^.BookmarkData:=FCurrentRecBuf;
  1374. end;
  1375.  
  1376. procedure TDoubleLinkedBufIndex.StoreSpareRecIntoBookmark(
  1377.   const ABookmark: PBufBookmark);
  1378. begin
  1379.   ABookmark^.BookmarkData:=FLastRecBuf;
  1380. end;
  1381.  
  1382. procedure TDoubleLinkedBufIndex.GotoBookmark(const ABookmark : PBufBookmark);
  1383. begin
  1384.   FCurrentRecBuf := ABookmark^.BookmarkData;
  1385. end;
  1386.  
  1387. procedure TDoubleLinkedBufIndex.InitialiseIndex;
  1388. begin
  1389.   // Do nothing
  1390. end;
  1391.  
  1392. function TDoubleLinkedBufIndex.CanScrollForward: Boolean;
  1393. begin
  1394.   if (FCurrentRecBuf[IndNr].next = FLastRecBuf) then
  1395.     Result := False
  1396.   else
  1397.     Result := True;
  1398. end;
  1399.  
  1400. procedure TDoubleLinkedBufIndex.InitialiseSpareRecord(const ASpareRecord : TRecordBuffer);
  1401. begin
  1402.   FFirstRecBuf := pointer(ASpareRecord);
  1403.   FLastRecBuf := FFirstRecBuf;
  1404.   FLastRecBuf[IndNr].prior:=nil;
  1405.   FLastRecBuf[IndNr].next:=FLastRecBuf;
  1406.   FCurrentRecBuf := FLastRecBuf;
  1407. end;
  1408.  
  1409. procedure TDoubleLinkedBufIndex.ReleaseSpareRecord;
  1410. begin
  1411.   FFirstRecBuf:= nil;
  1412. end;
  1413.  
  1414. function TDoubleLinkedBufIndex.GetRecNo(const ABookmark: PBufBookmark): integer;
  1415. Var TmpRecBuffer    : PBufRecLinkItem;
  1416.     recnr           : integer;
  1417. begin
  1418.   TmpRecBuffer := FFirstRecBuf;
  1419.   recnr := 1;
  1420.   while TmpRecBuffer <> ABookmark^.BookmarkData do
  1421.     begin
  1422.     inc(recnr);
  1423.     TmpRecBuffer := TmpRecBuffer[IndNr].next;
  1424.     end;
  1425.   Result := recnr;
  1426. end;
  1427.  
  1428. procedure TDoubleLinkedBufIndex.BeginUpdate;
  1429. begin
  1430.   if FCurrentRecBuf = FLastRecBuf then
  1431.     FCursOnFirstRec := True
  1432.   else
  1433.     FCursOnFirstRec := False;
  1434. end;
  1435.  
  1436. procedure TDoubleLinkedBufIndex.AddRecord;
  1437. var ARecord: TRecordBuffer;
  1438. begin
  1439.   ARecord := FDataset.IntAllocRecordBuffer;
  1440.   FLastRecBuf[IndNr].next := pointer(ARecord);
  1441.   FLastRecBuf[IndNr].next[IndNr].prior := FLastRecBuf;
  1442.  
  1443.   FLastRecBuf := FLastRecBuf[IndNr].next;
  1444. end;
  1445.  
  1446. procedure TDoubleLinkedBufIndex.InsertRecordBeforeCurrentRecord(const ARecord: TRecordBuffer);
  1447. var ANewRecord : PBufRecLinkItem;
  1448. begin
  1449.   ANewRecord:=PBufRecLinkItem(ARecord);
  1450.   ANewRecord[IndNr].prior:=FCurrentRecBuf[IndNr].prior;
  1451.   ANewRecord[IndNr].Next:=FCurrentRecBuf;
  1452.  
  1453.   if FCurrentRecBuf=FFirstRecBuf then
  1454.     begin
  1455.     FFirstRecBuf:=ANewRecord;
  1456.     ANewRecord[IndNr].prior:=nil;
  1457.     end
  1458.   else
  1459.     ANewRecord[IndNr].Prior[IndNr].next:=ANewRecord;
  1460.   ANewRecord[IndNr].next[IndNr].prior:=ANewRecord;
  1461. end;
  1462.  
  1463. procedure TDoubleLinkedBufIndex.RemoveRecordFromIndex(const ABookmark : TBufBookmark);
  1464. var ARecord : PBufRecLinkItem;
  1465. begin
  1466.   ARecord := ABookmark.BookmarkData;
  1467.   if ARecord = FCurrentRecBuf then DoScrollForward;
  1468.   if ARecord <> FFirstRecBuf then
  1469.     ARecord[IndNr].prior[IndNr].next := ARecord[IndNr].next
  1470.   else
  1471.     begin
  1472.     FFirstRecBuf := ARecord[IndNr].next;
  1473.     FLastRecBuf[IndNr].next := FFirstRecBuf;
  1474.     end;
  1475.   ARecord[IndNr].next[IndNr].prior := ARecord[IndNr].prior;
  1476. end;
  1477.  
  1478. procedure TDoubleLinkedBufIndex.OrderCurrentRecord;
  1479. var ARecord: PBufRecLinkItem;
  1480.     ABookmark: TBufBookmark;
  1481. begin
  1482.   // all records except current are already sorted
  1483.   // check prior records
  1484.   ARecord := FCurrentRecBuf;
  1485.   repeat
  1486.     ARecord := ARecord[IndNr].prior;
  1487.   until not assigned(ARecord) or (IndexCompareRecords(ARecord, FCurrentRecBuf, DBCompareStruct) <= 0);
  1488.   if assigned(ARecord) then
  1489.     ARecord := ARecord[IndNr].next
  1490.   else
  1491.     ARecord := FFirstRecBuf;
  1492.   if ARecord = FCurrentRecBuf then
  1493.   begin
  1494.     // prior record is less equal than current
  1495.     // check next records
  1496.     repeat
  1497.       ARecord := ARecord[IndNr].next;
  1498.     until (ARecord=FLastRecBuf) or (IndexCompareRecords(ARecord, FCurrentRecBuf, DBCompareStruct) >= 0);
  1499.     if ARecord = FCurrentRecBuf[IndNr].next then
  1500.       Exit; // current record is on proper position
  1501.   end;
  1502.   StoreCurrentRecIntoBookmark(@ABookmark);
  1503.   RemoveRecordFromIndex(ABookmark);
  1504.   FCurrentRecBuf := ARecord;
  1505.   InsertRecordBeforeCurrentRecord(TRecordBuffer(ABookmark.BookmarkData));
  1506.   GotoBookmark(@ABookmark);
  1507. end;
  1508.  
  1509. procedure TDoubleLinkedBufIndex.EndUpdate;
  1510. begin
  1511.   FLastRecBuf[IndNr].next := FFirstRecBuf;
  1512.   if FCursOnFirstRec then FCurrentRecBuf:=FLastRecBuf;
  1513. end;
  1514.  
  1515. procedure TCustomBufDataset.CurrentRecordToBuffer(Buffer: TRecordBuffer);
  1516. var ABookMark : PBufBookmark;
  1517. begin
  1518.   with FCurrentIndex do
  1519.     begin
  1520.     move(CurrentBuffer^,buffer^,FRecordSize);
  1521.     ABookMark:=PBufBookmark(Buffer + FRecordSize);
  1522.     ABookmark^.BookmarkFlag:=bfCurrent;
  1523.     StoreCurrentRecIntoBookmark(ABookMark);
  1524.     end;
  1525.  
  1526.   GetCalcFields(Buffer);
  1527. end;
  1528.  
  1529. procedure TCustomBufDataset.SetBufUniDirectional(const AValue: boolean);
  1530. begin
  1531.   CheckInactive;
  1532.   if (AValue<>IsUniDirectional) then
  1533.     begin
  1534.     SetUniDirectional(AValue);
  1535.     SetLength(FIndexes,0);
  1536.     FPacketRecords := 1; // temporary
  1537.     FIndexesCount:=0;
  1538.     end;
  1539. end;
  1540.  
  1541. procedure TCustomBufDataset.SetReadOnly(AValue: Boolean);
  1542. begin
  1543.   FReadOnly:=AValue;
  1544. end;
  1545.  
  1546. function TCustomBufDataset.GetRecord(Buffer: TRecordBuffer; GetMode: TGetMode; DoCheck: Boolean): TGetResult;
  1547.  
  1548. var Acceptable : Boolean;
  1549.     SaveState : TDataSetState;
  1550.  
  1551. begin
  1552.   Result := grOK;
  1553.   with FCurrentIndex do
  1554.     begin
  1555.     repeat
  1556.     Acceptable := True;
  1557.     case GetMode of
  1558.       gmPrior : Result := ScrollBackward;
  1559.       gmCurrent : Result := GetCurrent;
  1560.       gmNext : begin
  1561.                if not CanScrollForward and (getnextpacket = 0) then result := grEOF
  1562.                else
  1563.                  begin
  1564.                  result := grOK;
  1565.                  DoScrollForward;
  1566.                  end;
  1567.                end;
  1568.     end;
  1569.  
  1570.     if Result = grOK then
  1571.       begin
  1572.       CurrentRecordToBuffer(buffer);
  1573.  
  1574.       if Filtered then
  1575.         begin
  1576.         FFilterBuffer := Buffer;
  1577.         SaveState := SetTempState(dsFilter);
  1578.         DoFilterRecord(Acceptable);
  1579.         if (GetMode = gmCurrent) and not Acceptable then
  1580.           begin
  1581.           Acceptable := True;
  1582.           Result := grError;
  1583.           end;
  1584.         RestoreState(SaveState);
  1585.         end;
  1586.       end
  1587.     else if (Result = grError) and doCheck then
  1588.       DatabaseError('No record');
  1589.     until Acceptable;
  1590.   end;
  1591. end;
  1592.  
  1593. procedure TCustomBufDataset.DoBeforeClose;
  1594. begin
  1595.   inherited DoBeforeClose;
  1596.   if FFileName<>'' then
  1597.     SaveToFile(FFileName);
  1598. end;
  1599.  
  1600. function TCustomBufDataset.GetActiveRecordUpdateBuffer : boolean;
  1601.  
  1602. var ABookmark : TBufBookmark;
  1603.  
  1604. begin
  1605.   GetBookmarkData(ActiveBuffer,@ABookmark);
  1606.   result := GetRecordUpdateBufferCached(ABookmark);
  1607. end;
  1608.  
  1609. procedure TCustomBufDataset.ProcessFieldsToCompareStruct(const AFields, ADescFields, ACInsFields: TList;
  1610.       const AIndexOptions: TIndexOptions; const ALocateOptions: TLocateOptions; out ACompareStruct: TDBCompareStruct);
  1611. var i: integer;
  1612.     AField: TField;
  1613.     ACompareRec: TDBCompareRec;
  1614. begin
  1615.   SetLength(ACompareStruct, AFields.Count);
  1616.   for i:=0 to high(ACompareStruct) do
  1617.     begin
  1618.     AField := TField(AFields[i]);
  1619.  
  1620.     case AField.DataType of
  1621.       ftString, ftFixedChar : ACompareRec.Comparefunc := @DBCompareText;
  1622.       ftWideString, ftFixedWideChar: ACompareRec.Comparefunc := @DBCompareWideText;
  1623.       ftSmallint : ACompareRec.Comparefunc := @DBCompareSmallInt;
  1624.       ftInteger, ftBCD, ftAutoInc : ACompareRec.Comparefunc :=
  1625.         @DBCompareInt;
  1626.       ftWord : ACompareRec.Comparefunc := @DBCompareWord;
  1627.       ftBoolean : ACompareRec.Comparefunc := @DBCompareByte;
  1628.       ftFloat, ftCurrency : ACompareRec.Comparefunc := @DBCompareDouble;
  1629.       ftDateTime, ftDate, ftTime : ACompareRec.Comparefunc :=
  1630.         @DBCompareDouble;
  1631.       ftLargeint : ACompareRec.Comparefunc := @DBCompareLargeInt;
  1632.       ftFmtBCD : ACompareRec.Comparefunc := @DBCompareBCD;
  1633.     else
  1634.       DatabaseErrorFmt(SErrIndexBasedOnInvField, [AField.FieldName,Fieldtypenames[AField.DataType]]);
  1635.     end;
  1636.  
  1637.     ACompareRec.Off1:=BufferOffset + FFieldBufPositions[AField.FieldNo-1];
  1638.     ACompareRec.Off2:=ACompareRec.Off1;
  1639.  
  1640.     ACompareRec.FieldInd1:=AField.FieldNo-1;
  1641.     ACompareRec.FieldInd2:=ACompareRec.FieldInd1;
  1642.  
  1643.     ACompareRec.NullBOff1:=BufferOffset;
  1644.     ACompareRec.NullBOff2:=ACompareRec.NullBOff1;
  1645.  
  1646.     ACompareRec.Desc := ixDescending in AIndexOptions;
  1647.     if assigned(ADescFields) then
  1648.       ACompareRec.Desc := ACompareRec.Desc or (ADescFields.IndexOf(AField)>-1);
  1649.  
  1650.     ACompareRec.Options := ALocateOptions;
  1651.     if assigned(ACInsFields) and (ACInsFields.IndexOf(AField)>-1) then
  1652.       ACompareRec.Options := ACompareRec.Options + [loCaseInsensitive];
  1653.  
  1654.     ACompareStruct[i] := ACompareRec;
  1655.     end;
  1656. end;
  1657.  
  1658. procedure TCustomBufDataset.InitDefaultIndexes;
  1659. begin
  1660.   if FIndexesCount=0 then
  1661.     begin
  1662.     InternalAddIndex('DEFAULT_ORDER','',[],'','');
  1663.     FCurrentIndex:=FIndexes[0];
  1664.     if not IsUniDirectional then
  1665.       InternalAddIndex('','',[],'','');
  1666.     BookmarkSize := FCurrentIndex.BookmarkSize;
  1667.     end;
  1668. end;
  1669.  
  1670. procedure TCustomBufDataset.AddIndex(const AName, AFields : string; AOptions : TIndexOptions; const ADescFields: string = '';
  1671.                                const ACaseInsFields: string = '');
  1672. begin
  1673.   CheckBiDirectional;
  1674.   if AFields='' then DatabaseError(SNoIndexFieldNameGiven);
  1675.  
  1676.   if FIndexesCount=0 then
  1677.     InitDefaultIndexes;
  1678.  
  1679.   if Active and (FIndexesCount=FMaxIndexesCount) then
  1680.     DatabaseError(SMaxIndexes);
  1681.  
  1682.   // If not all packets are fetched, you can not sort properly.
  1683.   if not Active then
  1684.     FPacketRecords:=-1;
  1685.   InternalAddIndex(AName,AFields,AOptions,ADescFields,ACaseInsFields);
  1686. end;
  1687.  
  1688. procedure TCustomBufDataset.InternalAddIndex(const AName, AFields : string; AOptions : TIndexOptions; const ADescFields: string;
  1689.                                        const ACaseInsFields: string);
  1690. var StoreIndNr : Integer;
  1691. begin
  1692.   if Active then FetchAll;
  1693.   if FIndexesCount>0 then
  1694.     StoreIndNr:=FCurrentIndex.IndNr
  1695.   else
  1696.     StoreIndNr:=0;
  1697.   inc(FIndexesCount);
  1698.   setlength(FIndexes,FIndexesCount); // This invalidates the currentindex! -> not anymore
  1699.   FCurrentIndex:=FIndexes[StoreIndNr];
  1700.  
  1701.   if IsUniDirectional then
  1702.     FIndexes[FIndexesCount-1] := TUniDirectionalBufIndex.Create(self)
  1703.   else
  1704.     FIndexes[FIndexesCount-1] := TDoubleLinkedBufIndex.Create(self);
  1705. //  FIndexes[FIndexesCount-1] := TArrayBufIndex.Create(self);
  1706.   with FIndexes[FIndexesCount-1] do
  1707.     begin
  1708.     InitialiseIndex;
  1709.     IndNr:=FIndexesCount-1;
  1710.     Name:=AName;
  1711.     FieldsName:=AFields;
  1712.     DescFields:=ADescFields;
  1713.     CaseinsFields:=ACaseInsFields;
  1714.     Options:=AOptions;
  1715.     end;
  1716.  
  1717.   if Active then
  1718.     begin
  1719.     FIndexes[FIndexesCount-1].InitialiseSpareRecord(IntAllocRecordBuffer);
  1720.     BuildIndex(FIndexes[FIndexesCount-1]);
  1721.     end
  1722.   else if FIndexesCount>FMaxIndexesCount then
  1723.     FMaxIndexesCount := FIndexesCount;
  1724.  
  1725.   FIndexDefs.Updated:=false;
  1726. end;
  1727.  
  1728. procedure TCustomBufDataset.SetIndexFieldNames(const AValue: String);
  1729. begin
  1730.   if AValue<>'' then
  1731.     begin
  1732.     if FIndexesCount=0 then
  1733.       InitDefaultIndexes;
  1734.     FIndexes[1].FieldsName:=AValue;
  1735.     FCurrentIndex:=FIndexes[1];
  1736.     if Active then
  1737.       begin
  1738.       FetchAll;
  1739.       BuildIndex(FIndexes[1]);
  1740.       Resync([rmCenter]);
  1741.       end;
  1742.     FIndexDefs.Updated:=false;
  1743.     end
  1744.   else
  1745.     SetIndexName('');
  1746. end;
  1747.  
  1748. procedure TCustomBufDataset.SetIndexName(AValue: String);
  1749. var i : integer;
  1750. begin
  1751.   if AValue='' then AValue := 'DEFAULT_ORDER';
  1752.   for i := 0 to FIndexesCount-1 do
  1753.     if SameText(FIndexes[i].Name,AValue) then
  1754.       begin
  1755.       (FIndexes[i] as TDoubleLinkedBufIndex).FCurrentRecBuf:=(FCurrentIndex as TDoubleLinkedBufIndex).FCurrentRecBuf;
  1756.       FCurrentIndex:=FIndexes[i];
  1757.       if Active then Resync([rmCenter]);
  1758.       exit;
  1759.       end;
  1760. end;
  1761.  
  1762. procedure TCustomBufDataset.SetMaxIndexesCount(const AValue: Integer);
  1763. begin
  1764.   CheckInactive;
  1765.   if AValue > 1 then
  1766.     FMaxIndexesCount:=AValue
  1767.   else
  1768.     DatabaseError(SMinIndexes);
  1769. end;
  1770.  
  1771. procedure TCustomBufDataset.InternalSetToRecord(Buffer: TRecordBuffer);
  1772. begin
  1773.   FCurrentIndex.GotoBookmark(PBufBookmark(Buffer+FRecordSize));
  1774. end;
  1775.  
  1776. procedure TCustomBufDataset.SetBookmarkData(Buffer: TRecordBuffer; Data: Pointer);
  1777. begin
  1778.   PBufBookmark(Buffer + FRecordSize)^ := PBufBookmark(Data)^;
  1779. end;
  1780.  
  1781. procedure TCustomBufDataset.SetBookmarkFlag(Buffer: TRecordBuffer; Value: TBookmarkFlag);
  1782. begin
  1783.   PBufBookmark(Buffer + FRecordSize)^.BookmarkFlag := Value;
  1784. end;
  1785.  
  1786. procedure TCustomBufDataset.GetBookmarkData(Buffer: TRecordBuffer; Data: Pointer);
  1787. begin
  1788.   PBufBookmark(Data)^ := PBufBookmark(Buffer + FRecordSize)^;
  1789. end;
  1790.  
  1791. function TCustomBufDataset.GetBookmarkFlag(Buffer: TRecordBuffer): TBookmarkFlag;
  1792. begin
  1793.   Result := PBufBookmark(Buffer + FRecordSize)^.BookmarkFlag;
  1794. end;
  1795.  
  1796. procedure TCustomBufDataset.InternalGotoBookmark(ABookmark: Pointer);
  1797. begin
  1798.   // note that ABookMark should be a PBufBookmark. But this way it can also be
  1799.   // a pointer to a TBufRecLinkItem
  1800.   FCurrentIndex.GotoBookmark(ABookmark);
  1801. end;
  1802.  
  1803. function TCustomBufDataset.getnextpacket : integer;
  1804.  
  1805. var i : integer;
  1806.     pb : TRecordBuffer;
  1807.  
  1808. begin
  1809.   if FAllPacketsFetched then
  1810.     begin
  1811.     result := 0;
  1812.     exit;
  1813.     end;
  1814.  
  1815.   FCurrentIndex.BeginUpdate;
  1816.  
  1817.   i := 0;
  1818.   pb := FIndexes[0].SpareBuffer;
  1819.   while ((i < FPacketRecords) or (FPacketRecords = -1)) and (LoadBuffer(pb) = grOk) do
  1820.     begin
  1821.     with FIndexes[0] do
  1822.       begin
  1823.       AddRecord;
  1824.       pb := SpareBuffer;
  1825.       end;
  1826.     inc(i);
  1827.     end;
  1828.  
  1829.   FCurrentIndex.EndUpdate;
  1830.   FBRecordCount := FBRecordCount + i;
  1831.   result := i;
  1832. end;
  1833.  
  1834. function TCustomBufDataset.GetFieldSize(FieldDef : TFieldDef) : longint;
  1835.  
  1836. begin
  1837.   case FieldDef.DataType of
  1838.     ftUnknown    : result := 0;
  1839.     ftString,
  1840.       ftGuid,
  1841.       ftFixedChar: result := FieldDef.Size + 1;
  1842.     ftFixedWideChar,
  1843.       ftWideString:result := (FieldDef.Size + 1)*2;
  1844.     ftSmallint,
  1845.       ftInteger,
  1846.       ftAutoInc,
  1847.       ftword     : result := sizeof(longint);
  1848.     ftBoolean    : result := sizeof(wordbool);
  1849.     ftBCD        : result := sizeof(currency);
  1850.     ftFmtBCD     : result := sizeof(TBCD);
  1851.     ftFloat,
  1852.       ftCurrency : result := sizeof(double);
  1853.     ftLargeInt   : result := sizeof(largeint);
  1854.     ftTime,
  1855.       ftDate,
  1856.       ftDateTime : result := sizeof(TDateTime);
  1857.     ftBytes      : result := FieldDef.Size;
  1858.     ftVarBytes   : result := FieldDef.Size + 2;
  1859.     ftVariant    : result := sizeof(variant);
  1860.     ftBlob,
  1861.       ftMemo,
  1862.       ftGraphic,
  1863.       ftFmtMemo,
  1864.       ftParadoxOle,
  1865.       ftDBaseOle,
  1866.       ftTypedBinary,
  1867.       ftOraBlob,
  1868.       ftOraClob,
  1869.       ftWideMemo : result := sizeof(TBufBlobField)
  1870.   else
  1871.     DatabaseErrorFmt(SUnsupportedFieldType,[Fieldtypenames[FieldDef.DataType]]);
  1872.   end;
  1873. {$IFDEF FPC_REQUIRES_PROPER_ALIGNMENT}
  1874.   result:=Align(result,4);
  1875. {$ENDIF}
  1876. end;
  1877.  
  1878. function TCustomBufDataset.GetRecordUpdateBuffer(const ABookmark : TBufBookmark; IncludePrior : boolean = false; AFindNext : boolean = false): boolean;
  1879.  
  1880. var x        : integer;
  1881.     StartBuf : integer;
  1882.  
  1883. begin
  1884.   if AFindNext then
  1885.     StartBuf := FCurrentUpdateBuffer + 1
  1886.   else
  1887.     StartBuf := 0;
  1888.   Result := False;
  1889.   for x := StartBuf to high(FUpdateBuffer) do
  1890.    if FCurrentIndex.CompareBookmarks(@FUpdateBuffer[x].BookmarkData,@ABookmark) or
  1891.       (IncludePrior and (FUpdateBuffer[x].UpdateKind=ukDelete) and FCurrentIndex.CompareBookmarks(@FUpdateBuffer[x].NextBookmarkData,@ABookmark)) then
  1892.     begin
  1893.     FCurrentUpdateBuffer := x;
  1894.     Result := True;
  1895.     break;
  1896.     end;
  1897. end;
  1898.  
  1899. function TCustomBufDataset.GetRecordUpdateBufferCached(const ABookmark: TBufBookmark;
  1900.   IncludePrior: boolean): boolean;
  1901. begin
  1902.   // if the current update buffer matches, immediately return true
  1903.   if (FCurrentUpdateBuffer < length(FUpdateBuffer)) and (
  1904.       FCurrentIndex.CompareBookmarks(@FUpdateBuffer[FCurrentUpdateBuffer].BookmarkData,@ABookmark) or
  1905.       (IncludePrior
  1906.         and (FUpdateBuffer[FCurrentUpdateBuffer].UpdateKind=ukDelete)
  1907.         and  FCurrentIndex.CompareBookmarks(@FUpdateBuffer[FCurrentUpdateBuffer].NextBookmarkData,@ABookmark))) then
  1908.      begin
  1909.      Result := True;
  1910.      end
  1911.   else
  1912.     Result := GetRecordUpdateBuffer(ABookmark,IncludePrior);
  1913. end;
  1914.  
  1915. function TCustomBufDataset.LoadBuffer(Buffer : TRecordBuffer): TGetResult;
  1916.  
  1917. var NullMask        : pbyte;
  1918.     x               : longint;
  1919.     CreateBlobField : boolean;
  1920.     BufBlob         : PBufBlobField;
  1921.  
  1922. begin
  1923.   if not Fetch then
  1924.     begin
  1925.     Result := grEOF;
  1926.     FAllPacketsFetched := True;
  1927.     // This code has to be placed elsewhere. At least it should also run when
  1928.     // the datapacket is loaded from file ... see IntLoadRecordsFromFile
  1929.     if FIndexesCount>0 then for x := 1 to FIndexesCount-1 do
  1930.       begin
  1931.       if not ((x=1) and (FIndexes[1].FieldsName='')) then
  1932.         BuildIndex(FIndexes[x]);
  1933.       end;
  1934.     Exit;
  1935.     end;
  1936.  
  1937.   NullMask := pointer(buffer);
  1938.   fillchar(Nullmask^,FNullmaskSize,0);
  1939.   inc(buffer,FNullmaskSize);
  1940.  
  1941.   for x := 0 to FieldDefs.count-1 do
  1942.     begin
  1943.     if not LoadField(FieldDefs[x],buffer,CreateBlobField) then
  1944.       SetFieldIsNull(NullMask,x)
  1945.     else if CreateBlobField then
  1946.       begin
  1947.       BufBlob := PBufBlobField(Buffer);
  1948.       BufBlob^.BlobBuffer := GetNewBlobBuffer;
  1949.       LoadBlobIntoBuffer(FieldDefs[x],BufBlob);
  1950.       end;
  1951.     inc(buffer,GetFieldSize(FieldDefs[x]));
  1952.     end;
  1953.   Result := grOK;
  1954. end;
  1955.  
  1956. function TCustomBufDataset.GetCurrentBuffer: TRecordBuffer;
  1957. begin
  1958.   if State = dsFilter then Result := FFilterBuffer
  1959.   else if State = dsCalcFields then Result := CalcBuffer
  1960.   else Result := ActiveBuffer;
  1961. end;
  1962.  
  1963.  
  1964. function TCustomBufDataset.GetFieldData(Field: TField; Buffer: Pointer;
  1965.   NativeFormat: Boolean): Boolean;
  1966. begin
  1967.   Result := GetFieldData(Field, Buffer);
  1968. end;
  1969.  
  1970. function TCustomBufDataset.GetFieldData(Field: TField; Buffer: Pointer): Boolean;
  1971.  
  1972. var CurrBuff : TRecordBuffer;
  1973.  
  1974. begin
  1975.   Result := False;
  1976.   if State = dsOldValue then
  1977.   begin
  1978.     if FSavedState = dsInsert then
  1979.       CurrBuff := nil // old values = null
  1980.     else if GetActiveRecordUpdateBuffer then
  1981.       CurrBuff := FUpdateBuffer[FCurrentUpdateBuffer].OldValuesBuffer
  1982.     else
  1983.       // There is no UpdateBuffer for ActiveRecord, so there are no explicit old values available
  1984.       // then we can assume, that old values = current values
  1985.       CurrBuff := FCurrentIndex.CurrentBuffer;
  1986.   end
  1987.   else
  1988.     CurrBuff := GetCurrentBuffer;
  1989.  
  1990.   if not assigned(CurrBuff) then Exit;
  1991.  
  1992.   If Field.Fieldno > 0 then // If = 0, then calculated field or something similar
  1993.     begin
  1994.     if GetFieldIsNull(pbyte(CurrBuff),Field.FieldNo-1) then
  1995.       Exit;
  1996.     if assigned(buffer) then
  1997.       begin
  1998.       inc(CurrBuff,FFieldBufPositions[Field.FieldNo-1]);
  1999.       Move(CurrBuff^, Buffer^, GetFieldSize(FieldDefs[Field.FieldNo-1]));
  2000.       end;
  2001.     Result := True;
  2002.     end
  2003.   else
  2004.     begin
  2005.     Inc(CurrBuff, GetRecordSize + Field.Offset);
  2006.     Result := Boolean(CurrBuff^);
  2007.     if result and assigned(Buffer) then
  2008.       begin
  2009.       inc(CurrBuff);
  2010.       Move(CurrBuff^, Buffer^, Field.Datasize);
  2011.       end;
  2012.     end;
  2013. end;
  2014.  
  2015. procedure TCustomBufDataset.SetFieldData(Field: TField; Buffer: Pointer;
  2016.   NativeFormat: Boolean);
  2017. begin
  2018.   SetFieldData(Field,Buffer);
  2019. end;
  2020.  
  2021. procedure TCustomBufDataset.SetFieldData(Field: TField; Buffer: Pointer);
  2022.  
  2023. var CurrBuff : pointer;
  2024.     NullMask : pbyte;
  2025.  
  2026. begin
  2027.   if not (State in dsWriteModes) then
  2028.     DatabaseError(SNotEditing, Self);
  2029.   CurrBuff := GetCurrentBuffer;
  2030.   If Field.Fieldno > 0 then // If = 0, then calculated field or something
  2031.     begin
  2032.     if Field.ReadOnly and not (State in [dsSetKey, dsFilter]) then
  2033.       DatabaseErrorFmt(SReadOnlyField, [Field.DisplayName]);   
  2034.     if State in [dsEdit, dsInsert, dsNewValue] then
  2035.       Field.Validate(Buffer);  
  2036.     NullMask := CurrBuff;
  2037.  
  2038.     inc(CurrBuff,FFieldBufPositions[Field.FieldNo-1]);
  2039.     if assigned(buffer) then
  2040.       begin
  2041.       Move(Buffer^, CurrBuff^, GetFieldSize(FieldDefs[Field.FieldNo-1]));
  2042.       unSetFieldIsNull(NullMask,Field.FieldNo-1);
  2043.       end
  2044.     else
  2045.       SetFieldIsNull(NullMask,Field.FieldNo-1);
  2046.     end
  2047.   else
  2048.     begin
  2049.     Inc(CurrBuff, GetRecordSize + Field.Offset);
  2050.     Boolean(CurrBuff^) := Buffer <> nil;
  2051.     inc(CurrBuff);
  2052.     if assigned(Buffer) then
  2053.       Move(Buffer^, CurrBuff^, Field.Datasize);
  2054.     end;
  2055.   if not (State in [dsCalcFields, dsFilter, dsNewValue]) then
  2056.     DataEvent(deFieldChange, Ptrint(Field));
  2057. end;
  2058.  
  2059. procedure TCustomBufDataset.InternalDelete;
  2060. var i : Integer;
  2061.     RemRec : pointer;
  2062.     RemRecBookmrk : TBufBookmark;
  2063. begin
  2064.   InternalSetToRecord(ActiveBuffer);
  2065.   // Remove the record from all active indexes
  2066.   FCurrentIndex.StoreCurrentRecIntoBookmark(@RemRecBookmrk);
  2067.   RemRec := FCurrentIndex.CurrentBuffer;
  2068.   for i := 0 to FIndexesCount-1 do
  2069.     if (i<>1) or (FIndexes[i]=FCurrentIndex) then
  2070.       FIndexes[i].RemoveRecordFromIndex(RemRecBookmrk);
  2071.  
  2072.   if not GetActiveRecordUpdateBuffer then
  2073.     begin
  2074.     FCurrentUpdateBuffer := length(FUpdateBuffer);
  2075.     SetLength(FUpdateBuffer,FCurrentUpdateBuffer+1);
  2076.     FUpdateBuffer[FCurrentUpdateBuffer].OldValuesBuffer := IntAllocRecordBuffer;
  2077.     move(RemRec^, FUpdateBuffer[FCurrentUpdateBuffer].OldValuesBuffer^,FRecordSize);
  2078.     end
  2079.   else
  2080.     begin
  2081.     if FUpdateBuffer[FCurrentUpdateBuffer].UpdateKind <> ukModify then
  2082.       begin
  2083.       FUpdateBuffer[FCurrentUpdateBuffer].OldValuesBuffer := nil;  //this 'disables' the updatebuffer
  2084.       // Do NOT release record buffer (pointed to by RemRecBookmrk.BookmarkData) here
  2085.       //  - When record is inserted and deleted (and memory released) and again inserted then the same memory block can be returned
  2086.       //    which leads to confusion, because we get the same BookmarkData for distinct records
  2087.       //  - In CancelUpdates when records are restored, it is expected that deleted records still exist in memory
  2088.       // There also could be record(s) in the update buffer that is linked to this record.
  2089.       end;
  2090.     end;
  2091.   FCurrentIndex.StoreCurrentRecIntoBookmark(@FUpdateBuffer[FCurrentUpdateBuffer].NextBookmarkData);
  2092.   FUpdateBuffer[FCurrentUpdateBuffer].BookmarkData := RemRecBookmrk;
  2093.   FUpdateBuffer[FCurrentUpdateBuffer].UpdateKind := ukDelete;
  2094.   dec(FBRecordCount);
  2095. end;
  2096.  
  2097.  
  2098. procedure TCustomBufDataset.ApplyRecUpdate(UpdateKind : TUpdateKind);
  2099.  
  2100. begin
  2101.   raise EDatabaseError.Create(SApplyRecNotSupported);
  2102. end;
  2103.  
  2104. procedure TCustomBufDataset.CancelUpdates;
  2105. var StoreRecBM     : TBufBookmark;
  2106.   procedure CancelUpdBuffer(var AUpdBuffer : TRecUpdateBuffer);
  2107.   var
  2108.     TmpBuf         : TRecordBuffer;
  2109.     StoreUpdBuf    : integer;
  2110.     Bm             : TBufBookmark;
  2111.   begin
  2112.     with AUpdBuffer do
  2113.       begin
  2114.       if Not assigned(BookmarkData.BookmarkData) then
  2115.         exit;// this is used to exclude buffers which are already handled
  2116.       Case UpdateKind of
  2117.       ukModify:
  2118.         begin
  2119.         FCurrentIndex.GotoBookmark(@BookmarkData);
  2120.         move(TRecordBuffer(OldValuesBuffer)^,TRecordBuffer(FCurrentIndex.CurrentBuffer)^,FRecordSize);
  2121.         FreeRecordBuffer(OldValuesBuffer);
  2122.         end;
  2123.       ukDelete:
  2124.         if (assigned(OldValuesBuffer)) then
  2125.           begin
  2126.           FCurrentIndex.GotoBookmark(@NextBookmarkData);
  2127.           FCurrentIndex.InsertRecordBeforeCurrentRecord(TRecordBuffer(BookmarkData.BookmarkData));
  2128.           FCurrentIndex.ScrollBackward;
  2129.           move(TRecordBuffer(OldValuesBuffer)^,TRecordBuffer(FCurrentIndex.CurrentBuffer)^,FRecordSize);
  2130.  
  2131.           {for x := length(FUpdateBuffer)-1 downto 0 do
  2132.             begin
  2133.             if (FUpdateBuffer[x].UpdateKind=ukDelete) and FCurrentIndex.CompareBookmarks(@FUpdateBuffer[x].NextBookmarkData,@BookmarkData) then
  2134.               CancelUpdBuffer(FUpdateBuffer[x]);
  2135.             end;}
  2136.           FreeRecordBuffer(OldValuesBuffer);
  2137.           inc(FBRecordCount);
  2138.           end  ;
  2139.       ukInsert:
  2140.         begin
  2141.         // Process all update buffers linked to this record before this record is removed
  2142.         StoreUpdBuf:=FCurrentUpdateBuffer;
  2143.         Bm := BookmarkData;
  2144.         BookmarkData.BookmarkData:=nil; // Avoid infinite recursion...
  2145.         if GetRecordUpdateBuffer(Bm,True,False) then
  2146.           begin
  2147.           repeat
  2148.           if (FCurrentUpdateBuffer<>StoreUpdBuf) then
  2149.             begin
  2150.             CancelUpdBuffer(FUpdateBuffer[FCurrentUpdateBuffer]);
  2151.             end;
  2152.           until not GetRecordUpdateBuffer(Bm,True,True);
  2153.           end;
  2154.         FCurrentUpdateBuffer:=StoreUpdBuf;
  2155.  
  2156.         FCurrentIndex.GotoBookmark(@Bm);
  2157.         TmpBuf:=FCurrentIndex.CurrentRecord;
  2158.         // resync won't work if the currentbuffer is freed...
  2159.         if FCurrentIndex.CompareBookmarks(@Bm,@StoreRecBM) then with FCurrentIndex do
  2160.           begin
  2161.           GotoBookmark(@StoreRecBM);
  2162.           if ScrollForward = grEOF then
  2163.             if ScrollBackward = grBOF then
  2164.               ScrollLast;  // last record will be removed from index, so move to spare record
  2165.           StoreCurrentRecIntoBookmark(@StoreRecBM);
  2166.           end;
  2167.         FCurrentIndex.RemoveRecordFromIndex(Bm);
  2168.         FreeRecordBuffer(TmpBuf);
  2169.         dec(FBRecordCount);
  2170.         end;
  2171.       end;
  2172.       BookmarkData.BookmarkData:=nil;
  2173.       end;
  2174.   end;
  2175.  
  2176. var r              : Integer;
  2177.  
  2178. begin
  2179.   CheckBrowseMode;
  2180.  
  2181.   if Length(FUpdateBuffer) > 0 then
  2182.     begin
  2183.     FCurrentIndex.StoreCurrentRecIntoBookmark(@StoreRecBM);
  2184.     for r := Length(FUpdateBuffer) - 1 downto 0 do
  2185.       CancelUpdBuffer(FUpdateBuffer[r]);
  2186.  
  2187.     SetLength(FUpdateBuffer,0);
  2188.    
  2189.     FCurrentIndex.GotoBookmark(@StoreRecBM);
  2190.    
  2191.     Resync([]);
  2192.     end;
  2193. end;
  2194.  
  2195. procedure TCustomBufDataset.SetOnUpdateError(const AValue: TResolverErrorEvent);
  2196.  
  2197. begin
  2198.   FOnUpdateError := AValue;
  2199. end;
  2200.  
  2201. procedure TCustomBufDataset.ApplyUpdates; // For backward compatibility
  2202.  
  2203. begin
  2204.   ApplyUpdates(0);
  2205. end;
  2206.  
  2207. procedure TCustomBufDataset.ApplyUpdates(MaxErrors: Integer);
  2208.  
  2209. var r            : Integer;
  2210.     FailedCount  : integer;
  2211.     Response     : TResolverResponse;
  2212.     StoreCurrRec : TBufBookmark;
  2213.     AUpdateErr   : EUpdateError;
  2214.  
  2215. begin
  2216.   CheckBrowseMode;
  2217.  
  2218.   FCurrentIndex.StoreCurrentRecIntoBookmark(@StoreCurrRec);
  2219.  
  2220.   r := 0;
  2221.   FailedCount := 0;
  2222.   Response := rrApply;
  2223.   DisableControls;
  2224.   try
  2225.     while (r < Length(FUpdateBuffer)) and (Response <> rrAbort) do
  2226.       begin
  2227.       // If the record is first inserted and afterwards deleted, do nothing
  2228.       if not ((FUpdateBuffer[r].UpdateKind=ukDelete) and not (assigned(FUpdateBuffer[r].OldValuesBuffer))) then
  2229.         begin
  2230.         FCurrentIndex.GotoBookmark(@FUpdateBuffer[r].BookmarkData);
  2231.         // Synchronise the Currentbuffer to the ActiveBuffer
  2232.         CurrentRecordToBuffer(ActiveBuffer);
  2233.         Response := rrApply;
  2234.         try
  2235.           ApplyRecUpdate(FUpdateBuffer[r].UpdateKind);
  2236.         except
  2237.           on E: EDatabaseError do
  2238.             begin
  2239.             Inc(FailedCount);
  2240.             if FailedCount > word(MaxErrors) then Response := rrAbort
  2241.             else Response := rrSkip;
  2242.             if assigned(FOnUpdateError) then
  2243.               begin
  2244.               AUpdateErr := EUpdateError.Create(SOnUpdateError,E.Message,0,0,Exception(AcquireExceptionObject));
  2245.               FOnUpdateError(Self,Self,AUpdateErr,FUpdateBuffer[r].UpdateKind,Response);
  2246.               AUpdateErr.Free;
  2247.               if Response in [rrApply, rrIgnore] then dec(FailedCount);
  2248.               if Response = rrApply then dec(r);
  2249.               end
  2250.             else if Response = rrAbort then
  2251.               Raise EUpdateError.Create(SOnUpdateError,E.Message,0,0,Exception(AcquireExceptionObject));
  2252.             end
  2253.           else
  2254.             raise;
  2255.         end;
  2256.         if response in [rrApply, rrIgnore] then
  2257.           begin
  2258.           FreeRecordBuffer(FUpdateBuffer[r].OldValuesBuffer);
  2259.           if FUpdateBuffer[r].UpdateKind = ukDelete then
  2260.             FreeRecordBuffer( TRecordBuffer(FUpdateBuffer[r].BookmarkData.BookmarkData));
  2261.           FUpdateBuffer[r].BookmarkData.BookmarkData := nil;
  2262.           end
  2263.         end;
  2264.       inc(r);
  2265.       end;
  2266.   finally
  2267.     if FailedCount = 0 then
  2268.       MergeChangeLog;
  2269.  
  2270.     InternalGotoBookmark(@StoreCurrRec);
  2271.     Resync([]);
  2272.     EnableControls;
  2273.   end;
  2274. end;
  2275.  
  2276. procedure TCustomBufDataset.MergeChangeLog;
  2277.  
  2278. var r            : Integer;
  2279.  
  2280. begin
  2281.   for r:=0 to length(FUpdateBuffer)-1 do
  2282.     if assigned(FUpdateBuffer[r].OldValuesBuffer) then
  2283.       FreeMem(FUpdateBuffer[r].OldValuesBuffer);
  2284.   SetLength(FUpdateBuffer,0);
  2285.  
  2286.   if assigned(FUpdateBlobBuffers) then for r:=0 to length(FUpdateBlobBuffers)-1 do
  2287.     if assigned(FUpdateBlobBuffers[r]) then
  2288.       begin
  2289.       // update blob buffer is already referenced from record buffer (see InternalPost)
  2290.       if FUpdateBlobBuffers[r]^.OrgBufID >= 0 then
  2291.         begin
  2292.         FreeBlobBuffer(FBlobBuffers[FUpdateBlobBuffers[r]^.OrgBufID]);
  2293.         FBlobBuffers[FUpdateBlobBuffers[r]^.OrgBufID] := FUpdateBlobBuffers[r];
  2294.         end
  2295.       else
  2296.         begin
  2297.         setlength(FBlobBuffers,length(FBlobBuffers)+1);
  2298.         FUpdateBlobBuffers[r]^.OrgBufID := high(FBlobBuffers);
  2299.         FBlobBuffers[high(FBlobBuffers)] := FUpdateBlobBuffers[r];
  2300.         end;
  2301.       end;
  2302.   SetLength(FUpdateBlobBuffers,0);
  2303. end;
  2304.  
  2305.  
  2306. procedure TCustomBufDataset.InternalCancel;
  2307.  
  2308. Var i            : integer;
  2309.  
  2310. begin
  2311.   if assigned(FUpdateBlobBuffers) then for i:=0 to length(FUpdateBlobBuffers)-1 do
  2312.     if assigned(FUpdateBlobBuffers[i]) and (FUpdateBlobBuffers[i]^.FieldNo>0) then
  2313.       FreeBlobBuffer(FUpdateBlobBuffers[i]);
  2314. end;
  2315.  
  2316. procedure TCustomBufDataset.InternalPost;
  2317.  
  2318. Var ABuff        : TRecordBuffer;
  2319.     i            : integer;
  2320.     blobbuf      : tbufblobfield;
  2321.     NullMask     : pbyte;
  2322.     ABookmark    : PBufBookmark;
  2323.  
  2324. begin
  2325.   inherited InternalPost;
  2326.   if assigned(FUpdateBlobBuffers) then for i:=0 to length(FUpdateBlobBuffers)-1 do
  2327.    if assigned(FUpdateBlobBuffers[i]) and (FUpdateBlobBuffers[i]^.FieldNo>0) then
  2328.     begin
  2329.     blobbuf.BlobBuffer := FUpdateBlobBuffers[i];
  2330.     ABuff := ActiveBuffer;
  2331.     NullMask := PByte(ABuff);
  2332.  
  2333.     inc(ABuff,FFieldBufPositions[FUpdateBlobBuffers[i]^.FieldNo-1]);
  2334.     Move(blobbuf, ABuff^, GetFieldSize(FieldDefs[FUpdateBlobBuffers[i]^.FieldNo-1]));
  2335.     unSetFieldIsNull(NullMask,FUpdateBlobBuffers[i]^.FieldNo-1);
  2336.    
  2337.     FUpdateBlobBuffers[i]^.FieldNo := -1;
  2338.     end;
  2339.  
  2340.   if State = dsInsert then
  2341.     begin
  2342.     if assigned(FAutoIncField) then
  2343.       begin
  2344.       FAutoIncField.AsInteger := FAutoIncValue;
  2345.       inc(FAutoIncValue);
  2346.       end;
  2347.     // The active buffer is the newly created TDataset record,
  2348.     // from which the bookmark is set to the record where the new record should be
  2349.     // inserted
  2350.     ABookmark := PBufBookmark(ActiveBuffer + FRecordSize);
  2351.     // Create the new record buffer
  2352.     ABuff := IntAllocRecordBuffer;
  2353.  
  2354.     // Add new record to all active indexes
  2355.     for i := 0 to FIndexesCount-1 do
  2356.       if (i<>1) or (FIndexes[i]=FCurrentIndex) then
  2357.       begin
  2358.         if ABookmark^.BookmarkFlag = bfEOF then
  2359.           // append (at end)
  2360.           FIndexes[i].ScrollLast
  2361.         else
  2362.           // insert (before current record)
  2363.           FIndexes[i].GotoBookmark(ABookmark);
  2364.  
  2365.         FIndexes[i].InsertRecordBeforeCurrentRecord(ABuff);
  2366.         // newly inserted record becomes current record
  2367.         FIndexes[i].ScrollBackward;
  2368.       end;
  2369.  
  2370.     // Link the newly created record buffer to the newly created TDataset record
  2371.     FCurrentIndex.StoreCurrentRecIntoBookmark(ABookmark);
  2372.     ABookmark^.BookmarkFlag := bfInserted;
  2373.  
  2374.     inc(FBRecordCount);
  2375.     end
  2376.   else
  2377.     InternalSetToRecord(ActiveBuffer);
  2378.  
  2379.   // If there is no updatebuffer already, add one
  2380.   if not GetActiveRecordUpdateBuffer then
  2381.     begin
  2382.     // Add a new updatebuffer
  2383.     FCurrentUpdateBuffer := length(FUpdateBuffer);
  2384.     SetLength(FUpdateBuffer,FCurrentUpdateBuffer+1);
  2385.  
  2386.     // Store a bookmark of the current record into the updatebuffer's bookmark
  2387.     FCurrentIndex.StoreCurrentRecIntoBookmark(@FUpdateBuffer[FCurrentUpdateBuffer].BookmarkData);
  2388.  
  2389.     if State = dsEdit then
  2390.       begin
  2391.       // Create an oldvalues buffer with the old values of the record
  2392.       FUpdateBuffer[FCurrentUpdateBuffer].OldValuesBuffer := IntAllocRecordBuffer;
  2393.       with FCurrentIndex do
  2394.         // Move only the real data
  2395.         move(CurrentBuffer^,FUpdateBuffer[FCurrentUpdateBuffer].OldValuesBuffer^,FRecordSize);
  2396.       FUpdateBuffer[FCurrentUpdateBuffer].UpdateKind := ukModify;
  2397.       end
  2398.     else
  2399.       begin
  2400.       FUpdateBuffer[FCurrentUpdateBuffer].UpdateKind := ukInsert;
  2401.       FUpdateBuffer[FCurrentUpdateBuffer].OldValuesBuffer := nil;
  2402.       end;
  2403.     end;
  2404.  
  2405.   move(ActiveBuffer^,FCurrentIndex.CurrentBuffer^,FRecordSize);
  2406.  
  2407.   // new data are now in current record so reorder current record if needed
  2408.   for i := 1 to FIndexesCount-1 do
  2409.     if (i<>1) or (FIndexes[i]=FCurrentIndex) then
  2410.       FIndexes[i].OrderCurrentRecord;
  2411. end;
  2412.  
  2413. procedure TCustomBufDataset.CalcRecordSize;
  2414.  
  2415. var x : longint;
  2416.  
  2417. begin
  2418.   FNullmaskSize := 1+((FieldDefs.count-1) div 8);
  2419. {$IFDEF FPC_REQUIRES_PROPER_ALIGNMENT}
  2420.   FNullmaskSize:=Align(FNullmaskSize,4);
  2421. {$ENDIF}
  2422.   FRecordSize := FNullmaskSize;
  2423.   SetLength(FFieldBufPositions,FieldDefs.count);
  2424.   for x := 0 to FieldDefs.count-1 do
  2425.     begin
  2426.     FFieldBufPositions[x] := FRecordSize;
  2427.     inc(FRecordSize, GetFieldSize(FieldDefs[x]));
  2428.     end;
  2429. end;
  2430.  
  2431. function TCustomBufDataset.GetIndexFieldNames: String;
  2432. begin
  2433.   if (FIndexesCount=0) or (FCurrentIndex<>FIndexes[1]) then
  2434.     result := ''
  2435.   else
  2436.     result := FCurrentIndex.FieldsName;
  2437. end;
  2438.  
  2439. function TCustomBufDataset.GetIndexName: String;
  2440. begin
  2441.   if FIndexesCount>0 then
  2442.     result := FCurrentIndex.Name
  2443.   else
  2444.     result := '';
  2445. end;
  2446.  
  2447. function TCustomBufDataset.GetBufUniDirectional: boolean;
  2448. begin
  2449.   result := IsUniDirectional;
  2450. end;
  2451.  
  2452. function TCustomBufDataset.GetPacketReader(const Format: TDataPacketFormat; const AStream: TStream): TDataPacketReader;
  2453.  
  2454. var APacketReader: TDataPacketReader;
  2455.     APacketReaderReg: TDatapacketReaderRegistration;
  2456.  
  2457. begin
  2458.   if GetRegisterDatapacketReader(AStream, format, APacketReaderReg) then
  2459.     APacketReader := APacketReaderReg.ReaderClass.create(AStream)
  2460.   else if TFpcBinaryDatapacketReader.RecognizeStream(AStream) then
  2461.     begin
  2462.     AStream.Seek(0, soFromBeginning);
  2463.     APacketReader := TFpcBinaryDatapacketReader.create(AStream)
  2464.     end
  2465.   else
  2466.     DatabaseError(SStreamNotRecognised);
  2467.   Result:=APacketReader;
  2468. end;
  2469.  
  2470. function TCustomBufDataset.GetRecordSize : Word;
  2471.  
  2472. begin
  2473.   result := FRecordSize + BookmarkSize;
  2474. end;
  2475.  
  2476. function TCustomBufDataset.GetChangeCount: integer;
  2477.  
  2478. begin
  2479.   result := length(FUpdateBuffer);
  2480. end;
  2481.  
  2482.  
  2483. procedure TCustomBufDataset.InternalInitRecord(Buffer:  TRecordBuffer);
  2484.  
  2485. begin
  2486.   FillChar(Buffer^, FRecordSize, #0);
  2487.  
  2488.   fillchar(Buffer^,FNullmaskSize,255);
  2489. end;
  2490.  
  2491. procedure TCustomBufDataset.SetRecNo(Value: Longint);
  2492.  
  2493. var
  2494.     recnr        : integer;
  2495.     TmpRecBuffer : PBufRecLinkItem;
  2496.  
  2497. begin
  2498.   CheckBrowseMode;
  2499.   if value > RecordCount then
  2500.     begin
  2501.     repeat until (getnextpacket < FPacketRecords) or (value <= RecordCount) or (FPacketRecords = -1);
  2502.     if value > RecordCount then
  2503.       begin
  2504.       DatabaseError(SNoSuchRecord,self);
  2505.       exit;
  2506.       end;
  2507.     end;
  2508.   TmpRecBuffer := (FCurrentIndex as TDoubleLinkedBufIndex).FFirstRecBuf;
  2509.   for recnr := 1 to value-1 do
  2510.     TmpRecBuffer := TmpRecBuffer[FCurrentIndex.IndNr].next;
  2511.   GotoBookmark(@TmpRecBuffer);
  2512. end;
  2513.  
  2514. function TCustomBufDataset.GetRecNo: Longint;
  2515.  
  2516. Var abuf            :  TRecordBuffer;
  2517.  
  2518. begin
  2519.   abuf := GetCurrentBuffer;
  2520.   // If abuf isn't assigned, the recordset probably isn't opened.
  2521.   if assigned(abuf) and (FBRecordCount>0) and (State <> dsInsert) then
  2522.     Result:=FCurrentIndex.GetRecNo(PBufBookmark(abuf+FRecordSize))
  2523.   else
  2524.     result := 0;
  2525. end;
  2526.  
  2527. function TCustomBufDataset.IsCursorOpen: Boolean;
  2528.  
  2529. begin
  2530.   Result := FOpen;
  2531. end;
  2532.  
  2533. Function TCustomBufDataset.GetRecordCount: Longint;
  2534.  
  2535. begin
  2536.   Result := FBRecordCount;
  2537. end;
  2538.  
  2539. Function TCustomBufDataset.UpdateStatus: TUpdateStatus;
  2540.  
  2541. begin
  2542.   Result:=usUnmodified;
  2543.   if GetActiveRecordUpdateBuffer then
  2544.     case FUpdateBuffer[FCurrentUpdateBuffer].UpdateKind of
  2545.       ukModify : Result := usModified;
  2546.       ukInsert : Result := usInserted;
  2547.       ukDelete : Result := usDeleted;
  2548.     end;
  2549. end;
  2550.  
  2551. function TCustomBufDataset.GetNewBlobBuffer : PBlobBuffer;
  2552.  
  2553. var ABlobBuffer : PBlobBuffer;
  2554.  
  2555. begin
  2556.   setlength(FBlobBuffers,length(FBlobBuffers)+1);
  2557.   new(ABlobBuffer);
  2558.   fillbyte(ABlobBuffer^,sizeof(ABlobBuffer^),0);
  2559.   ABlobBuffer^.OrgBufID := high(FBlobBuffers);
  2560.   FBlobBuffers[high(FBlobBuffers)] := ABlobBuffer;
  2561.   result := ABlobBuffer;
  2562. end;
  2563.  
  2564. function TCustomBufDataset.GetNewWriteBlobBuffer : PBlobBuffer;
  2565.  
  2566. var ABlobBuffer : PBlobBuffer;
  2567.  
  2568. begin
  2569.   setlength(FUpdateBlobBuffers,length(FUpdateBlobBuffers)+1);
  2570.   new(ABlobBuffer);
  2571.   fillbyte(ABlobBuffer^,sizeof(ABlobBuffer^),0);
  2572.   FUpdateBlobBuffers[high(FUpdateBlobBuffers)] := ABlobBuffer;
  2573.   result := ABlobBuffer;
  2574. end;
  2575.  
  2576. procedure TCustomBufDataset.FreeBlobBuffer(var ABlobBuffer: PBlobBuffer);
  2577.  
  2578. begin
  2579.   if not Assigned(ABlobBuffer) then Exit;
  2580.   FreeMem(ABlobBuffer^.Buffer, ABlobBuffer^.Size);
  2581.   Dispose(ABlobBuffer);
  2582.   ABlobBuffer := Nil;
  2583. end;
  2584.  
  2585. function TBufBlobStream.Seek(Offset: Longint; Origin: Word): Longint;
  2586.  
  2587. begin
  2588.   Case Origin of
  2589.     soFromBeginning : FPosition:=Offset;
  2590.     soFromEnd       : FPosition:=FBlobBuffer^.Size+Offset;
  2591.     soFromCurrent   : FPosition:=FPosition+Offset;
  2592.   end;
  2593.   Result:=FPosition;
  2594. end;
  2595.  
  2596.  
  2597. function TBufBlobStream.Read(var Buffer; Count: Longint): Longint;
  2598.  
  2599. var ptr : pointer;
  2600.  
  2601. begin
  2602.   if FPosition + count > FBlobBuffer^.Size then
  2603.     count := FBlobBuffer^.Size-FPosition;
  2604.   ptr := FBlobBuffer^.Buffer+FPosition;
  2605.   move(ptr^,buffer,count);
  2606.   inc(FPosition,count);
  2607.   result := count;
  2608. end;
  2609.  
  2610. function TBufBlobStream.Write(const Buffer; Count: Longint): Longint;
  2611.  
  2612. var ptr : pointer;
  2613.  
  2614. begin
  2615.   ReAllocMem(FBlobBuffer^.Buffer,FPosition+Count);
  2616.   ptr := FBlobBuffer^.Buffer+FPosition;
  2617.   move(buffer,ptr^,count);
  2618.   inc(FBlobBuffer^.Size,count);
  2619.   inc(FPosition,count);
  2620.   Result := count;
  2621. end;
  2622.  
  2623. constructor TBufBlobStream.Create(Field: TBlobField; Mode: TBlobStreamMode);
  2624.  
  2625. var bufblob : TBufBlobField;
  2626.  
  2627. begin
  2628.   FDataset := Field.DataSet as TCustomBufDataset;
  2629.   if Mode = bmRead then
  2630.     begin
  2631.     if not Field.GetData(@bufblob) then
  2632.       DatabaseError(SFieldIsNull);
  2633.     if not assigned(bufblob.BlobBuffer) then with FDataSet do
  2634.       begin
  2635.       FBlobBuffer := GetNewBlobBuffer;
  2636.       bufblob.BlobBuffer := FBlobBuffer;
  2637.       LoadBlobIntoBuffer(FieldDefs[Field.FieldNo-1],@bufblob);
  2638.       end
  2639.     else
  2640.       FBlobBuffer := bufblob.BlobBuffer;
  2641.     end
  2642.   else if Mode=bmWrite then with FDataSet as TCustomBufDataset do
  2643.     begin
  2644.     FBlobBuffer := GetNewWriteBlobBuffer;
  2645.     FBlobBuffer^.FieldNo := Field.FieldNo;
  2646.     if (Field.GetData(@bufblob)) and assigned(bufblob.BlobBuffer) then
  2647.       FBlobBuffer^.OrgBufID := bufblob.BlobBuffer^.OrgBufID
  2648.     else
  2649.       FBlobBuffer^.OrgBufID := -1;
  2650.     end;
  2651. end;
  2652.  
  2653. function TCustomBufDataset.CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream;
  2654.  
  2655. var bufblob : TBufBlobField;
  2656.  
  2657. begin
  2658.   result := nil;
  2659.   if Mode = bmRead then
  2660.     begin
  2661.     if not Field.GetData(@bufblob) then
  2662.       exit;
  2663.  
  2664.     result := TBufBlobStream.Create(Field as TBlobField, bmRead);
  2665.     end
  2666.   else if Mode = bmWrite then
  2667.     begin
  2668.     if not (State in [dsEdit, dsInsert, dsFilter, dsCalcFields]) then
  2669.       DatabaseErrorFmt(SNotEditing,[Name],self);
  2670.  
  2671.     result := TBufBlobStream.Create(Field as TBlobField, bmWrite);
  2672.  
  2673.     if not (State in [dsCalcFields, dsFilter, dsNewValue]) then
  2674.       DataEvent(deFieldChange, Ptrint(Field));
  2675.     end;
  2676. end;
  2677.  
  2678. procedure TCustomBufDataset.SetDatasetPacket(AReader: TDataPacketReader);
  2679. begin
  2680.   FDatasetReader := AReader;
  2681.   try
  2682.     Open;
  2683.   finally
  2684.     FDatasetReader := nil;
  2685.   end;
  2686. end;
  2687.  
  2688. procedure TCustomBufDataset.GetDatasetPacket(AWriter: TDataPacketReader);
  2689.  
  2690.   procedure StoreUpdateBuffer(AUpdBuffer : TRecUpdateBuffer; var ARowState: TRowState);
  2691.   var AThisRowState : TRowState;
  2692.       AStoreUpdBuf  : Integer;
  2693.   begin
  2694.     if AUpdBuffer.UpdateKind = ukModify then
  2695.       begin
  2696.       AThisRowState := [rsvOriginal];
  2697.       ARowState:=[rsvUpdated];
  2698.       end
  2699.     else if AUpdBuffer.UpdateKind = ukDelete then
  2700.       begin
  2701.       AStoreUpdBuf:=FCurrentUpdateBuffer;
  2702.       if GetRecordUpdateBuffer(AUpdBuffer.BookmarkData,True,False) then
  2703.         begin
  2704.         repeat
  2705.           if FCurrentIndex.CompareBookmarks(@FUpdateBuffer[FCurrentUpdateBuffer].NextBookmarkData, @AUpdBuffer.BookmarkData) then
  2706.             StoreUpdateBuffer(FUpdateBuffer[FCurrentUpdateBuffer], ARowState);
  2707.         until not GetRecordUpdateBuffer(AUpdBuffer.BookmarkData,True,True)
  2708.         end;
  2709.       FCurrentUpdateBuffer:=AStoreUpdBuf;
  2710.       AThisRowState := [rsvDeleted];
  2711.       end
  2712.     else // ie: UpdateKind = ukInsert
  2713.       ARowState := [rsvInserted];
  2714.  
  2715.     FFilterBuffer:=AUpdBuffer.OldValuesBuffer;
  2716.     // OldValuesBuffer is nil if the record is either inserted or inserted and then deleted
  2717.     if assigned(FFilterBuffer) then
  2718.       FDatasetReader.StoreRecord(Self,AThisRowState,FCurrentUpdateBuffer);
  2719.   end;
  2720.  
  2721.   procedure HandleUpdateBuffersFromRecord(AFirstCall : boolean;ARecBookmark : TBufBookmark; var ARowState: TRowState);
  2722.   var StoreUpdBuf1,StoreUpdBuf2 : Integer;
  2723.   begin
  2724.     if AFirstCall then ARowState:=[];
  2725.     if GetRecordUpdateBuffer(ARecBookmark,True,not AFirstCall) then
  2726.       begin
  2727.       if FUpdateBuffer[FCurrentUpdateBuffer].UpdateKind=ukDelete then
  2728.         begin
  2729.         StoreUpdBuf1:=FCurrentUpdateBuffer;
  2730.         HandleUpdateBuffersFromRecord(False,ARecBookmark,ARowState);
  2731.         StoreUpdBuf2:=FCurrentUpdateBuffer;
  2732.         FCurrentUpdateBuffer:=StoreUpdBuf1;
  2733.         StoreUpdateBuffer(FUpdateBuffer[StoreUpdBuf1], ARowState);
  2734.         FCurrentUpdateBuffer:=StoreUpdBuf2;
  2735.         end
  2736.       else
  2737.         begin
  2738.         StoreUpdateBuffer(FUpdateBuffer[FCurrentUpdateBuffer], ARowState);
  2739.         HandleUpdateBuffersFromRecord(False,ARecBookmark,ARowState);
  2740.         end;
  2741.       end
  2742.   end;
  2743.  
  2744. var ScrollResult   : TGetResult;
  2745.     StoreDSState   : TDataSetState;
  2746.     ABookMark      : PBufBookmark;
  2747.     ATBookmark     : TBufBookmark;
  2748.     RowState       : TRowState;
  2749.  
  2750. begin
  2751.   FDatasetReader := AWriter;
  2752.   try
  2753.     //  CheckActive;
  2754.     ABookMark:=@ATBookmark;
  2755.     FDatasetReader.StoreFieldDefs(FieldDefs,FAutoIncValue);
  2756.  
  2757.     StoreDSState:=SetTempState(dsFilter);
  2758.     ScrollResult:=FCurrentIndex.ScrollFirst;
  2759.     while ScrollResult=grOK do
  2760.       begin
  2761.       RowState:=[];
  2762.       FCurrentIndex.StoreCurrentRecIntoBookmark(ABookmark);
  2763.       HandleUpdateBuffersFromRecord(True,ABookmark^,RowState);
  2764.       FFilterBuffer:=FCurrentIndex.CurrentBuffer;
  2765.       if RowState=[] then
  2766.         FDatasetReader.StoreRecord(Self,[])
  2767.       else
  2768.         FDatasetReader.StoreRecord(Self,RowState,FCurrentUpdateBuffer);
  2769.  
  2770.       ScrollResult:=FCurrentIndex.ScrollForward;
  2771.       if ScrollResult<>grOK then
  2772.         begin
  2773.         if getnextpacket>0 then
  2774.           ScrollResult := FCurrentIndex.ScrollForward;
  2775.         end;
  2776.       end;
  2777.     // There could be an update buffer linked to the last (spare) record
  2778.     FCurrentIndex.StoreSpareRecIntoBookmark(ABookmark);
  2779.     HandleUpdateBuffersFromRecord(True,ABookmark^,RowState);
  2780.  
  2781.     RestoreState(StoreDSState);
  2782.  
  2783.     FDatasetReader.FinalizeStoreRecords;
  2784.   finally
  2785.     FDatasetReader := nil;
  2786.   end;
  2787. end;
  2788.  
  2789. procedure TCustomBufDataset.LoadFromStream(AStream: TStream; Format: TDataPacketFormat);
  2790. var APacketReader : TDataPacketReader;
  2791. begin
  2792.   CheckBiDirectional;
  2793.   APacketReader:=GetPacketReader(Format, AStream);
  2794.   try
  2795.     SetDatasetPacket(APacketReader);
  2796.   finally
  2797.     APacketReader.Free;
  2798.   end;
  2799. end;
  2800.  
  2801. procedure TCustomBufDataset.SaveToStream(AStream: TStream; Format: TDataPacketFormat);
  2802. var APacketReaderReg : TDatapacketReaderRegistration;
  2803.     APacketWriter : TDataPacketReader;
  2804. begin
  2805.   CheckBiDirectional;
  2806.   if GetRegisterDatapacketReader(Nil,format,APacketReaderReg) then
  2807.     APacketWriter := APacketReaderReg.ReaderClass.create(AStream)
  2808.   else if Format = dfBinary then
  2809.     APacketWriter := TFpcBinaryDatapacketReader.create(AStream)
  2810.   else
  2811.     DatabaseError(SNoReaderClassRegistered);
  2812.   try
  2813.     GetDatasetPacket(APacketWriter);
  2814.   finally
  2815.     APacketWriter.Free;
  2816.   end;
  2817. end;
  2818.  
  2819. procedure TCustomBufDataset.LoadFromFile(AFileName: string; Format: TDataPacketFormat);
  2820. var AFileStream : TFileStream;
  2821. begin
  2822.   if AFileName='' then AFileName := FFileName;
  2823.   AFileStream := TFileStream.Create(AFileName,fmOpenRead);
  2824.   try
  2825.     LoadFromStream(AFileStream, Format);
  2826.   finally
  2827.     AFileStream.Free;
  2828.   end;
  2829. end;
  2830.  
  2831. procedure TCustomBufDataset.SaveToFile(AFileName: string;
  2832.   Format: TDataPacketFormat);
  2833. var AFileStream : TFileStream;
  2834. begin
  2835.   if AFileName='' then AFileName := FFileName;
  2836.   AFileStream := TFileStream.Create(AFileName,fmCreate);
  2837.   try
  2838.     SaveToStream(AFileStream, Format);
  2839.   finally
  2840.     AFileStream.Free;
  2841.   end;
  2842. end;
  2843.  
  2844. procedure TCustomBufDataset.CreateDataset;
  2845. var AStoreFileName: string;
  2846. begin
  2847.   CheckInactive;
  2848.   if ((FieldCount=0) or (FieldDefs.Count=0)) then
  2849.     begin
  2850.     if (FieldDefs.Count>0) then
  2851.       CreateFields
  2852.     else if (Fields.Count>0) then
  2853.       begin
  2854.       InitFieldDefsFromFields;
  2855.       BindFields(True);
  2856.       end
  2857.     else
  2858.       raise Exception.Create(SErrNoFieldsDefined);
  2859.     FAutoIncValue:=1;
  2860.     end;
  2861.   // When a FileName is set, do not read from this file
  2862.   AStoreFileName:=FFileName;
  2863.   FFileName := '';
  2864.   try
  2865.     Open;
  2866.   finally
  2867.     FFileName:=AStoreFileName;
  2868.   end;
  2869. end;
  2870.  
  2871. function TCustomBufDataset.BookmarkValid(ABookmark: TBookmark): Boolean;
  2872. begin
  2873.   Result:=assigned(FCurrentIndex) and  FCurrentIndex.BookmarkValid(pointer(ABookmark));
  2874. end;
  2875.  
  2876. function TCustomBufDataset.CompareBookmarks(Bookmark1, Bookmark2: TBookmark
  2877.   ): Longint;
  2878. begin
  2879.   if Assigned(FCurrentIndex) and FCurrentIndex.CompareBookmarks(pointer(Bookmark1),pointer(Bookmark2)) then
  2880.     Result := 0
  2881.   else
  2882.     Result := -1;
  2883. end;
  2884.  
  2885. procedure TCustomBufDataset.IntLoadFielddefsFromFile;
  2886.  
  2887. begin
  2888.   FieldDefs.Clear;
  2889.   FDatasetReader.LoadFielddefs(FieldDefs, FAutoIncValue);
  2890.   if DefaultFields then
  2891.     CreateFields
  2892.   else
  2893.     BindFields(true);
  2894. end;
  2895.  
  2896. procedure TCustomBufDataset.IntLoadRecordsFromFile;
  2897.  
  2898. var StoreState      : TDataSetState;
  2899.     AddRecordBuffer : boolean;
  2900.     ARowState       : TRowState;
  2901.     AUpdOrder       : integer;
  2902.     x               : integer;
  2903.  
  2904. begin
  2905.   CheckBiDirectional;
  2906.   FDatasetReader.InitLoadRecords;
  2907.   StoreState:=SetTempState(dsFilter);
  2908.  
  2909.   while FDatasetReader.GetCurrentRecord do
  2910.     begin
  2911.     ARowState := FDatasetReader.GetRecordRowState(AUpdOrder);
  2912.     if rsvOriginal in ARowState then
  2913.       begin
  2914.       if length(FUpdateBuffer) < (AUpdOrder+1) then
  2915.         SetLength(FUpdateBuffer,AUpdOrder+1);
  2916.  
  2917.       FCurrentUpdateBuffer:=AUpdOrder;
  2918.  
  2919.       FFilterBuffer:=IntAllocRecordBuffer;
  2920.       fillchar(FFilterBuffer^,FNullmaskSize,0);
  2921.       FUpdateBuffer[FCurrentUpdateBuffer].OldValuesBuffer := FFilterBuffer;
  2922.       FDatasetReader.RestoreRecord(self);
  2923.  
  2924.       FDatasetReader.GotoNextRecord;
  2925.       if not FDatasetReader.GetCurrentRecord then
  2926.         DatabaseError(SStreamNotRecognised);
  2927.       ARowState := FDatasetReader.GetRecordRowState(AUpdOrder);
  2928.       if rsvUpdated in ARowState then
  2929.         FUpdateBuffer[FCurrentUpdateBuffer].UpdateKind:= ukModify
  2930.       else
  2931.         DatabaseError(SStreamNotRecognised);
  2932.  
  2933.       FFilterBuffer:=FIndexes[0].SpareBuffer;
  2934.       FIndexes[0].StoreSpareRecIntoBookmark(@FUpdateBuffer[FCurrentUpdateBuffer].BookmarkData);
  2935.       fillchar(FFilterBuffer^,FNullmaskSize,0);
  2936.  
  2937.       FDatasetReader.RestoreRecord(self);
  2938.       FIndexes[0].AddRecord;
  2939.       inc(FBRecordCount);
  2940.  
  2941.       AddRecordBuffer:=False;
  2942.  
  2943.       end
  2944.     else if rsvDeleted in ARowState then
  2945.       begin
  2946.       if length(FUpdateBuffer) < (AUpdOrder+1) then
  2947.         SetLength(FUpdateBuffer,AUpdOrder+1);
  2948.  
  2949.       FCurrentUpdateBuffer:=AUpdOrder;
  2950.  
  2951.       FFilterBuffer:=IntAllocRecordBuffer;
  2952.       fillchar(FFilterBuffer^,FNullmaskSize,0);
  2953.  
  2954.       FUpdateBuffer[FCurrentUpdateBuffer].OldValuesBuffer := FFilterBuffer;
  2955.       FDatasetReader.RestoreRecord(self);
  2956.  
  2957.       FUpdateBuffer[FCurrentUpdateBuffer].UpdateKind:= ukDelete;
  2958.       FIndexes[0].StoreSpareRecIntoBookmark(@FUpdateBuffer[FCurrentUpdateBuffer].BookmarkData);
  2959.       FIndexes[0].AddRecord;
  2960.       FIndexes[0].RemoveRecordFromIndex(FUpdateBuffer[FCurrentUpdateBuffer].BookmarkData);
  2961.       FIndexes[0].StoreSpareRecIntoBookmark(@FUpdateBuffer[FCurrentUpdateBuffer].NextBookmarkData);
  2962.  
  2963.       for x := FCurrentUpdateBuffer+1 to length(FUpdateBuffer)-1 do
  2964.         if Findexes[0].CompareBookmarks(@FUpdateBuffer[FCurrentUpdateBuffer].BookmarkData,@FUpdateBuffer[x].NextBookmarkData) then
  2965.           FIndexes[0].StoreSpareRecIntoBookmark(@FUpdateBuffer[x].NextBookmarkData);
  2966.  
  2967.       AddRecordBuffer:=False;
  2968.       end
  2969.     else
  2970.       AddRecordBuffer:=True;
  2971.  
  2972.     if AddRecordBuffer then
  2973.       begin
  2974.       FFilterBuffer:=FIndexes[0].SpareBuffer;
  2975.       fillchar(FFilterBuffer^,FNullmaskSize,0);
  2976.  
  2977.       FDatasetReader.RestoreRecord(self);
  2978.  
  2979.       if rsvInserted in ARowState then
  2980.         begin
  2981.         if length(FUpdateBuffer) < (AUpdOrder+1) then
  2982.           SetLength(FUpdateBuffer,AUpdOrder+1);
  2983.         FCurrentUpdateBuffer:=AUpdOrder;
  2984.         FUpdateBuffer[FCurrentUpdateBuffer].UpdateKind:= ukInsert;
  2985.         FIndexes[0].StoreSpareRecIntoBookmark(@FUpdateBuffer[FCurrentUpdateBuffer].BookmarkData);
  2986.         end;
  2987.  
  2988.       FIndexes[0].AddRecord;
  2989.       inc(FBRecordCount);
  2990.       end;
  2991.  
  2992.     FDatasetReader.GotoNextRecord;
  2993.     end;
  2994.  
  2995.   RestoreState(StoreState);
  2996.   FIndexes[0].SetToFirstRecord;
  2997.   FAllPacketsFetched:=True;
  2998.   if assigned(FFileStream) then
  2999.     begin
  3000.     FreeAndNil(FFileStream);
  3001.     FreeAndNil(FDatasetReader);
  3002.     end;
  3003.  
  3004.   // rebuild indexes
  3005.   for x:=1 to FIndexesCount-1 do
  3006.     if (x<>1) or (FIndexes[x]=FCurrentIndex) then
  3007.       BuildIndex(FIndexes[x]);
  3008. end;
  3009.  
  3010. procedure TCustomBufDataset.DoFilterRecord(out Acceptable: Boolean);
  3011. begin
  3012.   Acceptable := true;
  3013.   // check user filter
  3014.   if Assigned(OnFilterRecord) then
  3015.     OnFilterRecord(Self, Acceptable);
  3016.  
  3017.   // check filtertext
  3018.   if Acceptable and (Length(Filter) > 0) then
  3019.     Acceptable := Boolean((FParser.ExtractFromBuffer(GetCurrentBuffer))^);
  3020. end;
  3021.  
  3022. procedure TCustomBufDataset.SetFilterText(const Value: String);
  3023. begin
  3024.   if Value = Filter then
  3025.     exit;
  3026.  
  3027.   // parse
  3028.   ParseFilter(Value);
  3029.  
  3030.   // call dataset method
  3031.   inherited;
  3032.  
  3033.   // refilter dataset if filtered
  3034.   if IsCursorOpen and Filtered then Resync([]);
  3035. end;
  3036.  
  3037. procedure TCustomBufDataset.SetFiltered(Value: Boolean); {override;}
  3038. begin
  3039.   if Value = Filtered then
  3040.     exit;
  3041.  
  3042.   // pass on to ancestor
  3043.   inherited;
  3044.  
  3045.   // only refresh if active
  3046.   if IsCursorOpen then
  3047.     Resync([]);
  3048. end;
  3049.  
  3050. procedure TCustomBufDataset.InternalRefresh;
  3051. var StoreDefaultFields: boolean;
  3052. begin
  3053.   if length(FUpdateBuffer)>0 then
  3054.     DatabaseError(SErrApplyUpdBeforeRefresh);
  3055.   StoreDefaultFields:=DefaultFields;
  3056.   SetDefaultFields(False);
  3057.   FreeFieldBuffers;
  3058.   ClearBuffers;
  3059.   InternalClose;
  3060.   BeforeRefreshOpenCursor;
  3061.   InternalOpen;
  3062.   SetDefaultFields(StoreDefaultFields);
  3063. end;
  3064.  
  3065. procedure TCustomBufDataset.BeforeRefreshOpenCursor;
  3066. begin
  3067.   // Do nothing
  3068. end;
  3069.  
  3070. procedure TCustomBufDataset.DataEvent(Event: TDataEvent; Info: Ptrint);
  3071. begin
  3072.   if Event = deUpdateState then
  3073.     // Save DataSet.State set by DataSet.SetState (filter out State set by DataSet.SetTempState)
  3074.     FSavedState := State;
  3075.   inherited;
  3076. end;
  3077.  
  3078. function TCustomBufDataset.Fetch: boolean;
  3079. begin
  3080.   // Empty procedure to make it possible to use TCustomBufDataset as a memory dataset
  3081.   Result := False;
  3082. end;
  3083.  
  3084. function TCustomBufDataset.LoadField(FieldDef: TFieldDef; buffer: pointer; out
  3085.   CreateBlob: boolean): boolean;
  3086. begin
  3087.   // Empty procedure to make it possible to use TCustomBufDataset as a memory dataset
  3088.   CreateBlob := False;
  3089.   Result := False;
  3090. end;
  3091.  
  3092. function TCustomBufDataset.IsReadFromPacket: Boolean;
  3093. begin
  3094.   Result := (FDatasetReader<>nil) or (FFileName<>'') or FReadFromFile;
  3095. end;
  3096.  
  3097. procedure TCustomBufDataset.ParseFilter(const AFilter: string);
  3098. begin
  3099.   // parser created?
  3100.   if Length(AFilter) > 0 then
  3101.   begin
  3102.     if (FParser = nil) and IsCursorOpen then
  3103.     begin
  3104.       FParser := TBufDatasetParser.Create(Self);
  3105.     end;
  3106.     // is there a parser now?
  3107.     if FParser <> nil then
  3108.     begin
  3109.       // set options
  3110.       FParser.PartialMatch := not (foNoPartialCompare in FilterOptions);
  3111.       FParser.CaseInsensitive := foCaseInsensitive in FilterOptions;
  3112.       // parse expression
  3113.       FParser.ParseExpression(AFilter);
  3114.     end;
  3115.   end;
  3116. end;
  3117.  
  3118. Function TCustomBufDataset.Locate(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions) : boolean;
  3119.  
  3120. var CurrLinkItem    : PBufRecLinkItem;
  3121.     bm              : TBufBookmark;
  3122.     SearchFields    : TList;
  3123.     DBCompareStruct : TDBCompareStruct;
  3124.     StoreDSState    : TDataSetState;
  3125.     FilterRecord    : TRecordBuffer;
  3126.     FiltAcceptable  : boolean;
  3127.  
  3128. begin
  3129.   // Call inherited to make sure the dataset is bi-directional
  3130.   Result := inherited;
  3131.   CheckActive;
  3132.   if IsEmpty then exit;
  3133.  
  3134.   // Build the DBCompare structure
  3135.   SearchFields := TList.Create;
  3136.   try
  3137.     GetFieldList(SearchFields,KeyFields);
  3138.     if SearchFields.Count=0 then exit;
  3139.     ProcessFieldsToCompareStruct(SearchFields, nil, nil, [], Options, DBCompareStruct);
  3140.   finally
  3141.     SearchFields.Free;
  3142.   end;
  3143.  
  3144.   // Set the filter buffer
  3145.   StoreDSState:=SetTempState(dsFilter);
  3146.   FFilterBuffer:=FCurrentIndex.SpareBuffer;
  3147.   SetFieldValues(KeyFields,KeyValues);
  3148.   FilterRecord:=IntAllocRecordBuffer;
  3149.   move(FCurrentIndex.SpareRecord^, FilterRecord^, FRecordSize+BufferOffset);
  3150.  
  3151.   // Iterate through the records until a match is found
  3152.   CurrLinkItem := (FCurrentIndex as TDoubleLinkedBufIndex).FFirstRecBuf;
  3153.   while (CurrLinkItem <> (FCurrentIndex as TDoubleLinkedBufIndex).FLastRecBuf) do
  3154.     begin
  3155.     if (IndexCompareRecords(FilterRecord,CurrLinkItem,DBCompareStruct) = 0) then
  3156.       begin
  3157.       if Filtered then
  3158.         begin
  3159.         FFilterBuffer:=pointer(CurrLinkItem)+BufferOffset;
  3160.         // The dataset state is still dsFilter at this point, so we don't have to set it.
  3161.         DoFilterRecord(FiltAcceptable);
  3162.         if FiltAcceptable then
  3163.           begin
  3164.           Result := True;
  3165.           break;
  3166.           end;
  3167.         end
  3168.       else
  3169.         begin
  3170.         Result := True;
  3171.         break;
  3172.         end;
  3173.       end;
  3174.     CurrLinkItem := CurrLinkItem[(FCurrentIndex as TDoubleLinkedBufIndex).IndNr].next;
  3175.     if CurrLinkItem = (FCurrentIndex as TDoubleLinkedBufIndex).FLastRecBuf then
  3176.       getnextpacket;
  3177.     end;
  3178.  
  3179.   RestoreState(StoreDSState);
  3180.   FreeRecordBuffer(FilterRecord);
  3181.  
  3182.   // If a match is found, jump to the found record
  3183.   if Result then
  3184.     begin
  3185.     bm.BookmarkData := CurrLinkItem;
  3186.     bm.BookmarkFlag := bfCurrent;
  3187.     GotoBookmark(@bm);
  3188.     end;
  3189. end;
  3190.  
  3191. function TCustomBufDataset.Lookup(const KeyFields: string;
  3192.   const KeyValues: Variant; const ResultFields: string): Variant;
  3193. var
  3194.   bm:TBookmark;
  3195. begin
  3196.   result:=Null;
  3197.   bm:=GetBookmark;
  3198.   DisableControls;
  3199.   try
  3200.     if Locate(KeyFields,KeyValues,[]) then
  3201.       begin
  3202.       //  CalculateFields(ActiveBuffer); // not needed, done by Locate more than once
  3203.       result:=FieldValues[ResultFields];
  3204.       end;
  3205.     GotoBookmark(bm);
  3206.     FreeBookmark(bm);
  3207.   finally
  3208.     EnableControls;
  3209.   end;
  3210. end;
  3211.  
  3212. { TArrayBufIndex }
  3213.  
  3214. function TArrayBufIndex.GetBookmarkSize: integer;
  3215. begin
  3216.   Result:=Sizeof(TBufBookmark);
  3217. end;
  3218.  
  3219. function TArrayBufIndex.GetCurrentBuffer: Pointer;
  3220. begin
  3221.   Result:=TRecordBuffer(FRecordArray[FCurrentRecInd]);
  3222. end;
  3223.  
  3224. function TArrayBufIndex.GetCurrentRecord:  TRecordBuffer;
  3225. begin
  3226.   Result:=GetCurrentBuffer;
  3227. end;
  3228.  
  3229. function TArrayBufIndex.GetIsInitialized: boolean;
  3230. begin
  3231.   Result:=Length(FRecordArray)>0;
  3232. end;
  3233.  
  3234. function TArrayBufIndex.GetSpareBuffer:  TRecordBuffer;
  3235. begin
  3236.   if FLastRecInd>-1 then
  3237.     Result:= TRecordBuffer(FRecordArray[FLastRecInd])
  3238.   else
  3239.     Result := nil;
  3240. end;
  3241.  
  3242. function TArrayBufIndex.GetSpareRecord:  TRecordBuffer;
  3243. begin
  3244.   Result := GetSpareBuffer;
  3245. end;
  3246.  
  3247. constructor TArrayBufIndex.Create(const ADataset: TCustomBufDataset);
  3248. begin
  3249.   Inherited create(ADataset);
  3250.   FInitialBuffers:=10000;
  3251.   FGrowBuffer:=1000;
  3252. end;
  3253.  
  3254. function TArrayBufIndex.ScrollBackward: TGetResult;
  3255. begin
  3256.   if FCurrentRecInd>0 then
  3257.     begin
  3258.     dec(FCurrentRecInd);
  3259.     Result := grOK;
  3260.     end
  3261.   else
  3262.     Result := grBOF;
  3263. end;
  3264.  
  3265. function TArrayBufIndex.ScrollForward: TGetResult;
  3266. begin
  3267.   if FCurrentRecInd = FLastRecInd-1 then
  3268.     result := grEOF
  3269.   else
  3270.     begin
  3271.     Result:=grOK;
  3272.     inc(FCurrentRecInd);
  3273.     end;
  3274. end;
  3275.  
  3276. function TArrayBufIndex.GetCurrent: TGetResult;
  3277. begin
  3278.   if FLastRecInd=0 then
  3279.     Result := grError
  3280.   else
  3281.     begin
  3282.     Result := grOK;
  3283.     if FCurrentRecInd = FLastRecInd then
  3284.       dec(FCurrentRecInd);
  3285.     end;
  3286. end;
  3287.  
  3288. function TArrayBufIndex.ScrollFirst: TGetResult;
  3289. begin
  3290.   FCurrentRecInd:=0;
  3291.   if (FCurrentRecInd = FLastRecInd) then
  3292.     result := grEOF
  3293.   else
  3294.     result := grOk;
  3295. end;
  3296.  
  3297. procedure TArrayBufIndex.ScrollLast;
  3298. begin
  3299.   FCurrentRecInd:=FLastRecInd;
  3300. end;
  3301.  
  3302. procedure TArrayBufIndex.SetToFirstRecord;
  3303. begin
  3304.   // if FCurrentRecBuf = FLastRecBuf then the dataset is just opened and empty
  3305.   // in which case InternalFirst should do nothing (bug 7211)
  3306.   if FCurrentRecInd <> FLastRecInd then
  3307.     FCurrentRecInd := -1;
  3308. end;
  3309.  
  3310. procedure TArrayBufIndex.SetToLastRecord;
  3311. begin
  3312.   if FLastRecInd <> 0 then FCurrentRecInd := FLastRecInd;
  3313. end;
  3314.  
  3315. procedure TArrayBufIndex.StoreCurrentRecord;
  3316. begin
  3317.   FStoredRecBuf := FCurrentRecInd;
  3318. end;
  3319.  
  3320. procedure TArrayBufIndex.RestoreCurrentRecord;
  3321. begin
  3322.   FCurrentRecInd := FStoredRecBuf;
  3323. end;
  3324.  
  3325. function TArrayBufIndex.CanScrollForward: Boolean;
  3326. begin
  3327.   Result := (FCurrentRecInd < FLastRecInd-1);
  3328. end;
  3329.  
  3330. procedure TArrayBufIndex.DoScrollForward;
  3331. begin
  3332.   inc(FCurrentRecInd);
  3333. end;
  3334.  
  3335. procedure TArrayBufIndex.StoreCurrentRecIntoBookmark(const ABookmark: PBufBookmark);
  3336. begin
  3337.   with ABookmark^ do
  3338.     begin
  3339.     BookmarkInt := FCurrentRecInd;
  3340.     BookmarkData := FRecordArray[FCurrentRecInd];
  3341.     end;
  3342. end;
  3343.  
  3344. procedure TArrayBufIndex.StoreSpareRecIntoBookmark(const ABookmark: PBufBookmark
  3345.   );
  3346. begin
  3347.   with ABookmark^ do
  3348.     begin
  3349.     BookmarkInt := FLastRecInd;
  3350.     BookmarkData := FRecordArray[FLastRecInd];
  3351.     end;
  3352. end;
  3353.  
  3354. function TArrayBufIndex.GetRecordFromBookmark(ABookMark: TBufBookmark) : integer;
  3355. begin
  3356.   // ABookmark.BookMarkBuf is nil if SetRecNo calls GotoBookmark
  3357.   if (ABookmark.BookmarkData<>nil) and (FRecordArray[ABookmark.BookmarkInt]<>ABookmark.BookmarkData) then
  3358.     begin
  3359.     // Start searching two records before the expected record
  3360.     if ABookmark.BookmarkInt > 2 then
  3361.       Result := ABookmark.BookmarkInt-2
  3362.     else
  3363.       Result := 0;
  3364.  
  3365.     while (Result<FLastRecInd) do
  3366.       begin
  3367.       if (FRecordArray[Result] = ABookmark.BookmarkData) then exit;
  3368.       inc(Result);
  3369.       end;
  3370.  
  3371.     Result:=0;
  3372.     while (Result<ABookmark.BookmarkInt) do
  3373.       begin
  3374.       if (FRecordArray[Result] = ABookmark.BookmarkData) then exit;
  3375.       inc(Result);
  3376.       end;
  3377.  
  3378.     DatabaseError(SInvalidBookmark)
  3379.     end
  3380.   else
  3381.     Result := ABookmark.BookmarkInt;
  3382. end;
  3383.  
  3384. procedure TArrayBufIndex.GotoBookmark(const ABookmark : PBufBookmark);
  3385. begin
  3386.   FCurrentRecInd:=GetRecordFromBookmark(ABookmark^);
  3387. end;
  3388.  
  3389. procedure TArrayBufIndex.InitialiseIndex;
  3390. begin
  3391.   //  FRecordArray:=nil;
  3392.   setlength(FRecordArray,FInitialBuffers);
  3393.   FCurrentRecInd:=-1;
  3394.   FLastRecInd:=-1;
  3395. end;
  3396.  
  3397. procedure TArrayBufIndex.InitialiseSpareRecord(const ASpareRecord:  TRecordBuffer);
  3398. begin
  3399.   FLastRecInd := 0;
  3400.   // FCurrentRecInd := 0;
  3401.   FRecordArray[0] := ASpareRecord;
  3402. end;
  3403.  
  3404. procedure TArrayBufIndex.ReleaseSpareRecord;
  3405. begin
  3406.   SetLength(FRecordArray,FInitialBuffers);
  3407. end;
  3408.  
  3409. function TArrayBufIndex.GetRecNo(const ABookmark: PBufBookmark): integer;
  3410. begin
  3411.   Result := GetRecordFromBookmark(ABookmark^)+1;
  3412. end;
  3413.  
  3414. procedure TArrayBufIndex.InsertRecordBeforeCurrentRecord(const ARecord:  TRecordBuffer);
  3415. begin
  3416.   inc(FLastRecInd);
  3417.   if FLastRecInd >= length(FRecordArray) then
  3418.     SetLength(FRecordArray,length(FRecordArray)+FGrowBuffer);
  3419.  
  3420.   Move(FRecordArray[FCurrentRecInd],FRecordArray[FCurrentRecInd+1],sizeof(Pointer)*(FLastRecInd-FCurrentRecInd));
  3421.   FRecordArray[FCurrentRecInd]:=ARecord;
  3422.   inc(FCurrentRecInd);
  3423. end;
  3424.  
  3425. procedure TArrayBufIndex.RemoveRecordFromIndex(const ABookmark : TBufBookmark);
  3426. var ARecordInd : integer;
  3427. begin
  3428.   ARecordInd:=GetRecordFromBookmark(ABookmark);
  3429.   Move(FRecordArray[ARecordInd+1],FRecordArray[ARecordInd],sizeof(Pointer)*(FLastRecInd-ARecordInd));
  3430.   dec(FLastRecInd);
  3431. end;
  3432.  
  3433. procedure TArrayBufIndex.BeginUpdate;
  3434. begin
  3435.   //  inherited BeginUpdate;
  3436. end;
  3437.  
  3438. procedure TArrayBufIndex.AddRecord;
  3439. var ARecord:  TRecordBuffer;
  3440. begin
  3441.   ARecord := FDataset.IntAllocRecordBuffer;
  3442.   inc(FLastRecInd);
  3443.   if FLastRecInd >= length(FRecordArray) then
  3444.     SetLength(FRecordArray,length(FRecordArray)+FGrowBuffer);
  3445.   FRecordArray[FLastRecInd]:=ARecord;
  3446. end;
  3447.  
  3448. procedure TArrayBufIndex.EndUpdate;
  3449. begin
  3450.   //  inherited EndUpdate;
  3451. end;
  3452.  
  3453. { TDataPacketReader }
  3454.  
  3455. class function TDataPacketReader.RowStateToByte(const ARowState: TRowState
  3456.   ): byte;
  3457. var RowStateInt : Byte;
  3458. begin
  3459.   RowStateInt:=0;
  3460.   if rsvOriginal in ARowState then RowStateInt := RowStateInt+1;
  3461.   if rsvDeleted in ARowState then RowStateInt := RowStateInt+2;
  3462.   if rsvInserted in ARowState then RowStateInt := RowStateInt+4;
  3463.   if rsvUpdated in ARowState then RowStateInt := RowStateInt+8;
  3464.   Result := RowStateInt;
  3465. end;
  3466.  
  3467. class function TDataPacketReader.ByteToRowState(const AByte: Byte): TRowState;
  3468. begin
  3469.   result := [];
  3470.   if (AByte and 1)=1 then Result := Result+[rsvOriginal];
  3471.   if (AByte and 2)=2 then Result := Result+[rsvDeleted];
  3472.   if (AByte and 4)=4 then Result := Result+[rsvInserted];
  3473.   if (AByte and 8)=8 then Result := Result+[rsvUpdated];
  3474. end;
  3475.  
  3476. class procedure TDataPacketReader.RestoreBlobField(ADataset: TCustomBufDataset; AField: TField; ASource: pointer; ASize: integer);
  3477. var
  3478.   ABufBlobField: TBufBlobField;
  3479. begin
  3480.   ABufBlobField.BlobBuffer:=ADataset.GetNewBlobBuffer;
  3481.   ABufBlobField.BlobBuffer^.Size:=ASize;
  3482.   ReAllocMem(ABufBlobField.BlobBuffer^.Buffer, ASize);
  3483.   move(ASource^, ABufBlobField.BlobBuffer^.Buffer^, ASize);
  3484.   AField.SetData(@ABufBlobField);
  3485. end;
  3486.  
  3487. constructor TDataPacketReader.create(AStream: TStream);
  3488. begin
  3489.   FStream := AStream;
  3490. end;
  3491.  
  3492.  
  3493. { TFpcBinaryDatapacketReader }
  3494.  
  3495. procedure TFpcBinaryDatapacketReader.LoadFieldDefs(AFieldDefs: TFieldDefs; var AnAutoIncValue: integer);
  3496.  
  3497. var FldCount : word;
  3498.     i        : integer;
  3499.     s        : string;
  3500.  
  3501. begin
  3502.   // Identify version
  3503.   SetLength(s, 13);
  3504.   if (Stream.Read(s[1], 13) = 13) then
  3505.     case s of
  3506.       FpcBinaryIdent1:
  3507.         FVersion := 10;
  3508.       FpcBinaryIdent2:
  3509.         FVersion := Stream.ReadByte;
  3510.       else
  3511.         DatabaseError(SStreamNotRecognised);
  3512.     end;
  3513.  
  3514.   // Read FieldDefs
  3515.   FldCount:=Stream.ReadWord;
  3516.   AFieldDefs.Clear;
  3517.   for i := 0 to FldCount -1 do with TFieldDef.create(AFieldDefs) do
  3518.     begin
  3519.     Name := Stream.ReadAnsiString;
  3520.     Displayname := Stream.ReadAnsiString;
  3521.     Size := Stream.ReadWord;
  3522.     DataType := TFieldType(Stream.ReadWord);
  3523.  
  3524.     if Stream.ReadByte = 1 then
  3525.       Attributes := Attributes + [faReadonly];
  3526.     end;
  3527.   Stream.ReadBuffer(i,sizeof(i));
  3528.   AnAutoIncValue := i;
  3529. end;
  3530.  
  3531. procedure TFpcBinaryDatapacketReader.StoreFieldDefs(AFieldDefs: TFieldDefs; AnAutoIncValue: integer);
  3532. var i : integer;
  3533. begin
  3534.   Stream.Write(FpcBinaryIdent2[1], length(FpcBinaryIdent2));
  3535.   Stream.WriteByte(20); // version 2.0
  3536.  
  3537.   Stream.WriteWord(AFieldDefs.Count);
  3538.   for i := 0 to AFieldDefs.Count -1 do with AFieldDefs[i] do
  3539.     begin
  3540.     Stream.WriteAnsiString(Name);
  3541.     Stream.WriteAnsiString(DisplayName);
  3542.     Stream.WriteWord(Size);
  3543.     Stream.WriteWord(ord(DataType));
  3544.  
  3545.     if faReadonly in Attributes then
  3546.       Stream.WriteByte(1)
  3547.     else
  3548.       Stream.WriteByte(0);
  3549.     end;
  3550.   i := AnAutoIncValue;
  3551.   Stream.WriteBuffer(i,sizeof(i));
  3552. end;
  3553.  
  3554. procedure TFpcBinaryDatapacketReader.InitLoadRecords;
  3555. begin
  3556.   //  Do nothing
  3557. end;
  3558.  
  3559. function TFpcBinaryDatapacketReader.GetCurrentRecord: boolean;
  3560. var Buf : byte;
  3561. begin
  3562.   Result := (Stream.Read(Buf,1)=1) and (Buf=$fe);
  3563. end;
  3564.  
  3565. function TFpcBinaryDatapacketReader.GetRecordRowState(out AUpdOrder : Integer) : TRowState;
  3566. var Buf : byte;
  3567. begin
  3568.   Stream.Read(Buf,1);
  3569.   Result := ByteToRowState(Buf);
  3570.   if Result<>[] then
  3571.     Stream.ReadBuffer(AUpdOrder,sizeof(integer))
  3572.   else
  3573.     AUpdOrder := 0;
  3574. end;
  3575.  
  3576. procedure TFpcBinaryDatapacketReader.GotoNextRecord;
  3577. begin
  3578.   //  Do Nothing
  3579. end;
  3580.  
  3581. procedure TFpcBinaryDatapacketReader.RestoreRecord(ADataset: TCustomBufDataset);
  3582. var
  3583.   AField: TField;
  3584.   i: integer;
  3585.   L: cardinal;
  3586.   B: TBytes;
  3587. begin
  3588.   case FVersion of
  3589.     10:
  3590.       Stream.ReadBuffer(ADataset.GetCurrentBuffer^, ADataset.FRecordSize);  // Ugly because private members of ADataset are used...
  3591.     20:
  3592.       with ADataset do
  3593.         for i:=0 to FieldDefs.Count-1 do
  3594.           begin
  3595.           AField := Fields.FieldByNumber(FieldDefs[i].FieldNo);
  3596.           if AField=nil then continue;
  3597.           if AField.DataType in StringFieldTypes then
  3598.             AField.AsString := Stream.ReadAnsiString
  3599.           else
  3600.             begin
  3601.             if AField.DataType in VarLenFieldTypes then
  3602.               L := Stream.ReadDWord
  3603.             else
  3604.               L := AField.DataSize;
  3605.             SetLength(B, L);
  3606.             if L > 0 then
  3607.               Stream.ReadBuffer(B[0], L);
  3608.             if AField.DataType in BlobFieldTypes then
  3609.               RestoreBlobField(ADataset, AField, @B[0], L)
  3610.             else
  3611.               AField.SetData(@B[0], False);  // set it to the FilterBuffer
  3612.             end;
  3613.           end;
  3614.   end;
  3615. end;
  3616.  
  3617. procedure TFpcBinaryDatapacketReader.StoreRecord(ADataset: TCustomBufDataset;
  3618.   ARowState: TRowState; AUpdOrder : integer);
  3619. var
  3620.   AField: TField;
  3621.   i: integer;
  3622.   L: cardinal;
  3623.   B: TBytes;
  3624. begin
  3625.   // Record header
  3626.   Stream.WriteByte($fe);
  3627.   Stream.WriteByte(RowStateToByte(ARowState));
  3628.   if ARowState<>[] then
  3629.     Stream.WriteBuffer(AUpdOrder,sizeof(integer));
  3630.  
  3631.   // Record data
  3632.   // Old 1.0 version: Stream.WriteBuffer(ADataset.GetCurrentBuffer^, ADataset.FRecordSize);
  3633.   with ADataset do
  3634.     for i:=0 to FieldDefs.Count-1 do
  3635.       begin
  3636.       AField := Fields.FieldByNumber(FieldDefs[i].FieldNo);
  3637.       if AField=nil then continue;
  3638.       if AField.DataType in StringFieldTypes then
  3639.         Stream.WriteAnsiString(AField.AsString)
  3640.       else
  3641.         begin
  3642.         B := AField.AsBytes;
  3643.         L := length(B);
  3644.         if AField.DataType in VarLenFieldTypes then
  3645.           Stream.WriteDWord(L);
  3646.         if L > 0 then
  3647.           Stream.WriteBuffer(B[0], L);
  3648.         end;
  3649.      end;
  3650. end;
  3651.  
  3652. procedure TFpcBinaryDatapacketReader.FinalizeStoreRecords;
  3653. begin
  3654.   //  Do nothing
  3655. end;
  3656.  
  3657. class function TFpcBinaryDatapacketReader.RecognizeStream(AStream: TStream): boolean;
  3658. var s : string;
  3659. begin
  3660.   SetLength(s, 13);
  3661.   if (AStream.Read(s[1], 13) = 13) then
  3662.     case s of
  3663.       FpcBinaryIdent1,
  3664.       FpcBinaryIdent2:
  3665.         Result := True;
  3666.       else
  3667.         Result := False;
  3668.     end;
  3669. end;
  3670.  
  3671. { TUniDirectionalBufIndex }
  3672.  
  3673. function TUniDirectionalBufIndex.GetBookmarkSize: integer;
  3674. begin
  3675.   // In principle there are no bookmarks, and the size should be 0.
  3676.   // But there is quite some code in TCustomBufDataset that relies on
  3677.   // an existing bookmark of the TBufBookmark type.
  3678.   // This code could be moved to the TBufIndex but that would make things
  3679.   // more complicated and probably slower. So use a 'fake' bookmark of
  3680.   // size TBufBookmark.
  3681.   // When there are other TBufIndexes which also need special bookmark code
  3682.   // this can be adapted.
  3683.   Result:=sizeof(TBufBookmark);
  3684. end;
  3685.  
  3686. function TUniDirectionalBufIndex.GetCurrentBuffer: Pointer;
  3687. begin
  3688.   result := FSPareBuffer;
  3689. end;
  3690.  
  3691. function TUniDirectionalBufIndex.GetCurrentRecord:  TRecordBuffer;
  3692. begin
  3693.   //  Result:=inherited GetCurrentRecord;
  3694. end;
  3695.  
  3696. function TUniDirectionalBufIndex.GetIsInitialized: boolean;
  3697. begin
  3698.   Result := Assigned(FSPareBuffer);
  3699. end;
  3700.  
  3701. function TUniDirectionalBufIndex.GetSpareBuffer:  TRecordBuffer;
  3702. begin
  3703.   result := FSPareBuffer;
  3704. end;
  3705.  
  3706. function TUniDirectionalBufIndex.GetSpareRecord:  TRecordBuffer;
  3707. begin
  3708.   result := FSPareBuffer;
  3709. end;
  3710.  
  3711. function TUniDirectionalBufIndex.ScrollBackward: TGetResult;
  3712. begin
  3713.   result := grError;
  3714. end;
  3715.  
  3716. function TUniDirectionalBufIndex.ScrollForward: TGetResult;
  3717. begin
  3718.   result := grOk;
  3719. end;
  3720.  
  3721. function TUniDirectionalBufIndex.GetCurrent: TGetResult;
  3722. begin
  3723.   result := grOk;
  3724. end;
  3725.  
  3726. function TUniDirectionalBufIndex.ScrollFirst: TGetResult;
  3727. begin
  3728.   Result:=grError;
  3729. end;
  3730.  
  3731. procedure TUniDirectionalBufIndex.ScrollLast;
  3732. begin
  3733.   DatabaseError(SUniDirectional);
  3734. end;
  3735.  
  3736. procedure TUniDirectionalBufIndex.SetToFirstRecord;
  3737. begin
  3738.   // for UniDirectional datasets should be [Internal]First valid method call
  3739.   // do nothing
  3740. end;
  3741.  
  3742. procedure TUniDirectionalBufIndex.SetToLastRecord;
  3743. begin
  3744.   DatabaseError(SUniDirectional);
  3745. end;
  3746.  
  3747. procedure TUniDirectionalBufIndex.StoreCurrentRecord;
  3748. begin
  3749.   DatabaseError(SUniDirectional);
  3750. end;
  3751.  
  3752. procedure TUniDirectionalBufIndex.RestoreCurrentRecord;
  3753. begin
  3754.   DatabaseError(SUniDirectional);
  3755. end;
  3756.  
  3757. function TUniDirectionalBufIndex.CanScrollForward: Boolean;
  3758. begin
  3759.   // should return true if next record is already fetched
  3760.   result := false;
  3761. end;
  3762.  
  3763. procedure TUniDirectionalBufIndex.DoScrollForward;
  3764. begin
  3765.   // do nothing
  3766. end;
  3767.  
  3768. procedure TUniDirectionalBufIndex.StoreCurrentRecIntoBookmark(const ABookmark: PBufBookmark);
  3769. begin
  3770.   // do nothing
  3771. end;
  3772.  
  3773. procedure TUniDirectionalBufIndex.StoreSpareRecIntoBookmark(const ABookmark: PBufBookmark);
  3774. begin
  3775.   // do nothing
  3776. end;
  3777.  
  3778. procedure TUniDirectionalBufIndex.GotoBookmark(const ABookmark: PBufBookmark);
  3779. begin
  3780.   DatabaseError(SUniDirectional);
  3781. end;
  3782.  
  3783. procedure TUniDirectionalBufIndex.InitialiseIndex;
  3784. begin
  3785.   // do nothing
  3786. end;
  3787.  
  3788. procedure TUniDirectionalBufIndex.InitialiseSpareRecord(const ASpareRecord:  TRecordBuffer);
  3789. begin
  3790.   FSPareBuffer:=ASpareRecord;
  3791. end;
  3792.  
  3793. procedure TUniDirectionalBufIndex.ReleaseSpareRecord;
  3794. begin
  3795.   FSPareBuffer:=nil;
  3796. end;
  3797.  
  3798. function TUniDirectionalBufIndex.GetRecNo(const ABookmark: PBufBookmark): integer;
  3799. begin
  3800.   result := -1;
  3801. end;
  3802.  
  3803. procedure TUniDirectionalBufIndex.BeginUpdate;
  3804. begin
  3805.   // Do nothing
  3806. end;
  3807.  
  3808. procedure TUniDirectionalBufIndex.AddRecord;
  3809. begin
  3810.   // Do nothing
  3811. end;
  3812.  
  3813. procedure TUniDirectionalBufIndex.InsertRecordBeforeCurrentRecord(const ARecord:  TRecordBuffer);
  3814. begin
  3815.   // Do nothing
  3816. end;
  3817.  
  3818. procedure TUniDirectionalBufIndex.RemoveRecordFromIndex(const ABookmark: TBufBookmark);
  3819. begin
  3820.   DatabaseError(SUniDirectional);
  3821. end;
  3822.  
  3823. procedure TUniDirectionalBufIndex.OrderCurrentRecord;
  3824. begin
  3825.   // Do nothing
  3826. end;
  3827.  
  3828. procedure TUniDirectionalBufIndex.EndUpdate;
  3829. begin
  3830.   // Do nothing
  3831. end;
  3832.  
  3833. initialization
  3834.   setlength(RegisteredDatapacketReaders,0);
  3835. finalization
  3836.   setlength(RegisteredDatapacketReaders,0);
  3837. end.
Advertisement
Add Comment
Please, Sign In to add comment
Public Pastes
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!