home *** CD-ROM | disk | FTP | other *** search
/ Chip 2003 January / Chip_2003-01_cd1.bin / zkuste / delphi / kompon / d56 / VKDBF.ZIP / VKDBFDataSet.pas < prev    next >
Pascal/Delphi Source File  |  2002-10-18  |  247KB  |  7,478 lines
  1. {Copyright:      Vlad Karpov  mailto:KarpovVV@protek.ru
  2.  Author:         Vlad Karpov
  3.  Remarks:        freeware, but this Copyright must be included
  4.  
  5.  Description:    TDataSet component for work with DBF tables,
  6.                  DBT LOB storage and NTX indexes from CLIPPER.
  7.                  That is much more then only DBFNTX driver for Delphi.
  8.                  It supports many extended types (~60) such as Byte,
  9.                  Word, Indeger, Int64, Real4, Real6, Real8, Binary LOB
  10.                  any size and so on...
  11.                  There is a Crypt DBF feature.
  12.  
  13.  Version:        1.0.0 beta 28.01.2002
  14.                  1.0.1 beta 28.01.2002
  15.                     1) Fix bug in Exclusive index support;
  16.                     2) Fix bug in Add Fields in Design time;
  17.                     3) Fix bug with Long Number fields (like ["F1", "N", 10, 0]);
  18.                     4) WideString support was added;
  19.                     5) Truncate (ZAP) method was added;
  20.                     6) More...;
  21.                  1.0.2 beta 18.02.2002
  22.                     1) Pack method was added;
  23.                     2) LookupOptions property was added;
  24.                     3) Explicitly type convention in SeekFields, Lookup, Locate
  25.                        was added;
  26.                     4) Recall and Delete record methodths was added;
  27.                     5) Explicit full scan added in LocateRecord method;
  28.                     6) ReindexAll method was added;
  29.                     7) Fix bug with dbftBlob and dbftGraphic types;
  30.                     8) Fix bug 'List index out of bounds' for index expression
  31.                        with Numeric literal contain decimal separator. Ambiguously
  32.                        determined decimal separator and literal separator ','.
  33.                  1.0.3 beta 25.03.2002
  34.                     1) In Mamory manager add raise error 'TVKDBFOneAlloc: Can not
  35.                        allocate 0 bytes memory!'
  36.                     2) Add methods CompareBookmarks, BookmarkValid
  37.                     3) CretateNow -> CreateNow
  38.                     4) Deleted constant LOCATE_BUFFER_SIZE
  39.                     5) Check empty KeyValues in LocateRecord->LocatePass
  40.                     6) Fixed bug in indexing Int64 fields
  41.                     7) TVKNTXIndex.CreateCompactIndex method was added
  42.                     8) Add Partial Key for index Locate and SeekFirst methods
  43.                        in TVKNTXIndex class
  44.                     9) Add 1A byte at end of DBF table in InternalClose method
  45.                     10) Add DBEval method and OnDBEval event
  46.                  1.0.4 beta 23.05.2002
  47.                     1) Add Method TranslateBuff and rewrite methods
  48.                        CreateBlobStream and SaveToDBT with TranslateBuff
  49.                        to prevent 'Access violation' in read and write CLOB.
  50.                     2) When set RecNo check Filter, SetDeleted and Range validation.
  51.                     3) Fix bud in TVKNTXRange.InRange(S: String) method
  52.                     4) Add event OnCreateIndex
  53.                     5) Add public var FullLengthCharFieldCopy to TVKSmartDBF for
  54.                        manage SetFieldData for 'C' type fields
  55.                     6) Fix buf with allocate memory for FLocateBuffer (AV when
  56.                        Locate, Lookup, ReindexAll, DBEval or Pack if BufferSize <> 4096)
  57.                     7) Complex actions to make index compatibility with CLIPPER:
  58.                             - Full rewrite TVKNTXIndex.DeleteKey procedure, now it
  59.                               normalize index like a CLIPPER.
  60.                             - Make TVKNTXIndex.DeleteKeyStyle property to switch
  61.                               Delete Key style between CLIPPER normalize index and
  62.                               all athers (Apollo, Halcyon...).
  63.                             - Add TVKNTXCompactIndex.NormalizeRest method to make
  64.                               normalize index in TVKNTXIndex.CreateCompactIndex and
  65.                               TVKNTXIndex.SubNtx procedures.
  66.  
  67.                         ATTENTION: Rebuild all indexes after apply this version !
  68.  
  69.                     8) Add methods:
  70.                               TVKNTXIndex.FindKey
  71.                               TVKNTXIndex.FindKeyFields with overloaded some parameters
  72.                        It is the same SeekFirst..., but subject to SetDeleted, Filter
  73.                        and Range.
  74.                        Partual key sapport Ok!
  75.                     9) Rewrite Lokate and Lookup on TVKNTXIndex.FindKeyFields.
  76.                     10) Add methods:
  77.  
  78.                               TVKSmartDBF.SetKey;
  79.                               TVKSmartDBF.EditKey;
  80.                               TVKSmartDBF.GotoKey;
  81.                               TVKSmartDBF.GotoNearest;
  82.                               TVKSmartDBF.DropEditKey;
  83.                               TVKSmartDBF.FindKey;
  84.                               TVKSmartDBF.FindNearest;
  85.  
  86.                         All this methods work throw TVKNTXIndex.FindKeyFields.
  87.                     11) Add TVKSmartDBF.IndexName property.
  88.                     12) Make type 'C' is not be NULL, if field empty Field.AsString
  89.                         return string of spases lethgt of field length.
  90.                  1.0.5 beta 18.10.2002
  91.                     1) New property StorageType
  92.                     2) property DBFFieldDefs now fill fields definition on open DataSet
  93.                     3) New data tapes:
  94.                           dbftDBFDataSet,         // DataSet
  95.                           dbftDBFDataSet_NB,      // DataSet with absolute pointer
  96.                                                   // (dbftU4_NB) to a lob
  97.                                                   // file and not align 512 byte
  98.                                                   // pages into the Lob
  99.  
  100.                     4) New component TVKNestedDBF related with dbftDBFDataSet and
  101.                        dbftDBFDataSet_NB.
  102.                     5) Fix bug when Field.IsNull for 'C' data type always return True.
  103.                        (Thanks Alexander Manuzin)
  104.                     6) Fix bug in TVKSmartDBF.NextBuffer. When read 1A end byte, it
  105.                        replace first byte in FBuffer (Delete byte in first record in
  106.                        FBuffer).
  107.                     7) Fix bug: When Edit record and it filtered by Filter or
  108.                        SetDeleted the record is not hidden in DB-Aware controls.
  109.                     8) Add SoftSeek parameter in TVKNTXIndex.FindKey procedure.
  110.                     9) TVKNTXIndex.Seek, TVKNTXIndex.SeekFirst,
  111.                        TVKNTXIndex.SeekFirstRecord, TVKNTXIndex.SeekFields made
  112.                        throw TVKNTXIndex.FindKey procedure subject to SetDeleted,
  113.                        Filter and Range.
  114.                     10) Fix bug: IsNull in culculated and lookup field not work.
  115.                     11) Add Validation handler to the Field and ReadOnly check.
  116.                     12) On SetDeleted and Filtered call Refresh method
  117.                         (it was First method).
  118.                     13) Add properties TVKDBFNTX.Orders[Num]: TVKNTXIndex and
  119.                         TVKDBFNTX.OrdersByName[Name]: TVKNTXIndex
  120.                     14) Make Source for D5 and D6. (Use $IFDEF VER130, VER140)
  121.                     15) Delete property TAccessMode.ShareDenyRead and
  122.                         TAccessMode.ShareCompat
  123.                     16) Fix bug: Incorrect work with OEM Unique index.
  124.                     17) Fix bug: If LookUp result Integer or Float - error.
  125.                     18) Fix bug: Lookup field by calculated field - error.
  126.                     19) Now Filtering record accepted into the DataSet use
  127.                         Filter string AND OnFilterRecord event together.
  128.                     20) Fix bug: When set range by index for LowKey and HiKey
  129.                         are out of keys in index the DataSet show last record by
  130.                         index.
  131.                     21) Fix bug: Modify DataSet incorrect when unique index or
  132.                         FOR index used.
  133.                     22) Make over Range.
  134.                     23) Add parameter Rec in TVKNTXIndex.FindKey method.
  135.                     24) Fix bug: 'Variant array index out of bounds' with
  136.                         partual key search in TVKSmartDBF.FindKey for multiple
  137.                         key.
  138.                     25) Property IndexDefs...
  139.                     26) Property IndexBags... with set of orders and StorageType.
  140.                     27) Add functions in Expression Parser:
  141.                           - IF()
  142.                           - IIF()
  143.                           - RIGHT()
  144.                           - LEFT()
  145.                           - SPACE()
  146.                           - STRZERO()
  147.                           - ALLTRIM()
  148.                     28) Add TVKDBFFieldDef.Tag property. Use it instead of
  149.                         TField.Tag because TField.Tag occupied with TVKDBFFieldDef
  150.                         object reference.
  151.  
  152.                         ATTANTION:
  153.                           Use TVKDBFFieldDef(TField.Tag).Tag
  154.                             instead of
  155.                           TField.Tag
  156.  
  157.                     29) Add error 'TVKSmartDBF.InternalOpen: BufferSize too small!'
  158.                     30) Message 'Table %s create successfully!' not appear in
  159.                         Loading state.
  160.  
  161.         WISH:
  162.  
  163.           -   Limit loaded NTX pages in mamory.
  164.           -   Range by index don't work with descended index
  165.           -   Realize Cashed updates.
  166.           -   New locate type by ordered DBF.
  167.           -   DBASE 7 support.
  168.           -   Realize FPT lob storage.
  169.           -   Realize IDX and CDX indexes.
  170.           -   Realize NDX and MDX indexes.
  171.  
  172.  * THIS SOFTWARE IS PROVIDED BY THE AUTHORS ''AS IS'' AND ANY EXPRESS
  173.  * OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
  174.  * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
  175.  * ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE
  176.  * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
  177.  * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
  178.  * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
  179.  * BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
  180.  * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
  181.  * OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,
  182.  * EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  183. }
  184. unit VKDBFDataSet;
  185.  
  186. interface
  187.  
  188. uses
  189.   Windows, Messages, SysUtils, Classes, Forms, Db, DbConsts,
  190.   {$IFDEF VER140} Variants, FmtBcd, {$ENDIF}
  191.   VKDBFPrx, VKDBFParser, VKDBFIndex, VKDBFNTX, VKDBFCDX,
  192.   VKDBFUtil, VKDBFMemMgr, VKDBFCrypt;
  193.  
  194. type
  195.  
  196.   {$A-}
  197.   DBF_HEAD = packed record
  198.     dbf_id:             Byte;                     //0
  199.     last_update:        array[0..2] of Byte;      //1
  200.     last_rec:           Longint;                  //4
  201.     data_offset:        Word;                     //8
  202.     rec_size:           Word;                     //10
  203.     Dummy1:             Word;                     // 12-13
  204.     IncTrans:           byte;                     // 14
  205.     Encrypt:            byte;                     // 15
  206.     Dummy2:             Integer;                  // 16-19
  207.     Dummy3: array[20..27] of byte;                // 20-27
  208.     prod_ind:           Shortint;                 //28
  209.     lang:               Shortint;                 //29
  210.     Dummy4:             Word;                     //30 - 31
  211.   end;
  212.  
  213.   num_size = packed record
  214.     len: Byte;
  215.     dec: Byte;
  216.   end;
  217.  
  218.   len_info = packed record
  219.     case Shortint of
  220.       0: (char_len: Word);
  221.       1: (num_len: num_size);
  222.   end;
  223.  
  224.   TVKDBFType = (
  225.     dbftS1,             //Shortint              (1 byte)
  226.     dbftS1_N,           //Shortint with NULL    (1 byte ShortInt + 1 byte null/not null)
  227.     dbftU1,             //Byte
  228.     dbftU1_N,           //Byte  with NULL
  229.     dbftS2,             //Smallint
  230.     dbftS2_N,           //Smallint with NULL
  231.     dbftU2,             //Word
  232.     dbftU2_N,           //Word with NULL
  233.     dbftS4,             //Longint
  234.     dbftS4_N,           //Longint with NULL
  235.     dbftU4,             //Longword
  236.     dbftU4_N,           //Longword with NULL
  237.     dbftS8,             //Int64
  238.     dbftS8_N,           //Int64 with NULL
  239.     dbftR4,             //Single
  240.     dbftR4_N,           //Single with NULL
  241.     dbftR6,             //Real48
  242.     dbftR6_N,           //Real48 with NULL
  243.     dbftR8,             //Double
  244.     dbftR8_N,           //Double with NULL
  245.     dbftR10,            //Extended                !!!!!!!Not yet realized
  246.     dbftR10_N,          //Extended with NULL      !!!!!!!Not yet realized
  247.     dbftD1,             //TDateTime
  248.     dbftD1_N,           //TDateTime with NULL
  249.     dbftD2,             //DataSet DateTime
  250.     dbftD2_N,           //DataSet DateTime with NULL
  251.     //
  252.     dbftString,         //String
  253.     dbftString_N,       //String witn NULL
  254.     dbftFixedChar,      //FixedChar
  255.     dbftWideString,     //WideString
  256.     dbftCurrency,       //Currency
  257.     dbftCurrency_N,     //Currency with NULL
  258.     //
  259.     dbftClob,           //Clob
  260.     dbftBlob,           //Blob
  261.     dbftGraphic,        //Graphic
  262.     dbftFmtMemo,        //FmtMemo
  263.     //
  264.     dbftBCD,            //BCD (34 bytes VCL BCD structure TBCD)
  265.     //
  266.     dbftDate,            //Date  (Integer, 4 bytes)
  267.     dbftDate_N,          //Date with NULL (Integer, 4 bytes + 1 null/not null byte)
  268.     dbftTime,            //Time (Integer, 4 bytes)
  269.     dbftTime_N,          //Time with NULL (Integer, 4 bytes + 1 null/not null byte)
  270.  
  271.     dbftD3,             //TDateTime as dbftR6 (6 bytes)
  272.     dbftD3_N,           //TDateTime as dbftR6 (6 bytes) with NULL ( + 1 byte null/not null)
  273.  
  274. ////////////////////////////////////////////////////////////////////////////////
  275. /// This integer and real types with 1 null/not null bit instead of sign bit
  276. ////////////////////////////////////////////////////////////////////////////////
  277.     dbftU1_NB,          //Byte              ( 0 - 127         )
  278.     dbftU2_NB,          //Word              ( 0 - 32767       )
  279.     dbftU4_NB,          //Longword          ( 0 - 2147483647  )
  280.     dbftR4_NB,          //Single            ( Positive Single )
  281.     dbftR6_NB,          //Real48            ( Positive Real48 )
  282.     dbftR8_NB,          //Double            ( Positive Double )
  283.     dbftD1_NB,          //TDateTime         ( Positive TDateTime  )  (8 bytes)
  284.     dbftD2_NB,          //DataSet DateTime  ( Positive DataSet DateTime) (8 bytes)
  285.     //
  286.     dbftCurrency_NB,    //Currency
  287.     //
  288.     dbftDate_NB,        //Date
  289.     dbftTime_NB,        //Time
  290.  
  291.     dbftD3_NB,          //TDateTime as dbftR6 (6 bytes) ( Positive Real48 )
  292.  
  293. ////////////////////////////////////////////////////////////////////////////////
  294.  
  295. ////////////////////////////////////////////////////////////////////////////////
  296. ///////////       This is Lob types with absolute pointer (dbftU4_NB) to a lob
  297. ///////////       file and not align 512 byte pages into the Lob
  298. ////////////////////////////////////////////////////////////////////////////////
  299.  
  300.     dbftClob_NB,           //Clob
  301.     dbftBlob_NB,           //Blob
  302.     dbftGraphic_NB,        //Graphic
  303.     dbftFmtMemo_NB,        //FmtMemo
  304.  
  305. ////////////////////////////////////////////////////////////////////////////////
  306.  
  307.     dbftUndefined,          //Special type
  308.  
  309. ////////////////////////////////////////////////////////////////////////////////
  310.  
  311.     dbftDBFDataSet,         //DataSet
  312.     dbftDBFDataSet_NB,      //DataSet with absolute pointer (dbftU4_NB) to a lob
  313.                             //file and not align 512 byte pages into the Lob
  314.  
  315. ////////////////////////////////////////////////////////////////////////////////
  316. ///////////       Not yet realized
  317. ////////////////////////////////////////////////////////////////////////////////
  318.  
  319.     dbftBytes,          //Bytes
  320.     dbftVarBytes,       //VarBytes
  321.     dbftTypedBinary,    //TypedBinary
  322.  
  323.     dbftADT,            //ADT
  324.     dbftArray,          //Array
  325.     dbftReference,      //Reference
  326.     dbftVariant,        //Variant
  327.     dbftInterface,      //Interface
  328.     dbftIDispatch,      //IDispatch
  329.     dbftGuid            //Guid
  330.  
  331. ////////////////////////////////////////////////////////////////////////////////
  332.  
  333.   );
  334.  
  335.   FIELD_REC = packed record
  336.     field_name:     array[0..10] of char;
  337.     field_type:     char;                   //C N D L M     E - Extendes types
  338.     extend_type:    TVKDBFType;             //use if field_type = 'E'
  339.     dummy:          array[0..2] of char;
  340.     lendth:         len_info;
  341.     NextAutoInc:    DWord;
  342.     filler:         array [0..9] of char;
  343.   end;
  344.  
  345.   TRecInfo = packed record
  346.     RecordRowID: Longint;
  347.     UpdateStatus: TUpdateStatus;
  348.     BookmarkFlag: TBookmarkFlag;
  349.   end;
  350.   {$A+}
  351.  
  352.   TBufDirection = (bdFromTop, bdFromBottom);
  353.  
  354.   pTRecInfo = ^TRecInfo;
  355.   ppTRecInfo = ^pTRecInfo;
  356.  
  357.   pDouble = ^Double;
  358.   pInteger = ^Integer;
  359.   pReal48 = ^Real48;
  360.  
  361.   TVKSmartDBF = class;
  362.   TVKNestedDBF = class;
  363.  
  364.   TCryptMethod = (cmNone, cmXOR, cmGost);
  365.   TOnCrypt = procedure(Sender: TObject; Context: LongWord; Buff: Pointer; Size: Integer) of object;
  366.  
  367.   TOnDBEval = procedure(Sender: TObject; nRecNo: LongWord) of object;
  368.  
  369.   {TVKDBFCrypt}
  370.   TVKDBFCrypt = class(TPersistent)
  371.   private
  372.     FActive: boolean;
  373.     FCryptMethod: TCryptMethod;
  374.     FPassword: String;
  375.     FOnEncrypt: TOnCrypt;
  376.     FOnDecrypt: TOnCrypt;
  377.     FOnActivate: TNotifyEvent;
  378.     FOnDeactivate: TNotifyEvent;
  379.     FObjectID: LongWord;
  380.     procedure SetActive(const Value: boolean);
  381.   public
  382.     SmartDBF: TVKSmartDBF;
  383.     constructor Create;
  384.     destructor Destroy; override;
  385.     procedure Encrypt(Context: LongWord; Buff: Pointer; Size: Integer);
  386.     procedure Decrypt(Context: LongWord; Buff: Pointer; Size: Integer);
  387.     property ObjectID: LongWord read FObjectID write FObjectID;
  388.   published
  389.     property Active: boolean read FActive write SetActive;
  390.     property CryptMethod: TCryptMethod read FCryptMethod write FCryptMethod;
  391.     property Password: String read FPassword write FPassword;
  392.     property OnActivateCrypt: TNotifyEvent read FOnActivate write FOnActivate;
  393.     property OnDeactivateCrypt: TNotifyEvent read FOnDeactivate write FOnDeactivate;
  394.     property OnEncrypt: TOnCrypt read FOnEncrypt write FOnEncrypt;
  395.     property OnDecrypt: TOnCrypt read FOnDecrypt write FOnDecrypt;
  396.   end;
  397.  
  398.   TVKDBFFieldDef = class;
  399.  
  400.   {TVKDataLink}
  401.   TVKDataLink = class(TDataLink)
  402.   private
  403.     FDBFDataSet: TVKSmartDBF;
  404.   protected
  405.     procedure DataEvent(Event: TDataEvent; Info: Longint); override;
  406.     procedure DataSetScrolled(Distance: Integer); override;
  407.   public
  408.     property DBFDataSet: TVKSmartDBF read FDBFDataSet write FDBFDataSet;
  409.   end;
  410.  
  411.   {TVKDBFFieldDefs}
  412.   TVKDBFFieldDefs = class(TOwnedCollection)
  413.   private
  414.  
  415.     {$IFDEF VER130}
  416.     function GetCollectionOwner: TPersistent;
  417.     {$ENDIF}
  418.     function GetItem(Index: Integer): TVKDBFFieldDef;
  419.     procedure SetItem(Index: Integer; const Value: TVKDBFFieldDef);
  420.  
  421.   public
  422.  
  423.     constructor Create(AOwner: TPersistent);
  424.     procedure AssignValues(Value: TVKDBFFieldDefs);
  425.     function FindIndex(const Value: string): TVKDBFFieldDef;
  426.     function IsEqual(Value: TVKDBFFieldDefs): Boolean;
  427.     {$IFDEF VER130}
  428.     property Owner: TPersistent read GetCollectionOwner;
  429.     {$ENDIF}
  430.     property Items[Index: Integer]: TVKDBFFieldDef read GetItem write SetItem; default;
  431.  
  432.   end;
  433.  
  434.   {TVKDBFFieldDef}
  435.   TVKDBFFieldDef = class(TCollectionItem)
  436.   private
  437.  
  438.     FTag: Integer;
  439.  
  440.     FOff: Integer;
  441.     FOffHD: Integer;
  442.  
  443.     FieldRec: FIELD_REC;
  444.     Fdec: Word;
  445.     Flen: Word;
  446.     FDBFFieldDefs: TVKDBFFieldDefs;
  447.     function GetField: FIELD_REC;
  448.     function GetDataSize: Word;
  449.     procedure SetDBFFieldDefs(const Value: TVKDBFFieldDefs);
  450.  
  451.     procedure ReadDBFFieldDefData(Reader: TReader);
  452.     procedure WriteDBFFieldDefData(Writer: TWriter);
  453.  
  454.   protected
  455.  
  456.     FFieldDefRef: TFieldDef;
  457.  
  458.     function GetDisplayName: string; override;
  459.     procedure SetDisplayName(const Value: string); override;
  460.     procedure AssignTo(Dest: TPersistent); override;
  461.  
  462.   public
  463.  
  464.     constructor Create(Collection: TCollection); override;
  465.     destructor Destroy; override;
  466.  
  467.     procedure DefineProperties(Filer: TFiler); override;
  468.  
  469.     function IsEqual(Value: TVKDBFFieldDef): Boolean; virtual;
  470.  
  471.     property Field: FIELD_REC read GetField;
  472.     property DataSize: Word read GetDataSize;
  473.  
  474.     property FieldDefRef: TFieldDef read FFieldDefRef;
  475.  
  476.   published
  477.  
  478.     property DBFFieldDefs: TVKDBFFieldDefs read FDBFFieldDefs write SetDBFFieldDefs stored false;
  479.     property Name: string read GetDisplayName write SetDisplayName;
  480.     property field_type: char read FieldRec.field_type write FieldRec.field_type;
  481.     property extend_type: TVKDBFType read FieldRec.extend_type write FieldRec.extend_type;
  482.     property len: Word read Flen write Flen;
  483.     property dec: Word read Fdec write Fdec;
  484.     property Offset: Integer read FOff;
  485.     property OffsetHD: Integer read FOffHD;
  486.  
  487.     property Tag: Integer read FTag write FTag;
  488.  
  489.   end;
  490.  
  491.   {TVKDBTStream}
  492.   TVKDBTStream = class(TMemoryStream)
  493.   protected
  494.     FModified: boolean;
  495.     FSmartDBF: TVKSmartDBF;
  496.     FField: TField;
  497.   public
  498.     constructor Create;
  499.     constructor CreateDBTStream(dbf: TVKSmartDBF; field: TField);
  500.     destructor Destroy; override;
  501.     procedure Clear;
  502.     procedure SetSize(NewSize: Longint); override;
  503.     procedure SaveToDBT;
  504.     function Write(const Buffer; Count: Longint): Longint; override;
  505.     property SmartDBF: TVKSmartDBF read FSmartDBF write FSmartDBF;
  506.     property Field: TField read FField write FField;
  507.   end;
  508.  
  509.   {TVKSmartDBF}
  510.   TVKSmartDBF = class(TDataSet)
  511.   private
  512.  
  513.     FOpenWithoutIndexes: boolean;
  514.     FSaveOnTheSamePlace: boolean;
  515.     FIndexName: ShortString;
  516.     FSaveState: TDataSetState;
  517.     FDataLink: TVKDataLink;
  518.     FDBFFieldDefs: TVKDBFFieldDefs;
  519.     FDBFIndexDefs: TVKDBFIndexDefs;
  520.     FIndRecBuf: pChar;
  521.     FIndState: boolean;
  522.     FLocateBuffer: pChar;
  523.     FMasterFields: String;
  524.     FRange: boolean;
  525.     ListMasterFields: TList;
  526.  
  527.     FAddBuffered: boolean;
  528.     FAddBuffer: pChar;
  529.     FAddBufferCrypt: pChar;
  530.     FAddBufferCount: Integer;
  531.     FAddBufferCurrent: Integer;
  532.     FLookupOptions: TLocateOptions;
  533.     FStorageType: TProxyStreamType;
  534.     FOuterStream: TStream;
  535.     FCreateNow: boolean;
  536.     FOuterLobStream: TStream;
  537.     FOnOuterStreamLock: TLockEvent;
  538.     FOnOuterStreamUnlock: TUnlockEvent;
  539.  
  540.     procedure SetRngInt;
  541.     function GetRecBuf: pChar;
  542.     function GetRecNoBuf: Longint;
  543.     procedure SetDataSource(const Value: TDataSource);
  544.     function GetCreateNow: Boolean;
  545.     procedure SetCreateNow(const Value: Boolean);
  546.     procedure SetMasterFields(const Value: String);
  547.     function GetMasterFields: Variant;
  548.     procedure SetDBFFieldDefs(const Value: TVKDBFFieldDefs);
  549.     procedure SetDBFIndexDefs(const Value: TVKDBFIndexDefs);
  550.     procedure SetOnEncrypt(const Value: TOnCrypt);
  551.     function GetOnEncrypt: TOnCrypt;
  552.     procedure SetOnDecrypt(const Value: TOnCrypt);
  553.     function GetOnDecrypt: TOnCrypt;
  554.     function GetOnCryptActivate: TNotifyEvent;
  555.     function GetOnCryptDeActivate: TNotifyEvent;
  556.     procedure SetOnCryptActivate(const Value: TNotifyEvent);
  557.     procedure SetOnCryptDeActivate(const Value: TNotifyEvent);
  558.     function GetInnerStream: TStream;
  559.     function GetInnerLobStream: TStream;
  560.     procedure HiddenInitFieldDefs(FDs: TFieldDefs; DBFFDs: TVKDBFFieldDefs; BeginOffset, BeginOffsetHD: Integer; NamePrefix: String = ''; CreateFieldDef: boolean = true);
  561.  
  562.   private
  563.     { Private declarations }
  564.     FStreamedActive: boolean;
  565.     FStreamedCreateNow: boolean;
  566.     FTempRecord: pChar;
  567.     FFilterRecord: pChar;
  568.     FSetKeyBuffer: pChar;
  569.     FFilterParser: TVKDBFExprParser;
  570.     FDBFFileName: String;
  571.     DBFHandler: TProxyStream;
  572.     LobHandler: TProxyStream;
  573.     DBFHeader: DBF_HEAD;
  574.     FRecordSize: Integer;
  575.     FAccessMode: TAccessMode;
  576.     FVKDBFCrypt: TVKDBFCrypt;
  577.     FCryptBuff: Pointer;
  578.     FOEM: Boolean;
  579.     FSetDeleted: Boolean;
  580.     FIndexes: TIndexes;
  581.     FTmpActive: boolean;
  582.     FKeyCalk: boolean;
  583.     FWaitBusyRes: Integer;
  584.  
  585.     FBufferSize: Integer;
  586.     FRecordsPerBuf: Integer;
  587.     FBuffer: pChar;
  588.     FBufInd: pLongint;
  589.     FBufCnt: Longint;
  590.     FBufDir: TBufDirection;
  591.     FCurInd: Integer;
  592.  
  593.     FBOF: boolean;
  594.     FEOF: boolean;
  595.  
  596.     FFileLock: boolean;
  597.     FLockRecords: TList;
  598.  
  599.     FLastFastPostRecord: boolean;
  600.     FFastPostRecord: boolean;
  601.  
  602.     FPackProcess: boolean;
  603.     FPackLobHandler: TProxyStream;
  604.  
  605.     FOnDBEval: TOnDBEval;
  606.  
  607.     function GetRecordBufferSize: Integer;
  608.     property RecordBufferSize: Integer read GetRecordBufferSize;
  609.     property RecBuf: pChar read GetRecBuf;
  610.     property RecNoBuf: Longint read GetRecNoBuf;
  611.     function GetActiveRecBuf(var pRecBuf: PChar): Boolean;
  612.     function GetDeleted: Boolean;
  613.     procedure SetDeletedFlag(const Value: Boolean);
  614.     function GetRecordByBuffer(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult;
  615.     function AcceptRecord: Boolean;
  616.     procedure SetSetDeleted(const Value: Boolean);
  617.  
  618.     procedure ReadIndexData(Reader: TReader);
  619.     procedure WriteIndexData(Writer: TWriter);
  620.  
  621.     procedure SetIndexList(const Value: TIndexes);
  622.     function AcceptRecordInternal: boolean;
  623.     procedure SetRecNoInternal(Value: Integer);
  624.     procedure BindDBFFieldDef;
  625.     procedure InternalSetCurrentIndex(i: Integer);
  626.  
  627.   protected
  628.     { Protected declarations }
  629.  
  630.     procedure Loaded; override;
  631.  
  632.     procedure DoAfterOpen; override;
  633.     procedure DoBeforeClose; override;
  634.     procedure DataConvert(Field: TField; Source, Dest: Pointer; ToNative: Boolean); override;
  635.  
  636.     function AllocRecordBuffer: PChar; override;
  637.     procedure FreeRecordBuffer(var Buffer: PChar); override;
  638.     procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
  639.     function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
  640.     function GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override;
  641.     function GetRecordSize: Word; override;
  642.     procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); override;
  643.     procedure InternalClose; override;
  644.     procedure DeleteRecallRecord(Del: boolean = true); virtual;
  645.     procedure InternalDelete; override;
  646.     procedure InternalFirst; override;
  647.     procedure InternalGotoBookmark(Bookmark: Pointer); override;
  648.     procedure InternalHandleException; override;
  649.     procedure InternalInitFieldDefs; override;
  650.     procedure InternalInitRecord(Buffer: PChar); override;
  651.     procedure InternalLast; override;
  652.     procedure InternalOpen; override;
  653.     procedure InternalEdit; override;
  654.     procedure InternalPost; override;
  655.     procedure InternalSetToRecord(Buffer: PChar); override;
  656.     procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
  657.     procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
  658.     procedure SetFieldData(Field: TField; Buffer: Pointer); override;
  659.     procedure SetActive(Value: Boolean); override;
  660.     procedure InternalRefresh; override;
  661.  
  662.     function FindRecord(Restart, GoForward: Boolean): Boolean; override;
  663.  
  664.     procedure SetRange(FieldList: String; FieldValues: array of const); overload; virtual;
  665.     procedure SetRange(FieldList: String; FieldValues: variant); overload; virtual;
  666.     procedure ClearRange; virtual;
  667.  
  668.     procedure NextIndexBuf;
  669.     procedure PriorIndexBuf;
  670.  
  671.     function NextBuffer: Longint;
  672.     function PriorBuffer: Longint;
  673.     procedure GetBufferByRec(Rec: Longint);
  674.     procedure RefreshBufferByRec(Rec: Longint);
  675.  
  676.     function GetRecordCount: Integer; override;
  677.     function GetRecNo: Integer; override;
  678.     procedure SetRecNo(Value: Integer); override;
  679.  
  680.     function GetStateFieldValue(State: TDataSetState; Field: TField): Variant; override;
  681.     function CompareLocateField(const Fields: TList; const KeyValues: Variant; Options: TLocateOptions): Integer;
  682.  
  683.     procedure SetFiltered(Value: Boolean); override;
  684.  
  685.     function GetDataSource: TDataSource; override;
  686.  
  687.     function GetCurIndByRec(nRec: Longint): Integer;
  688.  
  689.     function LockHeader: boolean;
  690.     function UnlockHeader: boolean;
  691.  
  692.     procedure LobHandlerCreate; virtual;
  693.     procedure CreateLobStream(dbf_id: Byte); virtual;
  694.     procedure OpenLobStream(dbf_id: Byte); virtual;
  695.     procedure CloseLobStream; virtual;
  696.     procedure LobHandlerDestroy; virtual;
  697.  
  698.     procedure PackLobHandlerCreate; virtual;
  699.     procedure PackLobHandlerOpen(TempLobName: String); virtual;
  700.     procedure PackLobHandlerClose(LobName, TempLobName: String); virtual;
  701.     procedure PackLobHandlerDestroy; virtual;
  702.  
  703.     function GetPackLobHandler: TProxyStream; virtual;
  704.  
  705.     property PackLobHandler: TProxyStream read GetPackLobHandler;
  706.  
  707.   public
  708.  
  709.     { Public declarations }
  710.  
  711.     FullLengthCharFieldCopy: boolean;
  712.     Changed: boolean;
  713.  
  714.     constructor Create(AOwner: TComponent); override;
  715.     destructor Destroy; override;
  716.  
  717.     function IsCursorOpen: Boolean; override;
  718.  
  719.     function GetFieldData(Field: TField; Buffer: Pointer): Boolean; override;
  720.     function Translate(Src, Dest: PChar; ToOem: Boolean): Integer; override;
  721.     function TranslateBuff(Src, Dest: PChar; ToOem: Boolean; Len: Integer): Integer;
  722.  
  723.     function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer; override;
  724.     function BookmarkValid(Bookmark: TBookmark): Boolean; override;
  725.  
  726.     function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override;
  727.     procedure CreateNestedStream(NestedDataSet: TVKSmartDBF; Field: TField; NestedStream: TStream); virtual;
  728.     procedure SaveToDBT(Source: TMemoryStream; Field: TField); virtual;
  729.     procedure SaveOnTheSamePlaceToDBT(Source: TMemoryStream; Field: TField); virtual;
  730.  
  731.     procedure CreateTable;
  732.     procedure Reindex;
  733.     procedure ReindexWithOutActivated;
  734.     procedure ReindexAll;
  735.  
  736.     procedure DefineProperties(Filer: TFiler); override;
  737.  
  738.     property LockRecords: TList read FLockRecords;
  739.  
  740.     property Deleted: Boolean read GetDeleted write SetDeletedFlag;
  741.     property Header: DBF_HEAD read DBFHeader;
  742.     property Handle: TProxyStream read DBFHandler;
  743.     property IndRecBuf: pChar read FIndRecBuf write FIndRecBuf;
  744.     property IndState: boolean read FIndState write FIndState;
  745.  
  746.     function FirstByIndex(IndInd: Integer): TGetResult;
  747.     function PriorByIndex(IndInd: Integer): TGetResult;
  748.     function NextByIndex(IndInd: Integer): TGetResult;
  749.     function LastByIndex(IndInd: Integer): TGetResult;
  750.  
  751.     procedure AddRecord(const Values: array of const); overload;
  752.     procedure AddRecord(ne: TNotifyEvent); overload;
  753.     procedure AddRecord(const Values: variant); overload;
  754.     procedure BeginAddRecord;
  755.     procedure EndAddRecord;
  756.     procedure SetTmpRecord(nRec: DWORD);
  757.     procedure CloseTmpRecord;
  758.  
  759.     procedure BeginAddBuffered(RecInBuffer: Integer);
  760.     procedure FlushAddBuffer;
  761.     procedure EndAddBuffered;
  762.  
  763.     function LocateRecord(  const KeyFields: string;
  764.                             const KeyValues: Variant;
  765.                             Options: TLocateOptions;
  766.                             nRec: DWORD = 1;
  767.                             FullScanOnly: boolean = false): Integer;
  768.     function Locate(const KeyFields: string; const KeyValues: Variant;
  769.       Options: TLocateOptions): Boolean; override;
  770.     function Lookup(const KeyFields: string; const KeyValues: Variant;
  771.       const ResultFields: string): Variant; override;
  772.  
  773.     function GetPrec(aField: TField): Integer;
  774.     function GetLen(aField: TField): Integer;
  775.  
  776.     function RLock: Boolean; overload;
  777.     function RLock(nRec: Integer): Boolean; overload;
  778.  
  779.     function RUnLock: Boolean; overload;
  780.     function RUnLock(nRec: Integer): Boolean; overload;
  781.  
  782.     function FLock: Boolean;
  783.     function UnLock: Boolean;
  784.  
  785.     procedure SetOrder(nOrd: Integer); overload;
  786.     procedure SetOrder(sOrd: ShortString); overload;
  787.     procedure SetOrderName(sOrd: ShortString); overload;
  788.     function GetOrder: ShortString;
  789.  
  790.     property Last_Rec: Longint read DBFHeader.last_rec;
  791.  
  792.     function SetAutoInc(const FieldName: String; Value: DWORD): boolean; overload;
  793.     function SetAutoInc(const FieldNum: Integer; Value: DWORD): boolean; overload;
  794.  
  795.     function GetCurrentAutoInc(const FieldName: String): DWORD; overload;
  796.     function GetCurrentAutoInc(const FieldNum: Integer): DWORD; overload;
  797.  
  798.     function GetNextAutoInc(const FieldName: String): DWORD; overload;
  799.     function GetNextAutoInc(const FieldNum: Integer): DWORD; overload;
  800.  
  801.     procedure Truncate;
  802.     procedure Zap;
  803.  
  804.     procedure DeleteRecord;
  805.     procedure RecallRecord;
  806.  
  807.     procedure Pack;
  808.  
  809.     procedure DBEval;
  810.  
  811.     function AcceptTmpRecord(nRec: DWORD): boolean;
  812.  
  813.     procedure SetKey;
  814.     procedure EditKey;
  815.     function GotoKey: boolean;
  816.     procedure GotoNearest;
  817.     procedure DropEditKey;
  818.     function FindKey(const KeyValues: array of const): Boolean;
  819.     procedure FindNearest(const KeyValues: array of const);
  820.  
  821.     property OuterStream: TStream read FOuterStream write FOuterStream;
  822.     property InnerStream: TStream read GetInnerStream;
  823.     property OuterLobStream: TStream read FOuterLobStream write FOuterLobStream;
  824.     property InnerLobStream: TStream read GetInnerLobStream;
  825.  
  826.     property Indexes: TIndexes read FIndexes write SetIndexList stored false;
  827.     property IndexName: ShortString read GetOrder write SetOrderName;
  828.  
  829.     property StorageType: TProxyStreamType read FStorageType write FStorageType;
  830.     property DBFFieldDefs: TVKDBFFieldDefs read FDBFFieldDefs write SetDBFFieldDefs stored false;
  831.     property DBFIndexDefs: TVKDBFIndexDefs read FDBFIndexDefs write SetDBFIndexDefs stored false;
  832.     property DBFFileName: String read FDBFFileName write FDBFFileName;
  833.     property AccessMode: TAccessMode read FAccessMode write FAccessMode;
  834.     property Crypt: TVKDBFCrypt read FVKDBFCrypt write FVKDBFCrypt;
  835.     property BufferSize: Integer read FBufferSize write FBufferSize;
  836.     property WaitBusyRes: Integer read FWaitBusyRes write FWaitBusyRes;
  837.     property DataSource: TDataSource read GetDataSource write SetDataSource;
  838.     property CreateNow: Boolean read GetCreateNow write SetCreateNow;
  839.     property MasterFields: String read FMasterFields write SetMasterFields;
  840.  
  841.   published
  842.  
  843.     { Published declarations }
  844.     property Active;
  845.     property OEM: Boolean read FOEM write FOEM default false;
  846.     property SetDeleted: Boolean read FSetDeleted write SetSetDeleted;
  847.     property FastPostRecord: Boolean read FFastPostRecord write FFastPostRecord;
  848.     property LookupOptions: TLocateOptions read FLookupOptions write FLookupOptions;
  849.  
  850.     property Filter;
  851.     property Filtered;
  852.     property FilterOptions;
  853.  
  854.     property BeforeOpen;
  855.     property AfterOpen;
  856.     property BeforeClose;
  857.     property AfterClose;
  858.     property BeforeInsert;
  859.     property AfterInsert;
  860.     property BeforeEdit;
  861.     property AfterEdit;
  862.     property BeforePost;
  863.     property AfterPost;
  864.     property BeforeCancel;
  865.     property AfterCancel;
  866.     property BeforeDelete;
  867.     property AfterDelete;
  868.     property BeforeScroll;
  869.     property AfterScroll;
  870.     property OnCalcFields;
  871.     property OnDeleteError;
  872.     property OnEditError;
  873.     property OnFilterRecord;
  874.     property OnNewRecord;
  875.     property OnPostError;
  876.  
  877.     property OnEncrypt: TOnCrypt read GetOnEncrypt write SetOnEncrypt;
  878.     property OnDecrypt: TOnCrypt read GetOnDecrypt write SetOnDecrypt;
  879.     property OnCryptActivate: TNotifyEvent  read GetOnCryptActivate
  880.                                             write SetOnCryptActivate;
  881.     property OnCryptDeActivate: TNotifyEvent  read GetOnCryptDeActivate
  882.                                             write SetOnCryptDeActivate;
  883.  
  884.     property OnDBEval: TOnDBEval read FOnDBEval write FOnDBEval;
  885.  
  886.     property OnOuterStreamLock: TLockEvent read FOnOuterStreamLock write FOnOuterStreamLock;
  887.     property OnOuterStreamUnlock: TUnlockEvent read FOnOuterStreamUnlock write FOnOuterStreamUnlock;
  888.  
  889.   end;
  890.  
  891.   {TVKNestedDBF}
  892.   TVKNestedDBF = class(TVKSmartDBF)
  893.   private
  894.     function GetParentDataSet: TVKSmartDBF;
  895.   protected
  896.  
  897.     procedure LobHandlerCreate; override;
  898.     procedure CreateLobStream(dbf_id: Byte); override;
  899.     procedure OpenLobStream(dbf_id: Byte); override;
  900.     procedure CloseLobStream; override;
  901.     procedure LobHandlerDestroy; override;
  902.  
  903.     procedure PackLobHandlerCreate; override;
  904.     procedure PackLobHandlerOpen(TempLobName: String); override;
  905.     procedure PackLobHandlerClose(LobName, TempLobName: String); override;
  906.     procedure PackLobHandlerDestroy; override;
  907.  
  908.     function GetPackLobHandler: TProxyStream; override;
  909.  
  910.     procedure SetDataSetField(const Value: TDataSetField); override;
  911.  
  912.     procedure InternalOpen; override;
  913.     procedure InternalPost; override;
  914.     procedure DeleteRecallRecord(Del: boolean = true); override;
  915.     procedure DataEvent(Event: TDataEvent; Info: Longint); override;
  916.  
  917.   public
  918.  
  919.     { Public declarations }
  920.     constructor Create(AOwner: TComponent); override;
  921.     property ParentDataSet: TVKSmartDBF read GetParentDataSet;
  922.  
  923.   published
  924.  
  925.     property DataSetField;
  926.  
  927.     property DBFFieldDefs;
  928.     property BufferSize;
  929.  
  930.   end;
  931.  
  932.   {TDBFNTX}
  933.   TVKDBFNTX = class(TVKSmartDBF)
  934.   private
  935.  
  936.     procedure ReadDBFFieldDefData(Reader: TReader);
  937.     procedure WriteDBFFieldDefData(Writer: TWriter);
  938.     procedure ReadDBFIndexDefData(Reader: TReader);
  939.     procedure WriteDBFIndexDefData(Writer: TWriter);
  940.     function GetOrdersByNum(Index: Integer): TVKNTXIndex;
  941.     function GetOrdersByName(const Index: String): TVKNTXIndex;
  942.  
  943.   public
  944.     { Public declarations }
  945.     constructor Create(AOwner: TComponent); override;
  946.     destructor Destroy; override;
  947.  
  948.     procedure DefineProperties(Filer: TFiler); override;
  949.  
  950.     procedure SetRange(FieldList: String; FieldValues: array of const); overload; override;
  951.     procedure SetRange(FieldList: String; FieldValues: variant); overload; override;
  952.     procedure ClearRange; override;
  953.  
  954.     property Orders[Index: Integer]: TVKNTXIndex read GetOrdersByNum;
  955.     property OrdersByName[const Index: String]: TVKNTXIndex read GetOrdersByName;
  956.  
  957.   published
  958.  
  959.     property StorageType;
  960.     property DBFFieldDefs;
  961.     property DBFIndexDefs;
  962.     property Indexes;
  963.     property IndexName;
  964.     property DBFFileName;
  965.     property AccessMode;
  966.     property Crypt;
  967.     property BufferSize;
  968.     property WaitBusyRes;
  969.     property DataSource;
  970.     property CreateNow;
  971.     property MasterFields;
  972.  
  973.   end;
  974.  
  975.   {TDBFCDX}
  976.   TVKDBFCDX = class(TVKSmartDBF)
  977.   private
  978.  
  979.     procedure ReadDBFFieldDefData(Reader: TReader);
  980.     procedure WriteDBFFieldDefData(Writer: TWriter);
  981.     procedure ReadDBFIndexDefData(Reader: TReader);
  982.     procedure WriteDBFIndexDefData(Writer: TWriter);
  983.  
  984.   public
  985.     { Public declarations }
  986.     constructor Create(AOwner: TComponent); override;
  987.     destructor Destroy; override;
  988.  
  989.     procedure DefineProperties(Filer: TFiler); override;
  990.  
  991.   published
  992.  
  993.     property StorageType;
  994.     property DBFFieldDefs;
  995.     property DBFIndexDefs;
  996.     property Indexes;
  997.     property IndexName;
  998.     property DBFFileName;
  999.     property AccessMode;
  1000.     property Crypt;
  1001.     property BufferSize;
  1002.     property WaitBusyRes;
  1003.     property DataSource;
  1004.     property CreateNow;
  1005.     property MasterFields;
  1006.  
  1007.   end;
  1008.  
  1009. procedure Wait(t: double; l: boolean = true);
  1010. function Space(iSize: Integer): String;
  1011. function Zerro(iSize: Integer): String;
  1012. function DoEncodeDate(Year, Month, Day: Word; var Date: TDateTime): Boolean;
  1013. function IsBlank(Buff: pChar; BufLen: Integer): boolean;
  1014. function ExtType2Str(t: TVKDBFType): String;
  1015. function Str2ExtType(s: String): TVKDBFType;
  1016. procedure Register;
  1017.  
  1018. implementation
  1019.  
  1020. uses Dialogs, DBcommon, ActiveX;
  1021.  
  1022. {$R DBF.RES}
  1023.  
  1024. //******************************************************************************
  1025. procedure Register;
  1026. begin
  1027.   RegisterComponents('VK DBF', [TVKDBFNTX, {TVKDBFCDX,} TVKNestedDBF]);
  1028. end;
  1029.  
  1030. //******************************************************************************
  1031. procedure Wait(t: double; l: boolean = true);
  1032. var
  1033.   t1: TDateTime;
  1034. begin
  1035.   t1 := Now;
  1036.   while (Now - t1) < (0.0000115741 * t) do
  1037.     if l then Application.ProcessMessages;
  1038. end;
  1039.  
  1040. //******************************************************************************
  1041. function Space(iSize: Integer): String;
  1042. var
  1043.   i: Integer;
  1044. begin
  1045.   Result := '';
  1046.   for i := 1 to iSize do
  1047.     Result := Result + ' ';
  1048. end;
  1049.  
  1050. //******************************************************************************
  1051. function Zerro(iSize: Integer): String;
  1052. var
  1053.   i: Integer;
  1054. begin
  1055.   Result := '';
  1056.   for i := 1 to iSize do
  1057.     Result := Result + #0;
  1058. end;
  1059.  
  1060. //******************************************************************************
  1061. function DoEncodeDate(Year, Month, Day: Word; var Date: TDateTime): Boolean;
  1062. var
  1063.   I: Integer;
  1064.   DayTable: PDayTable;
  1065. begin
  1066.   Result := False;
  1067.   DayTable := @MonthDays[IsLeapYear(Year)];
  1068.   if (Year >= 1) and (Year <= 9999) and (Month >= 1) and (Month <= 12) and
  1069.     (Day >= 1) and (Day <= DayTable^[Month]) then
  1070.   begin
  1071.     for I := 1 to Month - 1 do Inc(Day, DayTable^[I]);
  1072.     I := Year - 1;
  1073.     Date := I * 365 + I div 4 - I div 100 + I div 400 + Day - DateDelta;
  1074.     Result := True;
  1075.   end;
  1076. end;
  1077.  
  1078. //******************************************************************************
  1079. function IsBlank(Buff: pChar; BufLen: Integer): boolean;
  1080. var
  1081.   i, j: Integer;
  1082. begin
  1083.   Result := true;
  1084.   j := BufLen - 1;
  1085.   for i := 0 to j do
  1086.   begin
  1087.     if Buff[i] <> #32 then
  1088.     begin
  1089.       Result := false;
  1090.       break;
  1091.     end;
  1092.   end;
  1093. end;
  1094.  
  1095. function ExtType2Str(t: TVKDBFType): String;
  1096. begin
  1097.   case t of
  1098.     DBFTS1            : Result :=    'DBFTS1           ';
  1099.     DBFTU1            : Result :=    'DBFTU1           ';
  1100.     DBFTS2            : Result :=    'DBFTS2           ';
  1101.     DBFTU2            : Result :=    'DBFTU2           ';
  1102.     DBFTS4            : Result :=    'DBFTS4           ';
  1103.     DBFTU4            : Result :=    'DBFTU4           ';
  1104.     DBFTS8            : Result :=    'DBFTS8           ';
  1105.     DBFTR4            : Result :=    'DBFTR4           ';
  1106.     DBFTR6            : Result :=    'DBFTR6           ';
  1107.     DBFTR8            : Result :=    'DBFTR8           ';
  1108.     DBFTR10           : Result :=    'DBFTR10          ';
  1109.     DBFTD1            : Result :=    'DBFTD1           ';
  1110.     DBFTD2            : Result :=    'DBFTD2           ';
  1111.     DBFTS1_N          : Result :=    'DBFTS1_N         ';
  1112.     DBFTU1_N          : Result :=    'DBFTU1_N         ';
  1113.     DBFTS2_N          : Result :=    'DBFTS2_N         ';
  1114.     DBFTU2_N          : Result :=    'DBFTU2_N         ';
  1115.     DBFTS4_N          : Result :=    'DBFTS4_N         ';
  1116.     DBFTU4_N          : Result :=    'DBFTU4_N         ';
  1117.     DBFTS8_N          : Result :=    'DBFTS8_N         ';
  1118.     DBFTR4_N          : Result :=    'DBFTR4_N         ';
  1119.     DBFTR6_N          : Result :=    'DBFTR6_N         ';
  1120.     DBFTR8_N          : Result :=    'DBFTR8_N         ';
  1121.     DBFTR10_N         : Result :=    'DBFTR10_N        ';
  1122.     DBFTD1_N          : Result :=    'DBFTD1_N         ';
  1123.     DBFTD2_N          : Result :=    'DBFTD2_N         ';
  1124.     DBFTCLOB          : Result :=    'DBFTCLOB         ';
  1125.     DBFTBLOB          : Result :=    'DBFTBLOB         ';
  1126.     DBFTGRAPHIC       : Result :=    'DBFTGRAPHIC      ';
  1127.     DBFTFMTMEMO       : Result :=    'DBFTFMTMEMO      ';
  1128.     DBFTSTRING        : Result :=    'DBFTSTRING       ';
  1129.     DBFTSTRING_N      : Result :=    'DBFTSTRING_N     ';
  1130.     DBFTFIXEDCHAR     : Result :=    'DBFTFIXEDCHAR    ';
  1131.     DBFTWIDESTRING    : Result :=    'DBFTWIDESTRING   ';
  1132.     DBFTCURRENCY      : Result :=    'DBFTCURRENCY     ';
  1133.     DBFTCURRENCY_N    : Result :=    'DBFTCURRENCY_N   ';
  1134.     DBFTCURRENCY_NB   : Result :=    'DBFTCURRENCY_NB  ';
  1135.     DBFTBCD           : Result :=    'DBFTBCD          ';
  1136.     DBFTDATE          : Result :=    'DBFTDATE         ';
  1137.     DBFTDATE_N        : Result :=    'DBFTDATE_N       ';
  1138.     DBFTTIME          : Result :=    'DBFTTIME         ';
  1139.     DBFTTIME_N        : Result :=    'DBFTTIME_N       ';
  1140.     DBFTD3            : Result :=    'DBFTD3           ';
  1141.     DBFTD3_N          : Result :=    'DBFTD3_N         ';
  1142.     DBFTU1_NB         : Result :=    'DBFTU1_NB        ';
  1143.     DBFTU2_NB         : Result :=    'DBFTU2_NB        ';
  1144.     DBFTU4_NB         : Result :=    'DBFTU4_NB        ';
  1145.     DBFTR4_NB         : Result :=    'DBFTR4_NB        ';
  1146.     DBFTR6_NB         : Result :=    'DBFTR6_NB        ';
  1147.     DBFTR8_NB         : Result :=    'DBFTR8_NB        ';
  1148.     DBFTD1_NB         : Result :=    'DBFTD1_NB        ';
  1149.     DBFTD2_NB         : Result :=    'DBFTD2_NB        ';
  1150.     DBFTD3_NB         : Result :=    'DBFTD3_NB        ';
  1151.     DBFTDATE_NB       : Result :=    'DBFTDATE_NB      ';
  1152.     DBFTTIME_NB       : Result :=    'DBFTTIME_NB      ';
  1153.     DBFTCLOB_NB       : Result :=    'DBFTCLOB_NB      ';
  1154.     DBFTBLOB_NB       : Result :=    'DBFTBLOB_NB      ';
  1155.     DBFTGRAPHIC_NB    : Result :=    'DBFTGRAPHIC_NB   ';
  1156.     DBFTFMTMEMO_NB    : Result :=    'DBFTFMTMEMO_NB   ';
  1157.     DBFTDBFDATASET    : Result :=    'DBFTDBFDATASET   ';
  1158.     DBFTDBFDATASET_NB : Result :=    'DBFTDBFDATASET_NB';
  1159.   else
  1160.     Result := '';
  1161.   end;
  1162.   Result := trim(Result);
  1163. end;
  1164.  
  1165. function Str2ExtType(s: String): TVKDBFType;
  1166. var
  1167.   q: String;
  1168. begin
  1169.   Result := dbftUndefined;
  1170.   q := Uppercase(Trim(s));
  1171.   if q = 'DBFTS1'    then Result :=              DBFTS1;
  1172.   if q = 'DBFTU1'    then Result :=              DBFTU1;
  1173.   if q = 'DBFTS2'    then Result :=              DBFTS2;
  1174.   if q = 'DBFTU2'    then Result :=              DBFTU2;
  1175.   if q = 'DBFTS4'    then Result :=              DBFTS4;
  1176.   if q = 'DBFTU4'    then Result :=              DBFTU4;
  1177.   if q = 'DBFTS8'    then Result :=              DBFTS8;
  1178.   if q = 'DBFTR4'    then Result :=              DBFTR4;
  1179.   if q = 'DBFTR6'    then Result :=              DBFTR6;
  1180.   if q = 'DBFTR8'    then Result :=              DBFTR8;
  1181.   if q = 'DBFTR10'   then Result :=              DBFTR10;
  1182.   if q = 'DBFTD1'    then Result :=              DBFTD1;
  1183.   if q = 'DBFTD2'    then Result :=              DBFTD2;
  1184.   if q = 'DBFTS1_N'  then Result :=              DBFTS1_N;
  1185.   if q = 'DBFTU1_N'  then Result :=              DBFTU1_N;
  1186.   if q = 'DBFTS2_N'  then Result :=              DBFTS2_N;
  1187.   if q = 'DBFTU2_N'  then Result :=              DBFTU2_N;
  1188.   if q = 'DBFTS4_N'  then Result :=              DBFTS4_N;
  1189.   if q = 'DBFTU4_N'  then Result :=              DBFTU4_N;
  1190.   if q = 'DBFTS8_N'  then Result :=              DBFTS8_N;
  1191.   if q = 'DBFTR4_N'  then Result :=              DBFTR4_N;
  1192.   if q = 'DBFTR6_N'  then Result :=              DBFTR6_N;
  1193.   if q = 'DBFTR8_N'  then Result :=              DBFTR8_N;
  1194.   if q = 'DBFTR10_N' then Result :=              DBFTR10_N;
  1195.   if q = 'DBFTD1_N'  then Result :=              DBFTD1_N;
  1196.   if q = 'DBFTD2_N'  then Result :=              DBFTD2_N;
  1197.   if q = 'DBFTCLOB'     then Result :=           DBFTCLOB;
  1198.   if q = 'DBFTBLOB'     then Result :=           DBFTBLOB;
  1199.   if q = 'DBFTGRAPHIC'  then Result :=           DBFTGRAPHIC;
  1200.   if q = 'DBFTFMTMEMO'  then Result :=           DBFTFMTMEMO;
  1201.   if q = 'DBFTSTRING'  then Result :=            DBFTSTRING;
  1202.   if q = 'DBFTSTRING_N'  then Result :=          DBFTSTRING_N;
  1203.   if q = 'DBFTFIXEDCHAR' then Result :=          DBFTFIXEDCHAR;
  1204.   if q = 'DBFTWIDESTRING' then Result :=         DBFTWIDESTRING;
  1205.   if q = 'DBFTCURRENCY' then Result :=           DBFTCURRENCY;
  1206.   if q = 'DBFTCURRENCY_N' then Result :=         DBFTCURRENCY_N;
  1207.   if q = 'DBFTCURRENCY_NB' then Result :=        DBFTCURRENCY_NB;
  1208.   if q = 'DBFTBCD' then Result :=                DBFTBCD;
  1209.   if q = 'DBFTDATE' then Result :=               DBFTDATE;
  1210.   if q = 'DBFTDATE_N' then Result :=             DBFTDATE_N;
  1211.   if q = 'DBFTTIME' then Result :=               DBFTTIME;
  1212.   if q = 'DBFTTIME_N' then Result :=             DBFTTIME_N;
  1213.   if q = 'DBFTD3' then Result :=                 DBFTD3;
  1214.   if q = 'DBFTD3_N' then Result :=               DBFTD3_N;
  1215.   if q = 'DBFTU1_NB' then Result :=              DBFTU1_NB;
  1216.   if q = 'DBFTU2_NB' then Result :=              DBFTU2_NB;
  1217.   if q = 'DBFTU4_NB' then Result :=              DBFTU4_NB;
  1218.   if q = 'DBFTR4_NB' then Result :=              DBFTR4_NB;
  1219.   if q = 'DBFTR6_NB' then Result :=              DBFTR6_NB;
  1220.   if q = 'DBFTR8_NB' then Result :=              DBFTR8_NB;
  1221.   if q = 'DBFTD1_NB' then Result :=              DBFTD1_NB;
  1222.   if q = 'DBFTD2_NB' then Result :=              DBFTD2_NB;
  1223.   if q = 'DBFTD3_NB' then Result :=              DBFTD3_NB;
  1224.   if q = 'DBFTDATE_NB' then Result :=            DBFTDATE_NB;
  1225.   if q = 'DBFTTIME_NB' then Result :=            DBFTTIME_NB;
  1226.   if q = 'DBFTCLOB_NB' then Result :=            DBFTCLOB_NB;
  1227.   if q = 'DBFTBLOB_NB' then Result :=            DBFTBLOB_NB;
  1228.   if q = 'DBFTGRAPHIC_NB' then Result :=         DBFTGRAPHIC_NB;
  1229.   if q = 'DBFTFMTMEMO_NB' then Result :=         DBFTFMTMEMO_NB;
  1230.   if q = 'DBFTDBFDATASET' then Result :=         DBFTDBFDATASET;
  1231.   if q = 'DBFTDBFDATASET_NB' then Result :=      DBFTDBFDATASET_NB;
  1232. end;
  1233.  
  1234. { TVKSmartDBF }
  1235.  
  1236. function TVKSmartDBF.AcceptRecord: Boolean;
  1237. begin
  1238.   Result := true;
  1239.   if Assigned(OnFilterRecord) then
  1240.     OnFilterRecord(self, Result);
  1241.   if Filter <> '' then
  1242.     Result := Result and FFilterParser.Execute;
  1243.   if FSetDeleted then
  1244.     Result := Result and ( not Deleted );
  1245. end;
  1246.  
  1247. function TVKSmartDBF.AllocRecordBuffer: PChar;
  1248. begin
  1249.   Result := VKDBFMemMgr.oMem.GetMem(self, RecordBufferSize);
  1250. end;
  1251.  
  1252. function TVKSmartDBF.CompareLocateField(const Fields: TList;
  1253.   const KeyValues: Variant; Options: TLocateOptions): Integer;
  1254. var
  1255.   FieldCount: Integer;
  1256.   Field: TField;
  1257.   KeyVal: Variant;
  1258.   v1, v2: String;
  1259.   i1, i2: Integer;
  1260.   l1, l2, l3: Int64;
  1261.   w1, w2: Word;
  1262.   b1, b2: boolean;
  1263.   f1, f2: double;
  1264.   i: Integer;
  1265.   Code: Integer;
  1266.   kk: Int64;
  1267.     {$IFDEF VER130}
  1268.   Vr: Variant;
  1269.     {$ENDIF}
  1270. begin
  1271.   Result := 1;
  1272.   FieldCount := Fields.Count;
  1273.   if FieldCount = 1 then
  1274.   begin
  1275.     try
  1276.       Field := TField(Fields.First);
  1277.     except
  1278.       Field := nil;
  1279.     end;
  1280.     try
  1281.       if VarIsArray(KeyValues) then
  1282.          KeyVal := KeyValues[0]
  1283.       else
  1284.          KeyVal := KeyValues;
  1285.     except
  1286.       KeyVal := NULL;
  1287.     end;
  1288.     case Field.DataType of
  1289.       ftFixedChar, ftWideString, ftString, ftMemo:
  1290.       begin
  1291.         KeyVal := VarAsType(KeyVal, varString);
  1292.         v1 := Field.AsString;
  1293.         if not VarIsNull(KeyVal) then v2 := KeyVal else v2 := '';
  1294.         if loPartialKey in Options then begin
  1295.           if ( loCaseInsensitive in Options ) then begin
  1296.             v1 := AnsiUpperCase(v1);
  1297.             v2 := AnsiUpperCase(v2);
  1298.           end;
  1299.           Result := Pos(v2, v1);
  1300.           if Result <> 1 then
  1301.             Result := AnsiCompareStr(v1, v2)
  1302.           else
  1303.             Result := 0;
  1304.         end else
  1305.           if loCaseInsensitive in Options then
  1306.             Result := AnsiCompareText(v1, v2)
  1307.           else
  1308.             Result := AnsiCompareStr(v1, v2);
  1309.       end;
  1310.       ftSmallint, ftInteger:
  1311.       begin
  1312.         KeyVal := VarAsType(KeyVal, varInteger);
  1313.         i1 := Field.AsInteger;
  1314.         if not VarIsNull(KeyVal) then i2 := KeyVal else i2 := 0;
  1315.         Result := i1 - i2;
  1316.       end;
  1317.       ftLargeint:
  1318.       begin
  1319.         //
  1320.                 {$IFDEF VER130}
  1321.         if TVarData(KeyVal).VType <> VT_DECIMAL then begin
  1322.                 {$ENDIF}
  1323.                 {$IFDEF VER140}
  1324.                 if (VarType(KeyVal) <> varInt64) then begin
  1325.                 {$ENDIF}
  1326.           Val(KeyVal, kk, code);
  1327.           if code <> 0 then
  1328.             KeyVal := Null
  1329.           else begin
  1330.                         {$IFDEF VER130}
  1331.             TVarData(Vr).VType := VT_DECIMAL;
  1332.             Decimal(Vr).lo64 := kk;
  1333.             KeyVal := Vr;
  1334.                         {$ENDIF}
  1335.                         {$IFDEF VER140}
  1336.                         KeyVal := kk;
  1337.                         {$ENDIF}
  1338.           end;
  1339.         end;
  1340.         //
  1341.         l1 := TLargeintField(Field).AsLargeInt;
  1342.         if not VarIsNull(KeyVal) then
  1343.                     {$IFDEF VER130}
  1344.           l2 := Decimal(KeyVal).lo64
  1345.                     {$ENDIF}
  1346.                     {$IFDEF VER140}
  1347.                     l2 := KeyVal
  1348.                     {$ENDIF}
  1349.         else
  1350.           l2 := 0;
  1351.         l3 := l1 - l2;
  1352.         if l3 < 0 then
  1353.           Result := -1
  1354.         else if l3 = 0 then
  1355.           Result := 0
  1356.         else if l3 > 0 then
  1357.           Result := 1;
  1358.       end;
  1359.       ftWord:
  1360.       begin
  1361.         KeyVal := VarAsType(KeyVal, varInteger);
  1362.         w1 := Field.AsInteger;
  1363.         if not VarIsNull(KeyVal) then w2 := KeyVal else w2 := 0;
  1364.         Result := w1 - w2;
  1365.       end;
  1366.       ftBoolean:
  1367.       begin
  1368.         KeyVal := VarAsType(KeyVal, varBoolean);
  1369.         b1 := Field.AsBoolean;
  1370.         if not VarIsNull(KeyVal) then b2 := KeyVal else b2 := false;
  1371.         if (not b1) and b2 then
  1372.           Result := -1;
  1373.         if b1 = b2 then
  1374.           Result := 0;
  1375.         if b1 and (not b2) then
  1376.           Result := 1;
  1377.       end;
  1378.       ftFloat, ftCurrency, ftBCD:
  1379.       begin
  1380.         Result := VarAsType(Result, varDouble);
  1381.         f1 := Field.AsFloat;
  1382.         if not VarIsNull(KeyVal) then f2 := KeyVal else f2 := 0;
  1383.         if f1 < f2 then
  1384.           Result := -1;
  1385.         if f1 = f2 then
  1386.           Result := 0;
  1387.         if f1 > f2 then
  1388.           Result := 1;
  1389.       end;
  1390.       ftDate, ftTime, ftDateTime:
  1391.       begin
  1392.         Result := VarAsType(Result, varDate);
  1393.         f1 := Field.AsDateTime;
  1394.         if not VarIsNull(KeyVal) then f2 := KeyVal else f2 := 0;
  1395.         if f1 < f2 then
  1396.           Result := -1;
  1397.         if f1 = f2 then
  1398.           Result := 0;
  1399.         if f1 > f2 then
  1400.           Result := 1;
  1401.       end;
  1402.     end;
  1403.   end else begin
  1404.     for i := 0 to FieldCount - 1 do
  1405.     begin
  1406.       //
  1407.       try
  1408.         Field := TField(Fields.Items[i]);
  1409.       except
  1410.         Field := nil;
  1411.       end;
  1412.       try
  1413.         if VarIsArray(KeyValues) then
  1414.            KeyVal := KeyValues[i]
  1415.         else
  1416.            KeyVal := NULL;
  1417.       except
  1418.         KeyVal := NULL;
  1419.       end;
  1420.       case Field.DataType of
  1421.         ftFixedChar, ftWideString, ftString:
  1422.         begin
  1423.           KeyVal := VarAsType(KeyVal, varString);
  1424.           v1 := Field.AsString;
  1425.           if not VarIsNull(KeyVal) then v2 := KeyVal else v2 := '';
  1426.           if loPartialKey in Options then begin
  1427.             if ( loCaseInsensitive in Options ) then begin
  1428.               v1 := AnsiUpperCase(v1);
  1429.               v2 := AnsiUpperCase(v2);
  1430.             end;
  1431.             Result := Pos(v2, v1);
  1432.             if Result <> 1 then
  1433.               Result := AnsiCompareStr(v1, v2)
  1434.             else
  1435.               Result := 0;
  1436.           end else
  1437.             if loCaseInsensitive in Options then
  1438.               Result := AnsiCompareText(v1, v2)
  1439.             else
  1440.               Result := AnsiCompareStr(v1, v2);
  1441.         end;
  1442.         ftSmallint, ftInteger:
  1443.         begin
  1444.           KeyVal := VarAsType(KeyVal, varInteger);
  1445.           i1 := Field.AsInteger;
  1446.           if not VarIsNull(KeyVal) then i2 := KeyVal else i2 := 0;
  1447.           Result := i1 - i2;
  1448.         end;
  1449.         ftLargeint:
  1450.         begin
  1451.           //
  1452.                     {$IFDEF VER130}
  1453.           if TVarData(KeyVal).VType <> VT_DECIMAL then begin
  1454.                     {$ENDIF}
  1455.                     {$IFDEF VER140}
  1456.                     if (VarType(KeyVal) <> varInt64) then begin
  1457.                     {$ENDIF}
  1458.             Val(KeyVal, kk, code);
  1459.             if code <> 0 then
  1460.               KeyVal := Null
  1461.             else begin
  1462.                             {$IFDEF VER130}
  1463.               TVarData(Vr).VType := VT_DECIMAL;
  1464.               Decimal(Vr).lo64 := kk;
  1465.               KeyVal := Vr;
  1466.                             {$ENDIF}
  1467.                             {$IFDEF VER140}
  1468.                             KeyVal := kk;
  1469.                             {$ENDIF}
  1470.             end;
  1471.           end;
  1472.           //
  1473.           l1 := TLargeintField(Field).AsLargeInt;
  1474.           if not VarIsNull(KeyVal) then
  1475.                         {$IFDEF VER130}
  1476.             l2 := Decimal(KeyVal).lo64
  1477.                         {$ENDIF}
  1478.                         {$IFDEF VER140}
  1479.                         l2 := KeyVal
  1480.                         {$ENDIF}
  1481.           else
  1482.             l2 := 0;
  1483.           l3 := l1 - l2;
  1484.           if l3 < 0 then
  1485.             Result := -1
  1486.           else if l3 = 0 then
  1487.             Result := 0
  1488.           else if l3 > 0 then
  1489.             Result := 1;
  1490.         end;
  1491.         ftWord:
  1492.         begin
  1493.           KeyVal := VarAsType(KeyVal, varInteger);
  1494.           w1 := Field.AsInteger;
  1495.           if not VarIsNull(KeyVal) then w2 := KeyVal else w2 := 0;
  1496.           Result := w1 - w2;
  1497.         end;
  1498.         ftBoolean:
  1499.         begin
  1500.           KeyVal := VarAsType(KeyVal, varBoolean);
  1501.           b1 := Field.AsBoolean;
  1502.           if not VarIsNull(KeyVal) then b2 := KeyVal else b2 := false;
  1503.           if (not b1) and b2 then
  1504.             Result := -1;
  1505.           if b1 = b2 then
  1506.             Result := 0;
  1507.           if b1 and (not b2) then
  1508.             Result := 1;
  1509.         end;
  1510.         ftFloat, ftCurrency, ftBCD:
  1511.         begin
  1512.           KeyVal := VarAsType(KeyVal, varDouble);
  1513.           f1 := Field.AsFloat;
  1514.           if not VarIsNull(KeyVal) then f2 := KeyVal else f2 := 0;
  1515.           if f1 < f2 then
  1516.             Result := -1;
  1517.           if f1 = f2 then
  1518.             Result := 0;
  1519.           if f1 > f2 then
  1520.             Result := 1;
  1521.         end;
  1522.         ftDate, ftTime, ftDateTime:
  1523.         begin
  1524.           KeyVal := VarAsType(KeyVal, varDate);
  1525.           f1 := Field.AsDateTime;
  1526.           if not VarIsNull(KeyVal) then f2 := KeyVal else f2 := 0;
  1527.           if f1 < f2 then
  1528.             Result := -1;
  1529.           if f1 = f2 then
  1530.             Result := 0;
  1531.           if f1 > f2 then
  1532.             Result := 1;
  1533.         end;
  1534.       end;
  1535.       //
  1536.       if Result <> 0 then
  1537.         Exit;
  1538.     end;
  1539.   end;
  1540. end;
  1541.  
  1542. constructor TVKSmartDBF.Create(AOwner: TComponent);
  1543. var
  1544.   FieldMap: TFieldMap;
  1545. begin
  1546.   inherited Create(AOwner);
  1547.   DBFHandler := TProxyStream.Create;
  1548.   LobHandlerCreate;
  1549.   FStorageType := pstFile;
  1550.   FFilterParser := TVKDBFExprParser.Create(self, '', [], [poExtSyntax], '', nil, FieldMap);
  1551.   FAccessMode := TAccessMode.Create;
  1552.   FVKDBFCrypt := TVKDBFCrypt.Create;
  1553.   FVKDBFCrypt.SmartDBF := self;
  1554.   FLockRecords := TList.Create;
  1555.   FDBFFieldDefs := TVKDBFFieldDefs.Create(self);
  1556.   FOEM := false;
  1557.   FDBFFileName := '';
  1558.   FTmpActive := false;
  1559.   FKeyCalk := false;
  1560.   FBufferSize := 4096;
  1561.   FRecordsPerBuf := 0;
  1562.   FBuffer := nil;
  1563.   FBufInd := nil;
  1564.   FBufCnt := 0;
  1565.   FCurInd := -1;
  1566.   FBufDir := bdFromTop;;
  1567.   FBOF := false;
  1568.   FEOF := false;
  1569.   FWaitBusyRes := 3000;  //3 sec. waiting for a locking resource
  1570.  
  1571.   FDataLink := TVKDataLink.Create;
  1572.   FDataLink.DBFDataSet := self;
  1573.  
  1574.   FFileLock := false;
  1575.  
  1576.   FIndRecBuf := nil;
  1577.   FIndState := false;
  1578.  
  1579.   FMasterFields := '';
  1580.   FRange := false;
  1581.   ListMasterFields := TList.Create;
  1582.  
  1583.   FFastPostRecord := false;
  1584.  
  1585.   FAddBuffered := false;
  1586.   FAddBuffer := nil;
  1587.   FAddBufferCrypt := nil;
  1588.   FAddBufferCount := -1;
  1589.   FAddBufferCurrent := -1;
  1590.  
  1591.   FLookupOptions := [];
  1592.  
  1593.   FPackProcess := false;
  1594.   FPackLobHandler := nil;
  1595.  
  1596.   FullLengthCharFieldCopy := false;
  1597.  
  1598.   FOnOuterStreamLock := nil;
  1599.   FOnOuterStreamUnlock := nil;
  1600.  
  1601.   ObjectView := true;
  1602.  
  1603.   Changed := False;
  1604.  
  1605.   NestedDataSetClass := TVKNestedDBF;
  1606.  
  1607.   FSaveOnTheSamePlace := False;
  1608.  
  1609.   FOpenWithoutIndexes := False;
  1610.  
  1611. end;
  1612.  
  1613. procedure TVKSmartDBF.CreateTable;
  1614. var
  1615.   cHeader: DBF_HEAD;
  1616.   i, j: Integer;
  1617.   Year, Month, Day: Word;
  1618.   qq: byte;
  1619.   oBag: TVKDBFIndexBag;
  1620.   oOrd: TVKDBFOrder;
  1621.   OldActiveIndexObject: TIndex;
  1622.  
  1623.   procedure WriteFieldDef(DBFFDs: TVKDBFFieldDefs; LastWrite: boolean = false);
  1624.   var
  1625.     i: Integer;
  1626.     cField: FIELD_REC;
  1627.   begin
  1628.     if DBFFDs.Count = 0 then
  1629.       raise Exception.Create('TVKSmartDBF.CreateTable: You should define one field at least to create table!');
  1630.     for i := 0 to DBFFDs.Count - 1 do
  1631.     begin
  1632.       cHeader.rec_size := cHeader.rec_size + DBFFDs[i].DataSize;
  1633.       cField := DBFFDs[i].Field;
  1634.       cField.NextAutoInc := 0;
  1635.       if  ( cField.field_type = 'M' ) or
  1636.           ( ( cField.field_type = 'E' ) and ( cField.extend_type in
  1637.             [dbftClob, dbftBlob, dbftGraphic, dbftFmtMemo,
  1638.             dbftClob_NB, dbftBlob_NB, dbftGraphic_NB, dbftFmtMemo_NB,
  1639.             dbftDBFDataSet, dbftDBFDataSet_NB]  ) ) then
  1640.         cHeader.dbf_id := $83;
  1641.       DBFHandler.Write(cField, SizeOf(FIELD_REC));
  1642.       Inc(cHeader.data_offset, SizeOf(FIELD_REC));
  1643.       if  ( cField.field_type = 'E' ) and
  1644.           ( cField.extend_type in [dbftDBFDataSet, dbftDBFDataSet_NB]) then begin
  1645.         // Recursive call
  1646.         WriteFieldDef(DBFFDs[i].DBFFieldDefs);
  1647.       end;
  1648.     end;
  1649.     cField.field_name[0] := #$D;
  1650.     if LastWrite then
  1651.       DBFHandler.Write(cField, 1)
  1652.     else begin
  1653.       DBFHandler.Write(cField, SizeOf(FIELD_REC));
  1654.       Inc(cHeader.data_offset, SizeOf(FIELD_REC));
  1655.     end;
  1656.   end;
  1657.  
  1658. begin
  1659.   if not Active then
  1660.   begin
  1661.     DBFHandler.FileName := DBFFileName;
  1662.     DBFHandler.AccessMode.AccessMode := AccessMode.AccessMode;
  1663.     DBFHandler.ProxyStreamType := FStorageType;
  1664.     DBFHandler.OuterStream := FOuterStream;
  1665.     DBFHandler.CreateProxyStream;
  1666.     if DBFHandler.IsOpen then
  1667.     begin
  1668.       DecodeDate(Now, Year, Month, Day);
  1669.       with cHeader do
  1670.       begin
  1671.         dbf_id := $03;
  1672.         last_update[0] := Byte(Year);
  1673.         last_update[1] := Byte(Month);
  1674.         last_update[2] := Byte(Day);
  1675.         last_rec := 0;
  1676.         data_offset := 1;
  1677.         rec_size := 1;
  1678.         Dummy1 := 0;
  1679.         IncTrans := 0;
  1680.         Encrypt := 0;
  1681.         Dummy2 := 0;
  1682.         for i := 20 to 27 do
  1683.           Dummy3[i] := 0;
  1684.         prod_ind := 0;
  1685.         lang := 0;
  1686.         Dummy4 := 0;
  1687.       end;
  1688.       DBFHandler.Seek(0, 0);
  1689.       DBFHandler.Write(cHeader, SizeOf(DBF_HEAD));
  1690.       cHeader.data_offset := cHeader.data_offset + SizeOf(DBF_HEAD);
  1691.  
  1692.       WriteFieldDef(FDBFFieldDefs, true);
  1693.  
  1694.       cHeader.data_offset := cHeader.data_offset + 1;
  1695.       qq := $1A;
  1696.       DBFHandler.Write(qq, 1);
  1697.       DBFHandler.SetEndOfFile;
  1698.  
  1699.       DBFHandler.Seek(0, 0);
  1700.       DBFHandler.Write(cHeader, SizeOf(DBF_HEAD));
  1701.       DBFHandler.Close;
  1702.  
  1703.       CreateLobStream(cHeader.dbf_id);
  1704.  
  1705.     end else raise Exception.Create('TVKSmartDBF.CreateTable: Create error');
  1706.  
  1707.     if Indexes <> nil then begin
  1708.       OldActiveIndexObject := Indexes.ActiveObject;
  1709.       Indexes.ActiveObject := nil;
  1710.       FOpenWithoutIndexes := True;
  1711.       try
  1712.         Active := True;
  1713.         for i := 0 to DBFIndexDefs.Count - 1 do begin
  1714.           oBag := TVKDBFIndexBag(DBFIndexDefs[i]);
  1715.           oBag.CreateBag;
  1716.           for j := 0 to oBag.Orders.Count - 1 do begin
  1717.             oOrd := TVKDBFOrder(oBag.Orders[j]);
  1718.             oOrd.CreateOrder;
  1719.           end;
  1720.           oBag.Close;
  1721.         end;
  1722.         Active := False;
  1723.       finally
  1724.         FOpenWithoutIndexes := False;
  1725.         if Indexes <> nil then
  1726.           Indexes.ActiveObject := OldActiveIndexObject;
  1727.       end;
  1728.     end;
  1729.  
  1730.   end else raise Exception.Create('TVKSmartDBF.CreateTable: Can not create table while dataset is open');
  1731. end;
  1732.  
  1733. destructor TVKSmartDBF.Destroy;
  1734. begin
  1735.   try
  1736.     FLockRecords.Destroy;
  1737.     FAccessMode.Destroy;
  1738.     FVKDBFCrypt.Destroy;
  1739.     FFilterParser.Destroy;
  1740.     FDataLink.Destroy;
  1741.     FDBFFieldDefs.Destroy;
  1742.     ListMasterFields.Free;
  1743.     LobHandlerDestroy;
  1744.     DBFHandler.Destroy;
  1745.     inherited Destroy;
  1746.   except
  1747.     if DBFHandler.IsOpen then DBFHandler.Close;
  1748.     if LobHandler.IsOpen then LobHandler.Close;
  1749.   end;
  1750. end;
  1751.  
  1752. function TVKSmartDBF.FindRecord(Restart, GoForward: Boolean): Boolean;
  1753. var
  1754.   SaveState: TDataSetState;
  1755.   Accept: Boolean;
  1756.   Ret: TGetResult;
  1757. begin
  1758.   if (not Filtered) and (Filter <> '') then
  1759.       FFilterParser.SetExprParams(Filter, FilterOptions, [poExtSyntax], '');
  1760.   CheckBrowseMode;
  1761.   DoBeforeScroll;
  1762.   SetFound(False);
  1763.   UpdateCursorPos;
  1764.   CursorPosChanged;
  1765.   if GoForward then
  1766.   begin
  1767.     if Restart then InternalFirst;
  1768.     repeat
  1769.       Ret := GetRecordByBuffer(FFilterRecord, gmNext, false);
  1770.       SaveState := SetTempState(dsFilter);
  1771.       Accept := AcceptRecordInternal;
  1772.       RestoreState(SaveState);
  1773.     until Accept or (Ret <> grOK);
  1774.   end else
  1775.   begin
  1776.     if Restart then InternalLast;
  1777.     repeat
  1778.       Ret := GetRecordByBuffer(FFilterRecord, gmPrior, false);
  1779.       SaveState := SetTempState(dsFilter);
  1780.       Accept := AcceptRecordInternal;
  1781.       RestoreState(SaveState);
  1782.     until Accept or (Ret <> grOK);
  1783.   end;
  1784.   if Ret = grOK then
  1785.   begin
  1786.     Resync([rmExact, rmCenter]);
  1787.     SetFound(True);
  1788.   end else
  1789.     InternalSetToRecord(ActiveBuffer);
  1790.   Result := Found;
  1791.   if Result then DoAfterScroll;
  1792. end;
  1793.  
  1794. procedure TVKSmartDBF.FreeRecordBuffer(var Buffer: PChar);
  1795. begin
  1796.   VKDBFMemMgr.oMem.FreeMem(Buffer)
  1797. end;
  1798.  
  1799. function TVKSmartDBF.GetActiveRecBuf(var pRecBuf: PChar): Boolean;
  1800. begin
  1801.   if FIndState then begin
  1802.     pRecBuf := FIndRecBuf;
  1803.   end else begin
  1804.     if FKeyCalk then begin
  1805.       pRecBuf := RecBuf
  1806.     end else begin
  1807.       if FTmpActive then
  1808.         pRecBuf := FTempRecord
  1809.       else begin
  1810.         case State of
  1811.           dsBrowse: if IsEmpty then pRecBuf := nil else pRecBuf := ActiveBuffer;
  1812.           dsEdit, dsInsert: pRecBuf := ActiveBuffer;
  1813.           dsFilter: pRecBuf := FFilterRecord;
  1814.           dsNewValue, dsOldValue, dsCurValue: pRecBuf := ActiveBuffer;
  1815.           dsCalcFields: pRecBuf := CalcBuffer;
  1816.           dsSetKey: pRecBuf := FSetKeyBuffer;
  1817.         else
  1818.           pRecBuf := nil;
  1819.         end;
  1820.       end;
  1821.     end;
  1822.   end;
  1823.   Result := pRecBuf <> nil;
  1824. end;
  1825.  
  1826. procedure TVKSmartDBF.GetBookmarkData(Buffer: PChar; Data: Pointer);
  1827. begin
  1828.   Longword(Data^) := pTRecInfo(Buffer + FRecordSize).RecordRowID;
  1829. end;
  1830.  
  1831. function TVKSmartDBF.GetBookmarkFlag(Buffer: PChar): TBookmarkFlag;
  1832. begin
  1833.   Result := pTRecInfo(Buffer + FRecordSize).BookmarkFlag;
  1834. end;
  1835.  
  1836. function TVKSmartDBF.GetDeleted: Boolean;
  1837. var
  1838.   ActBuff: pChar;
  1839. begin
  1840.   Result := false;
  1841.   GetActiveRecBuf(ActBuff);
  1842.   if ActBuff <> nil then
  1843.   //begin
  1844.   //  if ActBuff[0] = #42 then //'*'
  1845.   //    Result := true;
  1846.   //  if not ( ActBuff[0] in [#32, #42] ) then //' '
  1847.   //    Result := false;
  1848.     Result := (ActBuff[0] = #42); //'*'
  1849.   //end;
  1850. end;
  1851.  
  1852. procedure TVKSmartDBF.SetDeletedFlag(const Value: Boolean);
  1853. var
  1854.   ActBuff: pChar;
  1855.   c: Boolean;
  1856. begin
  1857.   GetActiveRecBuf(ActBuff);
  1858.   if ActBuff <> nil then
  1859.   begin
  1860.     c := ( ActBuff[0] = #42 );
  1861.     if Value <> c then begin
  1862.       if not (State in [dsEdit, dsInsert]) then Edit;
  1863.       if Value then
  1864.         ActBuff[0] := #42 //'*'
  1865.       else
  1866.         ActBuff[0] := #32; //' '
  1867.       SetModified(True);
  1868.     end;
  1869.   end;
  1870. end;
  1871.  
  1872. function TVKSmartDBF.GetFieldData(Field: TField; Buffer: Pointer): Boolean;
  1873. var
  1874.   iCode, dInt: Integer;
  1875.   dInt64: Int64;
  1876.   dFloat: Double;
  1877.   ww: Extended;
  1878.   dBool: WordBool;
  1879.   dDate: TDateTime;
  1880.   sTS: TTimeStamp;
  1881.   dd: double;
  1882.   Year, Month, Day: Word;
  1883.   ss: pChar;
  1884.   ss1: array [0..255] of char;
  1885.   ActiveBuf: pChar;
  1886.   qq: TVKDBFFieldDef;
  1887.   oDS: TDataSet;
  1888.   LookupResult: Variant;
  1889.   LastSetp: Char;
  1890.   SLen: WORD;
  1891.   WLen: Integer;
  1892. begin
  1893.   Result := false;
  1894.   case Field.FieldKind of
  1895.   fkData:
  1896.     begin
  1897.       qq := TVKDBFFieldDef(Pointer(Field.Tag));
  1898.       GetActiveRecBuf(ActiveBuf);
  1899.       if ActiveBuf <> nil then
  1900.       begin
  1901.         ss := ActiveBuf + qq.FOff;
  1902.         if Buffer <> nil then
  1903.         begin
  1904.           case Field.DataType of
  1905.             ftTime:
  1906.               begin
  1907.                 case qq.extend_type of
  1908.                   dbftTime:
  1909.                     begin
  1910.                       Integer(Buffer^) := pInteger(ss)^;
  1911.                       Result := true;
  1912.                     end;
  1913.                   dbftTime_N:
  1914.                     begin
  1915.                       Result := (ss[0] <> ' ');  //if ' ' then NULL
  1916.                       if Result then
  1917.                         Integer(Buffer^) := pInteger(ss + 1)^;
  1918.                     end;
  1919.                   dbftTime_NB:
  1920.                     begin
  1921.                       Result := ( ( pLongword(ss)^ and $80000000 ) = $80000000 );
  1922.                       if Result then
  1923.                         Longword(Buffer^) := ( pLongword(ss)^ and $7FFFFFFF );
  1924.                     end;
  1925.                 end;
  1926.               end;
  1927.             ftDate:
  1928.               begin
  1929.                 if qq.field_type <> 'E' then begin
  1930.                   Result := not IsBlank(ss, qq.FLen);
  1931.                   if Result then begin
  1932.                     Year := (Byte(ss[0]) - $30) * 1000 + (Byte(ss[1]) - $30) * 100 + (Byte(ss[2]) - $30) * 10 + (Byte(ss[3]) - $30);
  1933.                     Month := (Byte(ss[4]) - $30) * 10 + (Byte(ss[5]) - $30);
  1934.                     Day := (Byte(ss[6]) - $30) * 10 + (Byte(ss[7]) - $30);
  1935.                     if DoEncodeDate(Year, Month, Day, dDate) then
  1936.                     begin
  1937.                       sTS := DateTimeToTimeStamp(dDate);
  1938.                       //dd := 3600.0*24*1000*sTS.Date + sTS.Time;
  1939.                       //double(Buffer^) := dd;
  1940.                       Integer(Buffer^) := sTS.Date;
  1941.                     end else
  1942.                       Result := false;
  1943.                   end;
  1944.                 end else begin
  1945.                   case qq.extend_type of
  1946.                     dbftDate:
  1947.                       begin
  1948.                         Integer(Buffer^) := pInteger(ss)^;
  1949.                         Result := true;
  1950.                       end;
  1951.                     dbftDate_NB:
  1952.                       begin
  1953.                         Result := ( ( pLongword(ss)^ and $80000000 ) = $80000000 );
  1954.                         if Result then
  1955.                           Longword(Buffer^) := ( pLongword(ss)^ and $7FFFFFFF );
  1956.                       end;
  1957.                     dbftDate_N:
  1958.                       begin
  1959.                         Result := (ss[0] <> ' ');  //if ' ' then NULL
  1960.                         if Result then
  1961.                           Integer(Buffer^) := pInteger(ss + 1)^;
  1962.                       end;
  1963.                   end;
  1964.                 end;
  1965.               end;
  1966.             ftBCD:
  1967.               begin
  1968.                 Result := (( Byte(ss[1]) and $40 ) <> $00);
  1969.                 if Result  then begin
  1970.                   Tbcd(Buffer^) := Pbcd(ss)^;
  1971.                   Tbcd(Buffer^).SignSpecialPlaces := (Tbcd(Buffer^).SignSpecialPlaces or $40);
  1972.                 end;
  1973.               end;
  1974.             ftCurrency:
  1975.               begin
  1976.                 case qq.extend_type of
  1977.                   dbftCurrency:
  1978.                     begin
  1979.                       Currency(Buffer^) := pCurrency(ss)^;
  1980.                       Result := true;
  1981.                     end;
  1982.                   dbftCurrency_N:
  1983.                     begin
  1984.                       Result := (ss[0] <> ' ');  //if ' ' then NULL
  1985.                       if Result then
  1986.                         Currency(Buffer^) := pCurrency(ss + 1)^;
  1987.                     end;
  1988.                   dbftCurrency_NB:
  1989.                     begin
  1990.                       Result := ( ( pByte(ss + 7)^ and $80 ) = $80 );
  1991.                       if Result then begin
  1992.                         pByte(ss + 7)^ := ( pByte(ss + 7)^ and $7F );
  1993.                         Currency(Buffer^) := Currency( Pointer(ss)^ );
  1994.                         pByte(ss + 7)^ := ( pByte(ss + 7)^ or $80 );
  1995.                       end;
  1996.                     end;
  1997.                 end;
  1998.               end;
  1999.             ftWideString:
  2000.               begin
  2001.                 Result := not IsBlank(ss, qq.FLen);
  2002.                 if Result then begin
  2003.                   WLen := pInteger(ss)^;
  2004.                   Move(ss^, Buffer^, WLen + 6);
  2005.                 end;
  2006.               end;
  2007.             ftString:
  2008.               begin
  2009.                 if qq.field_type <> 'E' then begin
  2010.                   //Result := not IsBlank(ss, qq.FLen);
  2011.                   //if Result then begin
  2012.                     Move(ss^, Buffer^, qq.FLen);
  2013.                     pChar(Buffer)[qq.FLen] := #0;
  2014.                   //end;
  2015.                   Result := true;
  2016.                 end else
  2017.                   case qq.extend_type of
  2018.                     dbftString:       //
  2019.                       begin
  2020.                         SLen := pWORD(ss)^;
  2021.                         if SLen < 8224 then begin
  2022.                           ss := ss + SizeOf(WORD);
  2023.                           Move(ss^, Buffer^, SLen);
  2024.                           pChar(Buffer)[SLen] := #0;
  2025.                           Result := true;
  2026.                         end else
  2027.                           Result := false;
  2028.                       end;
  2029.                     dbftString_N:     //
  2030.                       begin
  2031.                         Result := (ss[0] <> ' ');  //if ' ' then NULL
  2032.                         if Result then begin
  2033.                           ss := ss + 1;
  2034.                           SLen := pWORD(ss)^;
  2035.                           ss := ss + SizeOf(WORD);
  2036.                           Move(ss^, Buffer^, SLen);
  2037.                           pChar(Buffer)[SLen] := #0;
  2038.                         end;
  2039.                       end;
  2040.                     dbftFixedChar:
  2041.                       begin
  2042.                         Result := not IsBlank(ss, qq.FLen + 1);
  2043.                         if Result then
  2044.                           Move(ss^, Buffer^, qq.FLen + 1);
  2045.                       end;
  2046.                   else
  2047.                     Result := false;
  2048.                   end;
  2049.               end;
  2050.             ftSmallint:
  2051.               begin
  2052.                 case qq.extend_type of
  2053.                   dbftS1:       //Shortint
  2054.                     begin
  2055.                       Smallint(Buffer^) := pShortint(ss)^;
  2056.                       Result := true;
  2057.                     end;
  2058.                   dbftS2:       //Smallint
  2059.                     begin
  2060.                       Smallint(Buffer^) := pSmallint(ss)^;
  2061.                       Result := true;
  2062.                     end;
  2063.                   dbftS1_N:     //Shortint with NULL
  2064.                     begin
  2065.                       Result := (ss[0] <> ' ');  //if ' ' then NULL
  2066.                       if Result then
  2067.                         Smallint(Buffer^) := pShortint(ss + 1)^;
  2068.                     end;
  2069.                   dbftS2_N:     //Smallint with NULL
  2070.                     begin
  2071.                       Result := (ss[0] <> ' ');  //if ' ' then NULL
  2072.                       if Result then
  2073.                         Smallint(Buffer^) := pSmallint(ss + 1)^;
  2074.                     end;
  2075.                 else
  2076.                   Result := false;
  2077.                 end;
  2078.               end;
  2079.             ftWord:
  2080.               begin
  2081.                 case qq.extend_type of
  2082.                   dbftU1:     //Byte
  2083.                     begin
  2084.                       Word(Buffer^) := pByte(ss)^;
  2085.                       Result := true;
  2086.                     end;
  2087.                   dbftU2:     //Word
  2088.                     begin
  2089.                       Word(Buffer^) := pWord(ss)^;
  2090.                       Result := true;
  2091.                     end;
  2092.                   dbftU1_N:   //Byte with NULL
  2093.                     begin
  2094.                       Result := (ss[0] <> ' ');  //if ' ' then NULL
  2095.                       if Result then
  2096.                         Word(Buffer^) := pByte(ss + 1)^;
  2097.                     end;
  2098.                   dbftU2_N:   //Word with NULL
  2099.                     begin
  2100.                       Result := (ss[0] <> ' ');  //if ' ' then NULL
  2101.                       if Result then
  2102.                         Word(Buffer^) := pWord(ss + 1)^;
  2103.                     end;
  2104.                   dbftU1_NB:  //Positive byte with NULL bit instead of sign bit
  2105.                     begin
  2106.                       Result := ( ( Byte(ss[0]) and $80 ) = $80 );
  2107.                       if Result then
  2108.                         Word(Buffer^) := ( Byte(ss[0]) and $7F );
  2109.                     end;
  2110.                   dbftU2_NB:  //Positive word with NULL bit instead of sign bit
  2111.                     begin
  2112.                       Result := ( ( pWord(ss)^ and $8000 ) = $8000 );
  2113.                       if Result then
  2114.                         Word(Buffer^) := ( pWord(ss)^ and $7FFF );
  2115.                     end;
  2116.                 else
  2117.                   Result := false;
  2118.                 end;
  2119.               end;
  2120.             ftInteger:
  2121.               begin
  2122.                 if qq.field_type <> 'E' then begin
  2123.                   Move(ss^, ss1, qq.FLen);
  2124.                   ss1[qq.FLen] := #0;
  2125.                   Val(ss1, dInt, iCode);
  2126.                   if iCode = 0 then
  2127.                   begin
  2128.                     Integer(Buffer^) := dInt;
  2129.                     Result := true;
  2130.                   end else
  2131.                     Result := false;
  2132.                 end else begin
  2133.                   case qq.extend_type of
  2134.                     dbftS4, dbftU4:       //Longint, Longword
  2135.                       begin
  2136.                         Integer(Buffer^) := pInteger(ss)^;
  2137.                         Result := true;
  2138.                       end;
  2139.                     dbftS4_N, dbftU4_N:     //Longint with NULL, Longword with NULL
  2140.                       begin
  2141.                         Result := (ss[0] <> ' ');  //if ' ' then NULL
  2142.                         if Result then
  2143.                           Integer(Buffer^) := pInteger(ss + 1)^;
  2144.                       end;
  2145.                     dbftU4_NB:
  2146.                       begin
  2147.                         Result := ( ( pLongword(ss)^ and $80000000 ) = $80000000 );
  2148.                         if Result then
  2149.                           Longword(Buffer^) := ( pLongword(ss)^ and $7FFFFFFF );
  2150.                       end;
  2151.                   else
  2152.                     Result := false;
  2153.                   end;
  2154.                 end;
  2155.               end;
  2156.             ftLargeint:
  2157.               begin
  2158.                 if qq.field_type <> 'E' then begin
  2159.                   Move(ss^, ss1, qq.FLen);
  2160.                   ss1[qq.FLen] := #0;
  2161.                   Val(ss1, dInt64, iCode);
  2162.                   if iCode = 0 then
  2163.                   begin
  2164.                     Int64(Buffer^) := dInt64;
  2165.                     Result := true;
  2166.                   end else
  2167.                     Result := false;
  2168.                 end else begin
  2169.                   case qq.extend_type of
  2170.                     dbftS8:    //Int64
  2171.                       begin
  2172.                         Int64(Buffer^) := pInt64(ss)^;
  2173.                         Result := true;
  2174.                       end;
  2175.                     dbftS8_N:  //Int64 with NULL
  2176.                       begin
  2177.                         Result := (ss[0] <> ' ');  //if ' ' then NULL
  2178.                         if Result then
  2179.                           Int64(Buffer^) := pInt64(ss + 1)^;
  2180.                       end;
  2181.                   else
  2182.                     Result := false;
  2183.                   end;
  2184.                 end;
  2185.               end;
  2186.             ftFloat:
  2187.               begin
  2188.                 if qq.field_type <> 'E' then begin
  2189.                   Result := not IsBlank(ss, qq.FLen);
  2190.                   if Result then begin
  2191.                     Move(ss^, ss1, qq.FLen);
  2192.                     ss1[qq.FLen] := #0;
  2193.                     LastSetp := DecimalSeparator;
  2194.                     DecimalSeparator := '.';
  2195.                     if TextToFloat(ss1, ww, fvExtended) then
  2196.                     begin
  2197.                       dFloat := ww;
  2198.                       double(Buffer^) := dFloat;
  2199.                     end else
  2200.                       Result := false;
  2201.                     DecimalSeparator := LastSetp;
  2202.                   end;
  2203.                 end else begin
  2204.                   case qq.extend_type of
  2205.                     dbftR4:
  2206.                       begin
  2207.                         double(Buffer^) := pSingle(ss)^;
  2208.                         Result := true;
  2209.                       end;
  2210.                     dbftR6:
  2211.                       begin
  2212.                         double(Buffer^) := pReal48(ss)^;
  2213.                         Result := true;
  2214.                       end;
  2215.                     dbftR8:
  2216.                       begin
  2217.                         double(Buffer^) := pDouble(ss)^;
  2218.                         Result := true;
  2219.                       end;
  2220.                     dbftR10:
  2221.                       begin
  2222.                         Extended(Buffer^) := pExtended(ss)^;
  2223.                         Result := true;
  2224.                       end;
  2225.                     dbftR4_N:
  2226.                       begin
  2227.                         Result := (ss[0] <> ' ');  //if ' ' then NULL
  2228.                         if Result then
  2229.                           double(Buffer^) := pSingle(ss + 1)^;
  2230.                       end;
  2231.                     dbftR4_NB:
  2232.                       begin
  2233.                         Result := ( ( pByte(ss + 3)^ and $80 ) = $80 );
  2234.                         if Result then begin
  2235.                           pByte(ss + 3)^ := ( pByte(ss + 3)^ and $7F );
  2236.                           double(Buffer^) := Single( Pointer(ss)^ );
  2237.                           pByte(ss + 3)^ := ( pByte(ss + 3)^ or $80 );
  2238.                         end;
  2239.                       end;
  2240.                     dbftR6_NB:
  2241.                       begin
  2242.                         Result := ( ( pByte(ss + 5)^ and $80 ) = $80 );
  2243.                         if Result then begin
  2244.                           pByte(ss + 5)^ := ( pByte(ss + 5)^ and $7F );
  2245.                           double(Buffer^) := Real48( Pointer(ss)^ );
  2246.                           pByte(ss + 5)^ := ( pByte(ss + 5)^ or $80 );
  2247.                         end;
  2248.                       end;
  2249.                     dbftR8_NB:
  2250.                       begin
  2251.                         Result := ( ( pByte(ss + 7)^ and $80 ) = $80 );
  2252.                         if Result then begin
  2253.                           pByte(ss + 7)^ := ( pByte(ss + 7)^ and $7F );
  2254.                           double(Buffer^) := double( Pointer(ss)^ );
  2255.                           pByte(ss + 7)^ := ( pByte(ss + 7)^ or $80 );
  2256.                         end;
  2257.                       end;
  2258.                     dbftR6_N:
  2259.                       begin
  2260.                         Result := (ss[0] <> ' ');  //if ' ' then NULL
  2261.                         if Result then
  2262.                           double(Buffer^) := pReal48(ss + 1)^;
  2263.                       end;
  2264.                     dbftR8_N:
  2265.                       begin
  2266.                         Result := (ss[0] <> ' ');  //if ' ' then NULL
  2267.                         if Result then
  2268.                           double(Buffer^) := pDouble(ss + 1)^;
  2269.                       end;
  2270.                     dbftR10_N:
  2271.                       begin
  2272.                         Result := (ss[0] <> ' ');  //if ' ' then NULL
  2273.                         if Result then
  2274.                           Extended(Buffer^) := pExtended(ss + 1)^;
  2275.                       end;
  2276.                   else
  2277.                     Result := false;
  2278.                   end;
  2279.                 end;
  2280.               end;
  2281.             ftMemo, ftBlob, ftFmtMemo, ftGraphic:
  2282.               begin
  2283.                 if  ( qq.field_type = 'M' ) or
  2284.                     ( ( qq.field_type = 'E' ) and
  2285.                       ( qq.extend_type in [ dbftClob, dbftFmtMemo,
  2286.                                             dbftBlob, dbftGraphic] )) then begin
  2287.                   Result := not IsBlank(ss, 10);
  2288.                   if Result then
  2289.                     Move(ss^, Buffer^, 10);
  2290.                 end else begin
  2291.                   Result := ( ( pLongword(ss)^ and $80000000 ) = $80000000 );
  2292.                   if Result then
  2293.                     Integer(Buffer^) := Integer(Pointer(ss)^);
  2294.                 end;
  2295.               end;
  2296.             ftDateTime:
  2297.               begin
  2298.                 case qq.extend_type of
  2299.                   dbftD1:
  2300.                     begin
  2301.                       sTS := DateTimeToTimeStamp(pDouble(ss)^);
  2302.                       dd := 3600.0*24*1000*sTS.Date + sTS.Time;
  2303.                       double(Buffer^) := dd;
  2304.                       Result := true;
  2305.                     end;
  2306.                   dbftD1_NB:
  2307.                     begin
  2308.                       Result := ( ( pByte(ss + 7)^ and $80 ) = $80 );
  2309.                       if Result then begin
  2310.                         pByte(ss + 7)^ := ( pByte(ss + 7)^ and $7F );
  2311.                         sTS := DateTimeToTimeStamp(pDouble(ss)^);
  2312.                         pByte(ss + 7)^ := ( pByte(ss + 7)^ or $80 );
  2313.                         dd := 3600.0*24*1000*sTS.Date + sTS.Time;
  2314.                         double(Buffer^) := dd;
  2315.                       end;
  2316.                     end;
  2317.                   dbftD2:
  2318.                     begin
  2319.                       double(Buffer^) := pDouble(ss)^;
  2320.                       Result := true;
  2321.                     end;
  2322.                   dbftD2_NB:
  2323.                     begin
  2324.                       Result := ( ( pByte(ss + 7)^ and $80 ) = $80 );
  2325.                       if Result then begin
  2326.                         pByte(ss + 7)^ := ( pByte(ss + 7)^ and $7F );
  2327.                         double(Buffer^) := pDouble(ss)^;
  2328.                         pByte(ss + 7)^ := ( pByte(ss + 7)^ or $80 );
  2329.                       end;
  2330.                     end;
  2331.                   dbftD3:
  2332.                     begin
  2333.                       sTS := DateTimeToTimeStamp(pReal48(ss)^);
  2334.                       dd := 3600.0*24*1000*sTS.Date + sTS.Time;
  2335.                       double(Buffer^) := dd;
  2336.                       Result := true;
  2337.                     end;
  2338.                   dbftD3_NB:
  2339.                     begin
  2340.                       Result := ( ( pByte(ss + 5)^ and $80 ) = $80 );
  2341.                       if Result then begin
  2342.                         pByte(ss + 5)^ := ( pByte(ss + 5)^ and $7F );
  2343.                         double(Buffer^) := pReal48(ss)^;
  2344.                         pByte(ss + 5)^ := ( pByte(ss + 5)^ or $80 );
  2345.                       end;
  2346.                     end;
  2347.                   dbftD1_N:
  2348.                     begin
  2349.                       Result := (ss[0] <> ' ');  //if ' ' then NULL
  2350.                       if Result then begin
  2351.                         sTS := DateTimeToTimeStamp(pDouble(ss + 1)^);
  2352.                         dd := 3600.0*24*1000*sTS.Date + sTS.Time;
  2353.                         double(Buffer^) := dd;
  2354.                       end;
  2355.                     end;
  2356.                   dbftD2_N:
  2357.                     begin
  2358.                       Result := (ss[0] <> ' ');  //if ' ' then NULL
  2359.                       if Result then
  2360.                         double(Buffer^) := pDouble(ss + 1)^;
  2361.                     end;
  2362.                   dbftD3_N:
  2363.                     begin
  2364.                       Result := (ss[0] <> ' ');  //if ' ' then NULL
  2365.                       if Result then begin
  2366.                         sTS := DateTimeToTimeStamp(pReal48(ss + 1)^);
  2367.                         dd := 3600.0*24*1000*sTS.Date + sTS.Time;
  2368.                         double(Buffer^) := dd;
  2369.                       end;
  2370.                     end;
  2371.                 end;
  2372.               end;
  2373.             ftBoolean:
  2374.               begin
  2375.                 case ss[0] of
  2376.                   'T':
  2377.                     begin
  2378.                       dBool := true;
  2379.                       Result := true;
  2380.                     end;
  2381.                   'F':
  2382.                     begin
  2383.                       dBool := false;
  2384.                       Result := true;
  2385.                     end;
  2386.                   ' ':
  2387.                     begin
  2388.                       dBool := false;
  2389.                       Result := false;
  2390.                     end;
  2391.                 else
  2392.                   dBool := false;
  2393.                   Result := false;
  2394.                 end;
  2395.                 WordBool(Buffer^) := dBool;
  2396.               end;
  2397.             ftDataSet:
  2398.               begin
  2399.                 case qq.extend_type of
  2400.                   dbftDBFDataSet:
  2401.                     begin
  2402.                       Result := not IsBlank(ss, qq.FLen);
  2403.                       if Result then
  2404.                         Move(ss^, Buffer^, qq.FLen);
  2405.                     end;
  2406.                   dbftDBFDataSet_NB:
  2407.                     begin
  2408.                       Result := ( ( pLongword(ss)^ and $80000000 ) = $80000000 );
  2409.                       if Result then
  2410.                         Integer(Buffer^) := Integer(Pointer(ss)^);
  2411.                     end;
  2412.                 end;
  2413.               end;
  2414.           end;
  2415.         end else begin
  2416.           if qq.field_type <> 'E' then begin
  2417.             if qq.field_type <> 'C' then
  2418.               Result := not IsBlank(ss, qq.FLen)
  2419.             else
  2420.               Result := true;
  2421.           end else begin
  2422.             case qq.extend_type of
  2423.               dbftS1_N,     //Shortint with NULL
  2424.               dbftU1_N,     //Byte  with NULL
  2425.               dbftS2_N,     //Smallint with NULL
  2426.               dbftU2_N,     //Word with NULL
  2427.               dbftS4_N,     //Longint with NULL
  2428.               dbftU4_N,     //Longword with NULL
  2429.               dbftS8_N,     //Int64 with NULL
  2430.               dbftR4_N,     //Single with NULL
  2431.               dbftR6_N,     //Real48 with NULL
  2432.               dbftR8_N,     //Double with NULL
  2433.               dbftR10_N,    //Extended with NULL
  2434.               dbftD1_N,
  2435.               dbftD2_N,
  2436.               dbftD3_N,
  2437.               dbftString_N, //String with NULL
  2438.               dbftCurrency_N, //Currency with NULL
  2439.               dbftDate_N,
  2440.               dbftTime_N: Result := not (ss[0] = ' ');  //if ' ' then NULL
  2441.               dbftU1_NB: Result := not ( ( Byte(ss[0]) and $80 ) = $80 );
  2442.               dbftU2_NB: Result := ( ( pWord(ss)^ and $8000 ) = $8000 );
  2443.               dbftU4_NB: Result := ( ( pLongword(ss)^ and $80000000 ) = $80000000 );
  2444.               dbftR4_NB: Result := ( ( pByte(ss + 3)^ and $80 ) = $80 );
  2445.               dbftR6_NB: Result := ( ( pByte(ss + 5)^ and $80 ) = $80 );
  2446.               dbftR8_NB: Result := ( ( pByte(ss + 7)^ and $80 ) = $80 );
  2447.               dbftCurrency_NB: Result := ( ( pByte(ss + 7)^ and $80 ) = $80 );
  2448.               dbftD1_NB: Result := ( ( pByte(ss + 7)^ and $80 ) = $80 );
  2449.               dbftD2_NB: Result := ( ( pByte(ss + 7)^ and $80 ) = $80 );
  2450.               dbftD3_NB: Result := ( ( pByte(ss + 5)^ and $80 ) = $80 );
  2451.               dbftDate_NB: Result := ( ( pLongword(ss)^ and $80000000 ) = $80000000 );
  2452.               dbftTime_NB: Result := ( ( pLongword(ss)^ and $80000000 ) = $80000000 );
  2453.               dbftClob, dbftFmtMemo, dbftBlob, dbftGraphic, dbftDBFDataSet:
  2454.                 Result := not IsBlank(ss, qq.FLen);
  2455.               dbftClob_NB, dbftFmtMemo_NB, dbftBlob_NB, dbftGraphic_NB, dbftDBFDataSet_NB:
  2456.                 Result := ( ( pLongword(ss)^ and $80000000 ) = $80000000 );
  2457.               dbftString: Result := not ( pWORD(ss)^ = 8224 );
  2458.               dbftFixedChar: Result := not IsBlank(ss, qq.FLen + 1);
  2459.               dbftS1,
  2460.               dbftU1,
  2461.               dbftS2,
  2462.               dbftU2,
  2463.               dbftS4,
  2464.               dbftU4,
  2465.               dbftS8,
  2466.               dbftR4,
  2467.               dbftR6,
  2468.               dbftR8,
  2469.               dbftR10,
  2470.               dbftD1,
  2471.               dbftD2,
  2472.               dbftD3,
  2473.               dbftCurrency,
  2474.               dbftDate,
  2475.               dbftTime: Result := true;
  2476.               dbftBCD: Result := not ( ( Byte(ss[1]) and $40 ) = $00 );
  2477.             else
  2478.               Result := false;
  2479.             end;
  2480.           end;
  2481.         end;
  2482.       end else
  2483.         Result := false;
  2484.     end;
  2485.   fkCalculated:
  2486.     begin
  2487.       GetActiveRecBuf(ActiveBuf);
  2488.       if (ActiveBuf <> nil) then begin
  2489.         ss := ActiveBuf + FRecordSize + sizeof(TRecInfo) + Field.Offset;
  2490.         if Buffer <> nil then
  2491.         begin
  2492.           if not (csDesigning in ComponentState) then
  2493.           begin
  2494.             Move(ss^, Buffer^, Field.DataSize);
  2495.             if Field.DataType in [ftString, ftBytes, ftVarBytes]  then pChar(Buffer)[Field.DataSize] := Char(0);
  2496.             Result := true;
  2497.           end else begin
  2498.             FillChar(Buffer^, Field.DataSize, ' ');
  2499.             Result := false;
  2500.           end;
  2501.         end else
  2502.           Result := not IsBlank(ss, Field.DataSize);
  2503.       end;
  2504.     end;
  2505.   fkLookup:
  2506.     begin
  2507.       Result := false;
  2508.       if GetActiveRecBuf(ActiveBuf) then
  2509.       begin
  2510.         oDS := Field.LookupDataSet;
  2511.         if Buffer <> nil then
  2512.         begin
  2513.           if (oDS <> nil) and oDS.Active then
  2514.           begin
  2515.             LookupResult := oDS.Lookup(Field.LookupKeyFields, FieldValues[Field.KeyFields], Field.LookupResultField);
  2516.             if (not VarIsEmpty(LookupResult)) and (not VarIsNull(LookupResult)) then
  2517.             begin
  2518.               case Field.DataType of
  2519.                 ftString:
  2520.                   begin
  2521.                     ss := TVarData(LookupResult).VPointer;
  2522.                     Move(ss^, Buffer^, Length(ss) + 1);
  2523.                   end;
  2524.                 ftSmallint: Smallint(Buffer^) := TVarData(LookupResult).VSmallint;
  2525.                 ftInteger: Integer(Buffer^) := TVarData(LookupResult).VInteger;
  2526.                 ftWord: Word(Buffer^) := TVarData(LookupResult).VSmallint;
  2527.                 ftBoolean: WordBool(Buffer^) := TVarData(LookupResult).VBoolean;
  2528.                 ftFloat: double(Buffer^) := TVarData(LookupResult).VDouble;
  2529.                 ftCurrency: Currency(Buffer^) := TVarData(LookupResult).VCurrency;
  2530.                 ftDateTime: double(Buffer^) := TVarData(LookupResult).VDate;
  2531.                 ftTime:
  2532.                   begin
  2533.                     sTS := DateTimeToTimeStamp(TVarData(LookupResult).VDate);
  2534.                     Integer(Buffer^) := sTS.Time;
  2535.                   end;
  2536.                 ftDate:
  2537.                   begin
  2538.                     sTS := DateTimeToTimeStamp(TVarData(LookupResult).VDate);
  2539.                     Integer(Buffer^) := sTS.Date;
  2540.                   end;
  2541.               else
  2542.                 ss := pChar(@(TVarData(LookupResult).VAny));
  2543.                 Move(ss^, Buffer^, Field.DataSize);
  2544.               end;
  2545.               Result := true;
  2546.             end;
  2547.           end;
  2548.         end else begin
  2549.           if (oDS <> nil) and oDS.Active then
  2550.           begin
  2551.             LookupResult := oDS.Lookup(Field.LookupKeyFields, FieldValues[Field.KeyFields], Field.LookupResultField);
  2552.             if (not VarIsEmpty(LookupResult)) and (not VarIsNull(LookupResult)) then Result := True;
  2553.           end;
  2554.         end;
  2555.       end else begin
  2556.         FillChar(Buffer^, Field.DataSize, ' ');
  2557.         Result := false;
  2558.       end;
  2559.     end;
  2560.   end;
  2561. end;
  2562.  
  2563. function TVKSmartDBF.GetRecNo: Integer;
  2564. var
  2565.   ActiveBuf: pChar;
  2566. begin
  2567.   Result := -1;
  2568.   GetActiveRecBuf(ActiveBuf);
  2569.   if ActiveBuf <> nil then
  2570.     Result := pTRecInfo(ActiveBuf + RecordSize).RecordRowID;
  2571. end;
  2572.  
  2573. function TVKSmartDBF.GetRecord(Buffer: PChar; GetMode: TGetMode;
  2574.   DoCheck: Boolean): TGetResult;
  2575. var
  2576.   SaveState: TDataSetState;
  2577.   Accept: Boolean;
  2578. begin
  2579.   if not Filtered then
  2580.   begin
  2581.     if not FSetDeleted then
  2582.       Result := GetRecordByBuffer(Buffer, GetMode, DoCheck)
  2583.     else begin
  2584.       Accept := False;
  2585.       if GetMode <> gmCurrent then
  2586.       begin
  2587.         repeat
  2588.           Result := GetRecordByBuffer(FFilterRecord, GetMode, DoCheck);
  2589.           if Result <> grOK then Break;
  2590.           SaveState := SetTempState(dsFilter);
  2591.           Accept := not Deleted;
  2592.           RestoreState(SaveState);
  2593.         until Accept;
  2594.       end else begin
  2595.         Result := GetRecordByBuffer(FFilterRecord, GetMode, DoCheck);
  2596.         if Result = grOK then begin
  2597.           SaveState := SetTempState(dsFilter);
  2598.           Accept := not Deleted;
  2599.           RestoreState(SaveState);
  2600.           if not Accept then Result := grError;
  2601.         end;
  2602.       end;
  2603.       if Accept then
  2604.         Move(FFilterRecord^, Buffer^, RecordBufferSize)
  2605.       else
  2606.         Move(FTempRecord^, Buffer^, RecordBufferSize);
  2607.     end;
  2608.   end else begin
  2609.     Accept := False;
  2610.     if GetMode <> gmCurrent then
  2611.     begin
  2612.       repeat
  2613.         Result := GetRecordByBuffer(FFilterRecord, GetMode, DoCheck);
  2614.         if Result <> grOK then Break;
  2615.         SaveState := SetTempState(dsFilter);
  2616.         Accept := AcceptRecordInternal;
  2617.         RestoreState(SaveState);
  2618.       until Accept;
  2619.     end else begin
  2620.       Result := GetRecordByBuffer(FFilterRecord, GetMode, DoCheck);
  2621.       if Result = grOK then begin
  2622.         SaveState := SetTempState(dsFilter);
  2623.         Accept := AcceptRecordInternal;
  2624.         RestoreState(SaveState);
  2625.         if not Accept then Result := grError;
  2626.       end;
  2627.     end;
  2628.     if Accept then
  2629.       Move(FFilterRecord^, Buffer^, RecordBufferSize)
  2630.     else
  2631.       Move(FTempRecord^, Buffer^, RecordBufferSize);
  2632.   end;
  2633. end;
  2634.  
  2635. function TVKSmartDBF.GetRecordBufferSize: Integer;
  2636. begin
  2637.   Result := FRecordSize + sizeof(TRecInfo) + CalcFieldsSize;
  2638. end;
  2639.  
  2640. function TVKSmartDBF.GetRecordByBuffer(Buffer: PChar; GetMode: TGetMode;
  2641.   DoCheck: Boolean): TGetResult;
  2642. var
  2643.   cc: PChar;
  2644. begin
  2645.   Result := grOK;
  2646.   cc := pChar(Buffer);
  2647.   case GetMode of
  2648.     gmCurrent:
  2649.       if ( not FBOF ) and ( not FEOF ) then
  2650.       begin
  2651.         InternalInitRecord(cc);
  2652.         pTRecInfo(cc + FRecordSize).BookmarkFlag := bfCurrent;
  2653.         pTRecInfo(cc + FRecordSize).RecordRowID := RecNoBuf;
  2654.         pTRecInfo(cc + FRecordSize).UpdateStatus := usUnmodified;
  2655.         Move(RecBuf^, cc^, FRecordSize);
  2656.       end else begin
  2657.         InternalInitRecord(FTempRecord);
  2658.         Move(FTempRecord^, Buffer^, RecordBufferSize);
  2659.         pTRecInfo(FTempRecord + FRecordSize).BookmarkFlag := bfEOF;
  2660.         pTRecInfo(FTempRecord + FRecordSize).RecordRowID := 0;
  2661.         pTRecInfo(FTempRecord + FRecordSize).UpdateStatus := usUnmodified;
  2662.         Result := grError;
  2663.       end;
  2664.     gmNext:
  2665.       begin
  2666.         NextIndexBuf;
  2667.         if not FEOF then
  2668.         begin
  2669.           InternalInitRecord(cc);
  2670.           pTRecInfo(cc + FRecordSize).BookmarkFlag := bfCurrent;
  2671.           pTRecInfo(cc + FRecordSize).RecordRowID := RecNoBuf;
  2672.           pTRecInfo(cc + FRecordSize).UpdateStatus := usUnmodified;
  2673.           Move(RecBuf^, cc^, FRecordSize);
  2674.         end else begin
  2675.           InternalInitRecord(FTempRecord);
  2676.           Move(FTempRecord^, Buffer^, RecordBufferSize);
  2677.           pTRecInfo(FTempRecord + FRecordSize).BookmarkFlag := bfEOF;
  2678.           pTRecInfo(FTempRecord + FRecordSize).RecordRowID := 0;
  2679.           pTRecInfo(FTempRecord + FRecordSize).UpdateStatus := usUnmodified;
  2680.           Result := grEOF;
  2681.         end;
  2682.       end;
  2683.     gmPrior:
  2684.       begin
  2685.         PriorIndexBuf;
  2686.         if not FBOF then
  2687.         begin
  2688.           InternalInitRecord(cc);
  2689.           pTRecInfo(cc + FRecordSize).BookmarkFlag := bfCurrent;
  2690.           pTRecInfo(cc + FRecordSize).RecordRowID := RecNoBuf;
  2691.           pTRecInfo(cc + FRecordSize).UpdateStatus := usUnmodified;
  2692.           Move(RecBuf^, cc^, FRecordSize);
  2693.         end else begin
  2694.           InternalInitRecord(FTempRecord);
  2695.           Move(FTempRecord^, Buffer^, RecordBufferSize);
  2696.           pTRecInfo(FTempRecord + FRecordSize).BookmarkFlag := bfBOF;
  2697.           pTRecInfo(FTempRecord + FRecordSize).RecordRowID := 0;
  2698.           pTRecInfo(FTempRecord + FRecordSize).UpdateStatus := usUnmodified;
  2699.           Result := grBOF;
  2700.         end;
  2701.       end;
  2702.   end;
  2703.   if Result = grOK then
  2704.     GetCalcFields(Buffer);
  2705. end;
  2706.  
  2707. function TVKSmartDBF.GetRecordCount: Integer;
  2708. begin
  2709.   if LockHeader then
  2710.     try
  2711.       DBFHeader.last_rec := ( (DBFHandler.Seek(0, 2) - DBFHeader.data_offset) div DBFHeader.rec_size );
  2712.     finally
  2713.       UnLockHeader;
  2714.     end;
  2715.   Result := DBFHeader.last_rec;
  2716. end;
  2717.  
  2718. function TVKSmartDBF.GetRecordSize: Word;
  2719. begin
  2720.   Result := FRecordSize;
  2721. end;
  2722.  
  2723. function TVKSmartDBF.GetStateFieldValue(State: TDataSetState;
  2724.   Field: TField): Variant;
  2725. begin
  2726.   Result := NULL;
  2727.   if State in [dsNewValue, dsCurValue, dsOldValue] then
  2728.     Result := inherited GetStateFieldValue(State, Field);
  2729. end;
  2730.  
  2731. procedure TVKSmartDBF.CloseTmpRecord;
  2732. begin
  2733.   FTmpActive := false;
  2734.   FFastPostRecord := FLastFastPostRecord;
  2735. end;
  2736.  
  2737. procedure TVKSmartDBF.SetTmpRecord(nRec: DWORD);
  2738. begin
  2739.   DBFHandler.Seek(DBFHeader.data_offset + (nRec - 1) * DWORD(FRecordSize), soFromBeginning);
  2740.   DBFHandler.Read(FTempRecord^, FRecordSize);
  2741.   if Crypt.Active then
  2742.      Crypt.Decrypt(nRec, Pointer(FTempRecord), FRecordSize);
  2743.   SetBookmarkData(FTempRecord, @nRec);
  2744.   SetBookmarkFlag(FTempRecord, bfCurrent);
  2745.   FTmpActive := true;
  2746.   FLastFastPostRecord := FFastPostRecord;
  2747.   FFastPostRecord := true;
  2748. end;
  2749.  
  2750. procedure TVKSmartDBF.AddRecord(const Values: variant);
  2751. var
  2752.   i, j: Integer;
  2753. begin
  2754.   InternalInitRecord(FTempRecord);
  2755.   FTmpActive := true;
  2756.   FLastFastPostRecord := FFastPostRecord;
  2757.   FFastPostRecord := true;
  2758.   try
  2759.     j := VarArrayHighBound(Values, 1);
  2760.     for i := 0 to j - 1 do
  2761.       Fields[i].AsVariant := Values[i];
  2762.     InternalAddRecord(FTempRecord, true);
  2763.   finally
  2764.     FTmpActive := false;
  2765.     FFastPostRecord := FLastFastPostRecord;
  2766.   end;
  2767. end;
  2768.  
  2769. procedure TVKSmartDBF.AddRecord(ne: TNotifyEvent);
  2770. begin
  2771.   InternalInitRecord(FTempRecord);
  2772.   FTmpActive := true;
  2773.   FLastFastPostRecord := FFastPostRecord;
  2774.   FFastPostRecord := true;
  2775.   try
  2776.     if Assigned(ne) then ne(self);
  2777.     InternalAddRecord(FTempRecord, true);
  2778.   finally
  2779.     FTmpActive := false;
  2780.     FFastPostRecord := FLastFastPostRecord;
  2781.   end;
  2782. end;
  2783.  
  2784. procedure TVKSmartDBF.BeginAddRecord;
  2785. begin
  2786.   InternalInitRecord(FTempRecord);
  2787.   FTmpActive := true;
  2788.   FLastFastPostRecord := FFastPostRecord;
  2789.   FFastPostRecord := true;
  2790. end;
  2791.  
  2792. procedure TVKSmartDBF.EndAddRecord;
  2793. begin
  2794.   InternalAddRecord(FTempRecord, true);
  2795.   FTmpActive := false;
  2796.   FFastPostRecord := FLastFastPostRecord;
  2797. end;
  2798.  
  2799. procedure TVKSmartDBF.AddRecord(const Values: array of const);
  2800. begin
  2801.   InternalInitRecord(FTempRecord);
  2802.   FTmpActive := true;
  2803.   FLastFastPostRecord := FFastPostRecord;
  2804.   FFastPostRecord := true;
  2805.   try
  2806.     SetFields(Values);
  2807.     InternalAddRecord(FTempRecord, true);
  2808.   finally
  2809.     FTmpActive := false;
  2810.     FFastPostRecord := FLastFastPostRecord;
  2811.   end;
  2812. end;
  2813.  
  2814. procedure TVKSmartDBF.InternalAddRecord(Buffer: Pointer; Append: Boolean);
  2815. var
  2816.   i, RealRead, l, r: Integer;
  2817.   lpMsgBuf: array [0..500] of Char;
  2818.   le: DWORD;
  2819.   NewR: Longint;
  2820.   NewKey: String;
  2821.   b: boolean;
  2822.   cc: pChar;
  2823. begin
  2824.  
  2825.   CheckActive;
  2826.   if FAddBuffered then begin
  2827.     if FAddBufferCurrent = FAddBufferCount - 1 then FlushAddBuffer;
  2828.     Inc(FAddBufferCurrent);
  2829.     cc := FAddBuffer + FAddBufferCurrent * DBFHeader.rec_size;
  2830.     Move(Buffer^, cc^, DBFHeader.rec_size);
  2831.     Changed := True;
  2832.   end else begin
  2833.     b := false;
  2834.     if LockHeader then begin
  2835.       try
  2836.         DBFHeader.last_rec := ( (DBFHandler.Seek(0, 2) - DBFHeader.data_offset) div DBFHeader.rec_size );
  2837.         NewR := DBFHeader.last_rec + 1;
  2838.         if RLock(NewR) then begin
  2839.           try
  2840.             pTRecInfo(pChar(Buffer) + FRecordSize).RecordRowID := NewR;
  2841.             DBFHandler.Seek(DBFHeader.data_offset + LongWord(DBFHeader.last_rec * FRecordSize), 0);
  2842.             //Crypt
  2843.             if Crypt.FActive then begin
  2844.               Move(Buffer^, FCryptBuff^, DBFHeader.rec_size);
  2845.               Crypt.Encrypt(NewR, FCryptBuff, DBFHeader.rec_size);
  2846.               RealRead := DBFHandler.Write(FCryptBuff^, DBFHeader.rec_size);
  2847.             end else
  2848.               RealRead := DBFHandler.Write(Buffer^, DBFHeader.rec_size);
  2849.             if RealRead = -1 then
  2850.             begin
  2851.               le := GetLastError();
  2852.               FormatMessage(
  2853.                   FORMAT_MESSAGE_FROM_SYSTEM,
  2854.                   nil,
  2855.                   le,
  2856.                   0, // Default language
  2857.                   lpMsgBuf,
  2858.                   500,
  2859.                   nil
  2860.               );
  2861.               raise Exception.Create('TVKSmartDBF: ' + lpMsgBuf);
  2862.             end else begin
  2863.               Inc(DBFHeader.last_rec);
  2864.               DBFHandler.Seek(0, 0); //go to the begin
  2865.               RealRead := DBFHandler.Write(DBFHeader, SizeOf(DBFHeader));
  2866.               if RealRead = -1 then
  2867.               begin
  2868.                 le := GetLastError();
  2869.                 FormatMessage(
  2870.                     FORMAT_MESSAGE_FROM_SYSTEM,
  2871.                     nil,
  2872.                     le,
  2873.                     0, // Default language
  2874.                     lpMsgBuf,
  2875.                     500,
  2876.                     nil
  2877.                 );
  2878.                 raise Exception.Create('TVKSmartDBF: ' + lpMsgBuf);
  2879.               end else begin
  2880.                 l := DBFHeader.last_rec;
  2881.                 if Indexes <> nil then
  2882.                   for i := 0 to Indexes.Count - 1 do begin
  2883.                     NewKey := Indexes[i].EvaluteKeyExpr;
  2884.  
  2885.                     //if  (Indexes.ActiveObject <> nil) and
  2886.                     //    (Indexes.ActiveObject = Indexes[i]) and
  2887.                     //    (Indexes[i].IsRanged) and
  2888.                     //    (not Indexes[i].InRange(NewKey)) then b := true;
  2889.  
  2890.                     if  not (
  2891.                       ( (FAccessMode.FLast and fmShareExclusive) = fmShareExclusive ) or
  2892.                       ( (FAccessMode.FLast and fmShareDenyWrite) = fmShareDenyWrite ) or
  2893.                       FFileLock
  2894.                         ) then begin
  2895.                       if Indexes[i].FLock then
  2896.                         try
  2897.                           Indexes[i].StartUpdate(false);
  2898.                           Indexes[i].AddKey(NewKey, DBFHeader.last_rec);
  2899.                         finally
  2900.                           Indexes[i].Flush;
  2901.                           Indexes[i].FUnLock;
  2902.                         end
  2903.                       else
  2904.                         raise Exception.Create('TVKSmartDBF.InternalAddRecord: Can not add key to index file (FLock is false).');
  2905.                     end else begin
  2906.                       if Indexes[i].FLock then
  2907.                         try
  2908.                           Indexes[i].AddKey(NewKey, DBFHeader.last_rec);
  2909.                         finally
  2910.                           Indexes[i].FUnLock;
  2911.                         end
  2912.                       else
  2913.                         raise Exception.Create('TVKSmartDBF.InternalAddRecord: Can not add key to index file (FLock is false).');
  2914.                     end;
  2915.  
  2916.                     if  ( Indexes.ActiveObject <> nil ) and
  2917.                         ( Indexes.ActiveObject = Indexes[i] ) and
  2918.                         ( Indexes.ActiveObject.IsUniqueIndex or Indexes.ActiveObject.IsForIndex ) and
  2919.                         ( not FFastPostRecord ) then begin
  2920.                         r := Indexes.ActiveObject.FindKey(NewKey, true);
  2921.                         if r <> 0 then begin
  2922.                           if r <> l then l := r;
  2923.                         end else begin
  2924.                           InternalFirst;
  2925.                           b := true;
  2926.                         end;
  2927.                     end;
  2928.  
  2929.                   end;
  2930.                 if not FFastPostRecord then
  2931.                   if not b then begin
  2932.                     GetBufferByRec(l);
  2933.                     RefreshBufferByRec(l);
  2934.                   end;
  2935.               end;
  2936.               Changed := True;
  2937.             end;
  2938.           finally
  2939.             RUnLock(NewR);
  2940.           end
  2941.         end else
  2942.           raise Exception.Create('TVKSmartDBF.InternalAddRecord: Can not lock DBF record.');
  2943.       finally
  2944.         UnLockHeader;
  2945.       end
  2946.     end else
  2947.       raise Exception.Create('TVKSmartDBF.InternalAddRecord: Can not lock DBF header.');
  2948.   end;
  2949. end;
  2950.  
  2951. procedure TVKSmartDBF.DoBeforeClose;
  2952. begin
  2953.   EndAddBuffered;
  2954.   inherited DoBeforeClose;
  2955. end;
  2956.  
  2957. procedure TVKSmartDBF.InternalClose;
  2958. var
  2959.   i: Integer;
  2960.   end1a: Byte;
  2961. begin
  2962.   try
  2963.     if Indexes <> nil then
  2964.       for i := 0 to Indexes.Count - 1 do Indexes[i].Flush;
  2965.     FreeRecordBuffer(FBuffer);
  2966.     FRecordsPerBuf := 0;
  2967.     FBuffer := nil;
  2968.     VKDBFMemMgr.oMem.FreeMem(FBufInd);
  2969.     VKDBFMemMgr.oMem.FreeMem(FLocateBuffer);
  2970.     FBufInd := nil;
  2971.     FBufCnt := 0;
  2972.     FBufDir := bdFromTop;
  2973.     FreeRecordBuffer(FTempRecord);
  2974.     FreeRecordBuffer(FFilterRecord);
  2975.     FreeRecordBuffer(FSetKeyBuffer);
  2976.     FreeRecordBuffer(pChar(FCryptBuff));
  2977.     BindFields(false);
  2978.     if DefaultFields then DestroyFields;
  2979.     if FIndexes <> nil then FIndexes.CloseAll;
  2980.   finally
  2981.     CloseLobStream;
  2982.     if DBFHandler.IsOpen then begin
  2983.       //Add 1A at end dbf file
  2984.       if AccessMode.OpenReadWrite then begin
  2985.         DBFHandler.Seek(0, 2);
  2986.         DBFHandler.Seek(-1, 1);
  2987.         end1a := 0;
  2988.         DBFHandler.Read(end1a, 1);
  2989.         if end1a <> $1A then begin
  2990.           end1a := $1A;
  2991.           DBFHandler.Seek(0, 2);
  2992.           DBFHandler.Write(end1a, 1);
  2993.         end;
  2994.       end;
  2995.       DBFHandler.Close;
  2996.     end;
  2997.   end;
  2998. end;
  2999.  
  3000. procedure TVKSmartDBF.DeleteRecallRecord(Del: boolean = true);
  3001. var
  3002.   l, fOffset: Integer;
  3003.  
  3004.   ActiveBuf: pChar;
  3005.   RealRead: Integer;
  3006.  
  3007.   lpMsgBuf: array [0..500] of Char;
  3008.   le: DWORD;
  3009.  
  3010. begin
  3011.   CheckActive;
  3012.   GetActiveRecBuf(ActiveBuf);
  3013.   if Del then
  3014.     ActiveBuf[0] := #42   //'*'
  3015.   else
  3016.     ActiveBuf[0] := #32;  //' '
  3017.   l := pTRecInfo(ActiveBuf + RecordSize).RecordRowID;
  3018.   fOffset := DBFHandler.Seek(0, 1);
  3019.   if RLock(l) then
  3020.     try
  3021.       DBFHandler.Seek(DBFHeader.data_offset + LongWord((l - 1) * FRecordSize), 0);
  3022.       //Crypt
  3023.       if Crypt.FActive then begin
  3024.         Move(ActiveBuf^, FCryptBuff^, DBFHeader.rec_size);
  3025.         Crypt.Encrypt(l, FCryptBuff, DBFHeader.rec_size);
  3026.         RealRead := DBFHandler.Write(FCryptBuff^, DBFHeader.rec_size);
  3027.       end else
  3028.         RealRead := DBFHandler.Write(ActiveBuf^, DBFHeader.rec_size);
  3029.       Move(ActiveBuf^, (FBuffer + GetCurIndByRec(l) * FRecordSize)^, FRecordSize);
  3030.       if RealRead = -1 then
  3031.       begin
  3032.         le := GetLastError();
  3033.         FormatMessage(
  3034.             FORMAT_MESSAGE_FROM_SYSTEM,
  3035.             nil,
  3036.             le,
  3037.             0, // Default language
  3038.             lpMsgBuf,
  3039.             500,
  3040.             nil
  3041.         );
  3042.         raise Exception.Create('TVKSmartDBF: ' + lpMsgBuf);
  3043.       end else begin
  3044.         if not FFastPostRecord then begin
  3045.           //GetBufferByRec(l);
  3046.           RefreshBufferByRec(l);
  3047.           SetModified(true);
  3048.           DataEvent(deRecordChange, 0);
  3049.         end;
  3050.       end;
  3051.     finally
  3052.       RUnLock(l);
  3053.       DBFHandler.Seek(fOffset, 0);
  3054.     end
  3055.   else
  3056.     raise Exception.Create('TVKSmartDBF.InternalPost: Can not lock DBF record.');
  3057. end;
  3058.  
  3059.  
  3060. procedure TVKSmartDBF.InternalDelete;
  3061. begin
  3062.   DeleteRecallRecord;
  3063. end;
  3064.  
  3065. procedure TVKSmartDBF.DeleteRecord;
  3066. begin
  3067.   DeleteRecallRecord;
  3068. end;
  3069.  
  3070. procedure TVKSmartDBF.RecallRecord;
  3071. begin
  3072.   DeleteRecallRecord(false);
  3073. end;
  3074.  
  3075. procedure TVKSmartDBF.Pack;
  3076. var
  3077.   RecPareBuf, i, j, k: Integer;
  3078.   ReadSize, RealRead, RealWrite, BufCnt, BufCntPack: Integer;
  3079.   Rec, RecPack: Integer;
  3080.   Offset, OffsetPack: Integer;
  3081.   IndPackBuf: pChar;
  3082.   LobName: String;
  3083.   TempLobName: String;
  3084.   lb: TStream;
  3085.   LobFieldsNum: TList;
  3086.   DataSetFieldsNum: TList;
  3087.   NstDSet: TVKNestedDBF;
  3088.   BlobFld: TBlobField;
  3089.   DataSetFld: TDataSetField;
  3090. begin
  3091.   CheckActive;
  3092.   if State = dsEdit then Post;
  3093.   if LockHeader then begin
  3094.     PackLobHandlerCreate;
  3095.     LobFieldsNum := TList.Create;
  3096.     DataSetFieldsNum := TList.Create;
  3097.     try
  3098.  
  3099.       FPackProcess := true;
  3100.  
  3101.       if LobHandler.IsOpen then begin
  3102.  
  3103.         //Create new LOB
  3104.         LobName := ChangeFileExt(DBFFileName, '.dbt');
  3105.         TempLobName := GetTmpFileName;
  3106.  
  3107.         PackLobHandlerOpen(TempLobName);
  3108.  
  3109.         for k := 0 to FieldCount - 1 do begin
  3110.           if Fields[k].IsBlob then
  3111.             LobFieldsNum.Add(Pointer(k));
  3112.           if Fields[k].DataType = ftDataSet then
  3113.             DataSetFieldsNum.Add(Pointer(k));
  3114.         end;
  3115.       end;
  3116.  
  3117.       if Indexes <> nil then
  3118.         for j := 0 to Indexes.Count - 1 do Indexes.Items[j].BeginCreateIndexProcess;
  3119.  
  3120.       IndState := true;
  3121.       try
  3122.         RecPareBuf := FBufferSize div Header.rec_size;
  3123.         if RecPareBuf >= 1 then begin
  3124.           ReadSize := RecPareBuf * Header.rec_size;
  3125.  
  3126.           Offset := Header.data_offset;
  3127.           OffsetPack := Header.data_offset;
  3128.           Rec := 0;
  3129.           RecPack := 0;
  3130.  
  3131.           repeat
  3132.  
  3133.             Handle.Seek(Offset, 0);
  3134.             RealRead := Handle.Read(FLocateBuffer^, ReadSize);
  3135.             Inc(Offset, RealRead);
  3136.  
  3137.             BufCntPack := 0;
  3138.             BufCnt := RealRead div Header.rec_size;
  3139.             for i := 0 to BufCnt - 1 do begin
  3140.               IndRecBuf := FLocateBuffer + Header.rec_size * i;
  3141.               if Crypt.FActive then
  3142.                 Crypt.Decrypt(Rec + 1, Pointer(IndRecBuf), FRecordSize);
  3143.               Inc(Rec);
  3144.               if IndRecBuf[0] = #32 then begin (* If not Deleted *)
  3145.                 //Lob copy from old to new location
  3146.                 if LobHandler.IsOpen then begin
  3147.                   for k := 0 to LobFieldsNum.Count - 1 do
  3148.                     if Fields[Integer(LobFieldsNum.Items[k])].IsBlob then begin
  3149.                       BlobFld := TBlobField(Fields[Integer(LobFieldsNum.Items[k])]);
  3150.                       lb := CreateBlobStream(BlobFld, bmRead);
  3151.                       try
  3152.                         BlobFld.LoadFromStream(lb);
  3153.                       finally
  3154.                         lb.free;
  3155.                       end;
  3156.                     end;
  3157.                   for k := 0 to DataSetFieldsNum.Count - 1 do
  3158.                     if Fields[Integer(DataSetFieldsNum.Items[k])].DataType = ftDataSet then begin
  3159.                       DataSetFld := TDataSetField(Fields[Integer(DataSetFieldsNum.Items[k])]);
  3160.                       if not DataSetFld.IsNull then begin
  3161.                         NstDSet := TVKNestedDBF(DataSetFld.NestedDataSet);
  3162.                         NstDSet.Close;
  3163.                         NstDSet.Open;
  3164.                         NstDSet.Pack;
  3165.                       end;
  3166.                     end;
  3167.                 end;
  3168.                 //
  3169.                 IndPackBuf := FLocateBuffer + Header.rec_size * BufCntPack;
  3170.                 if IndRecBuf <> IndPackBuf then
  3171.                   Move(IndRecBuf^, IndPackBuf^, Header.rec_size);
  3172.                 if Crypt.FActive then
  3173.                   Crypt.Encrypt(RecPack + 1, Pointer(IndPackBuf), FRecordSize);
  3174.                 Inc(BufCntPack);
  3175.                 Inc(RecPack);
  3176.                 if Indexes <> nil then
  3177.                   for j := 0 to Indexes.Count - 1 do Indexes.Items[j].EvaluteAndAddKey(RecPack);
  3178.               end;
  3179.             end;
  3180.  
  3181.             if BufCntPack > 0 then begin
  3182.               Handle.Seek(OffsetPack, 0);
  3183.               RealWrite := Handle.Write(FLocateBuffer^, Header.rec_size * BufCntPack);
  3184.               Inc(OffsetPack, RealWrite);
  3185.             end;
  3186.  
  3187.           until ( BufCnt <= 0 );
  3188.  
  3189.           DBFHeader.last_rec := RecPack;
  3190.           Handle.Seek(0, 0);
  3191.           Handle.Write(DBFHeader, SizeOf(DBFHeader));
  3192.           Handle.Seek(OffsetPack, 0);
  3193.           Handle.SetEndOfFile;
  3194.  
  3195.           if LobHandler.IsOpen then
  3196.             PackLobHandlerClose(LobName, TempLobName);
  3197.  
  3198.         end else raise Exception.Create('TVKSmartDBF.Pack: Record size too large');
  3199.  
  3200.       finally
  3201.         if Indexes <> nil then
  3202.           for j := 0 to Indexes.Count - 1 do Indexes.Items[j].EndCreateIndexProcess;
  3203.         IndState := false;
  3204.         IndRecBuf := nil;
  3205.         FPackProcess := false;
  3206.       end;
  3207.  
  3208.     finally
  3209.       PackLobHandlerDestroy;
  3210.       DataSetFieldsNum.Free;
  3211.       LobFieldsNum.Free;
  3212.       UnLockHeader;
  3213.       Refresh;
  3214.     end;
  3215.   end else
  3216.     raise Exception.Create('TVKSmartDBF.Pack: Can not lock DBF header.');
  3217. end;
  3218.  
  3219. procedure TVKSmartDBF.InternalFirst;
  3220. var
  3221.   i, RealRead: Integer;
  3222. begin
  3223.   FBOF := true;
  3224.   FEOF := false;
  3225.   FBufDir := bdFromTop;
  3226.   FCurInd := -1;
  3227.   if (FIndexes = nil) or (FIndexes.ActiveObject = nil) then begin
  3228.     DBFHandler.Seek(DBFHeader.data_offset, soFromBeginning);
  3229.     RealRead := DBFHandler.Read(FBuffer^, FRecordsPerBuf * FRecordSize);
  3230.     FBufCnt := RealRead div FRecordSize;
  3231.     for i := 0 to FBufCnt - 1 do begin
  3232.       pLongint(pChar(FBufInd) + i * SizeOf(LongInt))^ := i + 1;
  3233.       if Crypt.FActive then
  3234.         Crypt.Decrypt(i + 1, Pointer(FBuffer + i * FRecordSize), FRecordSize);
  3235.     end;
  3236.     if FBufCnt = 0 then begin
  3237.       FBOF := true;
  3238.       FEOF := true;
  3239.     end;
  3240.   end else begin
  3241.     if FIndexes.ActiveObject.FLock then
  3242.       try
  3243.         FBufCnt := FIndexes.ActiveObject.FillFirstBufRecords(DBFHandler, FBuffer, FRecordsPerBuf, FRecordSize, FBufInd, DBFHeader.data_offset);
  3244.       finally
  3245.         FIndexes.ActiveObject.FUnLock;
  3246.       end
  3247.     else
  3248.       raise Exception.Create('TDBFDataSet: Can not read from index file (FLock is false).');
  3249.   end;
  3250. end;
  3251.  
  3252. procedure TVKSmartDBF.InternalGotoBookmark(Bookmark: Pointer);
  3253. var
  3254.   i : Longint;
  3255. begin
  3256.   i := pTRecInfo(Bookmark).RecordRowID;
  3257.   GetBufferByRec(i);
  3258. end;
  3259.  
  3260. procedure TVKSmartDBF.InternalHandleException;
  3261. begin
  3262.   Application.HandleException(self);
  3263. end;
  3264.  
  3265. procedure TVKSmartDBF.HiddenInitFieldDefs(FDs: TFieldDefs; DBFFDs: TVKDBFFieldDefs; BeginOffset, BeginOffsetHD: Integer; NamePrefix: String = ''; CreateFieldDef: boolean = true);
  3266. var
  3267.   DBFField: FIELD_REC;
  3268.   dbOffset, dbOffsetHD: Integer;
  3269.   dbSize: Integer;
  3270.   FD, CFD: TFieldDef;
  3271.   DBFFD: TVKDBFFieldDef;
  3272.   s: String;
  3273. begin
  3274.   CFD := TFieldDef.Create(nil);
  3275.   try
  3276.     dbOffset := BeginOffset;
  3277.     dbOffsetHD := BeginOffsetHD;
  3278.     while true do
  3279.     begin
  3280.       DBFHandler.Read(DBFField, SizeOf(FIELD_REC));
  3281.       if DBFField.field_name[0] = #13 then break;
  3282.       dbSize := 0;
  3283.       if CreateFieldDef then
  3284.         FD := FDs.AddFieldDef
  3285.       else
  3286.         FD := CFD;
  3287.       s := UpperCase(Trim(DBFField.field_name));
  3288.       with FD do begin
  3289.         Name := NamePrefix + s;
  3290.         Required := false;
  3291.       end;
  3292.       DBFFD := TVKDBFFieldDef(DBFFDs.Add);
  3293.       with DBFFD do begin
  3294.         Name          := s;
  3295.         field_type    := DBFField.field_type;
  3296.         extend_type   := DBFField.extend_type;
  3297.         if field_type <> 'E' then
  3298.           extend_type := dbftUndefined;
  3299.         FOff          := dbOffset;
  3300.         FOffHD        := dbOffsetHD;
  3301.         if CreateFieldDef then
  3302.           FFieldDefRef  := FD
  3303.         else
  3304.           FFieldDefRef  := nil;
  3305.       end;
  3306.       //
  3307.       case DBFField.field_type of
  3308.         'C':
  3309.           begin
  3310.             FD.DataType := ftString;
  3311.             FD.Size := DBFField.lendth.char_len;
  3312.             dbSize := DBFField.lendth.char_len;
  3313.             FD.Precision := 0;
  3314.             DBFFD.FLen    := dbSize;
  3315.             DBFFD.Fdec   := 0;
  3316.           end;
  3317.         'N':
  3318.           begin
  3319.             if DBFField.lendth.num_len.dec = 0 then
  3320.             begin
  3321.               if DBFField.lendth.num_len.len < 10 then begin
  3322.                 FD.DataType := ftInteger;
  3323.                 FD.Size := 0;
  3324.                 dbSize := DBFField.lendth.num_len.len;
  3325.                 FD.Precision := 0;
  3326.               end else begin
  3327.                 FD.DataType := ftLargeint;
  3328.                 FD.Size := 0;
  3329.                 dbSize := DBFField.lendth.num_len.len;
  3330.                 FD.Precision := 0;
  3331.               end;
  3332.             end else begin
  3333.               FD.DataType := ftFloat;
  3334.               FD.Size := 0;
  3335.               dbSize := DBFField.lendth.num_len.len;
  3336.               FD.Precision := DBFField.lendth.num_len.dec;
  3337.             end;
  3338.             DBFFD.FLen   := dbSize;
  3339.             DBFFD.Fdec   := FD.Precision;
  3340.           end;
  3341.         'D':
  3342.           begin
  3343.             FD.DataType := ftDate;
  3344.             FD.Size := 0;
  3345.             dbSize := 8;
  3346.             FD.Precision := 0;
  3347.             DBFFD.FLen   := 8;
  3348.             DBFFD.Fdec   := 0;
  3349.           end;
  3350.         'L':
  3351.           begin
  3352.             FD.DataType := ftBoolean;
  3353.             FD.Size := 0;
  3354.             dbSize := 1;
  3355.             FD.Precision := 0;
  3356.             DBFFD.FLen   := 1;
  3357.             DBFFD.Fdec   := 0;
  3358.           end;
  3359.         'M':
  3360.           begin
  3361.             FD.DataType := ftMemo;
  3362.             FD.Size := 0;
  3363.             dbSize := 10;
  3364.             FD.Precision := 0;
  3365.             DBFFD.FLen   := 10;
  3366.             DBFFD.Fdec   := 0;
  3367.           end;
  3368.         'E':    //Extended types
  3369.           begin
  3370.             case DBFField.extend_type of
  3371.               dbftS1:       //Shortint
  3372.                 begin
  3373.                   FD.DataType := ftSmallint;
  3374.                   dbSize := 1;
  3375.                   DBFFD.FLen   := 4;
  3376.                   DBFFD.Fdec   := 0;
  3377.                 end;
  3378.               dbftU1:       //Byte
  3379.                 begin
  3380.                   FD.DataType := ftWord;
  3381.                   dbSize := 1;
  3382.                   DBFFD.FLen   := 4;
  3383.                   DBFFD.Fdec   := 0;
  3384.                 end;
  3385.               dbftU1_NB:       //Byte with null bit instead of sign bit
  3386.                 begin
  3387.                   FD.DataType := ftWord;
  3388.                   dbSize := 1;
  3389.                   DBFFD.FLen   := 3;
  3390.                   DBFFD.Fdec   := 0;
  3391.                 end;
  3392.               dbftU2_NB:       //Byte with null bit instead of sign bit
  3393.                 begin
  3394.                   FD.DataType := ftWord;
  3395.                   dbSize := 2;
  3396.                   DBFFD.FLen   := 5;
  3397.                   DBFFD.Fdec   := 0;
  3398.                 end;
  3399.               dbftS2:       //Smallint
  3400.                 begin
  3401.                   FD.DataType := ftSmallint;
  3402.                   dbSize := 2;
  3403.                   DBFFD.FLen   := 6;
  3404.                   DBFFD.Fdec   := 0;
  3405.                 end;
  3406.               dbftU2:       //Word
  3407.                 begin
  3408.                   FD.DataType := ftWord;
  3409.                   dbSize := 2;
  3410.                   DBFFD.FLen   := 6;
  3411.                   DBFFD.Fdec   := 0;
  3412.                 end;
  3413.               dbftS4:       //Longint
  3414.                 begin
  3415.                   FD.DataType := ftInteger;
  3416.                   dbSize := 4;
  3417.                   DBFFD.FLen   := 11;
  3418.                   DBFFD.Fdec   := 0;
  3419.                 end;
  3420.               dbftU4:       //Longword
  3421.                 begin
  3422.                   FD.DataType := ftInteger;
  3423.                   dbSize := 4;
  3424.                   DBFFD.FLen   := 11;
  3425.                   DBFFD.Fdec   := 0;
  3426.                 end;
  3427.               dbftU4_NB:       //
  3428.                 begin
  3429.                   FD.DataType := ftInteger;
  3430.                   dbSize := 4;
  3431.                   DBFFD.FLen   := 10;
  3432.                   DBFFD.Fdec   := 0;
  3433.                 end;
  3434.               dbftS8:       //Int64
  3435.                 begin
  3436.                   FD.DataType := ftLargeint;
  3437.                   dbSize := 8;
  3438.                   DBFFD.FLen   := 21;
  3439.                   DBFFD.Fdec   := 0;
  3440.                 end;
  3441.               dbftR4:       //Single
  3442.                 begin
  3443.                   FD.DataType := ftFloat;
  3444.                   dbSize := 4;
  3445.                   DBFFD.FLen   := 18;
  3446.                   DBFFD.Fdec   := 8;
  3447.                 end;
  3448.               dbftR4_NB:
  3449.                 begin
  3450.                   FD.DataType := ftFloat;
  3451.                   dbSize := 4;
  3452.                   DBFFD.FLen   := 18;
  3453.                   DBFFD.Fdec   := 8;
  3454.                 end;
  3455.               dbftR6_NB:
  3456.                 begin
  3457.                   FD.DataType := ftFloat;
  3458.                   dbSize := 6;
  3459.                   DBFFD.FLen   := 26;
  3460.                   DBFFD.Fdec   := 12;
  3461.                 end;
  3462.               dbftR8_NB:
  3463.                 begin
  3464.                   FD.DataType := ftFloat;
  3465.                   dbSize := 8;
  3466.                   DBFFD.FLen   := 34;
  3467.                   DBFFD.Fdec   := 16;
  3468.                 end;
  3469.               dbftR6:       //Real48
  3470.                 begin
  3471.                   FD.DataType := ftFloat;
  3472.                   dbSize := 6;
  3473.                   DBFFD.FLen   := 26;
  3474.                   DBFFD.Fdec   := 12;
  3475.                 end;
  3476.               dbftR8:       //Double
  3477.                 begin
  3478.                   FD.DataType := ftFloat;
  3479.                   dbSize := 8;
  3480.                   DBFFD.FLen   := 34;
  3481.                   DBFFD.Fdec   := 16;
  3482.                 end;
  3483.               dbftR10:      //Extended
  3484.                 begin
  3485.                   FD.DataType := ftFloat;
  3486.                   dbSize := 10;
  3487.                   DBFFD.FLen   := 42;
  3488.                   DBFFD.Fdec   := 20;
  3489.                 end;
  3490.               dbftD1:
  3491.                 begin
  3492.                   FD.DataType := ftDateTime;
  3493.                   dbSize := 8;
  3494.                   DBFFD.FLen   := 8;
  3495.                   DBFFD.Fdec   := 0;
  3496.                 end;
  3497.               dbftD1_NB:
  3498.                 begin
  3499.                   FD.DataType := ftDateTime;
  3500.                   dbSize := 8;
  3501.                   DBFFD.FLen   := 8;
  3502.                   DBFFD.Fdec   := 0;
  3503.                 end;
  3504.               dbftD2:
  3505.                 begin
  3506.                   FD.DataType := ftDateTime;
  3507.                   dbSize := 8;
  3508.                   DBFFD.FLen   := 8;
  3509.                   DBFFD.Fdec   := 0;
  3510.                 end;
  3511.               dbftD2_NB:
  3512.                 begin
  3513.                   FD.DataType := ftDateTime;
  3514.                   dbSize := 8;
  3515.                   DBFFD.FLen   := 8;
  3516.                   DBFFD.Fdec   := 0;
  3517.                 end;
  3518.               dbftD3:
  3519.                 begin
  3520.                   FD.DataType := ftDateTime;
  3521.                   dbSize := 6;
  3522.                   DBFFD.FLen   := 8;
  3523.                   DBFFD.Fdec   := 0;
  3524.                 end;
  3525.               dbftD3_NB:
  3526.                 begin
  3527.                   FD.DataType := ftDateTime;
  3528.                   dbSize := 6;
  3529.                   DBFFD.FLen   := 8;
  3530.                   DBFFD.Fdec   := 0;
  3531.                 end;
  3532.               dbftS1_N:     //Shortint with NULL
  3533.                 begin
  3534.                   FD.DataType := ftSmallint;
  3535.                   dbSize := 2;
  3536.                   DBFFD.FLen   := 4;
  3537.                   DBFFD.Fdec   := 0;
  3538.                 end;
  3539.               dbftU1_N:     //Byte  with NULL
  3540.                 begin
  3541.                   FD.DataType := ftWord;
  3542.                   dbSize := 2;
  3543.                   DBFFD.FLen   := 4;
  3544.                   DBFFD.Fdec   := 0;
  3545.                 end;
  3546.               dbftS2_N:     //Smallint with NULL
  3547.                 begin
  3548.                   FD.DataType := ftSmallint;
  3549.                   dbSize := 3;
  3550.                   DBFFD.FLen   := 6;
  3551.                   DBFFD.Fdec   := 0;
  3552.                 end;
  3553.               dbftU2_N:     //Word with NULL
  3554.                 begin
  3555.                   FD.DataType := ftWord;
  3556.                   dbSize := 3;
  3557.                   DBFFD.FLen   := 6;
  3558.                   DBFFD.Fdec   := 0;
  3559.                 end;
  3560.               dbftS4_N:     //Longint with NULL
  3561.                 begin
  3562.                   FD.DataType := ftInteger;
  3563.                   dbSize := 5;
  3564.                   DBFFD.FLen   := 11;
  3565.                   DBFFD.Fdec   := 0;
  3566.                 end;
  3567.               dbftU4_N:     //Longword with NULL
  3568.                 begin
  3569.                   FD.DataType := ftInteger;
  3570.                   dbSize := 5;
  3571.                   DBFFD.FLen   := 11;
  3572.                   DBFFD.Fdec   := 0;
  3573.                 end;
  3574.               dbftS8_N:     //Int64 with NULL
  3575.                 begin
  3576.                   FD.DataType := ftLargeint;
  3577.                   dbSize := 9;
  3578.                   DBFFD.FLen   := 21;
  3579.                   DBFFD.Fdec   := 0;
  3580.                 end;
  3581.               dbftR4_N:     //Single with NULL
  3582.                 begin
  3583.                   FD.DataType := ftFloat;
  3584.                   dbSize := 5;
  3585.                   DBFFD.FLen   := 18;
  3586.                   DBFFD.Fdec   := 8;
  3587.                 end;
  3588.               dbftR6_N:     //Real48 with NULL
  3589.                 begin
  3590.                   FD.DataType := ftFloat;
  3591.                   dbSize := 7;
  3592.                   DBFFD.FLen   := 26;
  3593.                   DBFFD.Fdec   := 12;
  3594.                 end;
  3595.               dbftR8_N:     //Double with NULL
  3596.                 begin
  3597.                   FD.DataType := ftFloat;
  3598.                   dbSize := 9;
  3599.                   DBFFD.FLen   := 34;
  3600.                   DBFFD.Fdec   := 16;
  3601.                 end;
  3602.               dbftR10_N:     //Extended with NULL
  3603.                 begin
  3604.                   FD.DataType := ftFloat;
  3605.                   FD.Size := 11;
  3606.                   dbSize := 11;
  3607.                   DBFFD.FLen   := 42;
  3608.                   DBFFD.Fdec   := 20;
  3609.                 end;
  3610.               dbftD1_N:
  3611.                 begin
  3612.                   FD.DataType := ftDateTime;
  3613.                   dbSize := 9;
  3614.                   DBFFD.FLen   := 8;
  3615.                   DBFFD.Fdec   := 0;
  3616.                 end;
  3617.               dbftD2_N:
  3618.                 begin
  3619.                   FD.DataType := ftDateTime;
  3620.                   dbSize := 9;
  3621.                   DBFFD.FLen   := 8;
  3622.                   DBFFD.Fdec   := 0;
  3623.                 end;
  3624.               dbftD3_N:
  3625.                 begin
  3626.                   FD.DataType := ftDateTime;
  3627.                   dbSize := 7;
  3628.                   DBFFD.FLen   := 8;
  3629.                   DBFFD.Fdec   := 0;
  3630.                 end;
  3631.               dbftDate:
  3632.                 begin
  3633.                   FD.DataType := ftDate;
  3634.                   dbSize := 4;
  3635.                   DBFFD.FLen   := 8;
  3636.                   DBFFD.Fdec   := 0;
  3637.                 end;
  3638.               dbftDate_N:
  3639.                 begin
  3640.                   FD.DataType := ftDate;
  3641.                   dbSize := 5;
  3642.                   DBFFD.FLen   := 8;
  3643.                   DBFFD.Fdec   := 0;
  3644.                 end;
  3645.               dbftDate_NB:
  3646.                 begin
  3647.                   FD.DataType := ftDate;
  3648.                   dbSize := 4;
  3649.                   DBFFD.FLen   := 8;
  3650.                   DBFFD.Fdec   := 0;
  3651.                 end;
  3652.               dbftTime:
  3653.                 begin
  3654.                   FD.DataType := ftTime;
  3655.                   dbSize := 4;
  3656.                   DBFFD.FLen   := 6;
  3657.                   DBFFD.Fdec   := 0;
  3658.                 end;
  3659.               dbftTime_NB:
  3660.                 begin
  3661.                   FD.DataType := ftTime;
  3662.                   dbSize := 4;
  3663.                   DBFFD.FLen   := 6;
  3664.                   DBFFD.Fdec   := 0;
  3665.                 end;
  3666.               dbftTime_N:
  3667.                 begin
  3668.                   FD.DataType := ftTime;
  3669.                   dbSize := 5;
  3670.                   DBFFD.FLen   := 6;
  3671.                   DBFFD.Fdec   := 0;
  3672.                 end;
  3673.               dbftClob, dbftFmtMemo:
  3674.                 begin
  3675.                   FD.DataType := ftMemo;
  3676.                   FD.Size := 0;
  3677.                   dbSize := 10;
  3678.                   FD.Precision := 0;
  3679.                   DBFFD.FLen   := 10;
  3680.                   DBFFD.Fdec   := 0;
  3681.                 end;
  3682.               dbftBlob, dbftGraphic:
  3683.                 begin
  3684.                   FD.DataType := ftBlob;
  3685.                   FD.Size := 0;
  3686.                   dbSize := 10;
  3687.                   FD.Precision := 0;
  3688.                   DBFFD.FLen   := 10;
  3689.                   DBFFD.Fdec   := 0;
  3690.                 end;
  3691.               dbftClob_NB, dbftFmtMemo_NB:
  3692.                 begin
  3693.                   FD.DataType := ftMemo;
  3694.                   FD.Size := 0;
  3695.                   dbSize := 4;
  3696.                   FD.Precision := 0;
  3697.                   DBFFD.FLen   := 4;
  3698.                   DBFFD.Fdec   := 0;
  3699.                 end;
  3700.               dbftBlob_NB, dbftGraphic_NB:
  3701.                 begin
  3702.                   FD.DataType := ftBlob;
  3703.                   FD.Size := 0;
  3704.                   dbSize := 4;
  3705.                   FD.Precision := 0;
  3706.                   DBFFD.FLen   := 4;
  3707.                   DBFFD.Fdec   := 0;
  3708.                 end;
  3709.               dbftString:
  3710.                 begin
  3711.                   FD.DataType := ftString;
  3712.                   FD.Size := DBFField.lendth.char_len;
  3713.                   dbSize := DBFField.lendth.char_len + 2;
  3714.                   FD.Precision := 0;
  3715.                   DBFFD.FLen   := DBFField.lendth.char_len;
  3716.                   DBFFD.Fdec   := 0;
  3717.                 end;
  3718.               dbftString_N:
  3719.                 begin
  3720.                   FD.DataType := ftString;
  3721.                   FD.Size := DBFField.lendth.char_len;
  3722.                   dbSize := DBFField.lendth.char_len + 3;
  3723.                   FD.Precision := 0;
  3724.                   DBFFD.FLen   := DBFField.lendth.char_len;
  3725.                   DBFFD.Fdec   := 0;
  3726.                 end;
  3727.               dbftFixedChar:
  3728.                 begin
  3729.                   FD.DataType := ftFixedChar;
  3730.                   FD.Size := DBFField.lendth.char_len;
  3731.                   dbSize := DBFField.lendth.char_len + 1;
  3732.                   FD.Precision := 0;
  3733.                   DBFFD.FLen   := DBFField.lendth.char_len;
  3734.                   DBFFD.Fdec   := 0;
  3735.                 end;
  3736.               dbftWideString:
  3737.                 begin
  3738.                   FD.DataType := ftWideString;
  3739.                   FD.Size := DBFField.lendth.char_len;
  3740.                   dbSize := DBFField.lendth.char_len * 2 + 5;
  3741.                   FD.Precision := 0;
  3742.                   DBFFD.FLen   := DBFField.lendth.char_len;
  3743.                   DBFFD.Fdec   := 0;
  3744.                 end;
  3745.               dbftCurrency:
  3746.                 begin
  3747.                   FD.DataType := ftCurrency;
  3748.                   dbSize := 8;
  3749.                   DBFFD.FLen   := 25;
  3750.                   DBFFD.Fdec   := 4;
  3751.                 end;
  3752.               dbftCurrency_N:
  3753.                 begin
  3754.                   FD.DataType := ftCurrency;
  3755.                   dbSize := 9;
  3756.                   DBFFD.FLen   := 25;
  3757.                   DBFFD.Fdec   := 4;
  3758.                 end;
  3759.               dbftCurrency_NB:
  3760.                 begin
  3761.                   FD.DataType := ftCurrency;
  3762.                   dbSize := 8;
  3763.                   DBFFD.FLen   := 25;
  3764.                   DBFFD.Fdec   := 4;
  3765.                 end;
  3766.               dbftBCD:
  3767.                 begin
  3768.                   FD.DataType := ftBCD;
  3769.                   dbSize := DBFField.lendth.num_len.len shr 1;
  3770.                   if ( DBFField.lendth.num_len.len and $01 ) = $01 then Inc(dbSize);
  3771.                   Inc(dbSize);
  3772.                   DBFFD.FLen   := 25;
  3773.                   DBFFD.Fdec   := 4;
  3774.                 end;
  3775.               dbftDBFDataSet:
  3776.                 begin
  3777.                   FD.DataType := ftDataSet;
  3778.                   FD.Size := 0;
  3779.                   dbSize := 10;
  3780.                   FD.Precision := 0;
  3781.                   DBFFD.FLen   := 10;
  3782.                   DBFFD.Fdec   := 0;
  3783.  
  3784.                   // Recursive call
  3785.                   if CreateFieldDef then
  3786.                     HiddenInitFieldDefs(  FD.ChildDefs,
  3787.                                           DBFFD.DBFFieldDefs,
  3788.                                           dbOffset + dbSize,
  3789.                                           dbOffsetHD + SizeOf(FIELD_REC),
  3790.                                           NamePrefix,
  3791.                                           False)
  3792.                   else
  3793.                     HiddenInitFieldDefs(  nil,
  3794.                                           DBFFD.DBFFieldDefs,
  3795.                                           dbOffset + dbSize,
  3796.                                           dbOffsetHD + SizeOf(FIELD_REC),
  3797.                                           NamePrefix,
  3798.                                           False);
  3799.  
  3800.                 end;
  3801.               dbftDBFDataSet_NB:
  3802.                 begin
  3803.                   FD.DataType := ftDataSet;
  3804.                   FD.Size := 0;
  3805.                   dbSize := 4;
  3806.                   FD.Precision := 0;
  3807.                   DBFFD.FLen   := 4;
  3808.                   DBFFD.Fdec   := 0;
  3809.  
  3810.                   // Recursive call
  3811.                   if CreateFieldDef then
  3812.                     HiddenInitFieldDefs(  FD.ChildDefs,
  3813.                                           DBFFD.DBFFieldDefs,
  3814.                                           dbOffset + dbSize,
  3815.                                           dbOffsetHD + SizeOf(FIELD_REC),
  3816.                                           NamePrefix,
  3817.                                           False)
  3818.                   else
  3819.                     HiddenInitFieldDefs(  nil,
  3820.                                           DBFFD.DBFFieldDefs,
  3821.                                           dbOffset + dbSize,
  3822.                                           dbOffsetHD + SizeOf(FIELD_REC),
  3823.                                           NamePrefix,
  3824.                                           False);
  3825.  
  3826.                 end;
  3827.             end;
  3828.           end;
  3829.       end;
  3830.       //
  3831.       Inc(dbOffset, dbSize);
  3832.       Inc(dbOffsetHD, SizeOf(FIELD_REC));
  3833.     end;
  3834.   finally
  3835.     CFD.Free;
  3836.   end;
  3837. end;
  3838.  
  3839. procedure TVKSmartDBF.InternalInitFieldDefs;
  3840. begin
  3841.  
  3842.   FieldDefs.Clear;
  3843.   FDBFFieldDefs.Clear;
  3844.  
  3845.   if not DBFHandler.IsOpen then
  3846.     raise Exception.Create('TVKSmartDBF.InternalInitFieldDefs: Can not define fields while DataSet is closed!');
  3847.  
  3848.   DBFHandler.Seek(SizeOf(DBFHeader), soFromBeginning);
  3849.  
  3850.   HiddenInitFieldDefs(FieldDefs, FDBFFieldDefs, 1, SizeOf(DBFHeader));
  3851.  
  3852. end;
  3853.  
  3854. procedure TVKSmartDBF.InternalInitRecord(Buffer: PChar);
  3855. begin
  3856.   if Buffer <> nil then begin
  3857.     FillChar(Buffer^, RecordBufferSize, #32);
  3858.     pTRecInfo(Buffer + RecordSize).RecordRowID := 0;
  3859.     pTRecInfo(Buffer + RecordSize).UpdateStatus := usInserted;
  3860.     pTRecInfo(Buffer + RecordSize).BookmarkFlag := bfInserted;
  3861.   end;
  3862. end;
  3863.  
  3864. procedure TVKSmartDBF.InternalLast;
  3865. var
  3866.   j: Longint;
  3867.   i: Integer;
  3868.   LOff: Integer;
  3869. begin
  3870.   FBOF := false;
  3871.   FEOF := true;
  3872.   FBufDir := bdFromBottom;
  3873.   FCurInd := FRecordsPerBuf;
  3874.   if (FIndexes = nil) or (FIndexes.ActiveObject = nil) then begin
  3875.     LOff := DBFHandler.Seek(0, 2);
  3876.     if LockHeader then
  3877.       try
  3878.         DBFHeader.last_rec := ( (LOff - DBFHeader.data_offset) div DBFHeader.rec_size );
  3879.       finally
  3880.         UnLockHeader;
  3881.       end;
  3882.     if DBFHeader.last_rec <> 0 then begin
  3883.       j := DBFHeader.last_rec - FRecordsPerBuf + 1;
  3884.       if j < 1 then j := 1;
  3885.       FBufCnt := DBFHeader.last_rec - j + 1;
  3886.       DBFHandler.Seek(DBFHeader.data_offset + ((j - 1) * FRecordSize), soFromBeginning);
  3887.       DBFHandler.Read((FBuffer + (FRecordsPerBuf - FBufCnt) * FRecordSize)^, FBufCnt * FRecordSize);
  3888.       for i := 0 to FBufCnt - 1 do begin
  3889.         pLongint(pChar(FBufInd) + (FRecordsPerBuf - i - 1)*SizeOf(Longint))^ := DBFHeader.last_rec - i;
  3890.         if Crypt.FActive then
  3891.           Crypt.Decrypt(DBFHeader.last_rec - i, Pointer(FBuffer + (FRecordsPerBuf - i - 1) * FRecordSize), FRecordSize);
  3892.       end;
  3893.     end else begin
  3894.       FBOF := true;
  3895.       FEOF := true;
  3896.     end;
  3897.   end else begin
  3898.     if FIndexes.ActiveObject.FLock then
  3899.       try
  3900.         FBufCnt := FIndexes.ActiveObject.FillLastBufRecords(DBFHandler, FBuffer, FRecordsPerBuf, FRecordSize, FBufInd, DBFHeader.data_offset);
  3901.       finally
  3902.         FIndexes.ActiveObject.FUnLock;
  3903.       end
  3904.     else
  3905.       raise Exception.Create('TDBFDataSet: Can not read from index file (FLock is false).');
  3906.   end;
  3907. end;
  3908.  
  3909. procedure TVKSmartDBF.InternalOpen;
  3910. var
  3911.   i: Integer;
  3912.   b: boolean;
  3913.   oI: TIndex;
  3914.  
  3915.   procedure CloseAllInInternalOpen;
  3916.   begin
  3917.     FreeRecordBuffer(FBuffer);
  3918.     FRecordsPerBuf := 0;
  3919.     FBuffer := nil;
  3920.     VKDBFMemMgr.oMem.FreeMem(FBufInd);
  3921.     FBufInd := nil;
  3922.     FBufCnt := 0;
  3923.     FBufDir := bdFromTop;
  3924.     BindFields(false);
  3925.     if DefaultFields then DestroyFields;
  3926.     DBFHandler.Close;
  3927.     FIndexes.CloseAll;
  3928.   end;
  3929.  
  3930. begin
  3931.   CloseLobStream;
  3932.   DBFHandler.FileName := DBFFileName;
  3933.   DBFHandler.AccessMode.AccessMode := AccessMode.AccessMode;
  3934.   DBFHandler.ProxyStreamType := FStorageType;
  3935.   DBFHandler.OuterStream := FOuterStream;
  3936.   DBFHandler.OnLockEvent := FOnOuterStreamLock;
  3937.   DBFHandler.OnUnlockEvent := FOnOuterStreamUnlock;
  3938.   DBFHandler.Open;
  3939.   if not DBFHandler.IsOpen then begin
  3940.       raise Exception.Create('TVKSmartDBF.InternalOpen: Open error "' + DBFFileName + '"');
  3941.   end else begin
  3942.     DBFHandler.Seek(0, 0);
  3943.     DBFHandler.Read(DBFHeader, SizeOf(DBF_HEAD));
  3944.     if not ((DBFHeader.dbf_id = $03) or (DBFHeader.dbf_id = $07) or (DBFHeader.dbf_id = $83) or (DBFHeader.dbf_id = $8B)) then begin
  3945.       DBFHandler.Close;
  3946.       raise Exception.Create('TVKSmartDBF.InternalOpen: File "' + DBFFileName + '" is not DBF file');
  3947.     end else begin
  3948.       OpenLobStream(DBFHeader.dbf_id);
  3949.       FRecordSize := DBFHeader.rec_size;
  3950.       FBuffer := VKDBFMemMgr.oMem.GetMem(self, FBufferSize + 10);
  3951.       FRecordsPerBuf := FBufferSize div FRecordSize;
  3952.       if FRecordsPerBuf = 0 then
  3953.         raise Exception.Create('TVKSmartDBF.InternalOpen: BufferSize too small!');
  3954.       FBufCnt := 0;
  3955.       FBufDir := bdFromTop;
  3956.       FBufInd := VKDBFMemMgr.oMem.GetMem(self, FRecordsPerBuf * SizeOf(LongInt));
  3957.       FLocateBuffer := VKDBFMemMgr.oMem.GetMem(self, FBufferSize);
  3958.  
  3959.       FieldDefs.Updated := False;
  3960.       FieldDefs.Update;
  3961.       if DefaultFields then CreateFields;
  3962.       BindFields(True);
  3963.       BindDBFFieldDef;
  3964.  
  3965.       if FVKDBFCrypt.Active then begin
  3966.         FVKDBFCrypt.Active := false;
  3967.         FVKDBFCrypt.Active := true;
  3968.       end;
  3969.       b := true;
  3970.       if not FOpenWithoutIndexes then begin
  3971.         if FIndexes <> nil then begin
  3972.           for i := 0 to FIndexes.Count - 1 do begin
  3973.             if not FIndexes.Items[i].Open then begin
  3974.               b := false;
  3975.               CloseAllInInternalOpen;
  3976.               break;
  3977.             end;
  3978.           end;
  3979.           if b then begin
  3980.             for i := 0 to FDBFIndexDefs.Count - 1 do begin
  3981.               if not FDBFIndexDefs.Items[i].IsOpen then begin
  3982.                 oI := TIndex(FIndexes.Add);
  3983.                 oI.BagName := FDBFIndexDefs.Items[i].Name;
  3984.                 if not oI.Open then begin
  3985.                   b := false;
  3986.                   CloseAllInInternalOpen;
  3987.                   break;
  3988.                 end;
  3989.               end;
  3990.             end;
  3991.           end;
  3992.         end;
  3993.       end;
  3994.       if b then begin
  3995.         Changed := False;
  3996.         SetRngInt;
  3997.         InternalFirst;
  3998.         FTempRecord := AllocRecordBuffer;
  3999.         FFilterRecord := AllocRecordBuffer;
  4000.         FSetKeyBuffer := AllocRecordBuffer;
  4001.         FCryptBuff := AllocRecordBuffer;
  4002.         if Filtered and (Filter <> '') then
  4003.           FFilterParser.SetExprParams(Filter, FilterOptions, [poExtSyntax], '');
  4004.       end;
  4005.     end;
  4006.   end;
  4007.   FBOF := true;
  4008.   ObjectView := true;
  4009.   BookmarkSize := sizeof(Longword);
  4010. end;
  4011.  
  4012. procedure TVKSmartDBF.InternalPost;
  4013. var
  4014.  
  4015.   i, l, r: Integer;
  4016.   fOffset: Integer;
  4017.   ActiveBuf: pChar;
  4018.   RealRead: Integer;
  4019.  
  4020.   lpMsgBuf: array [0..500] of Char;
  4021.   le: DWORD;
  4022.  
  4023.   NewKey: String;
  4024.  
  4025.   b: boolean;
  4026. begin
  4027.  
  4028.   b := false;
  4029.   CheckActive;
  4030.   GetActiveRecBuf(ActiveBuf);
  4031.   l := pTRecInfo(ActiveBuf + RecordSize).RecordRowID;
  4032.   if State = dsEdit then
  4033.   begin
  4034.     fOffset := DBFHandler.Seek(0, 1);
  4035.     if RLock(l) then
  4036.       try
  4037.         DBFHandler.Seek(DBFHeader.data_offset + LongWord((l - 1) * FRecordSize), 0);
  4038.         //Crypt
  4039.         if Crypt.FActive then begin
  4040.           Move(ActiveBuf^, FCryptBuff^, DBFHeader.rec_size);
  4041.           Crypt.Encrypt(l, FCryptBuff, DBFHeader.rec_size);
  4042.           RealRead := DBFHandler.Write(FCryptBuff^, DBFHeader.rec_size);
  4043.         end else
  4044.           RealRead := DBFHandler.Write(ActiveBuf^, DBFHeader.rec_size);
  4045.         if RealRead = -1 then
  4046.         begin
  4047.           le := GetLastError();
  4048.           FormatMessage(
  4049.               FORMAT_MESSAGE_FROM_SYSTEM,
  4050.               nil,
  4051.               le,
  4052.               0, // Default language
  4053.               lpMsgBuf,
  4054.               500,
  4055.               nil
  4056.           );
  4057.           raise Exception.Create('TVKSmartDBF: ' + lpMsgBuf);
  4058.         end else begin
  4059.           Move(ActiveBuf^, (FBuffer + GetCurIndByRec(l) * FRecordSize)^, FRecordSize);
  4060.           if Indexes <> nil then
  4061.             for i := 0 to Indexes.Count - 1 do begin
  4062.               NewKey := Indexes[i].EvaluteKeyExpr;
  4063.               if NewKey <> Indexes[i].FOldEditKey then begin
  4064.  
  4065.                 //if  (Indexes.ActiveObject <> nil) and
  4066.                 //    (Indexes.ActiveObject = Indexes[i]) and
  4067.                 //    (Indexes[i].IsRanged) and
  4068.                 //    (not Indexes[i].InRange(NewKey)) then b := true;
  4069.  
  4070.                 if  not (
  4071.                   ( (FAccessMode.FLast and fmShareExclusive) = fmShareExclusive ) or
  4072.                   ( (FAccessMode.FLast and fmShareDenyWrite) = fmShareDenyWrite ) or
  4073.                   FFileLock
  4074.                     ) then begin
  4075.                   if Indexes[i].FLock then
  4076.                     try
  4077.                       Indexes[i].StartUpdate(false);
  4078.                       Indexes[i].DeleteKey(Indexes[i].FOldEditKey, Indexes[i].FOldEditRec);
  4079.                       Indexes[i].AddKey(NewKey, l);
  4080.                     finally
  4081.                       Indexes[i].Flush;
  4082.                       Indexes[i].FUnLock;
  4083.                     end
  4084.                   else
  4085.                     raise Exception.Create('TDBFDataSet.InternalPost: Can not Delete/add key to index file (FLock is false).');
  4086.                 end else begin
  4087.                   if Indexes[i].FLock then
  4088.                     try
  4089.                       Indexes[i].DeleteKey(Indexes[i].FOldEditKey, Indexes[i].FOldEditRec);
  4090.                       Indexes[i].AddKey(NewKey, l);
  4091.                     finally
  4092.                       Indexes[i].FUnLock;
  4093.                     end
  4094.                   else
  4095.                     raise Exception.Create('TDBFDataSet.InternalPost: Can not Delete/add key to index file (FLock is false).');
  4096.                 end;
  4097.                 if  ( Indexes.ActiveObject <> nil ) and
  4098.                     ( Indexes.ActiveObject = Indexes[i] ) and
  4099.                     ( Indexes.ActiveObject.IsUniqueIndex or Indexes.ActiveObject.IsForIndex ) and
  4100.                     ( not FFastPostRecord ) then begin
  4101.                     r := Indexes.ActiveObject.FindKey(NewKey, true);
  4102.                     if r <> 0 then begin
  4103.                       if r <> l then begin
  4104.                         l := r;
  4105.                         GetBufferByRec(r);
  4106.                       end;
  4107.                     end else begin
  4108.                       InternalFirst;
  4109.                       b := true;
  4110.                     end;
  4111.                 end;
  4112.               end;
  4113.             end;
  4114.           if not FFastPostRecord then
  4115.             if not b then
  4116.               RefreshBufferByRec(l);
  4117.           Changed := True;
  4118.         end;
  4119.       finally
  4120.         RUnLock(l);
  4121.         DBFHandler.Seek(fOffset, 0);
  4122.       end
  4123.     else
  4124.       raise Exception.Create('TVKSmartDBF.InternalPost: Can not lock DBF record.');
  4125.   end else begin
  4126.     InternalAddRecord(ActiveBuf, true);
  4127.   end;
  4128. end;
  4129.  
  4130. procedure TVKSmartDBF.InternalSetToRecord(Buffer: PChar);
  4131. var
  4132.   i: Longint;
  4133. begin
  4134.   i := pTRecInfo(Buffer + RecordSize).RecordRowID;
  4135.   InternalSetCurrentIndex(i);
  4136.   GetBufferByRec(i);
  4137. end;
  4138.  
  4139. function TVKSmartDBF.IsCursorOpen: Boolean;
  4140. begin
  4141.   Result := DBFHandler.IsOpen;
  4142. end;
  4143.  
  4144. procedure TVKSmartDBF.SetBookmarkData(Buffer: PChar; Data: Pointer);
  4145. begin
  4146.   pTRecInfo(Buffer + RecordSize).RecordRowID := Longword(Data^);
  4147. end;
  4148.  
  4149. procedure TVKSmartDBF.SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag);
  4150. begin
  4151.   pTRecInfo(Buffer + RecordSize).BookmarkFlag := Value;
  4152. end;
  4153.  
  4154. procedure TVKSmartDBF.SetFieldData(Field: TField; Buffer: Pointer);
  4155. var
  4156.   ss, ActiveBuf: pChar;
  4157.   qq: TVKDBFFieldDef;
  4158.   dd: double;
  4159.   sTS: TTimeStamp;
  4160.   Year, Month, Day: Word;
  4161.   dInt: Integer;
  4162.   dInt64: Int64;
  4163.   dFloat: double;
  4164.   dBool: WordBool;
  4165.   q: String;
  4166.   p0, p1, p2, p3: byte;
  4167.   wE: boolean;
  4168.   w: char;
  4169.   i: Integer;
  4170.   SLen: WORD;
  4171.   WLen: Integer;
  4172. begin
  4173.   if Field.ReadOnly and not (State in [dsSetKey, dsFilter]) then
  4174.     DatabaseErrorFmt(SFieldReadOnly, [Field.DisplayName]);
  4175.   Field.Validate(Buffer);
  4176.   case Field.FieldKind of
  4177.   fkData:
  4178.     begin
  4179.       qq := TVKDBFFieldDef(Pointer(Field.Tag));
  4180.       GetActiveRecBuf(ActiveBuf);
  4181.       if (ActiveBuf <> nil) then begin
  4182.         if (Buffer <> nil) then begin
  4183.           ss := ActiveBuf + qq.FOff;
  4184.           case Field.DataType of
  4185.             ftDataSet, ftMemo, ftFmtMemo, ftBlob:
  4186.               begin
  4187.                 if  ( qq.field_type = 'M' ) or
  4188.                     ( ( qq.field_type = 'E' ) and
  4189.                       ( qq.extend_type in [ dbftClob, dbftFmtMemo,
  4190.                                             dbftBlob, dbftGraphic,
  4191.                                             dbftDBFDataSet] )) then
  4192.                   Move(Buffer^, ss^, 10)
  4193.                 else
  4194.                   LongWord(Pointer(ss)^) := ( pLongWord(Buffer)^ or $80000000 );
  4195.               end;
  4196.             ftDate:
  4197.               begin
  4198.                 if qq.field_type <> 'E' then begin
  4199.                   sTS.Date := pInteger(Buffer)^;
  4200.                   sTS.Time := 0;
  4201.                   dd := TimeStampToDateTime(sTS);
  4202.                   DecodeDate(dd, Year, Month, Day);
  4203.                   p0 := Year div 1000;
  4204.                   ss[0] := char( p0 + $30 );
  4205.                   p1 := (Year - p0 * 1000) div 100;
  4206.                   ss[1] := Char( p1 + $30 );
  4207.                   p2 := (Year - p0 * 1000 - p1 * 100) div 10;
  4208.                   ss[2] := Char( p2 + $30 );
  4209.                   p3 := (Year - p0 * 1000 - p1 * 100 - p2 * 10);
  4210.                   ss[3] := Char( p3 + $30 );
  4211.                   ss[4] := Char( (Month div 10) + $30 );
  4212.                   ss[5] := Char( (Month - (Month div 10) * 10 ) + $30 );
  4213.                   ss[6] := Char( (Day div 10) + $30 );
  4214.                   ss[7] := Char( (Day - (Day div 10) * 10) + $30 );
  4215.                   (*
  4216.                   dd := double(Buffer^);
  4217.                   sTS.Date := Trunc(dd/(3600.0*24*1000));
  4218.                   sTS.Time := Trunc(dd - sTS.Date*((3600.0*24*1000)));
  4219.                   dd := TimeStampToDateTime(sTS);
  4220.                   DecodeDate(dd, Year, Month, Day);
  4221.                   p0 := Year div 1000;
  4222.                   ss[0] := char( p0 + $30 );
  4223.                   p1 := (Year - p0 * 1000) div 100;
  4224.                   ss[1] := Char( p1 + $30 );
  4225.                   p2 := (Year - p0 * 1000 - p1 * 100) div 10;
  4226.                   ss[2] := Char( p2 + $30 );
  4227.                   p3 := (Year - p0 * 1000 - p1 * 100 - p2 * 10);
  4228.                   ss[3] := Char( p3 + $30 );
  4229.                   ss[4] := Char( (Month div 10) + $30 );
  4230.                   ss[5] := Char( (Month - (Month div 10) * 10 ) + $30 );
  4231.                   ss[6] := Char( (Day div 10) + $30 );
  4232.                   ss[7] := Char( (Day - (Day div 10) * 10) + $30 );
  4233.                   *)
  4234.                 end else begin
  4235.                   case qq.extend_type of
  4236.                     dbftDate: pInteger(ss)^ := pInteger(Buffer)^;
  4237.                     dbftDate_N:
  4238.                       begin
  4239.                         Byte(Pointer(ss)^) := 1;
  4240.                         pInteger(ss + 1)^ := pInteger(Buffer)^;
  4241.                       end;
  4242.                     dbftDate_NB: LongWord(Pointer(ss)^) := ( pLongWord(Buffer)^ or $80000000 );
  4243.                   end;
  4244.                 end;
  4245.               end;
  4246.             ftTime:
  4247.               begin
  4248.                 case qq.extend_type of
  4249.                   dbftTime: pInteger(ss)^ := pInteger(Buffer)^;
  4250.                   dbftTime_N:
  4251.                     begin
  4252.                       Byte(Pointer(ss)^) := 1;
  4253.                       pInteger(ss + 1)^ := pInteger(Buffer)^;
  4254.                     end;
  4255.                   dbftTime_NB: LongWord(Pointer(ss)^) := ( pLongWord(Buffer)^ or $80000000 );
  4256.                 end;
  4257.               end;
  4258.             ftBCD:
  4259.               begin
  4260.                 pBcd(ss)^ := pBcd(Buffer)^;
  4261.                 Byte(ss[1]) := ( Byte(ss[1]) or $40 );
  4262.               end;
  4263.             ftCurrency:
  4264.               begin
  4265.                 case qq.extend_type of
  4266.                   dbftCurrency: Currency(Pointer(ss)^) := pCurrency(Buffer)^;
  4267.                   dbftCurrency_N:
  4268.                     begin
  4269.                       Byte(Pointer(ss)^) := 1;
  4270.                       Currency(Pointer(ss + 1)^) := pCurrency(Buffer)^;
  4271.                     end;
  4272.                   dbftCurrency_NB:
  4273.                     begin
  4274.                       Currency(Pointer(ss)^) := pCurrency(Buffer)^;
  4275.                       Byte(Pointer(ss + 7)^) := ( pByte(ss + 7)^ or $80 );
  4276.                     end;
  4277.                 end;
  4278.               end;
  4279.             ftWideString:
  4280.               begin
  4281.                 WLen := pInteger(Buffer)^;
  4282.                 Move(Buffer^, ss^, WLen + 6);
  4283.               end;
  4284.             ftString:
  4285.               begin
  4286.                 if qq.field_type <> 'E' then begin
  4287.  
  4288.                   if FullLengthCharFieldCopy then
  4289.                     StrMove(ss, Buffer, qq.FLen)
  4290.                   else begin
  4291.                     wE := false;
  4292.                     for i := 0 to qq.FLen - 1 do
  4293.                     begin
  4294.                       w := pChar(Buffer)[i];
  4295.                       if w = #0 then
  4296.                         wE := true;
  4297.                       if not wE then
  4298.                         ss[i] := w
  4299.                       else
  4300.                         ss[i] := ' ';
  4301.                     end;
  4302.                   end;
  4303.                 end else begin
  4304.                   case qq.extend_type of
  4305.                     dbftString:
  4306.                       begin
  4307.                         SLen := StrLen(Buffer);
  4308.                         WORD(Pointer(ss)^) := SLen;
  4309.                         ss := ss + SizeOf(WORD);
  4310.                         Move(Buffer^, ss^, SLen);
  4311.                       end;
  4312.                     dbftString_N:
  4313.                       begin
  4314.                         Byte(Pointer(ss)^) := 1;
  4315.                         SLen := StrLen(Buffer);
  4316.                         ss := ss + 1;
  4317.                         WORD(Pointer(ss)^) := SLen;
  4318.                         ss := ss + SizeOf(WORD);
  4319.                         Move(Buffer^, ss^, SLen);
  4320.                       end;
  4321.                     dbftFixedChar:
  4322.                       begin
  4323.                         SLen := StrLen(Buffer);
  4324.                         Move(Buffer^, ss^, SLen);
  4325.                         ss[SLen] := #0;
  4326.                       end;
  4327.                   end;
  4328.                 end;
  4329.               end;
  4330.             ftDateTime:
  4331.               begin
  4332.                 case qq.extend_type of
  4333.                   dbftD1:
  4334.                     begin
  4335.                       dd := double(Buffer^);
  4336.                       sTS.Date := Trunc(dd/(3600.0*24*1000));
  4337.                       sTS.Time := Trunc(dd - sTS.Date*((3600.0*24*1000)));
  4338.                       dd := TimeStampToDateTime(sTS);
  4339.                       Double(Pointer(ss)^) := Double(dd);
  4340.                     end;
  4341.                   dbftD1_NB:
  4342.                     begin
  4343.                       dd := double(Buffer^);
  4344.                       sTS.Date := Trunc(dd/(3600.0*24*1000));
  4345.                       sTS.Time := Trunc(dd - sTS.Date*((3600.0*24*1000)));
  4346.                       dd := TimeStampToDateTime(sTS);
  4347.                       Double(Pointer(ss)^) := Double(dd);
  4348.                       Byte(Pointer(ss + 7)^) := ( pByte(ss + 7)^ or $80 );
  4349.                     end;
  4350.                   dbftD2: Double(Pointer(ss)^) := pDouble(Buffer)^;
  4351.                   dbftD2_NB:
  4352.                     begin
  4353.                       Double(Pointer(ss)^) := pDouble(Buffer)^;
  4354.                       Byte(Pointer(ss + 7)^) := ( pByte(ss + 7)^ or $80 );
  4355.                     end;
  4356.                   dbftD3:
  4357.                     begin
  4358.                       dd := double(Buffer^);
  4359.                       sTS.Date := Trunc(dd/(3600.0*24*1000));
  4360.                       sTS.Time := Trunc(dd - sTS.Date*((3600.0*24*1000)));
  4361.                       dd := TimeStampToDateTime(sTS);
  4362.                       Real48(Pointer(ss)^) := Double(dd);
  4363.                     end;
  4364.                   dbftD3_NB:
  4365.                     begin
  4366.                       Real48(Pointer(ss)^) := pDouble(Buffer)^;
  4367.                       Byte(Pointer(ss + 5)^) := ( pByte(ss + 5)^ or $80 );
  4368.                     end;
  4369.                   dbftD1_N:
  4370.                     begin
  4371.                       dd := double(Buffer^);
  4372.                       sTS.Date := Trunc(dd/(3600.0*24*1000));
  4373.                       sTS.Time := Trunc(dd - sTS.Date*((3600.0*24*1000)));
  4374.                       dd := TimeStampToDateTime(sTS);
  4375.                       Byte(Pointer(ss)^) := 1;
  4376.                       Double(Pointer(ss + 1)^) := Double(dd);
  4377.                     end;
  4378.                   dbftD2_N:
  4379.                     begin
  4380.                       Byte(Pointer(ss)^) := 1;
  4381.                       Double(Pointer(ss + 1)^) := pDouble(Buffer)^;
  4382.                     end;
  4383.                   dbftD3_N:
  4384.                     begin
  4385.                       dd := double(Buffer^);
  4386.                       sTS.Date := Trunc(dd/(3600.0*24*1000));
  4387.                       sTS.Time := Trunc(dd - sTS.Date*((3600.0*24*1000)));
  4388.                       dd := TimeStampToDateTime(sTS);
  4389.                       Byte(Pointer(ss)^) := 1;
  4390.                       Real48(Pointer(ss + 1)^) := Double(dd);
  4391.                     end;
  4392.                 end;
  4393.               end;
  4394.             ftSmallint:
  4395.               begin
  4396.                 case qq.extend_type of
  4397.                   dbftS1: Shortint(Pointer(ss)^) := pShortint(Buffer)^;
  4398.                   dbftS2: Smallint(Pointer(ss)^) := pSmallint(Buffer)^;
  4399.                   dbftS1_N:     //Shortint with NULL
  4400.                     begin
  4401.                       Byte(Pointer(ss)^) := 1;
  4402.                       Shortint(Pointer(ss + 1)^) := pShortint(Buffer)^;
  4403.                     end;
  4404.                   dbftS2_N:     //Smallint with NULL
  4405.                     begin
  4406.                       Byte(Pointer(ss)^) := 1;
  4407.                       Smallint(Pointer(ss + 1)^) := pSmallint(Buffer)^;
  4408.                     end;
  4409.                 end;
  4410.               end;
  4411.             ftWord:
  4412.               begin
  4413.                 case qq.extend_type of
  4414.                   dbftU1: Byte(Pointer(ss)^) := pByte(Buffer)^;
  4415.                   dbftU2: Word(Pointer(ss)^) := pWord(Buffer)^;
  4416.                   dbftU1_N:
  4417.                     begin
  4418.                       Byte(Pointer(ss)^) := 1;
  4419.                       Byte(Pointer(ss + 1)^) := pByte(Buffer)^;
  4420.                     end;
  4421.                   dbftU2_N:
  4422.                     begin
  4423.                       Byte(Pointer(ss)^) := 1;
  4424.                       Word(Pointer(ss + 1)^) := pWord(Buffer)^;
  4425.                     end;
  4426.                   dbftU1_NB: Byte(Pointer(ss)^) := ( pByte(Buffer)^ or $80 );
  4427.                   dbftU2_NB: Word(Pointer(ss)^) := ( pWord(Buffer)^ or $8000 );
  4428.                 end;
  4429.               end;
  4430.             ftInteger:
  4431.               begin
  4432.                 if qq.field_type <> 'E' then begin
  4433.                   dInt := Integer(Buffer^);
  4434.                   Str(dInt:qq.FLen, q);
  4435.                   Move(pChar(q)^, ss^, qq.FLen);
  4436.                 end else begin
  4437.                   case qq.extend_type of
  4438.                     dbftS4, dbftU4:       //Longint, Longword
  4439.                       begin
  4440.                         Integer(Pointer(ss)^) := pInteger(Buffer)^;
  4441.                       end;
  4442.                     dbftS4_N, dbftU4_N:     //Longint with NULL, Longword with NULL
  4443.                       begin
  4444.                         Byte(Pointer(ss)^) := 1;
  4445.                         Integer(Pointer(ss + 1)^) := pInteger(Buffer)^;
  4446.                       end;
  4447.                     dbftU4_NB: LongWord(Pointer(ss)^) := ( pLongWord(Buffer)^ or $80000000 );
  4448.                   end;
  4449.                 end;
  4450.               end;
  4451.             ftLargeint:
  4452.               begin
  4453.                 if qq.field_type <> 'E' then begin
  4454.                   dInt64 := Int64(Buffer^);
  4455.                   Str(dInt64:qq.FLen, q);
  4456.                   Move(pChar(q)^, ss^, qq.FLen);
  4457.                 end else begin
  4458.                   case qq.extend_type of
  4459.                     dbftS8:   Int64(Pointer(ss)^) := pInt64(Buffer)^;
  4460.                     dbftS8_N:
  4461.                       begin
  4462.                         Byte(Pointer(ss)^) := 1;
  4463.                         Int64(Pointer(ss + 1)^) := pInt64(Buffer)^;
  4464.                       end;
  4465.                   end;
  4466.                 end;
  4467.               end;
  4468.             ftFloat:
  4469.               begin
  4470.                 if qq.field_type <> 'E' then begin
  4471.                   dFloat := Double(Buffer^);
  4472.                   Str(dFloat:qq.Flen:qq.Fdec, q);
  4473.                   Move(pChar(q)^, ss^, qq.FLen);
  4474.                 end else begin
  4475.                   case qq.extend_type of
  4476.                     dbftR4: Single(Pointer(ss)^) := pDouble(Buffer)^;
  4477.                     dbftR4_NB:
  4478.                       begin
  4479.                         Single(Pointer(ss)^) := pDouble(Buffer)^;
  4480.                         Byte(Pointer(ss + 3)^) := ( pByte(ss + 3)^ or $80 );
  4481.                       end;
  4482.                     dbftR6_NB:
  4483.                       begin
  4484.                         Real48(Pointer(ss)^) := pDouble(Buffer)^;
  4485.                         Byte(Pointer(ss + 5)^) := ( pByte(ss + 5)^ or $80 );
  4486.                       end;
  4487.                     dbftR8_NB:
  4488.                       begin
  4489.                         Double(Pointer(ss)^) := pDouble(Buffer)^;
  4490.                         Byte(Pointer(ss + 7)^) := ( pByte(ss + 7)^ or $80 );
  4491.                       end;
  4492.                     dbftR6: Real48(Pointer(ss)^) := pDouble(Buffer)^;
  4493.                     dbftR8: Double(Pointer(ss)^) := pDouble(Buffer)^;
  4494.                     dbftR10: Extended(Pointer(ss)^) := pExtended(Buffer)^;
  4495.                     dbftR4_N:
  4496.                       begin
  4497.                         Byte(Pointer(ss)^) := 1;
  4498.                         Single(Pointer(ss + 1)^) := pDouble(Buffer)^;
  4499.                       end;
  4500.                     dbftR6_N:
  4501.                       begin
  4502.                         Byte(Pointer(ss)^) := 1;
  4503.                         Real48(Pointer(ss + 1)^) := pDouble(Buffer)^;
  4504.                       end;
  4505.                     dbftR8_N:
  4506.                       begin
  4507.                         Byte(Pointer(ss)^) := 1;
  4508.                         Double(Pointer(ss + 1)^) := pDouble(Buffer)^;
  4509.                       end;
  4510.                     dbftR10_N:
  4511.                       begin
  4512.                         Byte(Pointer(ss)^) := 1;
  4513.                         Extended(Pointer(ss + 1)^) := pExtended(Buffer)^;
  4514.                       end;
  4515.                   end;
  4516.                 end;
  4517.               end;
  4518.             ftBoolean:
  4519.               begin
  4520.                 dBool := WordBool(Buffer^);
  4521.                 if dBool then
  4522.                    ss[0] := 'T'
  4523.                 else
  4524.                   ss[0] := 'F';
  4525.               end;
  4526.           end;
  4527.         end else begin
  4528.           ss := ActiveBuf + qq.FOff;
  4529.           if qq.field_type <> 'E' then begin
  4530.             for i := 0 to qq.FLen - 1 do ss[i] := ' ';
  4531.           end else begin
  4532.             case qq.extend_type of
  4533.               dbftS1_N,     //Shortint with NULL
  4534.               dbftU1_N,     //Byte  with NULL
  4535.               dbftS2_N,     //Smallint with NULL
  4536.               dbftU2_N,     //Word with NULL
  4537.               dbftS4_N,     //Longint with NULL
  4538.               dbftU4_N,     //Longword with NULL
  4539.               dbftS8_N,     //Int64 with NULL
  4540.               dbftR4_N,     //Single with NULL
  4541.               dbftR6_N,     //Real48 with NULL
  4542.               dbftR8_N,     //Double with NULL
  4543.               dbftR10_N,    //Extended with NULL
  4544.               dbftD1_N,     //TDateTime
  4545.               dbftD2_N,     //DataSet DateTime
  4546.               dbftD3_N,     //Real48 DateTime
  4547.               dbftString_N, //String
  4548.               dbftString,
  4549.               dbftCurrency_N,
  4550.               dbftBCD,
  4551.               dbftDate_N,
  4552.               dbftTime_N:
  4553.                 begin
  4554.                   ss[0] := ' ';
  4555.                   ss[1] := ' ';
  4556.                 end;
  4557.               dbftFixedChar: for i := 0 to qq.FLen do ss[i] := ' ';
  4558.               dbftU1_NB: Byte(Pointer(ss)^) := ( pByte(ss)^ and $7F );
  4559.               dbftU2_NB: Word(Pointer(ss)^) := ( pWord(ss)^ and $7FFF );
  4560.               dbftU4_NB: Longword(Pointer(ss)^) := ( pLongword(ss)^ and $7FFFFFFF );
  4561.               dbftR4_NB: Byte(Pointer(ss + 3)^) := ( pByte(ss + 3)^ and $7F );
  4562.               dbftR6_NB: Byte(Pointer(ss + 5)^) := ( pByte(ss + 5)^ and $7F );
  4563.               dbftR8_NB: Byte(Pointer(ss + 7)^) := ( pByte(ss + 7)^ and $7F );
  4564.               dbftCurrency_NB: Byte(Pointer(ss + 7)^) := ( pByte(ss + 7)^ and $7F );
  4565.               dbftD1_NB: Byte(Pointer(ss + 7)^) := ( pByte(ss + 7)^ and $7F );
  4566.               dbftD2_NB: Byte(Pointer(ss + 7)^) := ( pByte(ss + 7)^ and $7F );
  4567.               dbftD3_NB: Byte(Pointer(ss + 5)^) := ( pByte(ss + 5)^ and $7F );
  4568.               dbftDate_NB: Longword(Pointer(ss)^) := ( pLongword(ss)^ and $7FFFFFFF );
  4569.               dbftTime_NB: Longword(Pointer(ss)^) := ( pLongword(ss)^ and $7FFFFFFF );
  4570.               dbftClob, dbftFmtMemo, dbftBlob, dbftGraphic, dbftDBFDataSet: for i := 0 to qq.FLen do ss[i] := ' ';
  4571.               dbftClob_NB, dbftFmtMemo_NB, dbftBlob_NB, dbftGraphic_NB, dbftDBFDataSet_NB: LongWord(Pointer(ss)^) := ( pLongWord(ss)^ and $7FFFFFFF );
  4572.             end;
  4573.           end;
  4574.         end;
  4575.       end;
  4576.     end;
  4577.   fkCalculated:
  4578.     begin
  4579.       GetActiveRecBuf(ActiveBuf);
  4580.       if ActiveBuf <> nil then begin
  4581.         ss := ActiveBuf + FRecordSize + sizeof(TRecInfo) + Field.Offset;
  4582.         if Buffer <> nil then
  4583.           Move(Buffer^, ss^, Field.DataSize)
  4584.         else
  4585.           FillChar(ss^, Field.DataSize, ' ');
  4586.       end;
  4587.     end;
  4588.   end;
  4589.   if not (State in [dsCalcFields, dsFilter, dsNewValue]) then
  4590.     DataEvent(deFieldChange, Longint(Field));
  4591. end;
  4592.  
  4593. procedure TVKSmartDBF.SetFiltered(Value: Boolean);
  4594. begin
  4595.   if Active then
  4596.   begin
  4597.     CheckBrowseMode;
  4598.     if ((not Filtered) and Value) and (Filter <> '') then
  4599.       FFilterParser.SetExprParams(Filter, FilterOptions, [poExtSyntax], '');
  4600.     if Filtered <> Value then begin
  4601.       inherited SetFiltered(Value);
  4602.       Refresh;
  4603.     end;
  4604.   end else
  4605.     inherited SetFiltered(Value);
  4606. end;
  4607.  
  4608. procedure TVKSmartDBF.SetIndexList(const Value: TIndexes);
  4609. begin
  4610.   FIndexes.Assign(Value);
  4611. end;
  4612.  
  4613. procedure TVKSmartDBF.SetRecNo(Value: Integer);
  4614. begin
  4615.   CheckBrowseMode;
  4616.   if AcceptTmpRecord(Value) then SetRecNoInternal(Value);
  4617. end;
  4618.  
  4619. procedure TVKSmartDBF.SetSetDeleted(const Value: Boolean);
  4620. begin
  4621.   if Active then
  4622.   begin
  4623.     CheckBrowseMode;
  4624.     if FSetDeleted <> Value then FSetDeleted := Value;
  4625.     Refresh;
  4626.   end else
  4627.     FSetDeleted := Value;
  4628. end;
  4629.  
  4630. function TVKSmartDBF.TranslateBuff(Src, Dest: PChar; ToOem: Boolean;
  4631.   Len: Integer): Integer;
  4632. begin
  4633.   if FOEM then
  4634.   begin
  4635.     if not ToOem then begin
  4636.       if (Src <> nil) then
  4637.       begin
  4638.         if OemToCharBuff(Src, Dest, Len) then
  4639.           Result := Len
  4640.         else
  4641.           Result := 0;
  4642.       end else
  4643.         Result := 0;
  4644.     end else begin
  4645.       if (Src <> nil) then
  4646.       begin
  4647.         if CharToOemBuff(Src, Dest, Len) then
  4648.           Result := Len
  4649.         else
  4650.           Result := 0;
  4651.       end else
  4652.         Result := 0;
  4653.     end;
  4654.   end else
  4655.     Result := Translate(Src, Dest, ToOem);
  4656. end;
  4657.  
  4658. function TVKSmartDBF.Translate(Src, Dest: PChar; ToOem: Boolean): Integer;
  4659. begin
  4660.   if FOEM then
  4661.   begin
  4662.     if not ToOem then begin
  4663.       if (Src <> nil) then
  4664.       begin
  4665.         if OemToChar(Src, Dest) then
  4666.           Result := StrLen(Dest)
  4667.         else
  4668.           Result := 0;
  4669.       end else
  4670.         Result := 0;
  4671.     end else begin
  4672.       if (Src <> nil) then
  4673.       begin
  4674.         if CharToOem(Src, Dest) then
  4675.           Result := StrLen(Dest)
  4676.         else
  4677.           Result := 0;
  4678.       end else
  4679.         Result := 0;
  4680.     end;
  4681.   end else
  4682.     Result := inherited Translate(Src, Dest, ToOem);
  4683. end;
  4684.  
  4685. procedure TVKSmartDBF.DefineProperties(Filer: TFiler);
  4686.  
  4687.   function WriteData: Boolean;
  4688.   begin
  4689.     if FIndexes <> nil then begin
  4690.       if Filer.Ancestor <> nil then
  4691.         Result := not FIndexes.IsEqual(TVKSmartDBF(Filer.Ancestor).FIndexes)
  4692.       else
  4693.         Result := (FIndexes.Count > 0);
  4694.     end else
  4695.       Result := false;
  4696.   end;
  4697.  
  4698. begin
  4699.   inherited DefineProperties(Filer);
  4700.   Filer.DefineProperty('IndexData', ReadIndexData, WriteIndexData, WriteData);
  4701. end;
  4702.  
  4703. procedure TVKSmartDBF.ReadIndexData(Reader: TReader);
  4704. begin
  4705.   if Indexes <> nil then begin
  4706.     Reader.ReadValue;
  4707.     Reader.ReadCollection(Indexes);
  4708.   end;
  4709. end;
  4710.  
  4711. procedure TVKSmartDBF.WriteIndexData(Writer: TWriter);
  4712. begin
  4713.   if Indexes <> nil then
  4714.     Writer.WriteCollection(Indexes);
  4715. end;
  4716.  
  4717. function TVKSmartDBF.FirstByIndex(IndInd: Integer): TGetResult;
  4718. var
  4719.   i: Integer;
  4720. begin
  4721.   CheckBrowseMode;
  4722.   CursorPosChanged;
  4723.   DoBeforeScroll;
  4724.   Result := grError;
  4725.   if FIndexes <> nil then begin
  4726.     Result := FIndexes[IndInd].GetFirstByIndex(i);
  4727.     if Result = grOK then begin
  4728.       GetBufferByRec(i);
  4729.       Resync([]);
  4730.     end;
  4731.   end;
  4732.   DoAfterScroll;
  4733. end;
  4734.  
  4735. function TVKSmartDBF.LastByIndex(IndInd: Integer): TGetResult;
  4736. var
  4737.   i: Integer;
  4738. begin
  4739.   CheckBrowseMode;
  4740.   CursorPosChanged;
  4741.   DoBeforeScroll;
  4742.   Result := grError;
  4743.   if FIndexes <> nil then begin
  4744.     Result := FIndexes[IndInd].GetLastByIndex(i);
  4745.     if Result = grOK then begin
  4746.       GetBufferByRec(i);
  4747.       Resync([]);
  4748.     end;
  4749.   end;
  4750.   DoAfterScroll;
  4751. end;
  4752.  
  4753. function TVKSmartDBF.NextByIndex(IndInd: Integer): TGetResult;
  4754. var
  4755.   i: Integer;
  4756. begin
  4757.   CheckBrowseMode;
  4758.   CursorPosChanged;
  4759.   DoBeforeScroll;
  4760.   Result := grError;
  4761.   if FIndexes <> nil then begin
  4762.     FIndexes[IndInd].SetToRecord;
  4763.     Result := FIndexes[IndInd].GetRecordByIndex(gmNext, i);
  4764.     if Result = grOK then begin
  4765.       GetBufferByRec(i);
  4766.       Resync([]);
  4767.     end;
  4768.   end;
  4769.   DoAfterScroll;
  4770. end;
  4771.  
  4772. function TVKSmartDBF.PriorByIndex(IndInd: Integer): TGetResult;
  4773. var
  4774.   i: Integer;
  4775. begin
  4776.   CheckBrowseMode;
  4777.   CursorPosChanged;
  4778.   DoBeforeScroll;
  4779.   Result := grError;
  4780.   if FIndexes <> nil then begin
  4781.     FIndexes[IndInd].SetToRecord;
  4782.     Result := FIndexes[IndInd].GetRecordByIndex(gmPrior, i);
  4783.     if Result = grOK then begin
  4784.       GetBufferByRec(i);
  4785.       Resync([]);
  4786.     end;
  4787.   end;
  4788.   DoAfterScroll;
  4789. end;
  4790.  
  4791. function TVKSmartDBF.GetPrec(aField: TField): Integer;
  4792. begin
  4793.   //Result := (DBFFieldDefs.Items[aField.FieldNo - 1]).Fdec;
  4794.   Result := TVKDBFFieldDef(Pointer(aField.Tag)).Fdec;
  4795. end;
  4796.  
  4797. function TVKSmartDBF.GetLen(aField: TField): Integer;
  4798. begin
  4799.   //Result := (DBFFieldDefs.Items[aField.FieldNo - 1]).Flen;
  4800.   Result := TVKDBFFieldDef(Pointer(aField.Tag)).Flen;
  4801. end;
  4802.  
  4803. function TVKSmartDBF.NextBuffer: Longint;
  4804. var
  4805.   i, RealRead: Integer;
  4806.   OldIndex, NextRec: Longint;
  4807.   OldKey: String;
  4808.   OldRec: Longint;
  4809.   end1a: char;
  4810. begin
  4811.   if FBufCnt > 0 then begin
  4812.     if (FIndexes = nil) or (FIndexes.ActiveObject = nil) then begin
  4813.       if FBufDir = bdFromTop then
  4814.         NextRec := pLongint(pChar(FBufInd) + SizeOf(Longint)*(FBufCnt - 1))^
  4815.       else
  4816.         NextRec := pLongint(pChar(FBufInd) + SizeOf(Longint)*(FRecordsPerBuf - 1))^;
  4817.       DBFHandler.Seek(DBFHeader.data_offset + NextRec * FRecordSize, soFromBeginning);
  4818.       end1a := FBuffer[0];
  4819.       RealRead := DBFHandler.Read(FBuffer^, FRecordsPerBuf * FRecordSize);
  4820.       Result := RealRead div FRecordSize;
  4821.       if Result > 0 then begin
  4822.         FBufCnt := Result;
  4823.         FBufDir := bdFromTop;
  4824.         FCurInd := 0;
  4825.         for i := 0 to FBufCnt - 1 do begin
  4826.           pLongint(pChar(FBufInd) + SizeOf(Longint) * i)^ := NextRec + i + 1;
  4827.           if Crypt.FActive then
  4828.             Crypt.Decrypt(NextRec + i + 1, Pointer(FBuffer + i * FRecordSize), FRecordSize);
  4829.         end;
  4830.       end else
  4831.         FBuffer[0] := end1a;
  4832.     end else begin
  4833.       //Next buffer by index
  4834.       OldIndex := FCurInd;
  4835.       OldKey := FIndexes.ActiveObject.CurrentKey;
  4836.       OldRec := FIndexes.ActiveObject.CurrentRec;
  4837.       if FBufDir = bdFromTop then
  4838.         FCurInd := FBufCnt - 1
  4839.       else
  4840.         FCurInd := FRecordsPerBuf - 1;
  4841.       FKeyCalk := true;
  4842.       try
  4843.         FIndexes.ActiveObject.SetToRecord(pLongint(pChar(FBufInd) + SizeOf(Longint)*FCurInd)^);
  4844.       finally
  4845.         FKeyCalk := false;
  4846.       end;
  4847. //      Result := 0;
  4848.       if FIndexes.ActiveObject.FLock then
  4849.         try
  4850.           Result := FIndexes.ActiveObject.NextBuffer(DBFHandler, FBuffer, FRecordsPerBuf, FRecordSize, FBufInd, DBFHeader.data_offset);
  4851.         finally
  4852.           FIndexes.ActiveObject.FUnLock;
  4853.         end
  4854.       else
  4855.         raise Exception.Create('TDBFDataSet: Can not read from index file (FLock is false).');
  4856.       if Result > 0 then begin
  4857.         FBufCnt := Result;
  4858.         FBufDir := bdFromTop;
  4859.         FCurInd := 0;
  4860.       end else begin
  4861.         FCurInd := OldIndex;
  4862.         FIndexes.ActiveObject.SetToRecord(OldKey, OldRec);
  4863.       end;
  4864.     end;
  4865.   end else Result := 0;
  4866. end;
  4867.  
  4868. function TVKSmartDBF.PriorBuffer: Longint;
  4869. var
  4870.   j: Longint;
  4871.   i: Integer;
  4872.   OldIndex, NextRec: Longint;
  4873.   OldKey: String;
  4874.   OldRec: Longint;
  4875. begin
  4876.   if FBufCnt > 0 then begin
  4877.     if (FIndexes = nil) or (FIndexes.ActiveObject = nil) then begin
  4878.       if FBufDir = bdFromTop then
  4879.         NextRec := FBufInd^
  4880.       else
  4881.         NextRec := pLongint(pChar(FBufInd) + (FRecordsPerBuf - FBufCnt) * SizeOf(Longint))^;
  4882.       j := NextRec - FRecordsPerBuf;
  4883.       if j < 1 then j := 1;
  4884.       Result := NextRec - j;
  4885.       if Result > 0 then begin
  4886.         FBufCnt := Result;
  4887.         DBFHandler.Seek(DBFHeader.data_offset + ((j - 1) * FRecordSize), soFromBeginning);
  4888.         DBFHandler.Read((FBuffer + (FRecordsPerBuf - FBufCnt) * FRecordSize)^, FBufCnt * FRecordSize);
  4889.         FBufDir := bdFromBottom;
  4890.         FCurInd := FRecordsPerBuf - 1;
  4891.         for i := 0 to FBufCnt - 1 do begin
  4892.           pLongint(pChar(FBufInd) + (FRecordsPerBuf - i - 1) * SizeOf(LongInt))^ := NextRec - i - 1;
  4893.           if Crypt.FActive then
  4894.             Crypt.Decrypt(NextRec - i - 1, Pointer(FBuffer + (FRecordsPerBuf - i - 1) * FRecordSize), FRecordSize);
  4895.         end;
  4896.       end;
  4897.     end else begin
  4898.       //Prior buffer by index
  4899.       OldIndex := FCurInd;
  4900.       OldKey := FIndexes.ActiveObject.CurrentKey;
  4901.       OldRec := FIndexes.ActiveObject.CurrentRec;
  4902.       if FBufDir = bdFromTop then
  4903.         FCurInd := 0
  4904.       else
  4905.         FCurInd := FRecordsPerBuf - FBufCnt;
  4906.       FKeyCalk := true;
  4907.       try
  4908.         FIndexes.ActiveObject.SetToRecord(pLongint(pChar(FBufInd) + SizeOf(Longint)*FCurInd)^);
  4909.       finally
  4910.         FKeyCalk := false;
  4911.       end;
  4912. //      Result := 0;
  4913.       if FIndexes.ActiveObject.FLock then
  4914.         try
  4915.           Result := FIndexes.ActiveObject.PriorBuffer(DBFHandler, FBuffer, FRecordsPerBuf, FRecordSize, FBufInd, DBFHeader.data_offset);
  4916.         finally
  4917.           FIndexes.ActiveObject.FUnLock;
  4918.         end
  4919.       else
  4920.         raise Exception.Create('TDBFDataSet: Can not read from index file (FLock is false).');
  4921.       if Result > 0 then begin
  4922.         FBufCnt := Result;
  4923.         FBufDir := bdFromBottom;
  4924.         FCurInd := FRecordsPerBuf - 1;
  4925.         FIndexes.ActiveObject.SetToRecord;
  4926.       end else begin
  4927.         FCurInd := OldIndex;
  4928.         FIndexes.ActiveObject.SetToRecord(OldKey, OldRec);
  4929.       end;
  4930.     end;
  4931.   end else Result := 0;
  4932. end;
  4933.  
  4934. procedure TVKSmartDBF.GetBufferByRec(Rec: Integer);
  4935. var
  4936.   i, RealRead: Integer;
  4937.   NewRec: Longint;
  4938.   Result: Longint;
  4939. begin
  4940.   if (FIndexes = nil) or (FIndexes.ActiveObject = nil) then begin
  4941.     NewRec := Rec - ( FRecordsPerBuf div 2);
  4942.     if NewRec < 1 then NewRec := 1;
  4943.     DBFHandler.Seek(DBFHeader.data_offset + (NewRec - 1) * FRecordSize, soFromBeginning);
  4944.     RealRead := DBFHandler.Read(FBuffer^, FRecordsPerBuf * FRecordSize);
  4945.     FBufCnt := RealRead div FRecordSize;
  4946.     if FBufCnt = 0 then begin
  4947.       FBOF := true;
  4948.       FEOF := true;
  4949.     end else begin
  4950.       FBOF := false;
  4951.       FEOF := false;
  4952.       FCurInd := 0;
  4953.     end;
  4954.     FBufDir := bdFromTop;
  4955.     for i := 0 to FBufCnt - 1 do begin
  4956.       pLongint(pChar(FBufInd) + i * SizeOf(Longint))^ := NewRec + i;
  4957.       if pLongint(pChar(FBufInd) + SizeOf(Longint)*i)^ = Rec then
  4958.         FCurInd := i;
  4959.       if Crypt.FActive then
  4960.         Crypt.Decrypt(NewRec + i, Pointer(FBuffer + i * FRecordSize), FRecordSize);
  4961.     end;
  4962.   end else begin
  4963.     if Rec < 1 then Rec := 1;
  4964.     DBFHandler.Seek(DBFHeader.data_offset + (Rec - 1) * FRecordSize, soFromBeginning);
  4965.     RealRead := DBFHandler.Read(FBuffer^, FRecordSize);
  4966.     if Crypt.FActive then
  4967.       Crypt.Decrypt(Rec, Pointer(FBuffer), FRecordSize);
  4968.     if RealRead = FRecordSize then begin
  4969.       FBufInd^ := Rec;
  4970.       FCurInd := 0;
  4971.       FBufDir := bdFromTop;
  4972.       FKeyCalk := true;
  4973.       try
  4974.         if not FIndexes.ActiveObject.SetToRecord(Rec) then begin
  4975.           FCurInd := -1;
  4976.           FBufDir := bdFromTop;
  4977.           FBufCnt := 0;
  4978.           FBOF := true;
  4979.           FEOF := true;
  4980.           Exit;
  4981.         end else begin
  4982.           FBOF := false;
  4983.           FEOF := false;
  4984.         end;
  4985.       finally
  4986.         FKeyCalk := false;
  4987.       end;
  4988.       if FIndexes.ActiveObject.CurrentRec <> DWORD(Rec) then begin
  4989.         Rec := FIndexes.ActiveObject.CurrentRec;
  4990.         DBFHandler.Seek(DBFHeader.data_offset + (Rec - 1) * FRecordSize, soFromBeginning);
  4991.         DBFHandler.Read(FBuffer^, FRecordSize);
  4992.         if Crypt.FActive then
  4993.           Crypt.Decrypt(Rec, Pointer(FBuffer), FRecordSize);
  4994.         FBufInd^ := Rec;
  4995.         FCurInd := 0;
  4996.       end;
  4997. //      Result := 0;
  4998.       if FIndexes.ActiveObject.FLock then
  4999.         try
  5000.           Result := FIndexes.ActiveObject.NextBuffer(DBFHandler, FBuffer + FRecordSize, FRecordsPerBuf - 1, FRecordSize, pLongint(pChar(FBufInd) + SizeOf(Longint)), DBFHeader.data_offset);
  5001.         finally
  5002.           FIndexes.ActiveObject.FUnLock;
  5003.         end
  5004.       else
  5005.         raise Exception.Create('TDBFDataSet: Can not read from index file (FLock is false).');
  5006.       FBufCnt := Result + 1
  5007.     end else begin
  5008.       FCurInd := -1;
  5009.       FBufDir := bdFromTop;
  5010.       FBufCnt := 0;
  5011.       FBOF := true;
  5012.       FEOF := true;
  5013.     end;
  5014.   end;
  5015. end;
  5016.  
  5017. function TVKSmartDBF.GetRecBuf: pChar;
  5018. begin
  5019.   if ( 0 <= FCurInd ) and ( FCurInd <= FRecordsPerBuf ) then
  5020.     Result := FBuffer + FCurInd * FRecordSize
  5021.   else
  5022.     Result := nil;
  5023. end;
  5024.  
  5025. procedure TVKSmartDBF.NextIndexBuf;
  5026. begin
  5027.   FBOF := false;
  5028.   Inc(FCurInd);
  5029.   if FBufDir = bdFromTop then begin
  5030.     if FCurInd >= FBufCnt then if NextBuffer = 0 then begin
  5031.       FCurInd := FBufCnt;
  5032.       FEOF := true;
  5033.     end;
  5034.   end else begin
  5035.     if FCurInd >= FRecordsPerBuf then if NextBuffer = 0 then begin
  5036.       FCurInd := FRecordsPerBuf;
  5037.       FEOF := true;
  5038.     end;
  5039.   end;
  5040. end;
  5041.  
  5042. procedure TVKSmartDBF.PriorIndexBuf;
  5043. begin
  5044.   FEOF := false;
  5045.   Dec(FCurInd);
  5046.   if FBufDir = bdFromTop then begin
  5047.     if FCurInd < 0 then if PriorBuffer = 0 then begin
  5048.       //FCurInd := 0;
  5049.       FBOF := true;
  5050.     end;
  5051.   end else begin
  5052.     if FCurInd < FRecordsPerBuf - FBufCnt then  if PriorBuffer = 0 then begin
  5053.       //FCurInd := FRecordsPerBuf - FBufCnt;
  5054.       FBOF := true;
  5055.     end;
  5056.   end;
  5057. end;
  5058.  
  5059. function TVKSmartDBF.GetRecNoBuf: Longint;
  5060. begin
  5061.   Result := pLongint(pChar(FBufInd) + (FCurInd)*SizeOf(Longint))^;
  5062. end;
  5063.  
  5064. function TVKSmartDBF.GetDataSource: TDataSource;
  5065. begin
  5066.   Result := FDataLink.DataSource;
  5067. end;
  5068.  
  5069. procedure TVKSmartDBF.SetDataSource(const Value: TDataSource);
  5070. begin
  5071.   FDataLink.DataSource := Value;
  5072.   SetRngInt;
  5073. end;
  5074.  
  5075. procedure TVKSmartDBF.SetRngInt;
  5076. begin
  5077.   if FDataLink.DataSource <> nil then begin
  5078.     if FMasterFields <> '' then begin
  5079.       if FRange then ClearRange;
  5080.       FRange := true;
  5081.       ListMasterFields.Clear;
  5082.       if FDataLink.DataSource.DataSet <> nil then begin
  5083.         if FDataLink.DataSource.DataSet.Active then begin
  5084.           FDataLink.DataSource.DataSet.GetFieldList(ListMasterFields, FMasterFields);
  5085.           SetRange(FMasterFields, GetMasterFields);
  5086.         end;
  5087.       end;
  5088.     end;
  5089.   end;
  5090. end;
  5091.  
  5092. function TVKSmartDBF.RLock: Boolean;
  5093. begin
  5094.   Result := RLock(RecNo);
  5095. end;
  5096.  
  5097. function TVKSmartDBF.RLock(nRec: Integer): Boolean;
  5098. var
  5099.   i, k: Integer;
  5100.   l: boolean;
  5101. begin
  5102.   if FFileLock then
  5103.     Result := true
  5104.   else begin
  5105.     k := FLockRecords.IndexOf(Pointer(nRec));
  5106.     if k = -1 then begin
  5107.       l := ( ( (FAccessMode.FLast and fmShareExclusive) = fmShareExclusive ) or ( (FAccessMode.FLast and fmShareDenyWrite) = fmShareDenyWrite ) );
  5108.       if not l then begin
  5109.         i := 0;
  5110.         repeat
  5111.           Result := DBFHandler.Lock(1000000000 + nRec, 1);
  5112.           if not Result then begin
  5113.             Wait(0.001, false);
  5114.             Inc(i);
  5115.             if i >= FWaitBusyRes then Exit;
  5116.           end else
  5117.             FLockRecords.Add(Pointer(nRec));
  5118.         until Result;
  5119.       end else
  5120.         Result := true;
  5121.     end else
  5122.       Result := true;
  5123.   end;
  5124. end;
  5125.  
  5126. function TVKSmartDBF.RUnLock: Boolean;
  5127. begin
  5128.   Result := RUnLock(RecNo);
  5129. end;
  5130.  
  5131. function TVKSmartDBF.RUnLock(nRec: Integer): Boolean;
  5132. var
  5133.   l: boolean;
  5134.   k: Integer;
  5135. begin
  5136.   l := ( ( (FAccessMode.FLast and fmShareExclusive) = fmShareExclusive ) or ( (FAccessMode.FLast and fmShareDenyWrite) = fmShareDenyWrite ) );
  5137.   if not l then begin
  5138.     Result := DBFHandler.UnLock(1000000000 + nRec, 1);
  5139.     if Result then begin
  5140.       k := FLockRecords.IndexOf(Pointer(nRec));
  5141.       if k <> -1 then FLockRecords.Delete(k);
  5142.     end;
  5143.   end else
  5144.     Result := true;
  5145. end;
  5146.  
  5147. function TVKSmartDBF.LockHeader: boolean;
  5148. var
  5149.   i: Integer;
  5150.   l: boolean;
  5151. begin
  5152.   i := 0;
  5153.   l := ( ( (FAccessMode.FLast and fmShareExclusive) = fmShareExclusive ) or ( (FAccessMode.FLast and fmShareDenyWrite) = fmShareDenyWrite ) );
  5154.   repeat
  5155.     if not l then begin
  5156.       Result := DBFHandler.Lock(1000000000, 1);
  5157.       if not Result then begin
  5158.         Wait(0.001, false);
  5159.         Inc(i);
  5160.         if i >= FWaitBusyRes then Exit;
  5161.       end;
  5162.     end else
  5163.       Result := true;
  5164.   until Result;
  5165. end;
  5166.  
  5167. function TVKSmartDBF.UnlockHeader: boolean;
  5168. var
  5169.   l: boolean;
  5170. begin
  5171.   l := ( ( (FAccessMode.FLast and fmShareExclusive) = fmShareExclusive ) or ( (FAccessMode.FLast and fmShareDenyWrite) = fmShareDenyWrite ) );
  5172.   if not l then
  5173.     Result := DBFHandler.UnLock(1000000000, 1)
  5174.   else
  5175.     Result := true;
  5176. end;
  5177.  
  5178. function TVKSmartDBF.GetCurIndByRec(nRec: Integer): Integer;
  5179. var
  5180.   i: Integer;
  5181. begin
  5182.   Result := 0;
  5183.   if FBufDir = bdFromTop then begin
  5184.     for i := 0 to FBufCnt - 1 do
  5185.       if pLongint(pChar(FBufInd) + SizeOf(Longint)*i)^ = nRec then begin
  5186.         Result := i;
  5187.         Break;
  5188.       end;
  5189.   end else begin
  5190.     for i := 0 to FBufCnt - 1 do
  5191.       if pLongint(pChar(FBufInd) + (FRecordsPerBuf - i - 1) * SizeOf(LongInt))^ = nRec then begin
  5192.         Result := (FRecordsPerBuf - i - 1);
  5193.         Break;
  5194.       end;
  5195.   end;
  5196. end;
  5197.  
  5198. function TVKSmartDBF.FLock: Boolean;
  5199. var
  5200.   i: Integer;
  5201.   l: boolean;
  5202. begin
  5203.   Result := false;
  5204.   if FFileLock then begin
  5205.     Result := true;
  5206.     Exit;
  5207.   end else begin
  5208.     try
  5209.       i := 0;
  5210.       l := ( ( (FAccessMode.FLast and fmShareExclusive) = fmShareExclusive ) or ( (FAccessMode.FLast and fmShareDenyWrite) = fmShareDenyWrite ) );
  5211.       repeat
  5212.         if not l then begin
  5213.           Result := DBFHandler.Lock(1000000001, 1000000000);
  5214.           if not Result then begin
  5215.             Wait(0.001, false);
  5216.             Inc(i);
  5217.             if i = FWaitBusyRes then Exit;
  5218.           end;
  5219.         end else
  5220.           Result := true;
  5221.       until Result;
  5222.     finally
  5223.       FFileLock := Result;
  5224.     end;
  5225.     if FFileLock then
  5226.       if Indexes <> nil then
  5227.         for i := 0 to Indexes.Count - 1 do Indexes[i].StartUpdate;
  5228.   end;
  5229. end;
  5230.  
  5231. function TVKSmartDBF.UnLock: Boolean;
  5232. var
  5233.   l: boolean;
  5234.   i: Integer;
  5235. begin
  5236.   l := ( ( (FAccessMode.FLast and fmShareExclusive) = fmShareExclusive ) or ( (FAccessMode.FLast and fmShareDenyWrite) = fmShareDenyWrite ) );
  5237.   if not l then
  5238.     Result := DBFHandler.UnLock(1000000001, 1000000000)
  5239.   else
  5240.     Result := true;
  5241.   FFileLock := not Result;
  5242.   if Indexes <> nil then
  5243.     for i := 0 to Indexes.Count - 1 do Indexes[i].Flush;
  5244. end;
  5245.  
  5246. procedure TVKSmartDBF.InternalEdit;
  5247. var
  5248.   i, l: Integer;
  5249.   ActiveBuf: pChar;
  5250. begin
  5251.   GetActiveRecBuf(ActiveBuf);
  5252.   l := pTRecInfo(ActiveBuf + RecordSize).RecordRowID;
  5253.   if Indexes <> nil then
  5254.     for i := 0 to Indexes.Count - 1 do begin
  5255.       Indexes[i].FOldEditKey := Indexes[i].EvaluteKeyExpr;
  5256.       Indexes[i].FOldEditRec := l;
  5257.     end;
  5258. end;
  5259.  
  5260. procedure TVKSmartDBF.InternalRefresh;
  5261. var
  5262.   ActiveBuf: pChar;
  5263.   Rec: Longint;
  5264. begin
  5265.   GetActiveRecBuf(ActiveBuf);
  5266.   if ActiveBuf <> nil then begin
  5267.     Rec := pTRecInfo(ActiveBuf + RecordSize).RecordRowID;
  5268.     GetBufferByRec(Rec);
  5269.   end;
  5270. end;
  5271.  
  5272. procedure TVKSmartDBF.SetOrder(nOrd: Integer);
  5273. begin
  5274.   if (FIndexes <> nil) then begin
  5275.     if ( nOrd = 0 ) and ( FIndexes.ActiveObject <> nil ) then
  5276.       FIndexes.ActiveObject.Active := false;
  5277.     if (( nOrd - 1 ) >= 0 ) and ( ( nOrd - 1 ) < FIndexes.Count ) then
  5278.       FIndexes[nOrd - 1].Active := true;
  5279.   end;
  5280. end;
  5281.  
  5282. procedure TVKSmartDBF.SetOrder(sOrd: ShortString);
  5283. var
  5284.   i: Integer;
  5285. begin
  5286.   if (FIndexes <> nil) then begin
  5287.     for i := 0 to FIndexes.Count - 1 do
  5288.       if UpperCase(FIndexes[i].Name) = UpperCase(sOrd) then
  5289.         FIndexes[i].Active := true;
  5290.   end;
  5291. end;
  5292.  
  5293. function TVKSmartDBF.GetCreateNow: Boolean;
  5294. begin
  5295.   Result := FCreateNow;
  5296. end;
  5297.  
  5298. procedure TVKSmartDBF.SetCreateNow(const Value: Boolean);
  5299. begin
  5300.   if (csReading in ComponentState) then
  5301.   begin
  5302.     FStreamedCreateNow := Value;
  5303.   end else begin
  5304.     if Value then begin
  5305.       CreateTable;
  5306.       if  (csDesigning in ComponentState)
  5307.           and (not (csLoading in ComponentState)) then
  5308.             ShowMessage(Format('Table %s create successfully!', [DBFFileName]));
  5309.     end;
  5310.     FCreateNow := Value;
  5311.   end;
  5312. end;
  5313.  
  5314. function TVKSmartDBF.LocateRecord(  const KeyFields: string;
  5315.                                     const KeyValues: Variant;
  5316.                                     Options: TLocateOptions;
  5317.                                     nRec: DWORD = 1;
  5318.                                     FullScanOnly: boolean = false): Integer;
  5319. var
  5320.   m, i, j, k, l, n, p, o: Integer;
  5321.   FFields: TList;
  5322.  
  5323.   procedure CntFld;
  5324.   var
  5325.     I: Integer;
  5326.   begin
  5327.     I := p;
  5328.     while (I <= Length(KeyFields)) and (KeyFields[I] <> ';') do Inc(I);
  5329.     Inc(o);
  5330.     if (I <= Length(KeyFields)) and (KeyFields[I] = ';') then Inc(I);
  5331.     p := I;
  5332.   end;
  5333.  
  5334.   function LocatePass: Integer;
  5335.   var
  5336.     RecPareBuf, i: Integer;
  5337.     ReadSize, RealRead, BufCnt: Integer;
  5338.     Ok: boolean;
  5339.     Rec: Integer;
  5340.     //
  5341.     LowV, HiV, vj: Integer;
  5342.     //
  5343.   begin
  5344.     IndState := true;
  5345.     Result := 0;
  5346.     Rec := nRec - 1;
  5347.     Ok := false;
  5348.     // Check empty KeyValues
  5349.     if VarIsEmpty(KeyValues) or VarIsNull(KeyValues) then Exit;
  5350.     if VarIsArray(KeyValues) then begin
  5351.       LowV := VarArrayLowBound(KeyValues, 1);
  5352.       HiV := VarArrayHighBound(KeyValues, 1);
  5353.       for vj := LowV to HiV do begin
  5354.         if VarIsEmpty(KeyValues[vj]) or VarIsNull(KeyValues[vj]) then Exit;
  5355.       end;
  5356.     end;
  5357.     //
  5358.     try
  5359.       RecPareBuf := FBufferSize div Header.rec_size;
  5360.       if RecPareBuf >= 1 then begin
  5361.         ReadSize := RecPareBuf * Header.rec_size;
  5362.         Handle.Seek(Header.data_offset + ((nRec - 1) * Header.rec_size), 0);
  5363.         repeat
  5364.           RealRead := Handle.Read(FLocateBuffer^, ReadSize);
  5365.           BufCnt := RealRead div Header.rec_size;
  5366.           for i := 0 to BufCnt - 1 do begin
  5367.             IndRecBuf := FLocateBuffer + Header.rec_size * i;
  5368.             if Crypt.FActive then
  5369.               Crypt.Decrypt(Rec + 1, Pointer(IndRecBuf), FRecordSize);
  5370.             Inc(Rec);
  5371.             if AcceptRecordInternal then begin
  5372.               if CompareLocateField(FFields, KeyValues, Options) = 0 then begin
  5373.                 Ok := true;
  5374.                 Exit;
  5375.               end;
  5376.             end;
  5377.           end;
  5378.         until ( BufCnt <= 0 );
  5379.       end else raise Exception.Create('TVKSmartDBF.LocateRecord: Record size too large');
  5380.     finally
  5381.       IndState := false;
  5382.       IndRecBuf := nil;
  5383.       if Ok then
  5384.         Result := Rec
  5385.       else
  5386.         Result := 0;
  5387.     end;
  5388.   end;
  5389.  
  5390.   procedure FullScan;
  5391.   begin
  5392.     FFields := TList.Create;
  5393.     try
  5394.       GetFieldList(FFields, KeyFields);
  5395.       Result := LocatePass;
  5396.     finally
  5397.       FFields.Free;
  5398.     end;
  5399.   end;
  5400.  
  5401. begin
  5402.  
  5403.   if FullScanOnly then begin
  5404.     FullScan;
  5405.     Exit;
  5406.   end;
  5407.  
  5408.   m := 0;
  5409.   k := 0;
  5410.   p := 1;
  5411.   o := 0;
  5412.   if Indexes <> nil then begin
  5413.     while p <= Length(KeyFields) do CntFld;
  5414.     j := Indexes.Count - 1;
  5415.     for i := 0 to j do begin
  5416.       l := Indexes[i].SuiteFieldList(KeyFields, n);
  5417.       if l > m then begin
  5418.         m := l;
  5419.         k := i;
  5420.       end;
  5421.     end;
  5422.   end;
  5423.   if (m > 0) and (o = m) then begin
  5424.     if loPartialKey in Options then
  5425.       Result := Indexes[k].FindKeyFields(KeyFields, KeyValues, true)
  5426.     else
  5427.       Result := Indexes[k].FindKeyFields(KeyFields, KeyValues);
  5428.   end else
  5429.     FullScan;
  5430. end;
  5431.  
  5432. function TVKSmartDBF.Locate(const KeyFields: string;
  5433.   const KeyValues: Variant; Options: TLocateOptions): Boolean;
  5434. var
  5435.   Rec: Integer;
  5436. begin
  5437.   Result := false;
  5438.   Rec := LocateRecord(KeyFields, KeyValues, Options);
  5439.   if Rec <> 0 then begin
  5440.     SetRecNoInternal(Rec);
  5441.     Result := true;
  5442.   end;
  5443. end;
  5444.  
  5445. function TVKSmartDBF.Lookup(const KeyFields: string;
  5446.   const KeyValues: Variant; const ResultFields: string): Variant;
  5447. var
  5448.   Rec: Integer;
  5449. begin
  5450.   Rec := LocateRecord(KeyFields, KeyValues, FLookupOptions);
  5451.   if Rec <> 0 then begin
  5452.     Handle.Seek(Header.data_offset + (Rec - 1) * Header.rec_size, 0);
  5453.     Handle.Read(FLocateBuffer^, Header.rec_size);
  5454.     IndRecBuf := FLocateBuffer;
  5455.     if Crypt.FActive then
  5456.       Crypt.Decrypt(Rec, Pointer(IndRecBuf), FRecordSize);
  5457.     IndState := true;
  5458.     try
  5459.       GetCalcFields(IndRecBuf);
  5460.       Result := FieldValues[ResultFields];
  5461.     finally
  5462.       IndState := false;
  5463.       IndRecBuf := nil;
  5464.     end;
  5465.   end else
  5466.     Result := Unassigned;
  5467. end;
  5468.  
  5469. function TVKSmartDBF.GetMasterFields: Variant;
  5470. var
  5471.   i: Integer;
  5472. begin
  5473.   if ListMasterFields.Count > 0 then begin
  5474.     Result := VarArrayCreate([0, ListMasterFields.Count - 1], varVariant);
  5475.     for i := 0 to ListMasterFields.Count - 1 do
  5476.       Result[i] := TField(ListMasterFields[i]).AsVariant;
  5477.   end else
  5478.     Result := Null;
  5479. end;
  5480.  
  5481. procedure TVKSmartDBF.SetMasterFields(const Value: String);
  5482. begin
  5483.   if Value = '' then begin
  5484.     FMasterFields := Value;
  5485.     if FRange then ClearRange;
  5486.     FRange := false;
  5487.   end;
  5488.   if FMasterFields <> Value then begin
  5489.     FMasterFields := Value;
  5490.     if FRange then ClearRange;
  5491.     FRange := true;
  5492.     ListMasterFields.Clear;
  5493.     if DataSource <> nil then begin
  5494.       if DataSource.DataSet <> nil then begin
  5495.         if DataSource.DataSet.Active then begin
  5496.           DataSource.DataSet.GetFieldList(ListMasterFields, FMasterFields);
  5497.           SetRange(FMasterFields, GetMasterFields);
  5498.         end;
  5499.       end;
  5500.     end;
  5501.   end;
  5502. end;
  5503.  
  5504. procedure TVKSmartDBF.ClearRange;
  5505. begin
  5506.   //
  5507. end;
  5508.  
  5509. procedure TVKSmartDBF.SetRange(FieldList: String;
  5510.   FieldValues: array of const);
  5511. begin
  5512.   //
  5513. end;
  5514.  
  5515. procedure TVKSmartDBF.SetRange(FieldList: String; FieldValues: variant);
  5516. begin
  5517.   //
  5518. end;
  5519.  
  5520. procedure TVKSmartDBF.Reindex;
  5521. var
  5522.   i, j: Integer;
  5523. begin
  5524.   if Indexes <> nil then begin
  5525.     j := Indexes.Count - 1;
  5526.     for i := 0 to j do
  5527.       Indexes[i].Reindex;
  5528.   end;
  5529. end;
  5530.  
  5531. procedure TVKSmartDBF.ReindexWithOutActivated;
  5532. var
  5533.   i, j: Integer;
  5534. begin
  5535.   if Indexes <> nil then begin
  5536.     j := Indexes.Count - 1;
  5537.     for i := 0 to j do
  5538.       Indexes[i].Reindex(false);
  5539.   end;
  5540. end;
  5541.  
  5542. procedure TVKSmartDBF.SetDBFFieldDefs(const Value: TVKDBFFieldDefs);
  5543. begin
  5544.   FDBFFieldDefs.Assign(Value);
  5545. end;
  5546.  
  5547. procedure TVKSmartDBF.SetDBFIndexDefs(const Value: TVKDBFIndexDefs);
  5548. begin
  5549.   FDBFIndexDefs.Assign(Value);
  5550. end;
  5551.  
  5552. function TVKSmartDBF.CreateBlobStream(Field: TField;
  5553.   Mode: TBlobStreamMode): TStream;
  5554. var
  5555.   qq: TVKDBFFieldDef;
  5556.   ss: array [0..10] of char;
  5557.   iCode, dInt: Integer;
  5558.   dbfBuf: array [0..511] of byte;
  5559.   eof: boolean;
  5560.   i: Integer;
  5561.   rr, rr1: Integer;
  5562.   LenLob: Integer;
  5563. begin
  5564.   qq := TVKDBFFieldDef(Pointer(Field.Tag));
  5565.   if Field.GetData(Pointer(@ss[0])) then
  5566.   begin
  5567.     if Mode = bmWrite then begin
  5568.       Result := TVKDBTStream.CreateDBTStream(self, Field);
  5569.       TVKDBTStream(Result).FModified := true;
  5570.       Exit;
  5571.     end;
  5572.     if  ( qq.field_type = 'M' ) or
  5573.         ( ( qq.field_type = 'E' ) and
  5574.           ( qq.extend_type in [dbftClob, dbftFmtMemo,
  5575.                             dbftBlob, dbftGraphic] )) then begin
  5576.       ss[10] := #0;
  5577.       Val(ss, dInt, iCode);
  5578.     end else begin
  5579.       if ( ( pLongword(@ss[0])^ and $80000000 ) = $80000000 ) then begin
  5580.         dInt := ( pLongword(@ss[0])^ and $7FFFFFFF );
  5581.         iCode := 0;
  5582.       end else begin
  5583.         dInt := 0;
  5584.         iCode := 1;
  5585.       end;
  5586.     end;
  5587.     if (iCode = 0) and (LobHandler.IsOpen) then
  5588.     begin
  5589.       Result := TVKDBTStream.CreateDBTStream(self, Field);
  5590.       case qq.field_type of
  5591.         'M':
  5592.           begin
  5593.             eof := false;
  5594.             LobHandler.Seek(512 * dInt, 0);
  5595.             repeat
  5596.               rr := LobHandler.Read(dbfBuf, 512);
  5597.               rr1 := rr;
  5598.               for i := 0 to rr - 1 do begin
  5599.                 if dbfBuf[i] = $1A then begin
  5600.                   eof := true;
  5601.                   rr1 := i;
  5602.                   break;
  5603.                 end;
  5604.               end;
  5605.               Result.Write(dbfBuf, rr1);
  5606.             until eof;
  5607.             Result.Position := 0;
  5608.             if TVKDBTStream(Result).Memory <> nil then
  5609.               TranslateBuff(TVKDBTStream(Result).Memory, TVKDBTStream(Result).Memory, false, TVKDBTStream(Result).Size);
  5610.             TVKDBTStream(Result).FModified := false;
  5611.           end;
  5612.         'E':
  5613.           begin
  5614.             case qq.extend_type of
  5615.               dbftClob, dbftFmtMemo:
  5616.                 begin
  5617.                   LobHandler.Seek(512 * dInt, 0);
  5618.                   LobHandler.Read(LenLob, SizeOf(Integer));
  5619.                   Result.Size := LenLob;
  5620.                   LobHandler.Read(TVKDBTStream(Result).Memory^, LenLob);
  5621.                   Result.Position := 0;
  5622.                   if Crypt.FActive then
  5623.                     Crypt.Decrypt(512 * dInt, TVKDBTStream(Result).Memory, LenLob);
  5624.                   if TVKDBTStream(Result).Memory <> nil then
  5625.                     TranslateBuff(TVKDBTStream(Result).Memory, TVKDBTStream(Result).Memory, false, LenLob);
  5626.                   TVKDBTStream(Result).FModified := false;
  5627.                 end;
  5628.               dbftBlob, dbftGraphic:
  5629.                 begin
  5630.                   LobHandler.Seek(512 * dInt, 0);
  5631.                   LobHandler.Read(LenLob, SizeOf(Integer));
  5632.                   Result.Size := LenLob;
  5633.                   LobHandler.Read(TVKDBTStream(Result).Memory^, LenLob);
  5634.                   if Crypt.FActive then
  5635.                     Crypt.Decrypt(512 * dInt, TVKDBTStream(Result).Memory, LenLob);
  5636.                   Result.Position := 0;
  5637.                   TVKDBTStream(Result).FModified := false;
  5638.                 end;
  5639.               dbftClob_NB, dbftFmtMemo_NB:
  5640.                 begin
  5641.                   LobHandler.Seek(dInt, 0);
  5642.                   LobHandler.Read(LenLob, SizeOf(Integer));
  5643.                   Result.Size := LenLob;
  5644.                   LobHandler.Read(TVKDBTStream(Result).Memory^, LenLob);
  5645.                   Result.Position := 0;
  5646.                   if Crypt.FActive then
  5647.                     Crypt.Decrypt(dInt, TVKDBTStream(Result).Memory, LenLob);
  5648.                   if TVKDBTStream(Result).Memory <> nil then
  5649.                     TranslateBuff(TVKDBTStream(Result).Memory, TVKDBTStream(Result).Memory, false, LenLob);
  5650.                   TVKDBTStream(Result).FModified := false;
  5651.                 end;
  5652.               dbftBlob_NB, dbftGraphic_NB:
  5653.                 begin
  5654.                   LobHandler.Seek(dInt, 0);
  5655.                   LobHandler.Read(LenLob, SizeOf(Integer));
  5656.                   Result.Size := LenLob;
  5657.                   LobHandler.Read(TVKDBTStream(Result).Memory^, LenLob);
  5658.                   if Crypt.FActive then
  5659.                     Crypt.Decrypt(dInt, TVKDBTStream(Result).Memory, LenLob);
  5660.                   Result.Position := 0;
  5661.                   TVKDBTStream(Result).FModified := false;
  5662.                 end;
  5663.             else
  5664.               raise Exception.Create('TVKSmartDBF: Lob stream create error!');
  5665.             end;
  5666.           end;
  5667.       else
  5668.         raise Exception.Create('TVKSmartDBF: Lob stream create error!');
  5669.       end;
  5670.     end else
  5671.       Result := TVKDBTStream.CreateDBTStream(self, Field);
  5672.   end else
  5673.     Result := TVKDBTStream.CreateDBTStream(self, Field);
  5674. end;
  5675.  
  5676. procedure TVKSmartDBF.CreateNestedStream(NestedDataSet: TVKSmartDBF; Field: TField; NestedStream: TStream);
  5677. var
  5678.   qq: TVKDBFFieldDef;
  5679.   ss: array [0..10] of char;
  5680.   iCode, dInt: Integer;
  5681.   LenLob: Integer;
  5682.  
  5683.   procedure CreateNewStream;
  5684.   begin
  5685.     NestedDataSet.DBFFieldDefs.Clear;
  5686.     qq := DBFFieldDefs.FindIndex(Field.FullName);
  5687.     NestedDataSet.DBFFieldDefs.Assign(qq.DBFFieldDefs);
  5688.     NestedDataSet.CreateTable;
  5689.   end;
  5690.  
  5691. begin
  5692.   qq := TVKDBFFieldDef(Pointer(Field.Tag));
  5693.   if Field.GetData(@ss[0]) then
  5694.   begin
  5695.     if  ( ( qq.field_type = 'E' ) and
  5696.           ( qq.extend_type in [dbftDBFDataSet] )) then begin
  5697.       ss[10] := #0;
  5698.       Val(ss, dInt, iCode);
  5699.     end else begin
  5700.       if ( ( pLongword(@ss[0])^ and $80000000 ) = $80000000 ) then begin
  5701.         dInt := ( pLongword(@ss[0])^ and $7FFFFFFF );
  5702.         iCode := 0;
  5703.       end else begin
  5704.         dInt := 0;
  5705.         iCode := 1;
  5706.       end;
  5707.     end;
  5708.     if (iCode = 0) and (LobHandler.IsOpen) then
  5709.     begin
  5710.       case qq.field_type of
  5711.         'E':
  5712.           begin
  5713.             case qq.extend_type of
  5714.               dbftDBFDataSet:
  5715.                 begin
  5716.                   LobHandler.Seek(512 * dInt, 0);
  5717.                   LobHandler.Read(LenLob, SizeOf(Integer));
  5718.                   TMemoryStream(NestedStream).Size := LenLob;
  5719.                   LobHandler.Read(TMemoryStream(NestedStream).Memory^, LenLob);
  5720.                   TMemoryStream(NestedStream).Position := 0;
  5721.                   if Crypt.FActive then
  5722.                     Crypt.Decrypt(512 * dInt, TMemoryStream(NestedStream).Memory, LenLob);
  5723.                 end;
  5724.               dbftDBFDataSet_NB:
  5725.                 begin
  5726.                   LobHandler.Seek(dInt, 0);
  5727.                   LobHandler.Read(LenLob, SizeOf(Integer));
  5728.                   TMemoryStream(NestedStream).Size := LenLob;
  5729.                   LobHandler.Read(TMemoryStream(NestedStream).Memory^, LenLob);
  5730.                   if Crypt.FActive then
  5731.                     Crypt.Decrypt(dInt, TMemoryStream(NestedStream).Memory, LenLob);
  5732.                   TMemoryStream(NestedStream).Position := 0;
  5733.                 end;
  5734.               else
  5735.                 raise Exception.Create('TVKSmartDBF: Nested stream create error!');
  5736.               end;
  5737.           end;
  5738.       else
  5739.         raise Exception.Create('TVKSmartDBF: Nested stream create error!');
  5740.       end;
  5741.     end else
  5742.       CreateNewStream;
  5743.   end else
  5744.     CreateNewStream;
  5745. end;
  5746.  
  5747. procedure TVKSmartDBF.SaveOnTheSamePlaceToDBT(Source: TMemoryStream; Field: TField);
  5748. begin
  5749.   FSaveOnTheSamePlace := True;
  5750.   try
  5751.     SaveToDBT(Source, Field);
  5752.   finally
  5753.     FSaveOnTheSamePlace := False;
  5754.   end;
  5755. end;
  5756.  
  5757. procedure TVKSmartDBF.SaveToDBT(Source: TMemoryStream; Field: TField);
  5758. var
  5759.   qq: TVKDBFFieldDef;
  5760.   ss: array [0..10] of char;
  5761.   lEnd, dInt: Integer;
  5762.   LenLob: Integer;
  5763.   CryptContext: LongWord;
  5764.   LHnd: TProxyStream;
  5765. begin
  5766.   qq := TVKDBFFieldDef(Pointer(Field.Tag));
  5767.   if FPackProcess then
  5768.     LHnd := PackLobHandler
  5769.   else
  5770.     LHnd := LobHandler;
  5771.   if LHnd.IsOpen then
  5772.   begin
  5773.     if Source.Memory <> nil then begin
  5774.       lEnd := LHnd.Seek(0, 2);
  5775.       if  ( qq.field_type = 'M' ) or
  5776.           ( ( qq.field_type = 'E' ) and
  5777.             ( qq.extend_type in [ dbftClob, dbftFmtMemo,
  5778.                                   dbftBlob, dbftGraphic,
  5779.                                   dbftDBFDataSet] )) then begin
  5780.         if not FSaveOnTheSamePlace then begin
  5781.           dInt := lEnd div 512;
  5782.           if (lEnd mod 512) > 0 then Inc(dInt);
  5783.           CryptContext := dInt * 512;
  5784.           LHnd.Seek(dInt * 512, 0);
  5785.           Str(dInt:10, ss);
  5786.           Field.SetData(Pointer(@ss[0]));
  5787.         end else begin
  5788.           Field.GetData(Pointer(@ss[0]));
  5789.           dInt := StrToInt(ss);
  5790.           CryptContext := dInt * 512;
  5791.           LHnd.Seek(dInt * 512, 0);
  5792.         end;
  5793.       end else begin
  5794.         if not FSaveOnTheSamePlace then begin
  5795.           dInt := lEnd;
  5796.           CryptContext := dInt;
  5797.           LHnd.Seek(dInt, 0);
  5798.           Field.SetData(@dInt);
  5799.         end else begin
  5800.           Field.GetData(@dInt);
  5801.           CryptContext := dInt;
  5802.           LHnd.Seek(dInt, 0);
  5803.         end;
  5804.       end;
  5805.       case qq.field_type of
  5806.         'M':
  5807.           begin
  5808.             //This Lob type you can not to Crypt !!!
  5809.             LenLob := Source.Size;
  5810.             TranslateBuff(Source.Memory, Source.Memory, true, LenLob);
  5811.             LHnd.Write(Pointer(Source.Memory)^, LenLob);
  5812.             ss[0] := #$1A;
  5813.             LHnd.Write(ss, 1);
  5814.           end;
  5815.         'E':
  5816.           begin
  5817.             case qq.extend_type of
  5818.               dbftClob, dbftFmtMemo:
  5819.                 begin
  5820.                   LenLob := Source.Size;
  5821.                   TranslateBuff(Source.Memory, Source.Memory, true, LenLob);
  5822.                   if Crypt.FActive then Crypt.Encrypt(CryptContext, Source.Memory, LenLob);
  5823.                   LHnd.Write(LenLob, SizeOf(Integer));
  5824.                   LHnd.Write(Pointer(Source.Memory)^, LenLob);
  5825.                 end;
  5826.               dbftBlob, dbftGraphic, dbftDBFDataSet:
  5827.                 begin
  5828.                   LenLob := Source.Size;
  5829.                   if Crypt.FActive then Crypt.Encrypt(CryptContext, Source.Memory, LenLob);
  5830.                   LHnd.Write(LenLob, SizeOf(Integer));
  5831.                   LHnd.Write(Pointer(Source.Memory)^, LenLob);
  5832.                 end;
  5833.               dbftClob_NB, dbftFmtMemo_NB:
  5834.                 begin
  5835.                   LenLob := Source.Size;
  5836.                   TranslateBuff(Source.Memory, Source.Memory, true, LenLob);
  5837.                   if Crypt.FActive then Crypt.Encrypt(CryptContext, Source.Memory, LenLob);
  5838.                   LHnd.Write(LenLob, SizeOf(Integer));
  5839.                   LHnd.Write(Pointer(Source.Memory)^, LenLob);
  5840.                 end;
  5841.               dbftBlob_NB, dbftGraphic_NB, dbftDBFDataSet_NB:
  5842.                 begin
  5843.                   LenLob := Source.Size;
  5844.                   if Crypt.FActive then Crypt.Encrypt(CryptContext, Source.Memory, LenLob);
  5845.                   LHnd.Write(LenLob, SizeOf(Integer));
  5846.                   LHnd.Write(Pointer(Source.Memory)^, LenLob);
  5847.                 end;
  5848.             else
  5849.               raise Exception.Create('TVKSmartDBF: Lob stream save error!');
  5850.             end;
  5851.           end;
  5852.       else
  5853.         raise Exception.Create('TVKSmartDBF: Lob stream save error!');
  5854.       end;
  5855.     end else
  5856.       Field.SetData(nil);
  5857.   end;
  5858. end;
  5859.  
  5860. procedure TVKSmartDBF.BeginAddBuffered(RecInBuffer: Integer);
  5861. begin
  5862.   if not FAddBuffered then begin
  5863.     FAddBuffered := true;
  5864.     FAddBufferCount := RecInBuffer;
  5865.     FAddBuffer := VKDBFMemMgr.oMem.GetMem(self, FAddBufferCount * FRecordSize);
  5866.     FAddBufferCrypt := VKDBFMemMgr.oMem.GetMem(self, FAddBufferCount * FRecordSize);
  5867.     FAddBufferCurrent := -1; // 0 - (FAddBufferCount - 1)
  5868.   end;
  5869. end;
  5870.  
  5871. procedure TVKSmartDBF.EndAddBuffered;
  5872. begin
  5873.   if FAddBuffered then begin
  5874.     if FAddBufferCount > -1 then FlushAddBuffer;
  5875.     VKDBFMemMgr.oMem.FreeMem(FAddBuffer);
  5876.     VKDBFMemMgr.oMem.FreeMem(FAddBufferCrypt);
  5877.     FAddBuffered := false;
  5878.     FAddBuffer := nil;
  5879.     FAddBufferCrypt := nil;
  5880.     FAddBufferCount := -1;
  5881.     FAddBufferCurrent := -1;
  5882.   end;
  5883. end;
  5884.  
  5885. procedure TVKSmartDBF.FlushAddBuffer;
  5886. var
  5887.   i, j, RealRead: Integer;
  5888.   lpMsgBuf: array [0..500] of Char;
  5889.   le: DWORD;
  5890.   NewKey: String;
  5891.   NewRec: LongInt;
  5892.   LockR, b: boolean;
  5893.   b1, b2: pChar;
  5894.  
  5895. begin
  5896.  
  5897.   if FAddBuffered then begin
  5898.     if FAddBufferCurrent > -1 then begin
  5899.       CheckActive;
  5900.       if LockHeader then begin
  5901.         try
  5902.           DBFHeader.last_rec := ( (DBFHandler.Seek(0, 2) - DBFHeader.data_offset) div DBFHeader.rec_size );
  5903.           NewRec := DBFHeader.last_rec + 1;
  5904.           DBFHandler.Seek(0, 2);
  5905.           DBFHandler.Seek(DBFHeader.data_offset + LongWord(DBFHeader.last_rec * FRecordSize), 0);
  5906.           //Crypt
  5907.           if Crypt.FActive then begin
  5908.             for j := 0 to FAddBufferCurrent do begin
  5909.               b1 := FAddBuffer + j * DBFHeader.rec_size;
  5910.               b2 := FAddBufferCrypt + j * DBFHeader.rec_size;
  5911.               Move(b1^, b2^, DBFHeader.rec_size);
  5912.               Crypt.Encrypt(NewRec + j, b2, DBFHeader.rec_size);
  5913.             end;
  5914.             RealRead := DBFHandler.Write(FAddBufferCrypt^, DBFHeader.rec_size * ( FAddBufferCurrent + 1 ) );
  5915.           end else
  5916.             RealRead := DBFHandler.Write(FAddBuffer^, DBFHeader.rec_size * ( FAddBufferCurrent + 1 ) );
  5917.           if RealRead = -1 then begin
  5918.             le := GetLastError();
  5919.             FormatMessage(
  5920.               FORMAT_MESSAGE_FROM_SYSTEM,
  5921.               nil,
  5922.               le,
  5923.               0, // Default language
  5924.               lpMsgBuf,
  5925.               500,
  5926.               nil
  5927.               );
  5928.             raise Exception.Create('TVKSmartDBF: ' + lpMsgBuf);
  5929.           end else begin
  5930.             Inc(DBFHeader.last_rec, FAddBufferCurrent + 1);
  5931.             DBFHandler.Seek(0, 0); //go to the begin
  5932.             RealRead := DBFHandler.Write(DBFHeader, SizeOf(DBFHeader));
  5933.             if RealRead = -1 then begin
  5934.               le := GetLastError();
  5935.               FormatMessage(
  5936.                 FORMAT_MESSAGE_FROM_SYSTEM,
  5937.                 nil,
  5938.                 le,
  5939.                 0, // Default language
  5940.                 lpMsgBuf,
  5941.                 500,
  5942.                 nil
  5943.                 );
  5944.               raise Exception.Create('TVKSmartDBF: ' + lpMsgBuf);
  5945.             end else begin
  5946.               FIndState := true;
  5947.               try
  5948.                 if Indexes <> nil then
  5949.                   for i := 0 to Indexes.Count - 1 do begin
  5950.                     b :=  ( (FAccessMode.FLast and fmShareExclusive) = fmShareExclusive ) or
  5951.                           ( (FAccessMode.FLast and fmShareDenyWrite) = fmShareDenyWrite ) or
  5952.                           FFileLock;
  5953.                     LockR := Indexes[i].FLock;
  5954.                     if not b then Indexes[i].StartUpdate(false);
  5955.                     if LockR then
  5956.                       try
  5957.                         for j := 0 to FAddBufferCurrent do begin
  5958.                           FIndRecBuf := FAddBuffer + j * DBFHeader.rec_size;
  5959.                           NewKey := Indexes[i].EvaluteKeyExpr;
  5960.                           Indexes[i].AddKey(NewKey, NewRec + j);
  5961.                         end;
  5962.                       finally
  5963.                         if not b then Indexes[i].Flush;
  5964.                         Indexes[i].FUnLock;
  5965.                       end
  5966.                     else
  5967.                       raise Exception.Create('TVKSmartDBF.FlushAddBuffer: Can not add key to index file (FLock is false).');
  5968.                   end;
  5969.               finally
  5970.                 FIndRecBuf := nil;
  5971.                 FIndState := false;
  5972.               end;
  5973.             end;
  5974.           end;
  5975.         finally
  5976.           UnLockHeader;
  5977.         end;
  5978.       end else
  5979.         raise Exception.Create('TVKSmartDBF.FlushAddBuffer: Can not lock DBF header.');
  5980.     end;
  5981.     FAddBufferCurrent := -1;
  5982.   end;
  5983. end;
  5984.  
  5985. function TVKSmartDBF.GetOnEncrypt: TOnCrypt;
  5986. begin
  5987.   Result := FVKDBFCrypt.FOnEncrypt;
  5988. end;
  5989.  
  5990. procedure TVKSmartDBF.SetOnDecrypt(const Value: TOnCrypt);
  5991. begin
  5992.   FVKDBFCrypt.FOnDecrypt := Value;
  5993. end;
  5994.  
  5995. procedure TVKSmartDBF.SetOnEncrypt(const Value: TOnCrypt);
  5996. begin
  5997.   FVKDBFCrypt.FOnEncrypt := Value;
  5998. end;
  5999.  
  6000. function TVKSmartDBF.GetOnDecrypt: TOnCrypt;
  6001. begin
  6002.   Result := FVKDBFCrypt.FOnDecrypt;
  6003. end;
  6004.  
  6005. function TVKSmartDBF.GetOnCryptActivate: TNotifyEvent;
  6006. begin
  6007.   Result := FVKDBFCrypt.FOnActivate;
  6008. end;
  6009.  
  6010. function TVKSmartDBF.GetOnCryptDeActivate: TNotifyEvent;
  6011. begin
  6012.   Result := FVKDBFCrypt.FOnDeactivate;
  6013. end;
  6014.  
  6015. procedure TVKSmartDBF.SetOnCryptActivate(const Value: TNotifyEvent);
  6016. begin
  6017.   FVKDBFCrypt.FOnActivate := Value;
  6018. end;
  6019.  
  6020. procedure TVKSmartDBF.SetOnCryptDeActivate(const Value: TNotifyEvent);
  6021. begin
  6022.   FVKDBFCrypt.FOnDeactivate := Value;
  6023. end;
  6024.  
  6025. function TVKSmartDBF.SetAutoInc(const FieldName: String;
  6026.   Value: DWORD): boolean;
  6027. var
  6028.   oFld: TField;
  6029. begin
  6030.   Result := false;
  6031.   oFld := FindField(FieldName);
  6032.   if oFld <> nil then
  6033.     Result := SetAutoInc(oFld.FieldNo, Value);
  6034. end;
  6035.  
  6036. function TVKSmartDBF.SetAutoInc(const FieldNum: Integer;
  6037.   Value: DWORD): boolean;
  6038. var
  6039.   qq: TVKDBFFieldDef;
  6040.   FR: FIELD_REC;
  6041. begin
  6042.   CheckActive;
  6043.   if LockHeader then begin
  6044.     try
  6045.       //qq := DBFFieldDefs.Items[FieldNum - 1];
  6046.       qq := TVKDBFFieldDef(Pointer(FieldByNumber(FieldNum).Tag));
  6047.       DBFHandler.Seek(qq.FOffHD, soFromBeginning);
  6048.       DBFHandler.Read(FR, SizeOf(FIELD_REC));
  6049.       FR.NextAutoInc := Value;
  6050.       DBFHandler.Seek(qq.FOffHD, soFromBeginning);
  6051.       DBFHandler.Write(FR, SizeOf(FIELD_REC));
  6052.       Result := true;
  6053.     finally
  6054.       UnLockHeader;
  6055.     end
  6056.   end else
  6057.     raise Exception.Create('TVKSmartDBF.SetAutoInc: Can not lock DBF header.');
  6058. end;
  6059.  
  6060. function TVKSmartDBF.GetCurrentAutoInc(const FieldName: String): DWORD;
  6061. var
  6062.   oFld: TField;
  6063. begin
  6064.   Result := DWORD(-1);
  6065.   oFld := FindField(FieldName);
  6066.   if oFld <> nil then
  6067.     Result := GetCurrentAutoInc(oFld.FieldNo);
  6068. end;
  6069.  
  6070. function TVKSmartDBF.GetCurrentAutoInc(const FieldNum: Integer): DWORD;
  6071. var
  6072.   qq: TVKDBFFieldDef;
  6073.   FR: FIELD_REC;
  6074. begin
  6075.   CheckActive;
  6076.   if LockHeader then begin
  6077.     try
  6078.       //qq := DBFFieldDefs.Items[FieldNum - 1];
  6079.       qq := TVKDBFFieldDef(Pointer(FieldByNumber(FieldNum).Tag));
  6080.       DBFHandler.Seek(qq.FOffHD, soFromBeginning);
  6081.       DBFHandler.Read(FR, SizeOf(FIELD_REC));
  6082.       Result := FR.NextAutoInc;
  6083.     finally
  6084.       UnLockHeader;
  6085.     end
  6086.   end else
  6087.     raise Exception.Create('TVKSmartDBF.GetCurrentAutoInc: Can not lock DBF header.');
  6088. end;
  6089.  
  6090. function TVKSmartDBF.GetNextAutoInc(const FieldName: String): DWORD;
  6091. var
  6092.   oFld: TField;
  6093. begin
  6094.   Result := DWORD(-1);
  6095.   oFld := FindField(FieldName);
  6096.   if oFld <> nil then
  6097.     Result := GetNextAutoInc(oFld.FieldNo);
  6098. end;
  6099.  
  6100. function TVKSmartDBF.GetNextAutoInc(const FieldNum: Integer): DWORD;
  6101. var
  6102.   qq: TVKDBFFieldDef;
  6103.   FR: FIELD_REC;
  6104. begin
  6105.   CheckActive;
  6106.   if LockHeader then begin
  6107.     try
  6108.       //qq := DBFFieldDefs.Items[FieldNum - 1];
  6109.       qq := TVKDBFFieldDef(Pointer(FieldByNumber(FieldNum).Tag));
  6110.       DBFHandler.Seek(qq.FOffHD, soFromBeginning);
  6111.       DBFHandler.Read(FR, SizeOf(FIELD_REC));
  6112.       Inc(FR.NextAutoInc);
  6113.       DBFHandler.Seek(qq.FOffHD, soFromBeginning);
  6114.       DBFHandler.Write(FR, SizeOf(FIELD_REC));
  6115.       Result := FR.NextAutoInc;
  6116.     finally
  6117.       UnLockHeader;
  6118.     end
  6119.   end else
  6120.     raise Exception.Create('TVKSmartDBF.GetNextAutoInc: Can not lock DBF header.');
  6121. end;
  6122.  
  6123. procedure TVKSmartDBF.Truncate;
  6124. begin
  6125.   CheckActive;
  6126.   if LockHeader then
  6127.     try
  6128.       DBFHeader.last_rec := 0;
  6129.       DBFHandler.Seek(0, 0);
  6130.       DBFHandler.Write(DBFHeader, SizeOf(DBF_HEAD));
  6131.       DBFHandler.Seek(DBFHeader.data_offset, 0);
  6132.       DBFHandler.SetEndOfFile;
  6133.       if LobHandler.IsOpen then begin
  6134.         LobHandler.Seek(0, 0);
  6135.         LobHandler.SetEndOfFile;
  6136.         LobHandler.Write('This is Lob!', 12);
  6137.       end;
  6138.       ReindexWithOutActivated;
  6139.     finally
  6140.       UnLockHeader;
  6141.       First;
  6142.     end
  6143.   else
  6144.     raise Exception.Create('TVKSmartDBF.Truncate: Can not lock DBF header.');
  6145. end;
  6146.  
  6147. procedure TVKSmartDBF.DataConvert(Field: TField; Source, Dest: Pointer;
  6148.   ToNative: Boolean);
  6149. var
  6150.   Len: Integer;
  6151. begin
  6152.   case Field.DataType of
  6153.     ftWideString:
  6154.       begin
  6155.         if ToNative then begin
  6156.           Len := pInteger(pChar(pWideChar(Source^)) - 4)^;
  6157.           Move(Pointer(pChar(pWideChar(Source^)) - 4)^, Dest^, Len + 6);
  6158.         end else begin
  6159.           pWideString(Dest)^ := pWideChar(pChar(Source) + 4);
  6160.         end;
  6161.       end;
  6162.   else
  6163.     inherited DataConvert(Field, Source, Dest, ToNative);
  6164.   end;
  6165. end;
  6166.  
  6167. procedure TVKSmartDBF.Zap;
  6168. begin
  6169.   Truncate;
  6170. end;
  6171.  
  6172. procedure TVKSmartDBF.ReindexAll;
  6173. var
  6174.   RecPareBuf, i, j: Integer;
  6175.   ReadSize, RealRead, BufCnt: Integer;
  6176.   Rec: Integer;
  6177.   Offset: Integer;
  6178. begin
  6179.   if Indexes <> nil then begin
  6180.     CheckActive;
  6181.     if State = dsEdit then Post;
  6182.     if LockHeader then
  6183.       try
  6184.  
  6185.         for j := 0 to Indexes.Count - 1 do Indexes.Items[j].BeginCreateIndexProcess;
  6186.  
  6187.         IndState := true;
  6188.         try
  6189.           RecPareBuf := FBufferSize div Header.rec_size;
  6190.           if RecPareBuf >= 1 then begin
  6191.             ReadSize := RecPareBuf * Header.rec_size;
  6192.  
  6193.             Offset := Header.data_offset;
  6194.             Rec := 0;
  6195.  
  6196.             repeat
  6197.  
  6198.               Handle.Seek(Offset, 0);
  6199.               RealRead := Handle.Read(FLocateBuffer^, ReadSize);
  6200.               Inc(Offset, RealRead);
  6201.  
  6202.               BufCnt := RealRead div Header.rec_size;
  6203.               for i := 0 to BufCnt - 1 do begin
  6204.                 IndRecBuf := FLocateBuffer + Header.rec_size * i;
  6205.                 if Crypt.FActive then
  6206.                   Crypt.Decrypt(Rec + 1, Pointer(IndRecBuf), FRecordSize);
  6207.                 Inc(Rec);
  6208.                 for j := 0 to Indexes.Count - 1 do Indexes.Items[j].EvaluteAndAddKey(Rec);
  6209.               end;
  6210.  
  6211.             until ( BufCnt <= 0 );
  6212.  
  6213.           end else raise Exception.Create('TVKSmartDBF.ReindexAll: Record size too large');
  6214.  
  6215.         finally
  6216.           for j := 0 to Indexes.Count - 1 do Indexes.Items[j].EndCreateIndexProcess;
  6217.           IndState := false;
  6218.           IndRecBuf := nil;
  6219.         end;
  6220.  
  6221.  
  6222.       finally
  6223.         UnLockHeader;
  6224.         First;
  6225.       end
  6226.     else
  6227.       raise Exception.Create('TVKSmartDBF.ReindexAll: Can not lock DBF header.');
  6228.   end;
  6229. end;
  6230.  
  6231. function TVKSmartDBF.CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer;
  6232. begin
  6233.   Result := 9;
  6234.   if Bookmark1 = nil then
  6235.   begin
  6236.     if Bookmark2 <> nil then
  6237.       Result := -1
  6238.     else
  6239.       Result := 0;
  6240.   end else
  6241.     if Bookmark2 = nil then
  6242.       Result := 1;
  6243.   if Result = 9 then
  6244.   begin
  6245.     Result := StrComp(PChar(BookMark1),PChar(Bookmark2));
  6246.     if Result < 0 then
  6247.       Result := -1
  6248.     else
  6249.       if Result > 0 then
  6250.         Result := 1;
  6251.   end;
  6252. end;
  6253.  
  6254. function TVKSmartDBF.BookmarkValid(Bookmark: TBookmark): Boolean;
  6255. var
  6256.   q: LongWord;
  6257. begin
  6258.   Result := false;
  6259.   if Bookmark <> nil then begin
  6260.     q := pLongWord(Bookmark)^;
  6261.     if ( q > 0 ) and ( q <= LongWord(Header.last_rec) ) then Result := true;
  6262.   end;
  6263. end;
  6264.  
  6265. procedure TVKSmartDBF.DBEval;
  6266. var
  6267.   RecPareBuf, i: Integer;
  6268.   ReadSize, RealRead, BufCnt: Integer;
  6269.   Rec: Integer;
  6270.   Offset: Integer;
  6271.   FLastFastPostRecord: boolean;
  6272. begin
  6273.   CheckActive;
  6274.   if State = dsEdit then Post;
  6275.   if LockHeader then
  6276.     try
  6277.  
  6278.       if Flock() then
  6279.         try
  6280.  
  6281.           FTmpActive := true;
  6282.           FLastFastPostRecord := FFastPostRecord;
  6283.           FFastPostRecord := true;
  6284.  
  6285.           try
  6286.  
  6287.             RecPareBuf := FBufferSize div Header.rec_size;
  6288.             if RecPareBuf >= 1 then begin
  6289.               ReadSize := RecPareBuf * Header.rec_size;
  6290.  
  6291.               Offset := Header.data_offset;
  6292.               Rec := 0;
  6293.  
  6294.               repeat
  6295.  
  6296.                 Handle.Seek(Offset, 0);
  6297.                 RealRead := Handle.Read(FLocateBuffer^, ReadSize);
  6298.                 Inc(Offset, RealRead);
  6299.  
  6300.                 BufCnt := RealRead div Header.rec_size;
  6301.                 for i := 0 to BufCnt - 1 do begin
  6302.  
  6303.                   Inc(Rec);
  6304.  
  6305.                   if Crypt.Active then
  6306.                     Crypt.Decrypt(Rec, Pointer(FTempRecord), FRecordSize)
  6307.                   else
  6308.                     Move((FLocateBuffer + Header.rec_size * i)^, FTempRecord^, FRecordSize);
  6309.                   SetBookmarkData(FTempRecord, @Rec);
  6310.                   SetBookmarkFlag(FTempRecord, bfCurrent);
  6311.  
  6312.                   if Assigned(FOnDBEval) then FOnDBEval(self, Rec);
  6313.  
  6314.                 end;
  6315.  
  6316.               until ( BufCnt <= 0 );
  6317.  
  6318.             end else raise Exception.Create('TVKSmartDBF.DBEval: Record size too large');
  6319.  
  6320.           finally
  6321.             FTmpActive := false;
  6322.             FFastPostRecord := FLastFastPostRecord;
  6323.           end;
  6324.  
  6325.         finally
  6326.           UnLock;
  6327.         end
  6328.       else
  6329.         raise Exception.Create('TVKSmartDBF.DBEval: Can not lock DBF table.');
  6330.  
  6331.     finally
  6332.       UnLockHeader;
  6333.       Refresh;
  6334.     end
  6335.   else
  6336.     raise Exception.Create('TVKSmartDBF.DBEval: Can not lock DBF header.');
  6337. end;
  6338.  
  6339. function TVKSmartDBF.GetOrder: ShortString;
  6340. begin
  6341.   Result := '';
  6342.   if (FIndexes <> nil) and ( FIndexes.ActiveObject <> nil ) then Result := FIndexes.ActiveObject.Name;
  6343. end;
  6344.  
  6345. procedure TVKSmartDBF.SetOrderName(sOrd: ShortString);
  6346. begin
  6347.   if csReading in ComponentState then
  6348.     FIndexName := sOrd
  6349.   else
  6350.     SetOrder(sOrd);
  6351. end;
  6352.  
  6353. procedure TVKSmartDBF.SetKey;
  6354. begin
  6355.   FSaveState := SetTempState(dsSetKey);
  6356.   InternalInitRecord(FSetKeyBuffer);
  6357. end;
  6358.  
  6359. procedure TVKSmartDBF.EditKey;
  6360. begin
  6361.   FSaveState := SetTempState(dsSetKey);
  6362. end;
  6363.  
  6364. procedure TVKSmartDBF.DropEditKey;
  6365. begin
  6366.   RestoreState(FSaveState);
  6367. end;
  6368.  
  6369. function TVKSmartDBF.GotoKey: boolean;
  6370. var
  6371.   RecN: Integer;
  6372. begin
  6373.   RecN := 0;
  6374.   Result := false;
  6375.   try
  6376.     if ( Indexes <> nil ) and ( Indexes.ActiveObject <> nil ) then
  6377.       RecN := Indexes.ActiveObject.FindKeyFields;
  6378.   finally
  6379.     RestoreState(FSaveState);
  6380.     if RecN > 0 then begin
  6381.       SetRecNoInternal(RecN);
  6382.       Result := True;
  6383.     end;
  6384.   end;
  6385. end;
  6386.  
  6387. procedure TVKSmartDBF.GotoNearest;
  6388. var
  6389.   RecN: Integer;
  6390. begin
  6391.   RecN := 0;
  6392.   try
  6393.     if ( Indexes <> nil ) and ( Indexes.ActiveObject <> nil ) then
  6394.       RecN := Indexes.ActiveObject.FindKeyFields(true);
  6395.   finally
  6396.     RestoreState(FSaveState);
  6397.     if RecN > 0 then
  6398.       SetRecNoInternal(RecN);
  6399.   end;
  6400. end;
  6401.  
  6402. function TVKSmartDBF.FindKey(const KeyValues: array of const): Boolean;
  6403. var
  6404.   RecN: Integer;
  6405. begin
  6406.   Result := false;
  6407.   if ( Indexes <> nil ) and ( Indexes.ActiveObject <> nil ) then begin
  6408.     RecN := Indexes.ActiveObject.FindKeyFields('', KeyValues);
  6409.     if RecN > 0 then begin
  6410.       SetRecNoInternal(RecN);
  6411.       Result := true;
  6412.     end;
  6413.   end;
  6414. end;
  6415.  
  6416. procedure TVKSmartDBF.FindNearest(const KeyValues: array of const);
  6417. var
  6418.   RecN: Integer;
  6419. begin
  6420.   if ( Indexes <> nil ) and ( Indexes.ActiveObject <> nil ) then begin
  6421.     RecN := Indexes.ActiveObject.FindKeyFields('', KeyValues, true);
  6422.     if RecN > 0 then SetRecNoInternal(RecN);
  6423.   end;
  6424. end;
  6425.  
  6426. function TVKSmartDBF.AcceptTmpRecord(nRec: DWORD): boolean;
  6427. begin
  6428.   if (not Filtered) and (Filter <> '') then
  6429.       FFilterParser.SetExprParams(Filter, FilterOptions, [poExtSyntax], '');
  6430.   SetTmpRecord(nRec);
  6431.   try
  6432.     Result := AcceptRecordInternal;
  6433.   finally
  6434.     CloseTmpRecord;
  6435.   end;
  6436. end;
  6437.  
  6438. function TVKSmartDBF.AcceptRecordInternal: boolean;
  6439. begin
  6440.   if not Filtered then begin
  6441.     if not FSetDeleted then
  6442.       Result := true
  6443.     else
  6444.       Result := not Deleted;
  6445.   end else
  6446.     Result := AcceptRecord;
  6447.   if  ( Result ) and
  6448.       ( Indexes <> nil ) and
  6449.       ( Indexes.ActiveObject <> nil ) and
  6450.       ( Indexes.ActiveObject.IsRanged ) then
  6451.         Result := Indexes.ActiveObject.InRange;
  6452. end;
  6453.  
  6454. procedure TVKSmartDBF.SetRecNoInternal(Value: Integer);
  6455. begin
  6456.   CursorPosChanged;
  6457.   DoBeforeScroll;
  6458.   GetBufferByRec(Value);
  6459.   Resync([]);
  6460.   DoAfterScroll;
  6461. end;
  6462.  
  6463. procedure TVKSmartDBF.Loaded;
  6464. begin
  6465.   inherited Loaded;
  6466.   IndexName := FIndexName;
  6467.   if FStreamedCreateNow then CreateNow := True;
  6468.   if FStreamedActive then Active := True;
  6469. end;
  6470.  
  6471. function TVKSmartDBF.GetInnerStream: TStream;
  6472. begin
  6473.   Result := DBFHandler.InnerStream;
  6474. end;
  6475.  
  6476. procedure TVKSmartDBF.SetActive(Value: Boolean);
  6477. begin
  6478.   if (csReading in ComponentState) then
  6479.   begin
  6480.     FStreamedActive := Value;
  6481.   end
  6482.   else
  6483.     inherited SetActive(Value);
  6484. end;
  6485.  
  6486. function TVKSmartDBF.GetInnerLobStream: TStream;
  6487. begin
  6488.   Result := LobHandler.InnerStream;
  6489. end;
  6490.  
  6491. procedure TVKSmartDBF.BindDBFFieldDef;
  6492. var
  6493.   i: Integer;
  6494.   FieldFullName: String;
  6495.   F: TField;
  6496.  
  6497.   function HideBindDBFFieldDef(FDS: TVKDBFFieldDefs; Prefix: String = ''): boolean;
  6498.   var
  6499.     i: Integer;
  6500.     FD: TVKDBFFieldDef;
  6501.   begin
  6502.     Result := False;
  6503.     for i := 0 to FDS.Count - 1 do begin
  6504.       FD := FDS[i];
  6505.       if FD.FFieldDefRef <> nil then begin
  6506.         if Prefix + FD.Name = FieldFullName then begin
  6507.           F.Tag := Integer(Pointer(FD));
  6508.           Result := true;
  6509.           Exit;
  6510.         end;
  6511.       end;
  6512.       if FD.DBFFieldDefs.Count > 0 then begin
  6513.         Result := HideBindDBFFieldDef(FD.DBFFieldDefs, Prefix + FD.Name + '.');
  6514.         if Result then Exit;
  6515.       end;
  6516.     end;
  6517.   end;
  6518.  
  6519. begin
  6520.  
  6521.   for i := 0 to Fields.Count - 1 do begin
  6522.     F := Fields[i];
  6523.     FieldFullName := F.FullName;
  6524.     HideBindDBFFieldDef(DBFFieldDefs);
  6525.   end;
  6526.  
  6527. end;
  6528.  
  6529. procedure TVKSmartDBF.LobHandlerCreate;
  6530. begin
  6531.   LobHandler := TProxyStream.Create;
  6532. end;
  6533.  
  6534. procedure TVKSmartDBF.LobHandlerDestroy;
  6535. begin
  6536.   LobHandler.Destroy;
  6537. end;
  6538.  
  6539. procedure TVKSmartDBF.CreateLobStream(dbf_id: Byte);
  6540. begin
  6541.   if dbf_id = $83 then begin
  6542.     LobHandler.FileName := ChangeFileExt(DBFFileName, '.dbt');
  6543.     LobHandler.AccessMode.AccessMode := AccessMode.AccessMode;
  6544.     LobHandler.ProxyStreamType := FStorageType;
  6545.     LobHandler.OuterStream := FOuterLobStream;
  6546.     LobHandler.CreateProxyStream;
  6547.     LobHandler.Write('This is Lob!', 12);
  6548.     LobHandler.Close;
  6549.   end;
  6550. end;
  6551.  
  6552. procedure TVKSmartDBF.CloseLobStream;
  6553. begin
  6554.   if LobHandler.IsOpen then begin
  6555.     LobHandler.Close;
  6556.   end;
  6557. end;
  6558.  
  6559. procedure TVKSmartDBF.OpenLobStream(dbf_id: Byte);
  6560. begin
  6561.   if dbf_id = $83 then begin
  6562.     LobHandler.FileName := ChangeFileExt(DBFFileName, '.dbt');
  6563.     LobHandler.AccessMode.AccessMode := AccessMode.AccessMode;
  6564.     LobHandler.ProxyStreamType := FStorageType;
  6565.     LobHandler.OuterStream := FOuterLobStream;
  6566.     LobHandler.Open;
  6567.   end;
  6568. end;
  6569.  
  6570. procedure TVKSmartDBF.DoAfterOpen;
  6571. var
  6572.   i: Integer;
  6573.   oNested: TVKNestedDBF;
  6574. begin
  6575.   if Assigned(NestedDataSets) then
  6576.     for i := 0 to NestedDataSets.Count - 1 do begin
  6577.       oNested := TVKNestedDBF(NestedDataSets[i]);
  6578.       oNested.Close;
  6579.       oNested.Open;
  6580.     end;
  6581.   inherited DoAfterOpen;
  6582. end;
  6583.  
  6584. procedure TVKSmartDBF.RefreshBufferByRec(Rec: Integer);
  6585. var
  6586.   NewRec: Integer;
  6587.   WasEof, WasBof: boolean;
  6588. begin
  6589.  
  6590.   InternalSetCurrentIndex(Rec);
  6591.  
  6592.   WasEof := False;
  6593.   WasBof := False;
  6594.  
  6595.   FIndState := true;
  6596.   try
  6597.     repeat
  6598.       FIndRecBuf := FBuffer + FCurInd * FRecordSize;
  6599.       NewRec := pLongint(pChar(FBufInd) + FCurInd * SizeOf(Longint))^;
  6600.       if AcceptRecordInternal then Break
  6601.       else begin
  6602.         NextIndexBuf;
  6603.         if FEOF then begin
  6604.           WasEof := True;
  6605.           Break;
  6606.         end;
  6607.       end;
  6608.     until False;
  6609.     if FEOF then begin
  6610.       GetBufferByRec(Rec);
  6611.       repeat
  6612.         FIndRecBuf := FBuffer + FCurInd * FRecordSize;
  6613.         NewRec := pLongint(pChar(FBufInd) + FCurInd * SizeOf(Longint))^;
  6614.         if AcceptRecordInternal then Break
  6615.         else begin
  6616.           PriorIndexBuf;
  6617.           if FBOF then begin
  6618.             WasBof := True;
  6619.             Break;
  6620.           end;
  6621.         end;
  6622.       until False;
  6623.     end;
  6624.   finally
  6625.     FIndRecBuf := nil;
  6626.     FIndState := false;
  6627.   end;
  6628.  
  6629.   if WasEof and WasBof then begin
  6630.     // Clear buffer
  6631.     FCurInd := -1;
  6632.     FBufDir := bdFromTop;
  6633.     FBufCnt := 0;
  6634.     FBOF := True;
  6635.     FEOF := True;
  6636.   end else
  6637.     GetBufferByRec(NewRec);
  6638.  
  6639. end;
  6640.  
  6641. procedure TVKSmartDBF.InternalSetCurrentIndex(i: Integer);
  6642. var
  6643.   j: Integer;
  6644. begin
  6645.   for j := 0 to FBufCnt - 1 do begin
  6646.     if FBufDir = bdFromTop then
  6647.       if pLongint(pChar(FBufInd) + j * SizeOf(Longint))^ = i then begin
  6648.         FCurInd := j;
  6649.         FBOF := false;
  6650.         FEOF := false;
  6651.         Exit;
  6652.       end;
  6653.     if FBufDir = bdFromBottom then
  6654.       if pLongint(pChar(FBufInd) + (FRecordsPerBuf - j) * SizeOf(Longint))^ = i then begin
  6655.         FCurInd := FRecordsPerBuf - j;
  6656.         FBOF := false;
  6657.         FEOF := false;
  6658.         Exit;
  6659.       end;
  6660.   end;
  6661. end;
  6662.  
  6663. procedure TVKSmartDBF.PackLobHandlerCreate;
  6664. begin
  6665.   FPackLobHandler := TProxyStream.Create;
  6666. end;
  6667.  
  6668. procedure TVKSmartDBF.PackLobHandlerOpen(TempLobName: String);
  6669. begin
  6670.   FPackLobHandler.FileName := TempLobName;
  6671.   FPackLobHandler.AccessMode.AccessMode := AccessMode.AccessMode;
  6672.   FPackLobHandler.ProxyStreamType := pstFile;
  6673.   FPackLobHandler.CreateProxyStream;
  6674.   FPackLobHandler.Write('This is Lob!', 12);
  6675. end;
  6676.  
  6677. procedure TVKSmartDBF.PackLobHandlerClose(LobName, TempLobName: String);
  6678. begin
  6679.   //Copy new LOB into old LOB
  6680.   FPackLobHandler.Close;
  6681.   LobHandler.Close;
  6682.   case StorageType of
  6683.     pstFile:
  6684.       begin
  6685.         DeleteFile(LobName);
  6686.         RenameFile(TempLobName, LobName);
  6687.       end;
  6688.     pstInnerStream, pstOuterStream:
  6689.       begin
  6690.         LobHandler.LoadFromFile(TempLobName);
  6691.         DeleteFile(TempLobName);
  6692.       end;
  6693.   end;
  6694.   LobHandler.Open;
  6695. end;
  6696.  
  6697. procedure TVKSmartDBF.PackLobHandlerDestroy;
  6698. begin
  6699.   FPackLobHandler.Free;
  6700. end;
  6701.  
  6702. function TVKSmartDBF.GetPackLobHandler: TProxyStream;
  6703. begin
  6704.   Result := FPackLobHandler;
  6705. end;
  6706.  
  6707. { TVKDBFNTX }
  6708.  
  6709. procedure TVKDBFNTX.ClearRange;
  6710. begin
  6711.   if Indexes.ActiveObject <> nil then
  6712.     TVKNTXIndex(Indexes.ActiveObject).NTXRange.Active := false;
  6713. end;
  6714.  
  6715. constructor TVKDBFNTX.Create(AOwner: TComponent);
  6716. begin
  6717.   inherited Create(AOwner);
  6718.   FIndexes := TIndexes.Create(self, TVKNTXIndex);
  6719.   FDBFIndexDefs := TVKDBFIndexDefs.Create(self, TVKNTXBag);
  6720. end;
  6721.  
  6722. procedure TVKDBFNTX.DefineProperties(Filer: TFiler);
  6723.  
  6724.   function WriteDBFFieldDefDataB: Boolean;
  6725.   begin
  6726.     if Filer.Ancestor <> nil then
  6727.       Result := not FDBFFieldDefs.IsEqual(TVKSmartDBF(Filer.Ancestor).FDBFFieldDefs)
  6728.     else
  6729.       Result := (FDBFFieldDefs.Count > 0);
  6730.   end;
  6731.  
  6732.   function WriteDBFIndexDefDataB: Boolean;
  6733.   begin
  6734.     if Filer.Ancestor <> nil then
  6735.       Result := not FDBFIndexDefs.IsEqual(TVKSmartDBF(Filer.Ancestor).FDBFIndexDefs)
  6736.     else
  6737.       Result := (FDBFIndexDefs.Count > 0);
  6738.   end;
  6739.  
  6740. begin
  6741.   inherited DefineProperties(Filer);
  6742.   Filer.DefineProperty('DBFFieldDefs', ReadDBFFieldDefData, WriteDBFFieldDefData, WriteDBFFieldDefDataB);
  6743.   Filer.DefineProperty('DBFIndexDefs', ReadDBFIndexDefData, WriteDBFIndexDefData, WriteDBFIndexDefDataB);
  6744. end;
  6745.  
  6746. destructor TVKDBFNTX.Destroy;
  6747. begin
  6748.   Active := false;
  6749.   FIndexes.Destroy;
  6750.   FIndexes := nil;
  6751.   FDBFIndexDefs.Destroy;
  6752.   FDBFIndexDefs := nil;
  6753.   inherited Destroy;
  6754. end;
  6755.  
  6756. procedure TVKDBFNTX.SetRange(FieldList: String; FieldValues: array of const);
  6757. var
  6758.   m, i, j, k, l, n, p, o: Integer;
  6759.  
  6760.   procedure CntFld;
  6761.   var
  6762.     I: Integer;
  6763.   begin
  6764.     I := p;
  6765.     while (I <= Length(FieldList)) and (FieldList[I] <> ';') do Inc(I);
  6766.     Inc(o);
  6767.     if (I <= Length(FieldList)) and (FieldList[I] = ';') then Inc(I);
  6768.     p := I;
  6769.   end;
  6770.  
  6771. begin
  6772.   m := 0;
  6773.   k := 0;
  6774.   o := 0;
  6775.   p := 1;
  6776.   while p <= Length(FieldList) do CntFld;
  6777.   j := Indexes.Count - 1;
  6778.   for i := 0 to j do begin
  6779.     l := Indexes[i].SuiteFieldList(FieldList, n);
  6780.     if l > m then begin
  6781.       m := l;
  6782.       k := i;
  6783.     end;
  6784.   end;
  6785.   if (m > 0) and (o = m) then
  6786.     Indexes[k].SetRangeFields(FieldList, FieldValues)
  6787.   else
  6788.     raise Exception.Create('TVKSmartDBF: There is no suitable index for range!');
  6789. end;
  6790.  
  6791. procedure TVKDBFNTX.ReadDBFFieldDefData(Reader: TReader);
  6792. begin
  6793.   Reader.ReadValue;
  6794.   Reader.ReadCollection(DBFFieldDefs);
  6795. end;
  6796.  
  6797. procedure TVKDBFNTX.SetRange(FieldList: String; FieldValues: variant);
  6798. var
  6799.   m, i, j, k, l, n, p, o: Integer;
  6800.  
  6801.   procedure CntFld;
  6802.   var
  6803.     I: Integer;
  6804.   begin
  6805.     I := p;
  6806.     while (I <= Length(FieldList)) and (FieldList[I] <> ';') do Inc(I);
  6807.     Inc(o);
  6808.     if (I <= Length(FieldList)) and (FieldList[I] = ';') then Inc(I);
  6809.     p := I;
  6810.   end;
  6811.  
  6812. begin
  6813.   m := 0;
  6814.   k := 0;
  6815.   o := 0;
  6816.   p := 1;
  6817.   while p <= Length(FieldList) do CntFld;
  6818.   j := Indexes.Count - 1;
  6819.   for i := 0 to j do begin
  6820.     l := Indexes[i].SuiteFieldList(FieldList, n);
  6821.     if l > m then begin
  6822.       m := l;
  6823.       k := i;
  6824.     end;
  6825.   end;
  6826.   if (m > 0) and (o = m) then
  6827.     Indexes[k].SetRangeFields(FieldList, FieldValues)
  6828.   else
  6829.     raise Exception.Create('TVKSmartDBF: There is no suitable index for range!');
  6830. end;
  6831.  
  6832. procedure TVKDBFNTX.WriteDBFFieldDefData(Writer: TWriter);
  6833. begin
  6834.   Writer.WriteCollection(DBFFieldDefs);
  6835. end;
  6836.  
  6837. function TVKDBFNTX.GetOrdersByNum(Index: Integer): TVKNTXIndex;
  6838. begin
  6839.   if (FIndexes <> nil) then
  6840.     Result := TVKNTXIndex(Indexes[Index])
  6841.   else
  6842.     Result := nil;
  6843. end;
  6844.  
  6845. function TVKDBFNTX.GetOrdersByName(const Index: String): TVKNTXIndex;
  6846. var
  6847.   i: Integer;
  6848. begin
  6849.   Result := nil;
  6850.   if (FIndexes <> nil) then begin
  6851.     for i := 0 to FIndexes.Count - 1 do
  6852.       if UpperCase(FIndexes[i].Name) = UpperCase(Index) then begin
  6853.         Result := TVKNTXIndex(Indexes[i]);
  6854.         Break;
  6855.       end;
  6856.   end;
  6857. end;
  6858.  
  6859. procedure TVKDBFNTX.ReadDBFIndexDefData(Reader: TReader);
  6860. begin
  6861.   Reader.ReadValue;
  6862.   Reader.ReadCollection(DBFIndexDefs);
  6863. end;
  6864.  
  6865. procedure TVKDBFNTX.WriteDBFIndexDefData(Writer: TWriter);
  6866. begin
  6867.   Writer.WriteCollection(DBFIndexDefs);
  6868. end;
  6869.  
  6870. { TVKDBFCDX }
  6871.  
  6872. constructor TVKDBFCDX.Create(AOwner: TComponent);
  6873. begin
  6874.   inherited Create(AOwner);
  6875.   FIndexes := TIndexes.Create(self, TVKCDXIndex);
  6876.   FDBFIndexDefs := TVKDBFIndexDefs.Create(self, TVKCDXBag);
  6877. end;
  6878.  
  6879. procedure TVKDBFCDX.DefineProperties(Filer: TFiler);
  6880.  
  6881.   function WriteDBFFieldDefDataB: Boolean;
  6882.   begin
  6883.     if Filer.Ancestor <> nil then
  6884.       Result := not FDBFFieldDefs.IsEqual(TVKSmartDBF(Filer.Ancestor).FDBFFieldDefs)
  6885.     else
  6886.       Result := (FDBFFieldDefs.Count > 0);
  6887.   end;
  6888.  
  6889.   function WriteDBFIndexDefDataB: Boolean;
  6890.   begin
  6891.     if Filer.Ancestor <> nil then
  6892.       Result := not FDBFIndexDefs.IsEqual(TVKSmartDBF(Filer.Ancestor).FDBFIndexDefs)
  6893.     else
  6894.       Result := (FDBFIndexDefs.Count > 0);
  6895.   end;
  6896.   
  6897. begin
  6898.   inherited DefineProperties(Filer);
  6899.   Filer.DefineProperty('DBFFieldDefs', ReadDBFFieldDefData, WriteDBFFieldDefData, WriteDBFFieldDefDataB);
  6900.   Filer.DefineProperty('DBFIndexDefs', ReadDBFIndexDefData, WriteDBFIndexDefData, WriteDBFIndexDefDataB);
  6901. end;
  6902.  
  6903. destructor TVKDBFCDX.Destroy;
  6904. begin
  6905.   Active := false;
  6906.   FDBFIndexDefs.Destroy;
  6907.   FDBFIndexDefs := nil;
  6908.   FIndexes.Destroy;
  6909.   FIndexes := nil;
  6910.   inherited Destroy;
  6911. end;
  6912.  
  6913. procedure TVKDBFCDX.ReadDBFFieldDefData(Reader: TReader);
  6914. begin
  6915.   Reader.ReadValue;
  6916.   Reader.ReadCollection(DBFFieldDefs);
  6917. end;
  6918.  
  6919. procedure TVKDBFCDX.ReadDBFIndexDefData(Reader: TReader);
  6920. begin
  6921.   Reader.ReadValue;
  6922.   Reader.ReadCollection(DBFIndexDefs);
  6923. end;
  6924.  
  6925. procedure TVKDBFCDX.WriteDBFFieldDefData(Writer: TWriter);
  6926. begin
  6927.   Writer.WriteCollection(DBFFieldDefs);
  6928. end;
  6929.  
  6930. procedure TVKDBFCDX.WriteDBFIndexDefData(Writer: TWriter);
  6931. begin
  6932.   Writer.WriteCollection(DBFIndexDefs);
  6933. end;
  6934.  
  6935. { TVKDataLink }
  6936.  
  6937. procedure TVKDataLink.DataEvent(Event: TDataEvent; Info: Integer);
  6938. begin
  6939.   inherited;
  6940.   if Event = deDataSetChange then begin
  6941.     if FDBFDataSet.FRange then begin
  6942.       if FDBFDataSet.ListMasterFields.Count = 0 then
  6943.         DataSet.GetFieldList(FDBFDataSet.ListMasterFields, FDBFDataSet.FMasterFields);
  6944.       FDBFDataSet.SetRange(FDBFDataSet.FMasterFields, FDBFDataSet.GetMasterFields);
  6945.     end else begin
  6946.       if bof then FDBFDataSet.First;
  6947.       if eof then FDBFDataSet.Last;
  6948.     end;
  6949.   end;
  6950. end;
  6951.  
  6952. procedure TVKDataLink.DataSetScrolled(Distance: Integer);
  6953. begin
  6954.   inherited;
  6955.   if FDBFDataSet.FRange then begin
  6956.     if FDBFDataSet.ListMasterFields.Count = 0 then
  6957.       DataSet.GetFieldList(FDBFDataSet.ListMasterFields, FDBFDataSet.FMasterFields);
  6958.     FDBFDataSet.SetRange(FDBFDataSet.FMasterFields, FDBFDataSet.GetMasterFields);
  6959.   end else
  6960.     FDBFDataSet.MoveBy(Distance);
  6961. end;
  6962.  
  6963. { TVKDBFFieldDefs }
  6964.  
  6965. procedure TVKDBFFieldDefs.AssignValues(Value: TVKDBFFieldDefs);
  6966. var
  6967.   I: Integer;
  6968.   P: TVKDBFFieldDef;
  6969. begin
  6970.   for I := 0 to Value.Count - 1 do
  6971.   begin
  6972.     P := FindIndex(Value[I].Name);
  6973.     if P <> nil then
  6974.       P.Assign(Value[I]);
  6975.   end;
  6976. end;
  6977.  
  6978. constructor TVKDBFFieldDefs.Create(AOwner: TPersistent);
  6979. begin
  6980.   inherited Create(AOwner, TVKDBFFieldDef);
  6981. end;
  6982.  
  6983. function TVKDBFFieldDefs.FindIndex(const Value: string): TVKDBFFieldDef;
  6984.  
  6985.   function HideFindIndex(FDS: TVKDBFFieldDefs; var FD: TVKDBFFieldDef): boolean;
  6986.   var
  6987.     i: Integer;
  6988.   begin
  6989.     for i := 0 to FDS.Count - 1 do
  6990.     begin
  6991.       FD := TVKDBFFieldDef(FDS.Items[i]);
  6992.       if FD <> nil then begin
  6993.         if AnsiCompareText(FD.Name, Value) = 0 then begin
  6994.           Result := true;
  6995.           Exit;
  6996.         end;
  6997.         if FD.DBFFieldDefs.Count > 0 then begin
  6998.           Result := HideFindIndex(FD.DBFFieldDefs, FD);
  6999.           if Result then Exit;
  7000.         end;
  7001.       end;
  7002.     end;
  7003.     Result := False;
  7004.   end;
  7005.  
  7006. begin
  7007.  
  7008.   Result := nil;
  7009.   HideFindIndex(self, Result);
  7010.  
  7011. end;
  7012.  
  7013. {$IFDEF VER130}
  7014. function TVKDBFFieldDefs.GetCollectionOwner: TPersistent;
  7015. begin
  7016.   Result := GetOwner;
  7017. end;
  7018. {$ENDIF}
  7019.  
  7020. function TVKDBFFieldDefs.GetItem(Index: Integer): TVKDBFFieldDef;
  7021. begin
  7022.   Result := TVKDBFFieldDef(inherited Items[Index]);
  7023. end;
  7024.  
  7025. function TVKDBFFieldDefs.IsEqual(Value: TVKDBFFieldDefs): Boolean;
  7026. var
  7027.   I: Integer;
  7028. begin
  7029.   Result := (Count = Value.Count);
  7030.   if Result then
  7031.     for I := 0 to Count - 1 do
  7032.     begin
  7033.       Result := TVKDBFFieldDef(Items[I]).IsEqual(TVKDBFFieldDef(Value.Items[I]));
  7034.       if not Result then Break;
  7035.     end
  7036. end;
  7037.  
  7038. procedure TVKDBFFieldDefs.SetItem(Index: Integer; const Value: TVKDBFFieldDef);
  7039. begin
  7040.   inherited SetItem(Index, TCollectionItem(Value));
  7041. end;
  7042.  
  7043. { TVKDBFFieldDef }
  7044.  
  7045. procedure TVKDBFFieldDef.AssignTo(Dest: TPersistent);
  7046. begin
  7047.   with Dest as TVKDBFFieldDef do begin
  7048.     Name := self.Name;
  7049.     field_type := self.field_type;
  7050.     extend_type := self.extend_type;
  7051.     len := self.len;
  7052.     dec := self.dec;
  7053.     FOff := self.FOff;
  7054.     FOffHD := self.FOffHD;
  7055.     FDBFFieldDefs.Assign(self.FDBFFieldDefs);
  7056.   end;
  7057. end;
  7058.  
  7059. constructor TVKDBFFieldDef.Create(Collection: TCollection);
  7060. begin
  7061.   inherited Create(Collection);
  7062.   FDBFFieldDefs := TVKDBFFieldDefs.Create(self);
  7063.   FTag := 0;
  7064. end;
  7065.  
  7066. procedure TVKDBFFieldDef.DefineProperties(Filer: TFiler);
  7067.  
  7068.   function WriteDBFFieldDefDataB: Boolean;
  7069.   begin
  7070.     if Filer.Ancestor <> nil then
  7071.       Result := not FDBFFieldDefs.IsEqual(TVKDBFFieldDef(Filer.Ancestor).FDBFFieldDefs)
  7072.     else
  7073.       Result := (FDBFFieldDefs.Count > 0);
  7074.   end;
  7075.  
  7076. begin
  7077.   inherited DefineProperties(Filer);
  7078.   Filer.DefineProperty('DBFFieldDefs', ReadDBFFieldDefData, WriteDBFFieldDefData, WriteDBFFieldDefDataB);
  7079. end;
  7080.  
  7081. procedure TVKDBFFieldDef.ReadDBFFieldDefData(Reader: TReader);
  7082. begin
  7083.   Reader.ReadValue;
  7084.   Reader.ReadCollection(DBFFieldDefs);
  7085. end;
  7086.  
  7087. procedure TVKDBFFieldDef.WriteDBFFieldDefData(Writer: TWriter);
  7088. begin
  7089.   Writer.WriteCollection(DBFFieldDefs);
  7090. end;
  7091.  
  7092. destructor TVKDBFFieldDef.Destroy;
  7093. begin
  7094.   FDBFFieldDefs.Destroy;
  7095.   inherited Destroy;
  7096. end;
  7097.  
  7098. function TVKDBFFieldDef.GetDataSize: Word;
  7099. begin
  7100.   //C N D L M     E
  7101.   case FieldRec.field_type of
  7102.     'C', 'N': Result := len;
  7103.     'D': Result := 8;
  7104.     'L': Result := 1;
  7105.     'M': Result := 10;
  7106.     'E':
  7107.       case FieldRec.extend_type of
  7108.         dbftS1:     Result := 1;  //Shortint
  7109.         dbftU1:     Result := 1;  //Byte
  7110.         dbftS2:     Result := 2;  //Smallint
  7111.         dbftU2:     Result := 2;  //Word
  7112.         dbftS4:     Result := 4;  //Longint
  7113.         dbftU4:     Result := 4;  //Longword
  7114.         dbftS8:     Result := 8;  //Int64
  7115.         dbftR4:     Result := 4;  //Single
  7116.         dbftR6:     Result := 6;  //Real48
  7117.         dbftR8:     Result := 8;  //Double
  7118.         dbftR10:    Result := 10; //Extended
  7119.         dbftD1:     Result := 8;  //TDateTime
  7120.         dbftD2:     Result := 8;  //DataSet DateTime
  7121.         dbftD3:     Result := 6;  //Real48 DateTime
  7122.         dbftS1_N:   Result := 2;  //Shortint with NULL
  7123.         dbftU1_N:   Result := 2;  //Byte  with NULL
  7124.         dbftS2_N:   Result := 3;  //Smallint with NULL
  7125.         dbftU2_N:   Result := 3;  //Word with NULL
  7126.         dbftS4_N:   Result := 5;  //Longint with NULL
  7127.         dbftU4_N:   Result := 5;  //Longword with NULL
  7128.         dbftS8_N:   Result := 9;  //Int64 with NULL
  7129.         dbftR4_N:   Result := 5;  //Single with NULL
  7130.         dbftR6_N:   Result := 7;  //Real48 with NULL
  7131.         dbftR8_N:   Result := 9;  //Double with NULL
  7132.         dbftR10_N:  Result := 11; //Extended with NULL
  7133.         dbftD1_N:   Result := 9;  //TDateTime with NULL
  7134.         dbftD2_N:   Result := 9;  //DataSet DateTime with NULL
  7135.         dbftD3_N:   Result := 7;  //Real48 DateTime
  7136.         dbftClob:   Result := 10;
  7137.         dbftBlob:   Result := 10;
  7138.         dbftGraphic:  Result := 10;
  7139.         dbftFmtMemo:  Result := 10;
  7140.         dbftClob_NB:   Result := 4;
  7141.         dbftBlob_NB:   Result := 4;
  7142.         dbftGraphic_NB:  Result := 4;
  7143.         dbftFmtMemo_NB:  Result := 4;
  7144.         dbftString:   Result := len + 2;
  7145.         dbftString_N: Result := len + 3;
  7146.         dbftFixedChar: Result := len + 1;
  7147.         dbftWideString: Result := len * 2 + 4;
  7148.         dbftCurrency: Result := 8;
  7149.         dbftCurrency_N: Result := 9;
  7150.         dbftCurrency_NB: Result := 8;
  7151.         dbftBCD: Result := SizeOf(TBcd);
  7152.         dbftDate:   Result := 4;  //ftDate
  7153.         dbftDate_N:   Result := 5;  //ftDate with NULL byte
  7154.         dbftTime:   Result := 4;  //ftTime
  7155.         dbftTime_N:   Result := 5;  //ftTime with NULL byte
  7156.         dbftU1_NB: Result := 1;
  7157.         dbftU2_NB: Result := 2;
  7158.         dbftU4_NB: Result := 4;
  7159.         dbftR4_NB: Result := 4;
  7160.         dbftR6_NB: Result := 6;
  7161.         dbftR8_NB: Result := 8;
  7162.         dbftD1_NB: Result := 8;
  7163.         dbftD2_NB: Result := 8;
  7164.         dbftD3_NB: Result := 6;
  7165.         dbftDate_NB: Result := 4;
  7166.         dbftTime_NB: Result := 4;
  7167.         dbftDBFDataSet: Result := 10;
  7168.         dbftDBFDataSet_NB: Result := 10;
  7169.       else
  7170.         raise Exception.Create('Extend_type incarect!');
  7171.       end;
  7172.   else
  7173.     raise Exception.Create('Field_type incarect!');
  7174.   end;
  7175. end;
  7176.  
  7177. function TVKDBFFieldDef.GetDisplayName: string;
  7178. begin
  7179.   Result := FieldRec.field_name;
  7180. end;
  7181.  
  7182. function TVKDBFFieldDef.GetField: FIELD_REC;
  7183. begin
  7184.   //C N D L M     E
  7185.   case FieldRec.field_type of
  7186.     'C':
  7187.       begin
  7188.         FieldRec.lendth.char_len := len;
  7189.       end;
  7190.     'N':
  7191.       begin
  7192.         FieldRec.lendth.num_len.len := Byte(len);
  7193.         FieldRec.lendth.num_len.dec := Byte(dec);
  7194.       end;
  7195.     'D':
  7196.       begin
  7197.         FieldRec.lendth.num_len.len := Byte(8);
  7198.         FieldRec.lendth.num_len.dec := Byte(0);
  7199.       end;
  7200.     'L':
  7201.       begin
  7202.         FieldRec.lendth.num_len.len := Byte(1);
  7203.         FieldRec.lendth.num_len.dec := Byte(0);
  7204.       end;
  7205.     'M':
  7206.       begin
  7207.         FieldRec.lendth.num_len.len := Byte(10);
  7208.         FieldRec.lendth.num_len.dec := Byte(0);
  7209.       end;
  7210.     'E':
  7211.       begin
  7212.         if FieldRec.extend_type in [  dbftString, dbftString_N,
  7213.                                       dbftFixedChar, dbftWideString] then begin
  7214.           FieldRec.lendth.num_len.len := Byte(len);
  7215.         end else if FieldRec.extend_type in [dbftBCD] then begin
  7216.           FieldRec.lendth.num_len.len := Byte(len);
  7217.           FieldRec.lendth.num_len.dec := Byte(dec);
  7218.         end else begin
  7219.           FieldRec.lendth.num_len.len := Byte(0);
  7220.           FieldRec.lendth.num_len.dec := Byte(0);
  7221.         end;
  7222.       end;
  7223.   else
  7224.     raise Exception.Create('Field_type incarect!');
  7225.   end;
  7226.   Result := FieldRec;
  7227. end;
  7228.  
  7229. function TVKDBFFieldDef.IsEqual(Value: TVKDBFFieldDef): Boolean;
  7230. begin
  7231.   Result := false;
  7232.   if Value.Name = Name then Result := true;
  7233.   if Result then begin
  7234.     if ( Value.DBFFieldDefs.Count = DBFFieldDefs.Count ) then
  7235.       Result := DBFFieldDefs.IsEqual(Value.DBFFieldDefs);
  7236.   end;
  7237. end;
  7238.  
  7239. procedure TVKDBFFieldDef.SetDBFFieldDefs(const Value: TVKDBFFieldDefs);
  7240. begin
  7241.   FDBFFieldDefs := Value;
  7242. end;
  7243.  
  7244. procedure TVKDBFFieldDef.SetDisplayName(const Value: string);
  7245. var
  7246.   l: Integer;
  7247. begin
  7248.   l := Length(Value);
  7249.   if l > 10 then raise ERangeError.CreateFmt('Field length must be <= 10, but no %d!', [l]);
  7250.   FillChar(FieldRec.field_name, 11, 0);
  7251.   Move(pChar(Value)^, FieldRec.field_name, l);
  7252. end;
  7253.  
  7254. { TVKDBTStream }
  7255.  
  7256. procedure TVKDBTStream.Clear;
  7257. begin
  7258.   inherited Clear;
  7259.   FModified := true;
  7260. end;
  7261.  
  7262. constructor TVKDBTStream.Create;
  7263. begin
  7264.   inherited Create;
  7265.   FModified := false;
  7266. end;
  7267.  
  7268. constructor TVKDBTStream.CreateDBTStream(dbf: TVKSmartDBF; field: TField);
  7269. begin
  7270.   inherited Create;
  7271.   FModified := false;
  7272.   FSmartDBF := dbf;
  7273.   FField := field;
  7274. end;
  7275.  
  7276. destructor TVKDBTStream.Destroy;
  7277. begin
  7278.   if FModified then
  7279.     SaveToDBT;
  7280.   inherited Destroy;
  7281. end;
  7282.  
  7283. procedure TVKDBTStream.SaveToDBT;
  7284. begin
  7285.   FSmartDBF.SaveToDBT(self, FField);
  7286. end;
  7287.  
  7288. procedure TVKDBTStream.SetSize(NewSize: Integer);
  7289. begin
  7290.   inherited SetSize(NewSize);
  7291.   FModified := true;
  7292. end;
  7293.  
  7294. function TVKDBTStream.Write(const Buffer; Count: Integer): Longint;
  7295. begin
  7296.   FModified := true;
  7297.   Result := inherited Write(Buffer, Count);
  7298. end;
  7299.  
  7300. { TVKDBFCrypt }
  7301.  
  7302. constructor TVKDBFCrypt.Create;
  7303. begin
  7304.   inherited Create;
  7305.   FActive := false;
  7306.   FCryptMethod := cmNONE;
  7307.   FPassword := '';
  7308.   FOnEncrypt := nil;
  7309.   FOnDecrypt := nil;
  7310. end;
  7311.  
  7312. destructor TVKDBFCrypt.Destroy;
  7313. begin
  7314.   Active := false;
  7315.   inherited Destroy;
  7316. end;
  7317.  
  7318. procedure TVKDBFCrypt.Decrypt(Context: LongWord; Buff: Pointer; Size: Integer);
  7319. begin
  7320.   if not Assigned(FOnDecrypt) then
  7321.     case FCryptMethod of
  7322.       cmXOR: XORDecrypt(FObjectID, Context, Buff, Size);
  7323.       cmGost: GostDecrypt(FObjectID, Context, Buff, Size);
  7324.     end
  7325.   else
  7326.     FOnDecrypt(self, Context, Buff, Size);
  7327. end;
  7328.  
  7329. procedure TVKDBFCrypt.Encrypt(Context: LongWord; Buff: Pointer; Size: Integer);
  7330. begin
  7331.   if not Assigned(FOnEncrypt) then
  7332.     case FCryptMethod of
  7333.       cmXOR: XOREncrypt(FObjectID, Context, Buff, Size);
  7334.       cmGost: GostEncrypt(FObjectID, Context, Buff, Size);
  7335.     end
  7336.   else
  7337.     FOnEncrypt(self, Context, Buff, Size);
  7338. end;
  7339.  
  7340. procedure TVKDBFCrypt.SetActive(const Value: boolean);
  7341. begin
  7342.   if Value <> FActive then begin
  7343.     FActive := Value;
  7344.     if FActive then begin
  7345.       if Assigned(FOnActivate) then
  7346.         FOnActivate(self)
  7347.       else
  7348.         case FCryptMethod of
  7349.           cmXOR: FObjectID := XORActivate(FPassword);
  7350.           cmGost: FObjectID := GostActivate(FPassword);
  7351.         end;
  7352.     end else begin
  7353.       if Assigned(FOnDeactivate) then
  7354.         FOnDeactivate(self)
  7355.       else
  7356.         case FCryptMethod of
  7357.           cmXOR: XORDeactivate(FObjectID);
  7358.           cmGost: GostDeactivate(FObjectID);
  7359.         end;
  7360.     end;
  7361.   end;
  7362. end;
  7363.  
  7364. { TVKNestedDBF }
  7365.  
  7366. procedure TVKNestedDBF.CloseLobStream;
  7367. begin
  7368.   // Nothing to do
  7369. end;
  7370.  
  7371. constructor TVKNestedDBF.Create(AOwner: TComponent);
  7372. begin
  7373.   inherited Create(AOwner);
  7374.   StorageType := pstInnerStream;
  7375. end;
  7376.  
  7377. procedure TVKNestedDBF.CreateLobStream(dbf_id: Byte);
  7378. begin
  7379.   LobHandler := ParentDataSet.LobHandler;
  7380. end;
  7381.  
  7382. procedure TVKNestedDBF.DataEvent(Event: TDataEvent; Info: Integer);
  7383. var
  7384.   i: Integer;
  7385.   oNested: TVKNestedDBF;
  7386. begin
  7387.   case Event of
  7388.     deFieldChange: ParentDataSet.DataEvent(deFieldChange, Info);
  7389.     deParentScroll:
  7390.       begin
  7391.         Close;
  7392.         Open;
  7393.         for i := 0 to NestedDataSets.Count - 1 do begin
  7394.           oNested := TVKNestedDBF(NestedDataSets[i]);
  7395.           oNested.DataEvent(Event, Info);
  7396.         end;
  7397.       end;
  7398.   end;
  7399.   inherited DataEvent(Event, Info);
  7400. end;
  7401.  
  7402. procedure TVKNestedDBF.DeleteRecallRecord(Del: boolean = true);
  7403. begin
  7404.   inherited DeleteRecallRecord(Del);
  7405.   SaveOnTheSamePlaceToDBT(TMemoryStream(self.InnerStream), DataSetField);
  7406. end;
  7407.  
  7408. function TVKNestedDBF.GetPackLobHandler: TProxyStream;
  7409. begin
  7410.   Result := nil;
  7411.   if ParentDataSet <> nil then Result := ParentDataSet.PackLobHandler;
  7412. end;
  7413.  
  7414. function TVKNestedDBF.GetParentDataSet: TVKSmartDBF;
  7415. begin
  7416.   Result := nil;
  7417.   if DataSetField <> nil then
  7418.     Result := DataSetField.DataSet as TVKSmartDBF;
  7419. end;
  7420.  
  7421. procedure TVKNestedDBF.InternalOpen;
  7422. begin
  7423.   ParentDataSet.CreateNestedStream(self, DataSetField, self.InnerStream);
  7424.   OEM := ParentDataSet.OEM;
  7425.   SetDeleted := ParentDataSet.SetDeleted;
  7426.   inherited InternalOpen;
  7427. end;
  7428.  
  7429. procedure TVKNestedDBF.InternalPost;
  7430. begin
  7431.   inherited InternalPost;
  7432.   SaveToDBT(TMemoryStream(self.InnerStream), DataSetField);
  7433. end;
  7434.  
  7435. procedure TVKNestedDBF.LobHandlerCreate;
  7436. begin
  7437.   // Nothing to do
  7438. end;
  7439.  
  7440. procedure TVKNestedDBF.LobHandlerDestroy;
  7441. begin
  7442.   // Nothing to do
  7443. end;
  7444.  
  7445. procedure TVKNestedDBF.OpenLobStream(dbf_id: Byte);
  7446. begin
  7447.   // Nothing to do
  7448. end;
  7449.  
  7450. procedure TVKNestedDBF.PackLobHandlerClose(LobName, TempLobName: String);
  7451. begin
  7452.   SaveToDBT(TMemoryStream(self.InnerStream), DataSetField);
  7453. end;
  7454.  
  7455. procedure TVKNestedDBF.PackLobHandlerCreate;
  7456. begin
  7457.   // Nothing to do
  7458. end;
  7459.  
  7460. procedure TVKNestedDBF.PackLobHandlerDestroy;
  7461. begin
  7462.   // Nothing to do
  7463. end;
  7464.  
  7465. procedure TVKNestedDBF.PackLobHandlerOpen(TempLobName: String);
  7466. begin
  7467.   // Nothing to do
  7468. end;
  7469.  
  7470. procedure TVKNestedDBF.SetDataSetField(const Value: TDataSetField);
  7471. begin
  7472.   inherited SetDataSetField(Value);
  7473.   if ParentDataSet <> nil then
  7474.     LobHandler := ParentDataSet.LobHandler;
  7475. end;
  7476.  
  7477. end.
  7478.