home *** CD-ROM | disk | FTP | other *** search
/ Chip 2003 January / Chip_2003-01_cd1.bin / zkuste / delphi / kompon / d56 / VKDBF.ZIP / VKDBFIndex.pas < prev    next >
Pascal/Delphi Source File  |  2002-09-24  |  31KB  |  1,197 lines
  1. unit VKDBFIndex;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, db,
  7.   {$IFDEF VER140} Variants, {$ENDIF}
  8.   VKDBFPrx;
  9.  
  10. type
  11.  
  12.   TCLIPPER_VERSION = (v500, v501, v520, v530);
  13.   TDBFIndexType = (itNotDefined, itNTX, itNDX, itMDX, itIDX, itCDX);
  14.  
  15.   TIndexAttributes = packed record
  16.     key_size: WORD;
  17.     key_dec: WORD;
  18.     key_expr: String;
  19.     for_expr: String;
  20.   end;
  21.   pIndexAttributes = ^TIndexAttributes;
  22.  
  23.   TOnSubIndex = procedure(Sender: TObject; var ItemKey: String; RecordNum: DWORD) of object;
  24.   TOnSubNtx = procedure(Sender: TObject; var ItemKey: String; RecordNum: DWORD; var Accept: boolean) of object;
  25.   TOnEvaluteKey = procedure(Sender: TObject; out Key: String) of object;
  26.   TOnEvaluteFor = procedure(Sender: TObject; out ForValue: boolean) of object;
  27.   TOnCompareKeys = procedure(Sender: TObject; CurrentKey, ItemKey: PChar; MaxLen: Cardinal; out c: Integer) of object;
  28.   TOnCreateIndex = procedure(Sender: TObject; var IndAttr: TIndexAttributes) of object;
  29.  
  30.   TVKDBFOrder = class;
  31.  
  32.   {TVKDBFOrders}
  33.   TVKDBFOrders = class(TOwnedCollection)
  34.   private
  35.  
  36.     {$IFDEF VER130}
  37.     function GetCollectionOwner: TPersistent;
  38.     {$ENDIF}
  39.     function GetItem(Index: Integer): TVKDBFOrder;
  40.     procedure SetItem(Index: Integer; const Value: TVKDBFOrder);
  41.     function GetOwnerTable: TDataSet;
  42.  
  43.   public
  44.  
  45.     constructor Create(AOwner: TPersistent; ItemClass: TCollectionItemClass);
  46.     procedure AssignValues(Value: TVKDBFOrders);
  47.     function FindIndex(const Value: string): TVKDBFOrder;
  48.     function IsEqual(Value: TVKDBFOrders): Boolean;
  49.     {$IFDEF VER130}
  50.     property Owner: TPersistent read GetCollectionOwner;
  51.     {$ENDIF}
  52.     property Items[Index: Integer]: TVKDBFOrder read GetItem write SetItem; default;
  53.  
  54.     property OwnerTable: TDataSet read GetOwnerTable;
  55.  
  56.   end;
  57.  
  58.   {TVKDBFOrder}
  59.   TVKDBFOrder = class(TCollectionItem)
  60.   private
  61.  
  62.     FName: String;
  63.     FCl501Rus: boolean;
  64.     FKeyTranslate: boolean;
  65.     FDesc: boolean;
  66.     FTemp: boolean;
  67.     FUnique: boolean;
  68.     FForExpresion: String;
  69.     FKeyExpresion: String;
  70.     FClipperVer: TCLIPPER_VERSION;
  71.  
  72.     FOnCompareKeys: TOnCompareKeys;
  73.     FOnCreateIndex: TOnCreateIndex;
  74.     FOnEvaluteFor: TOnEvaluteFor;
  75.     FOnEvaluteKey: TOnEvaluteKey;
  76.  
  77.     function GetOwnerTable: TDataSet;
  78.  
  79.   protected
  80.  
  81.     function GetDisplayName: string; override;
  82.  
  83.   public
  84.  
  85.     constructor Create(Collection: TCollection); override;
  86.     destructor Destroy; override;
  87.  
  88.     procedure Assign(Source: TPersistent); override;
  89.     function IsEqual(Value: TVKDBFOrder): Boolean;
  90.  
  91.     function CreateOrder: boolean; virtual;
  92.  
  93.     property OwnerTable: TDataSet read GetOwnerTable;
  94.  
  95.   published
  96.  
  97.     property Name: String read FName write FName;
  98.  
  99.     property KeyExpresion: String read FKeyExpresion write FKeyExpresion;
  100.     property ForExpresion: String read FForExpresion write FForExpresion;
  101.     property KeyTranslate: boolean read FKeyTranslate write FKeyTranslate default true;
  102.     property Clipper501RusOrder: boolean read FCl501Rus write FCl501Rus;
  103.     property Unique: boolean read FUnique write FUnique;
  104.     property Desc: boolean read FDesc write FDesc;
  105.     property Temp: boolean read FTemp write FTemp;
  106.     property ClipperVer: TCLIPPER_VERSION read FClipperVer write FClipperVer default v500;
  107.  
  108.     property OnEvaluteKey: TOnEvaluteKey read FOnEvaluteKey write FOnEvaluteKey;
  109.     property OnEvaluteFor: TOnEvaluteFor read FOnEvaluteFor write FOnEvaluteFor;
  110.     property OnCompareKeys: TOnCompareKeys read FOnCompareKeys write FOnCompareKeys;
  111.     property OnCreateIndex: TOnCreateIndex read FOnCreateIndex write FOnCreateIndex;
  112.  
  113.   end;
  114.  
  115.   TVKDBFIndexBag = class;
  116.  
  117.   {TVKDBFIndexDefs}
  118.   TVKDBFIndexDefs = class(TOwnedCollection)
  119.   private
  120.  
  121.     FIndexType: TDBFIndexType;
  122.  
  123.     {$IFDEF VER130}
  124.     function GetCollectionOwner: TPersistent;
  125.     {$ENDIF}
  126.     function GetItem(Index: Integer): TVKDBFIndexBag;
  127.     procedure SetItem(Index: Integer; const Value: TVKDBFIndexBag);
  128.     function GetOwnerTable: TDataSet;
  129.  
  130.   public
  131.  
  132.     constructor Create(AOwner: TPersistent; ItemClass: TCollectionItemClass);
  133.     procedure AssignValues(Value: TVKDBFIndexDefs);
  134.     function FindIndex(const Value: string): TVKDBFIndexBag;
  135.     function IsEqual(Value: TVKDBFIndexDefs): Boolean;
  136.  
  137.     {$IFDEF VER130}
  138.     property Owner: TPersistent read GetCollectionOwner;
  139.     {$ENDIF}
  140.     property Items[Index: Integer]: TVKDBFIndexBag read GetItem write SetItem; default;
  141.  
  142.     property OwnerTable: TDataSet read GetOwnerTable;
  143.  
  144.   end;
  145.  
  146.   {TVKDBFIndexBag}
  147.   TVKDBFIndexBag = class(TCollectionItem)
  148.   private
  149.  
  150.     FName: String;
  151.     FIndexFileName: String;
  152.     FStorageType: TProxyStreamType;
  153.     FOuterStream: TStream;
  154.     FOrders: TVKDBFOrders;
  155.     function GetInnerStream: TStream;
  156.     procedure SetOrders(const Value: TVKDBFOrders);
  157.  
  158.     procedure ReadOrderData(Reader: TReader);
  159.     procedure WriteOrderData(Writer: TWriter);
  160.     procedure SetIndexFileName(const Value: String);
  161.     function GetOwnerTable: TDataSet;
  162.  
  163.   protected
  164.  
  165.     Handler: TProxyStream;
  166.  
  167.     function GetDisplayName: string; override;
  168.  
  169.   public
  170.  
  171.     constructor Create(Collection: TCollection); override;
  172.     destructor Destroy; override;
  173.  
  174.     procedure Assign(Source: TPersistent); override;
  175.     function IsEqual(Value: TVKDBFIndexBag): Boolean;
  176.  
  177.     procedure DefineProperties(Filer: TFiler); override;
  178.  
  179.     function CreateBag: boolean; virtual;
  180.     function Open: boolean; virtual;
  181.     function IsOpen: boolean; virtual;
  182.     procedure Close; virtual;
  183.  
  184.     property OwnerTable: TDataSet read GetOwnerTable;
  185.  
  186.     property OuterStream: TStream read FOuterStream write FOuterStream;
  187.     property InnerStream: TStream read GetInnerStream;
  188.  
  189.   published
  190.  
  191.     property Orders: TVKDBFOrders read FOrders write SetOrders stored false;
  192.     property Name: String read FName write FName;
  193.     property IndexFileName: String read FIndexFileName write SetIndexFileName;
  194.     property StorageType: TProxyStreamType read FStorageType write FStorageType;
  195.  
  196.   end;
  197.  
  198.   TIndex = class;
  199.  
  200.   {TIndexes}
  201.   TIndexes = class(TOwnedCollection)
  202.   private
  203.  
  204.     FIndexType: TDBFIndexType;
  205.     FActiveObject: TIndex;
  206.     {$IFDEF VER130}
  207.     function GetCollectionOwner: TPersistent;
  208.     {$ENDIF}
  209.     function GetItem(Index: Integer): TIndex;
  210.     procedure SetItem(Index: Integer; const Value: TIndex);
  211.  
  212.   public
  213.  
  214.     constructor Create(AOwner: TPersistent; ItemClass: TCollectionItemClass);
  215.     procedure AssignValues(Value: TIndexes);
  216.     function FindIndex(const Value: string): TIndex;
  217.     function IsEqual(Value: TIndexes): Boolean;
  218.     function CreateIndex(IndexName: String): TIndex;
  219.     procedure CloseAll;
  220.     {$IFDEF VER130}
  221.     property Owner: TPersistent read GetCollectionOwner;
  222.     {$ENDIF}
  223.     property Items[Index: Integer]: TIndex read GetItem write SetItem; default;
  224.     property IndexType: TDBFIndexType read FIndexType write FIndexType;
  225.     property ActiveObject: TIndex read FActiveObject write FActiveObject;
  226.  
  227.   end;
  228.  
  229.   {TIndex}
  230.   TIndex = class(TCollectionItem)
  231.   private
  232.  
  233.     b_R: boolean;
  234.     FBagName: String;
  235.     FIndexBag: TVKDBFIndexBag;
  236.     FIndexOrder: TVKDBFOrder;
  237.  
  238.     procedure SetActive(const Value: boolean);
  239.  
  240.   protected
  241.  
  242.     FName: String;
  243.     FIndexes: TIndexes;
  244.     FActive: boolean;
  245.  
  246.     FOnSubIndex: TOnSubIndex;
  247.     FOnEvaluteFor: TOnEvaluteFor;
  248.     FOnEvaluteKey: TOnEvaluteKey;
  249.     FOnCompareKeys: TOnCompareKeys;
  250.     FOnCreateIndex: TOnCreateIndex;
  251.  
  252.     function GetIsRanged: boolean; virtual;
  253.     procedure AssignIndex(oInd: TIndex);
  254.     function GetDisplayName: string; override;
  255.     function InternalFirst: TGetResult; virtual;
  256.     function InternalNext: TGetResult; virtual;
  257.     function InternalPrior: TGetResult; virtual;
  258.     function InternalLast: TGetResult; virtual;
  259.     function GetCurrentKey: String; virtual;
  260.     function GetCurrentRec: DWORD; virtual;
  261.  
  262.     function GetOrder: String; virtual;
  263.     procedure SetOrder(Value: String); virtual;
  264.  
  265.     procedure DefineBag; virtual;
  266.     procedure DefineBagAndOrder; virtual;
  267.  
  268.   public
  269.  
  270.     FOldEditKey: String;
  271.     FOldEditRec: Longint;
  272.  
  273.     constructor Create(Collection: TCollection); override;
  274.     destructor Destroy; override;
  275.     procedure Assign(Source: TPersistent); override;
  276.     function IsEqual(Value: TIndex): Boolean; virtual;
  277.     function Open: boolean; virtual;
  278.     procedure Close; virtual;
  279.     function IsOpen: boolean; virtual;
  280.     function SetToRecord: boolean; overload; virtual;
  281.     function SetToRecord(Key: String; Rec: Longint): boolean; overload; virtual;
  282.     function SetToRecord(Rec: Longint): boolean; overload; virtual;
  283.     function Seek(Key: String; SoftSeek: boolean = false): boolean; virtual;
  284.     function SeekFirst( Key: String; SoftSeek: boolean = false;
  285.                         PartialKey: boolean = false): boolean; virtual;
  286.     function SeekFirstRecord( Key: String; SoftSeek: boolean = false;
  287.                               PartialKey: boolean = false): Integer; virtual;
  288.     function SeekFields(const KeyFields: string; const KeyValues: Variant;
  289.                         SoftSeek: boolean = false;
  290.                         PartialKey: boolean = false): Integer; virtual;
  291.     function FindKey(Key: String; PartialKey: boolean = false; SoftSeek: boolean = false; Rec: DWORD = 0): Integer; virtual;
  292.     function FindKeyFields( const KeyFields: string; const KeyValues: Variant;
  293.                             PartialKey: boolean = false): Integer; overload; virtual;
  294.     function FindKeyFields( const KeyFields: string; const KeyValues: array of const;
  295.                             PartialKey: boolean = false): Integer; overload; virtual;
  296.     function FindKeyFields( PartialKey: boolean = false): Integer; overload; virtual;
  297.     function SubIndex(LowKey, HiKey: String): boolean; virtual;
  298.     function FillFirstBufRecords(DBFHandler: TProxyStream; FBuffer: pChar; FRecordsPerBuf: Integer; FRecordSize: Integer; FBufInd: pLongint; data_offset: Word): longint; virtual;
  299.     function FillLastBufRecords(DBFHandler: TProxyStream; FBuffer: pChar; FRecordsPerBuf: Integer; FRecordSize: Integer; FBufInd: pLongint; data_offset: Word): longint; virtual;
  300.     function EvaluteKeyExpr: String; virtual;
  301.     function SuiteFieldList(fl: String; out m: Integer): Integer; virtual;
  302.     function EvaluteForExpr: boolean; virtual;
  303.     function GetRecordByIndex(GetMode: TGetMode; var cRec: Longint): TGetResult; virtual;
  304.     function GetFirstByIndex(var cRec: Longint): TGetResult; virtual;
  305.     function GetLastByIndex(var cRec: Longint): TGetResult; virtual;
  306.     procedure First; virtual;
  307.     procedure Next; virtual;
  308.     procedure Prior; virtual;
  309.     procedure Last; virtual;
  310.     function LastKey(out LastKey: String; out LastRec: LongInt): boolean; virtual;
  311.     function NextBuffer(DBFHandler: TProxyStream; FBuffer: pChar; FRecordsPerBuf: Integer; FRecordSize: Integer; FBufInd: pLongint; data_offset: Word): Longint; virtual;
  312.     function PriorBuffer(DBFHandler: TProxyStream; FBuffer: pChar; FRecordsPerBuf: Integer; FRecordSize: Integer; FBufInd: pLongint; data_offset: Word): Longint; virtual;
  313.     procedure CreateIndex(Activate: boolean = true); virtual;
  314.     procedure CreateCompactIndex(BlockBufferSize: LongWord = 4096; Activate: boolean = true); virtual;
  315.     procedure Reindex(Activate: boolean = true); virtual;
  316.     procedure SetRangeFields(FieldList: String; FieldValues: array of const); overload; virtual;
  317.     procedure SetRangeFields(FieldList: String; FieldValues: variant); overload; virtual;
  318.     function InRange(Key: String): boolean; overload; virtual;
  319.     function InRange: boolean; overload; virtual;
  320.  
  321.     function FLock: boolean; virtual;
  322.     function FUnLock: boolean; virtual;
  323.  
  324.     procedure StartUpdate(UnLock: boolean = true); virtual;
  325.     procedure Flush; virtual;
  326.  
  327.     procedure DeleteKey(sKey: String; nRec: Longint); virtual;
  328.     procedure AddKey(sKey: String; nRec: Longint); virtual;
  329.  
  330.     procedure Truncate; virtual;
  331.  
  332.     procedure BeginCreateIndexProcess; virtual;
  333.     procedure EvaluteAndAddKey(nRec: DWORD); virtual;
  334.     procedure EndCreateIndexProcess; virtual;
  335.  
  336.     procedure ArrayOfConstant2Variant(const InputValue: array of const; var Value: Variant);
  337.  
  338.     function IsUniqueIndex: boolean; virtual;
  339.     function IsForIndex: boolean; virtual;
  340.  
  341.     property Order: String read GetOrder write SetOrder;
  342.  
  343.     property IndexBag: TVKDBFIndexBag read FIndexBag write FIndexBag;
  344.     property IndexOrder: TVKDBFOrder read FIndexOrder write FIndexOrder;
  345.  
  346.     property IsRanged: boolean read GetIsRanged;
  347.     property CurrentKey: String read GetCurrentKey;
  348.     property CurrentRec: DWORD read GetCurrentRec;
  349.  
  350.     property OnSubIndex: TOnSubIndex read FOnSubIndex write FOnSubIndex;
  351.     property OnEvaluteKey: TOnEvaluteKey read FOnEvaluteKey write FOnEvaluteKey;
  352.     property OnEvaluteFor: TOnEvaluteFor read FOnEvaluteFor write FOnEvaluteFor;
  353.     property OnCompareKeys: TOnCompareKeys read FOnCompareKeys write FOnCompareKeys;
  354.     property OnCreateIndex: TOnCreateIndex read FOnCreateIndex write FOnCreateIndex;
  355.  
  356.   published
  357.  
  358.     property Name: String read FName write FName;
  359.     property BagName: String read FBagName write FBagName;
  360.     property Active: boolean read FActive write SetActive;
  361.  
  362.   end;
  363.  
  364. implementation
  365.  
  366. uses
  367.    VKDBFDataSet, VKDBFNTX, VKDBFCDX, VKDBFParser;
  368.  
  369. { TIndexes }
  370.  
  371. procedure TIndexes.AssignValues(Value: TIndexes);
  372. var
  373.   I: Integer;
  374.   P: TIndex;
  375. begin
  376.   for I := 0 to Value.Count - 1 do
  377.   begin
  378.     P := FindIndex(Value[I].Name);
  379.     if P <> nil then
  380.       P.Assign(Value[I]);
  381.   end;
  382. end;
  383.  
  384. procedure TIndexes.CloseAll;
  385. var
  386.   I: Integer;
  387.  
  388.   function FindOpened(var Ind: Integer): boolean;
  389.   var
  390.     i: Integer;
  391.   begin
  392.     Result := false;
  393.     for i := 0 to Count - 1 do
  394.       if Items[i].IsOpen then begin
  395.         Ind := i;
  396.         Result := true;
  397.         Exit;
  398.       end;
  399.   end;
  400.  
  401. begin
  402.   while FindOpened(I) do Items[I].Close;
  403. end;
  404.  
  405. constructor TIndexes.Create(AOwner: TPersistent;
  406.   ItemClass: TCollectionItemClass);
  407. begin
  408.   inherited Create(AOwner, ItemClass);
  409.   if ItemClass.ClassName = 'TVKNTXIndex' then
  410.     FIndexType := itNTX
  411.   else if ItemClass.ClassName = 'TVKNDXIndex' then
  412.     FIndexType := itNDX
  413.   else if ItemClass.ClassName = 'TVKMDXIndex' then
  414.     FIndexType := itMDX
  415.   else if ItemClass.ClassName = 'TVKCDXIndex' then
  416.     FIndexType := itCDX
  417.   else
  418.     FIndexType := itNotDefined;
  419.   FActiveObject := nil;
  420. end;
  421.  
  422. function TIndexes.CreateIndex(IndexName: String): TIndex;
  423. begin
  424.   case FIndexType of
  425.     itNotDefined: raise Exception.Create('TIndex: IndexType not defined.');
  426.     itNTX: Result := Add as TVKNTXIndex;
  427.     //itNDX: Result := Add as TVKNDXIndex;
  428.     //itMDX: Result := Add as TVKMDXIndex;
  429.     itCDX: Result := Add as TVKCDXIndex;
  430.   else
  431.     Result := Add as TIndex;
  432.   end;
  433.   Result.Name := IndexName;
  434. end;
  435.  
  436. function TIndexes.FindIndex(const Value: string): TIndex;
  437. var
  438.   I: Integer;
  439. begin
  440.   for I := 0 to Count - 1 do
  441.   begin
  442.     Result := TIndex(inherited Items[I]);
  443.     if AnsiCompareText(Result.Name, Value) = 0 then Exit;
  444.   end;
  445.   Result := nil;
  446. end;
  447.  
  448. {$IFDEF VER130}
  449. function TIndexes.GetCollectionOwner: TPersistent;
  450. begin
  451.   Result := GetOwner;
  452. end;
  453. {$ENDIF}
  454.  
  455. function TIndexes.GetItem(Index: Integer): TIndex;
  456. begin
  457.   Result := TIndex(inherited Items[Index]);
  458. end;
  459.  
  460. function TIndexes.IsEqual(Value: TIndexes): Boolean;
  461. var
  462.   I: Integer;
  463. begin
  464.   Result := (Count = Value.Count);
  465.   if Result then
  466.     for I := 0 to Count - 1 do
  467.     begin
  468.       Result := TIndex(Items[I]).IsEqual(TIndex(Value.Items[I]));
  469.       if not Result then Break;
  470.     end
  471. end;
  472.  
  473. procedure TIndexes.SetItem(Index: Integer; const Value: TIndex);
  474. begin
  475.   inherited SetItem(Index, TCollectionItem(Value));
  476. end;
  477.  
  478. { TIndex }
  479.  
  480. procedure TIndex.AddKey(sKey: String; nRec: Integer);
  481. begin
  482.   //
  483. end;
  484.  
  485. procedure TIndex.Assign(Source: TPersistent);
  486. begin
  487.   if Source is TIndex then
  488.     AssignIndex(TIndex(Source))
  489.   else
  490.     inherited Assign(Source);
  491. end;
  492.  
  493. procedure TIndex.AssignIndex(oInd: TIndex);
  494. begin
  495.   if oInd <> nil then
  496.   begin
  497.     Name := oInd.Name;
  498.   end;
  499. end;
  500.  
  501. procedure TIndex.Close;
  502. begin
  503.   //
  504. end;
  505.  
  506. constructor TIndex.Create(Collection: TCollection);
  507. begin
  508.   inherited Create(Collection);
  509.   FIndexes := TIndexes(Collection);
  510.   b_R := false;
  511. end;
  512.  
  513. procedure TIndex.CreateIndex(Activate: boolean = true);
  514. begin
  515.   //
  516. end;
  517.  
  518. procedure TIndex.DeleteKey(sKey: String; nRec: Integer);
  519. begin
  520.   //
  521. end;
  522.  
  523. destructor TIndex.Destroy;
  524. begin
  525.   inherited Destroy;
  526. end;
  527.  
  528. function TIndex.EvaluteForExpr: boolean;
  529. begin
  530.   Result := false;
  531. end;
  532.  
  533. function TIndex.EvaluteKeyExpr: String;
  534. begin
  535.   Result := '';
  536. end;
  537.  
  538. function TIndex.FillFirstBufRecords(DBFHandler: TProxyStream; FBuffer: pChar;
  539.   FRecordsPerBuf, FRecordSize: Integer;
  540.   FBufInd: pLongint; data_offset: Word): longint;
  541. begin
  542.   Result := 0;
  543. end;
  544.  
  545. function TIndex.FillLastBufRecords(DBFHandler: TProxyStream; FBuffer: pChar;
  546.   FRecordsPerBuf, FRecordSize: Integer; FBufInd: pLongint;
  547.   data_offset: Word): longint;
  548. begin
  549.   Result := 0;
  550. end;
  551.  
  552. procedure TIndex.First;
  553. begin
  554.   //
  555. end;
  556.  
  557. function TIndex.FLock: boolean;
  558. begin
  559.   Result := false;
  560. end;
  561.  
  562. function TIndex.FUnLock: boolean;
  563. begin
  564.   Result := false;
  565. end;
  566.  
  567. function TIndex.GetCurrentKey: String;
  568. begin
  569.   Result := '';
  570. end;
  571.  
  572. function TIndex.GetCurrentRec: DWORD;
  573. begin
  574.   Result := 0;
  575. end;
  576.  
  577. function TIndex.GetDisplayName: string;
  578. begin
  579.   if Name <> '' then
  580.     Result := Name
  581.   else
  582.     Result := inherited GetDisplayName;
  583. end;
  584.  
  585. function TIndex.GetFirstByIndex(var cRec: Integer): TGetResult;
  586. begin
  587.   Result := grError;
  588. end;
  589.  
  590. function TIndex.GetLastByIndex(var cRec: Integer): TGetResult;
  591. begin
  592.   Result := grError;
  593. end;
  594.  
  595. function TIndex.GetRecordByIndex(GetMode: TGetMode;
  596.   var cRec: Integer): TGetResult;
  597. begin
  598.   Result := grError;
  599. end;
  600.  
  601. function TIndex.InternalFirst: TGetResult;
  602. begin
  603.   Result := grError;
  604. end;
  605.  
  606. function TIndex.InternalLast: TGetResult;
  607. begin
  608.   Result := grError;
  609. end;
  610.  
  611. function TIndex.InternalNext: TGetResult;
  612. begin
  613.   Result := grError;
  614. end;
  615.  
  616. function TIndex.InternalPrior: TGetResult;
  617. begin
  618.   Result := grError;
  619. end;
  620.  
  621. function TIndex.IsEqual(Value: TIndex): Boolean;
  622. begin
  623.   Result := false;
  624. end;
  625.  
  626. function TIndex.IsOpen: boolean;
  627. begin
  628.   Result := false;
  629. end;
  630.  
  631. procedure TIndex.Last;
  632. begin
  633.   //
  634. end;
  635.  
  636. function TIndex.LastKey(out LastKey: String; out LastRec: Integer): boolean;
  637. begin
  638.   LastKey := '';
  639.   LastRec := -1;
  640.   Result := false;
  641. end;
  642.  
  643. procedure TIndex.Next;
  644. begin
  645.   //
  646. end;
  647.  
  648. function TIndex.NextBuffer(DBFHandler: TProxyStream; FBuffer: pChar; FRecordsPerBuf: Integer; FRecordSize: Integer; FBufInd: pLongint; data_offset: Word): Longint;
  649. begin
  650.   Result := 0;
  651. end;
  652.  
  653. function TIndex.Open: boolean;
  654. begin
  655.   Result := false;
  656. end;
  657.  
  658. procedure TIndex.Prior;
  659. begin
  660.   //
  661. end;
  662.  
  663. function TIndex.PriorBuffer(DBFHandler: TProxyStream; FBuffer: pChar; FRecordsPerBuf: Integer; FRecordSize: Integer; FBufInd: pLongint; data_offset: Word): Longint;
  664. begin
  665.   Result := 0;
  666. end;
  667.  
  668. function TIndex.Seek(Key: String; SoftSeek: boolean): boolean;
  669. begin
  670.   Result := false;
  671. end;
  672.  
  673. function TIndex.SeekFields(const KeyFields: string;
  674.   const KeyValues: Variant; SoftSeek: boolean = false;
  675.   PartialKey: boolean = false): Integer;
  676. begin
  677.   Result := 0;
  678. end;
  679.  
  680. function TIndex.SeekFirst(Key: String; SoftSeek: boolean = false;
  681.                           PartialKey: boolean = false): boolean;
  682. begin
  683.   Result := false;
  684. end;
  685.  
  686. procedure TIndex.SetActive(const Value: boolean);
  687. var
  688.   i: Integer;
  689.   oW: TVKDBFNTX;
  690.   R: Integer;
  691. begin
  692.   if FActive <> Value then begin
  693.     oW := TVKDBFNTX(FIndexes.Owner);
  694.     if Value then begin
  695.       try
  696.         b_R := true;
  697.         for i := 0 to FIndexes.Count - 1 do
  698.           FIndexes.Items[i].Active := false;
  699.       finally
  700.         b_R := false;
  701.       end;
  702.       FIndexes.FActiveObject := self;
  703.       FActive := true;
  704.       if oW.Active then begin
  705.         R := FindKey(EvaluteKeyExpr, False, True, oW.RecNo);
  706.         if R <> 0 then begin
  707.           oW.RecNo := R;
  708.         end else
  709.           oW.First;
  710.       end;
  711.     end else begin
  712.       if ( FIndexes.FActiveObject <> nil ) and ( FIndexes.FActiveObject = self ) then begin
  713.         FIndexes.FActiveObject := nil;
  714.         if not b_R then if oW.Active then oW.RecNo := oW.RecNo;
  715.       end;
  716.     end;
  717.     FActive := Value;
  718.   end;
  719. end;
  720.  
  721. function TIndex.SetToRecord: boolean;
  722. begin
  723.   Result := false;
  724. end;
  725.  
  726. function TIndex.SetToRecord(Key: String; Rec: Integer): boolean;
  727. begin
  728.   Result := false;
  729. end;
  730.  
  731. procedure TIndex.SetRangeFields(FieldList: String;
  732.   FieldValues: array of const);
  733. begin
  734.   //
  735. end;
  736.  
  737. procedure TIndex.SetRangeFields(FieldList: String; FieldValues: variant);
  738. begin
  739.   //
  740. end;
  741.  
  742. function TIndex.SetToRecord(Rec: Integer): boolean;
  743. begin
  744.   Result := false;
  745. end;
  746.  
  747. function TIndex.SubIndex(LowKey, HiKey: String): boolean;
  748. begin
  749.   Result := false;
  750. end;
  751.  
  752. function TIndex.SuiteFieldList(fl: String; out m: Integer): Integer;
  753. begin
  754.   m := 0;
  755.   Result := 0;
  756. end;
  757.  
  758. function TIndex.GetIsRanged: boolean;
  759. begin
  760.   Result := false;
  761. end;
  762.  
  763. function TIndex.InRange(Key: String): boolean;
  764. begin
  765.   Result := false;
  766. end;
  767.  
  768. procedure TIndex.Flush;
  769. begin
  770.   //
  771. end;
  772.  
  773. procedure TIndex.Reindex(Activate: boolean = true);
  774. begin
  775.   //
  776. end;
  777.  
  778. procedure TIndex.StartUpdate(UnLock: boolean = true);
  779. begin
  780. //
  781. end;
  782.  
  783. function TIndex.SeekFirstRecord(Key: String; SoftSeek: boolean = false;
  784.                                 PartialKey: boolean = false): Integer;
  785. begin
  786.   Result := 0;
  787. end;
  788.  
  789. procedure TIndex.Truncate;
  790. begin
  791. //
  792. end;
  793.  
  794. procedure TIndex.BeginCreateIndexProcess;
  795. begin
  796.   //
  797. end;
  798.  
  799. procedure TIndex.EndCreateIndexProcess;
  800. begin
  801.   //
  802. end;
  803.  
  804. procedure TIndex.EvaluteAndAddKey(nRec: DWORD);
  805. begin
  806.   //
  807. end;
  808.  
  809. procedure TIndex.CreateCompactIndex(BlockBufferSize: LongWord;
  810.   Activate: boolean);
  811. begin
  812.   //
  813. end;
  814.  
  815. function TIndex.InRange: boolean;
  816. begin
  817.   Result := false;
  818. end;
  819.  
  820. function TIndex.FindKey(  Key: String; PartialKey: boolean = false;
  821.                           SoftSeek: boolean = false; Rec: DWORD = 0): Integer;
  822. begin
  823.   Result := 0;
  824. end;
  825.  
  826. function TIndex.FindKeyFields(const KeyFields: string;
  827.   const KeyValues: Variant; PartialKey: boolean): Integer;
  828. begin
  829.   Result := 0;
  830. end;
  831.  
  832. procedure TIndex.ArrayOfConstant2Variant(const InputValue: array of const;
  833.   var Value: Variant);
  834. var
  835.   i: Integer;
  836. begin
  837.   Value := VarArrayCreate([0, High(InputValue)], varVariant);
  838.   for i := 0 to High(InputValue) do begin
  839.     with InputValue[I] do
  840.       case VType of
  841.         vtInteger:    Value[i] := VInteger;
  842.         vtBoolean:    Value[i] := VBoolean;
  843.         vtChar:       Value[i] := VChar;
  844.         vtExtended:   Value[i] := VExtended^;
  845.         vtString:     Value[i] := VString^;
  846.         //vtPChar:      Value[i] := VPChar;
  847.         //vtObject:     Value[i] := VObject;
  848.         //vtClass:      Value[i] := VClass;
  849.         vtAnsiString: Value[i] := string(VAnsiString);
  850.         vtCurrency:   Value[i] := VCurrency^;
  851.         vtVariant:    Value[i] := VVariant^;
  852.         //vtInt64:      Value[i] := VInt64^;
  853.     end;
  854.   end;
  855. end;
  856.  
  857. function TIndex.FindKeyFields(const KeyFields: string;
  858.   const KeyValues: array of const; PartialKey: boolean): Integer;
  859. begin
  860.   Result := 0;
  861. end;
  862.  
  863. function TIndex.FindKeyFields(PartialKey: boolean = false): Integer;
  864. begin
  865.   Result := 0;
  866. end;
  867.  
  868. function TIndex.IsForIndex: boolean;
  869. begin
  870.   Result := False;
  871. end;
  872.  
  873. function TIndex.IsUniqueIndex: boolean;
  874. begin
  875.   Result := False;
  876. end;
  877.  
  878. function TIndex.GetOrder: String;
  879. begin
  880.   Result := Name;
  881. end;
  882.  
  883. procedure TIndex.SetOrder(Value: String);
  884. begin
  885.   Name := Value;
  886. end;
  887.  
  888. procedure TIndex.DefineBagAndOrder;
  889. begin
  890.   //
  891. end;
  892.  
  893. procedure TIndex.DefineBag;
  894. begin
  895.   //
  896. end;
  897.  
  898. { TVKDBFIndexBag }
  899.  
  900. procedure TVKDBFIndexBag.Assign(Source: TPersistent);
  901. begin
  902.   inherited Assign(Source);
  903. end;
  904.  
  905. procedure TVKDBFIndexBag.Close;
  906. begin
  907.   Handler.Close;
  908. end;
  909.  
  910. constructor TVKDBFIndexBag.Create(Collection: TCollection);
  911. begin
  912.   inherited Create(Collection);
  913.   FName := 'TVKDBFIndexBag' + IntToStr(Index);
  914.   with Collection as TVKDBFIndexDefs do begin
  915.     case FIndexType of
  916.       itNTX: FOrders := TVKDBFOrders.Create(self, TVKNTXOrder);
  917.       //itNDX:
  918.       //itMDX:
  919.       //itIDX:
  920.       itCDX: FOrders := TVKDBFOrders.Create(self, TVKCDXOrder);
  921.     else
  922.       FOrders := TVKDBFOrders.Create(self, TVKDBFOrder);
  923.     end;
  924.   end;
  925.   Handler := TProxyStream.Create;
  926.   FStorageType := pstFile;
  927. end;
  928.  
  929. function TVKDBFIndexBag.CreateBag: boolean;
  930. begin
  931.   Result := False;
  932. end;
  933.  
  934. procedure TVKDBFIndexBag.DefineProperties(Filer: TFiler);
  935.  
  936.   function WriteOrderDataB: Boolean;
  937.   begin
  938.     if Filer.Ancestor <> nil then
  939.       Result := not FOrders.IsEqual(TVKDBFIndexBag(Filer.Ancestor).FOrders)
  940.     else
  941.       Result := (FOrders.Count > 0);
  942.   end;
  943.  
  944. begin
  945.   inherited DefineProperties(Filer);
  946.   Filer.DefineProperty('Orders', ReadOrderData, WriteOrderData, WriteOrderDataB);
  947. end;
  948.  
  949. destructor TVKDBFIndexBag.Destroy;
  950. begin
  951.   FOrders.Destroy;
  952.   FOrders := nil;
  953.   inherited Destroy;
  954. end;
  955.  
  956. function TVKDBFIndexBag.GetDisplayName: string;
  957. begin
  958.   Result := Name;
  959. end;
  960.  
  961. function TVKDBFIndexBag.GetInnerStream: TStream;
  962. begin
  963.   Result := Handler.InnerStream;
  964. end;
  965.  
  966. function TVKDBFIndexBag.GetOwnerTable: TDataSet;
  967. begin
  968.   Result := (Collection as TVKDBFIndexDefs).OwnerTable;
  969. end;
  970.  
  971. function TVKDBFIndexBag.IsEqual(Value: TVKDBFIndexBag): Boolean;
  972. begin
  973.   Result := false;
  974. end;
  975.  
  976. function TVKDBFIndexBag.IsOpen: boolean;
  977. begin
  978.   Result := False;
  979. end;
  980.  
  981. function TVKDBFIndexBag.Open: boolean;
  982. begin
  983.   Result := False;
  984. end;
  985.  
  986. procedure TVKDBFIndexBag.ReadOrderData(Reader: TReader);
  987. begin
  988.   Reader.ReadValue;
  989.   Reader.ReadCollection(FOrders);
  990. end;
  991.  
  992. procedure TVKDBFIndexBag.SetIndexFileName(const Value: String);
  993. begin
  994.   FIndexFileName := Value;
  995.   if FName = 'TVKDBFIndexBag' + IntToStr(Index) then
  996.     FName := ChangeFileExt(ExtractFileName(FIndexFileName), '');
  997.   Handler.FileName := FIndexFileName;
  998. end;
  999.  
  1000. procedure TVKDBFIndexBag.SetOrders(const Value: TVKDBFOrders);
  1001. begin
  1002.   FOrders.Assign(Value);
  1003. end;
  1004.  
  1005. procedure TVKDBFIndexBag.WriteOrderData(Writer: TWriter);
  1006. begin
  1007.   Writer.WriteCollection(FOrders);
  1008. end;
  1009.  
  1010. { TVKDBFIndexDefs }
  1011.  
  1012. procedure TVKDBFIndexDefs.AssignValues(Value: TVKDBFIndexDefs);
  1013. var
  1014.   I: Integer;
  1015.   P: TVKDBFIndexBag;
  1016. begin
  1017.   for I := 0 to Value.Count - 1 do
  1018.   begin
  1019.     P := FindIndex(Value[I].Name);
  1020.     if P <> nil then
  1021.       P.Assign(Value[I]);
  1022.   end;
  1023. end;
  1024.  
  1025.  
  1026. constructor TVKDBFIndexDefs.Create(AOwner: TPersistent;
  1027.   ItemClass: TCollectionItemClass);
  1028. begin
  1029.   inherited Create(AOwner, ItemClass);
  1030.   if ItemClass.ClassName = 'TVKNTXBag' then
  1031.     FIndexType := itNTX
  1032.   else if ItemClass.ClassName = 'TVKNDXBag' then
  1033.     FIndexType := itNDX
  1034.   else if ItemClass.ClassName = 'TVKMDXBag' then
  1035.     FIndexType := itMDX
  1036.   else if ItemClass.ClassName = 'TVKCDXBag' then
  1037.     FIndexType := itCDX
  1038.   else
  1039.     FIndexType := itNotDefined;
  1040. end;
  1041.  
  1042. function TVKDBFIndexDefs.FindIndex(const Value: string): TVKDBFIndexBag;
  1043. var
  1044.   I: Integer;
  1045. begin
  1046.   for I := 0 to Count - 1 do
  1047.   begin
  1048.     Result := TVKDBFIndexBag(inherited Items[I]);
  1049.     if AnsiCompareText(Result.Name, Value) = 0 then Exit;
  1050.   end;
  1051.   Result := nil;
  1052. end;
  1053.  
  1054. {$IFDEF VER130}
  1055. function TVKDBFIndexDefs.GetCollectionOwner: TPersistent;
  1056. begin
  1057.   Result := GetOwner;
  1058. end;
  1059. {$ENDIF}
  1060.  
  1061. function TVKDBFIndexDefs.GetItem(Index: Integer): TVKDBFIndexBag;
  1062. begin
  1063.   Result := TVKDBFIndexBag(inherited Items[Index]);
  1064. end;
  1065.  
  1066. function TVKDBFIndexDefs.GetOwnerTable: TDataSet;
  1067. begin
  1068.   Result := Owner as TDataSet;
  1069. end;
  1070.  
  1071. function TVKDBFIndexDefs.IsEqual(Value: TVKDBFIndexDefs): Boolean;
  1072. var
  1073.   I: Integer;
  1074. begin
  1075.   Result := (Count = Value.Count);
  1076.   if Result then
  1077.     for I := 0 to Count - 1 do
  1078.     begin
  1079.       Result := TVKDBFIndexBag(Items[I]).IsEqual(TVKDBFIndexBag(Value.Items[I]));
  1080.       if not Result then Break;
  1081.     end
  1082. end;
  1083.  
  1084. procedure TVKDBFIndexDefs.SetItem(Index: Integer;
  1085.   const Value: TVKDBFIndexBag);
  1086. begin
  1087.   inherited SetItem(Index, TCollectionItem(Value));
  1088. end;
  1089.  
  1090. { TVKDBFOrders }
  1091.  
  1092. procedure TVKDBFOrders.AssignValues(Value: TVKDBFOrders);
  1093. var
  1094.   I: Integer;
  1095.   P: TVKDBFOrder;
  1096. begin
  1097.   for I := 0 to Value.Count - 1 do
  1098.   begin
  1099.     P := FindIndex(Value[I].Name);
  1100.     if P <> nil then
  1101.       P.Assign(Value[I]);
  1102.   end;
  1103. end;
  1104.  
  1105. constructor TVKDBFOrders.Create(AOwner: TPersistent;
  1106.   ItemClass: TCollectionItemClass);
  1107. begin
  1108.   inherited Create(AOwner, ItemClass);
  1109. end;
  1110.  
  1111. function TVKDBFOrders.FindIndex(const Value: string): TVKDBFOrder;
  1112. var
  1113.   I: Integer;
  1114. begin
  1115.   for I := 0 to Count - 1 do
  1116.   begin
  1117.     Result := TVKDBFOrder(inherited Items[I]);
  1118.     if AnsiCompareText(Result.Name, Value) = 0 then Exit;
  1119.   end;
  1120.   Result := nil;
  1121. end;
  1122.  
  1123. {$IFDEF VER130}
  1124. function TVKDBFOrders.GetCollectionOwner: TPersistent;
  1125. begin
  1126.   Result := GetOwner;
  1127. end;
  1128. {$ENDIF}
  1129.  
  1130. function TVKDBFOrders.GetItem(Index: Integer): TVKDBFOrder;
  1131. begin
  1132.   Result := TVKDBFOrder(inherited Items[Index]);
  1133. end;
  1134.  
  1135. function TVKDBFOrders.GetOwnerTable: TDataSet;
  1136. begin
  1137.   Result := (Owner as TVKDBFIndexBag).OwnerTable;
  1138. end;
  1139.  
  1140. function TVKDBFOrders.IsEqual(Value: TVKDBFOrders): Boolean;
  1141. var
  1142.   I: Integer;
  1143. begin
  1144.   Result := (Count = Value.Count);
  1145.   if Result then
  1146.     for I := 0 to Count - 1 do
  1147.     begin
  1148.       Result := TVKDBFOrder(Items[I]).IsEqual(TVKDBFOrder(Value.Items[I]));
  1149.       if not Result then Break;
  1150.     end
  1151. end;
  1152.  
  1153. procedure TVKDBFOrders.SetItem(Index: Integer; const Value: TVKDBFOrder);
  1154. begin
  1155.   inherited SetItem(Index, TCollectionItem(Value));
  1156. end;
  1157.  
  1158. { TVKDBFOrder }
  1159.  
  1160. procedure TVKDBFOrder.Assign(Source: TPersistent);
  1161. begin
  1162.   inherited Assign(Source);
  1163. end;
  1164.  
  1165. constructor TVKDBFOrder.Create(Collection: TCollection);
  1166. begin
  1167.   inherited Create(Collection);
  1168.   FName := 'TVKDBFOrder' + IntToStr(Index);
  1169. end;
  1170.  
  1171. function TVKDBFOrder.CreateOrder: boolean;
  1172. begin
  1173.   Result := False;
  1174. end;
  1175.  
  1176. destructor TVKDBFOrder.Destroy;
  1177. begin
  1178.   inherited Destroy;
  1179. end;
  1180.  
  1181. function TVKDBFOrder.GetDisplayName: string;
  1182. begin
  1183.   Result := Name;
  1184. end;
  1185.  
  1186. function TVKDBFOrder.GetOwnerTable: TDataSet;
  1187. begin
  1188.   Result := (Collection as TVKDBFOrders).OwnerTable;
  1189. end;
  1190.  
  1191. function TVKDBFOrder.IsEqual(Value: TVKDBFOrder): Boolean;
  1192. begin
  1193.   Result := false;
  1194. end;
  1195.  
  1196. end.
  1197.