Chip 2003 January/ChipCD_1.03.iso/zkuste/delphi/kompon/d56/VKDBF.ZIP/VKDBFIndex.pas

Pascal/Delphi Source File | 2002-09-24 | 30.2 KB | 1,197 lines

unit VKDBFIndex;

interface

uses
  Windows, Messages, SysUtils, Classes, db,
  {$IFDEF VER140} Variants, {$ENDIF}
  VKDBFPrx;

type

  TCLIPPER_VERSION = (v500, v501, v520, v530);
  TDBFIndexType = (itNotDefined, itNTX, itNDX, itMDX, itIDX, itCDX);

  TIndexAttributes = packed record
    key_size: WORD;
    key_dec: WORD;
    key_expr: String;
    for_expr: String;
  end;
  pIndexAttributes = ^TIndexAttributes;

  TOnSubIndex = procedure(Sender: TObject; var ItemKey: String; RecordNum: DWORD) of object;
  TOnSubNtx = procedure(Sender: TObject; var ItemKey: String; RecordNum: DWORD; var Accept: boolean) of object;
  TOnEvaluteKey = procedure(Sender: TObject; out Key: String) of object;
  TOnEvaluteFor = procedure(Sender: TObject; out ForValue: boolean) of object;
  TOnCompareKeys = procedure(Sender: TObject; CurrentKey, ItemKey: PChar; MaxLen: Cardinal; out c: Integer) of object;
  TOnCreateIndex = procedure(Sender: TObject; var IndAttr: TIndexAttributes) of object;

  TVKDBFOrder = class;

  {TVKDBFOrders}
  TVKDBFOrders = class(TOwnedCollection)
  private

    {$IFDEF VER130}
    function GetCollectionOwner: TPersistent;
    {$ENDIF}
    function GetItem(Index: Integer): TVKDBFOrder;
    procedure SetItem(Index: Integer; const Value: TVKDBFOrder);
    function GetOwnerTable: TDataSet;

  public

    constructor Create(AOwner: TPersistent; ItemClass: TCollectionItemClass);
    procedure AssignValues(Value: TVKDBFOrders);
    function FindIndex(const Value: string): TVKDBFOrder;
    function IsEqual(Value: TVKDBFOrders): Boolean;
    {$IFDEF VER130}
    property Owner: TPersistent read GetCollectionOwner;
    {$ENDIF}
    property Items[Index: Integer]: TVKDBFOrder read GetItem write SetItem; default;

    property OwnerTable: TDataSet read GetOwnerTable;

  end;

  {TVKDBFOrder}
  TVKDBFOrder = class(TCollectionItem)
  private

    FName: String;
    FCl501Rus: boolean;
    FKeyTranslate: boolean;
    FDesc: boolean;
    FTemp: boolean;
    FUnique: boolean;
    FForExpresion: String;
    FKeyExpresion: String;
    FClipperVer: TCLIPPER_VERSION;

    FOnCompareKeys: TOnCompareKeys;
    FOnCreateIndex: TOnCreateIndex;
    FOnEvaluteFor: TOnEvaluteFor;
    FOnEvaluteKey: TOnEvaluteKey;

    function GetOwnerTable: TDataSet;

  protected

    function GetDisplayName: string; override;

  public

    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;

    procedure Assign(Source: TPersistent); override;
    function IsEqual(Value: TVKDBFOrder): Boolean;

    function CreateOrder: boolean; virtual;

    property OwnerTable: TDataSet read GetOwnerTable;

  published

    property Name: String read FName write FName;

    property KeyExpresion: String read FKeyExpresion write FKeyExpresion;
    property ForExpresion: String read FForExpresion write FForExpresion;
    property KeyTranslate: boolean read FKeyTranslate write FKeyTranslate default true;
    property Clipper501RusOrder: boolean read FCl501Rus write FCl501Rus;
    property Unique: boolean read FUnique write FUnique;
    property Desc: boolean read FDesc write FDesc;
    property Temp: boolean read FTemp write FTemp;
    property ClipperVer: TCLIPPER_VERSION read FClipperVer write FClipperVer default v500;

    property OnEvaluteKey: TOnEvaluteKey read FOnEvaluteKey write FOnEvaluteKey;
    property OnEvaluteFor: TOnEvaluteFor read FOnEvaluteFor write FOnEvaluteFor;
    property OnCompareKeys: TOnCompareKeys read FOnCompareKeys write FOnCompareKeys;
    property OnCreateIndex: TOnCreateIndex read FOnCreateIndex write FOnCreateIndex;

  end;

  TVKDBFIndexBag = class;

  {TVKDBFIndexDefs}
  TVKDBFIndexDefs = class(TOwnedCollection)
  private

    FIndexType: TDBFIndexType;

    {$IFDEF VER130}
    function GetCollectionOwner: TPersistent;
    {$ENDIF}
    function GetItem(Index: Integer): TVKDBFIndexBag;
    procedure SetItem(Index: Integer; const Value: TVKDBFIndexBag);
    function GetOwnerTable: TDataSet;

  public

    constructor Create(AOwner: TPersistent; ItemClass: TCollectionItemClass);
    procedure AssignValues(Value: TVKDBFIndexDefs);
    function FindIndex(const Value: string): TVKDBFIndexBag;
    function IsEqual(Value: TVKDBFIndexDefs): Boolean;

    {$IFDEF VER130}
    property Owner: TPersistent read GetCollectionOwner;
    {$ENDIF}
    property Items[Index: Integer]: TVKDBFIndexBag read GetItem write SetItem; default;

    property OwnerTable: TDataSet read GetOwnerTable;

  end;

  {TVKDBFIndexBag}
  TVKDBFIndexBag = class(TCollectionItem)
  private

    FName: String;
    FIndexFileName: String;
    FStorageType: TProxyStreamType;
    FOuterStream: TStream;
    FOrders: TVKDBFOrders;
    function GetInnerStream: TStream;
    procedure SetOrders(const Value: TVKDBFOrders);

    procedure ReadOrderData(Reader: TReader);
    procedure WriteOrderData(Writer: TWriter);
    procedure SetIndexFileName(const Value: String);
    function GetOwnerTable: TDataSet;

  protected

    Handler: TProxyStream;

    function GetDisplayName: string; override;

  public

    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;

    procedure Assign(Source: TPersistent); override;
    function IsEqual(Value: TVKDBFIndexBag): Boolean;

    procedure DefineProperties(Filer: TFiler); override;

    function CreateBag: boolean; virtual;
    function Open: boolean; virtual;
    function IsOpen: boolean; virtual;
    procedure Close; virtual;

    property OwnerTable: TDataSet read GetOwnerTable;

    property OuterStream: TStream read FOuterStream write FOuterStream;
    property InnerStream: TStream read GetInnerStream;

  published

    property Orders: TVKDBFOrders read FOrders write SetOrders stored false;
    property Name: String read FName write FName;
    property IndexFileName: String read FIndexFileName write SetIndexFileName;
    property StorageType: TProxyStreamType read FStorageType write FStorageType;

  end;

  TIndex = class;

  {TIndexes}
  TIndexes = class(TOwnedCollection)
  private

    FIndexType: TDBFIndexType;
    FActiveObject: TIndex;
    {$IFDEF VER130}
    function GetCollectionOwner: TPersistent;
    {$ENDIF}
    function GetItem(Index: Integer): TIndex;
    procedure SetItem(Index: Integer; const Value: TIndex);

  public

    constructor Create(AOwner: TPersistent; ItemClass: TCollectionItemClass);
    procedure AssignValues(Value: TIndexes);
    function FindIndex(const Value: string): TIndex;
    function IsEqual(Value: TIndexes): Boolean;
    function CreateIndex(IndexName: String): TIndex;
    procedure CloseAll;
    {$IFDEF VER130}
    property Owner: TPersistent read GetCollectionOwner;
    {$ENDIF}
    property Items[Index: Integer]: TIndex read GetItem write SetItem; default;
    property IndexType: TDBFIndexType read FIndexType write FIndexType;
    property ActiveObject: TIndex read FActiveObject write FActiveObject;

  end;

  {TIndex}
  TIndex = class(TCollectionItem)
  private

    b_R: boolean;
    FBagName: String;
    FIndexBag: TVKDBFIndexBag;
    FIndexOrder: TVKDBFOrder;

    procedure SetActive(const Value: boolean);

  protected

    FName: String;
    FIndexes: TIndexes;
    FActive: boolean;

    FOnSubIndex: TOnSubIndex;
    FOnEvaluteFor: TOnEvaluteFor;
    FOnEvaluteKey: TOnEvaluteKey;
    FOnCompareKeys: TOnCompareKeys;
    FOnCreateIndex: TOnCreateIndex;

    function GetIsRanged: boolean; virtual;
    procedure AssignIndex(oInd: TIndex);
    function GetDisplayName: string; override;
    function InternalFirst: TGetResult; virtual;
    function InternalNext: TGetResult; virtual;
    function InternalPrior: TGetResult; virtual;
    function InternalLast: TGetResult; virtual;
    function GetCurrentKey: String; virtual;
    function GetCurrentRec: DWORD; virtual;

    function GetOrder: String; virtual;
    procedure SetOrder(Value: String); virtual;

    procedure DefineBag; virtual;
    procedure DefineBagAndOrder; virtual;

  public

    FOldEditKey: String;
    FOldEditRec: Longint;

    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    function IsEqual(Value: TIndex): Boolean; virtual;
    function Open: boolean; virtual;
    procedure Close; virtual;
    function IsOpen: boolean; virtual;
    function SetToRecord: boolean; overload; virtual;
    function SetToRecord(Key: String; Rec: Longint): boolean; overload; virtual;
    function SetToRecord(Rec: Longint): boolean; overload; virtual;
    function Seek(Key: String; SoftSeek: boolean = false): boolean; virtual;
    function SeekFirst( Key: String; SoftSeek: boolean = false;
                        PartialKey: boolean = false): boolean; virtual;
    function SeekFirstRecord( Key: String; SoftSeek: boolean = false;
                              PartialKey: boolean = false): Integer; virtual;
    function SeekFields(const KeyFields: string; const KeyValues: Variant;
                        SoftSeek: boolean = false;
                        PartialKey: boolean = false): Integer; virtual;
    function FindKey(Key: String; PartialKey: boolean = false; SoftSeek: boolean = false; Rec: DWORD = 0): Integer; virtual;
    function FindKeyFields( const KeyFields: string; const KeyValues: Variant;
                            PartialKey: boolean = false): Integer; overload; virtual;
    function FindKeyFields( const KeyFields: string; const KeyValues: array of const;
                            PartialKey: boolean = false): Integer; overload; virtual;
    function FindKeyFields( PartialKey: boolean = false): Integer; overload; virtual;
    function SubIndex(LowKey, HiKey: String): boolean; virtual;
    function FillFirstBufRecords(DBFHandler: TProxyStream; FBuffer: pChar; FRecordsPerBuf: Integer; FRecordSize: Integer; FBufInd: pLongint; data_offset: Word): longint; virtual;
    function FillLastBufRecords(DBFHandler: TProxyStream; FBuffer: pChar; FRecordsPerBuf: Integer; FRecordSize: Integer; FBufInd: pLongint; data_offset: Word): longint; virtual;
    function EvaluteKeyExpr: String; virtual;
    function SuiteFieldList(fl: String; out m: Integer): Integer; virtual;
    function EvaluteForExpr: boolean; virtual;
    function GetRecordByIndex(GetMode: TGetMode; var cRec: Longint): TGetResult; virtual;
    function GetFirstByIndex(var cRec: Longint): TGetResult; virtual;
    function GetLastByIndex(var cRec: Longint): TGetResult; virtual;
    procedure First; virtual;
    procedure Next; virtual;
    procedure Prior; virtual;
    procedure Last; virtual;
    function LastKey(out LastKey: String; out LastRec: LongInt): boolean; virtual;
    function NextBuffer(DBFHandler: TProxyStream; FBuffer: pChar; FRecordsPerBuf: Integer; FRecordSize: Integer; FBufInd: pLongint; data_offset: Word): Longint; virtual;
    function PriorBuffer(DBFHandler: TProxyStream; FBuffer: pChar; FRecordsPerBuf: Integer; FRecordSize: Integer; FBufInd: pLongint; data_offset: Word): Longint; virtual;
    procedure CreateIndex(Activate: boolean = true); virtual;
    procedure CreateCompactIndex(BlockBufferSize: LongWord = 4096; Activate: boolean = true); virtual;
    procedure Reindex(Activate: boolean = true); virtual;
    procedure SetRangeFields(FieldList: String; FieldValues: array of const); overload; virtual;
    procedure SetRangeFields(FieldList: String; FieldValues: variant); overload; virtual;
    function InRange(Key: String): boolean; overload; virtual;
    function InRange: boolean; overload; virtual;

    function FLock: boolean; virtual;
    function FUnLock: boolean; virtual;

    procedure StartUpdate(UnLock: boolean = true); virtual;
    procedure Flush; virtual;

    procedure DeleteKey(sKey: String; nRec: Longint); virtual;
    procedure AddKey(sKey: String; nRec: Longint); virtual;

    procedure Truncate; virtual;

    procedure BeginCreateIndexProcess; virtual;
    procedure EvaluteAndAddKey(nRec: DWORD); virtual;
    procedure EndCreateIndexProcess; virtual;

    procedure ArrayOfConstant2Variant(const InputValue: array of const; var Value: Variant);

    function IsUniqueIndex: boolean; virtual;
    function IsForIndex: boolean; virtual;

    property Order: String read GetOrder write SetOrder;

    property IndexBag: TVKDBFIndexBag read FIndexBag write FIndexBag;
    property IndexOrder: TVKDBFOrder read FIndexOrder write FIndexOrder;

    property IsRanged: boolean read GetIsRanged;
    property CurrentKey: String read GetCurrentKey;
    property CurrentRec: DWORD read GetCurrentRec;

    property OnSubIndex: TOnSubIndex read FOnSubIndex write FOnSubIndex;
    property OnEvaluteKey: TOnEvaluteKey read FOnEvaluteKey write FOnEvaluteKey;
    property OnEvaluteFor: TOnEvaluteFor read FOnEvaluteFor write FOnEvaluteFor;
    property OnCompareKeys: TOnCompareKeys read FOnCompareKeys write FOnCompareKeys;
    property OnCreateIndex: TOnCreateIndex read FOnCreateIndex write FOnCreateIndex;

  published

    property Name: String read FName write FName;
    property BagName: String read FBagName write FBagName;
    property Active: boolean read FActive write SetActive;

  end;

implementation

uses
   VKDBFDataSet, VKDBFNTX, VKDBFCDX, VKDBFParser;

{ TIndexes }

procedure TIndexes.AssignValues(Value: TIndexes);
var
  I: Integer;
  P: TIndex;
begin
  for I := 0 to Value.Count - 1 do
  begin
    P := FindIndex(Value[I].Name);
    if P <> nil then
      P.Assign(Value[I]);
  end;
end;

procedure TIndexes.CloseAll;
var
  I: Integer;

  function FindOpened(var Ind: Integer): boolean;
  var
    i: Integer;
  begin
    Result := false;
    for i := 0 to Count - 1 do
      if Items[i].IsOpen then begin
        Ind := i;
        Result := true;
        Exit;
      end;
  end;

begin
  while FindOpened(I) do Items[I].Close;
end;

constructor TIndexes.Create(AOwner: TPersistent;
  ItemClass: TCollectionItemClass);
begin
  inherited Create(AOwner, ItemClass);
  if ItemClass.ClassName = 'TVKNTXIndex' then
    FIndexType := itNTX
  else if ItemClass.ClassName = 'TVKNDXIndex' then
    FIndexType := itNDX
  else if ItemClass.ClassName = 'TVKMDXIndex' then
    FIndexType := itMDX
  else if ItemClass.ClassName = 'TVKCDXIndex' then
    FIndexType := itCDX
  else
    FIndexType := itNotDefined;
  FActiveObject := nil;
end;

function TIndexes.CreateIndex(IndexName: String): TIndex;
begin
  case FIndexType of
    itNotDefined: raise Exception.Create('TIndex: IndexType not defined.');
    itNTX: Result := Add as TVKNTXIndex;
    //itNDX: Result := Add as TVKNDXIndex;
    //itMDX: Result := Add as TVKMDXIndex;
    itCDX: Result := Add as TVKCDXIndex;
  else
    Result := Add as TIndex;
  end;
  Result.Name := IndexName;
end;

function TIndexes.FindIndex(const Value: string): TIndex;
var
  I: Integer;
begin
  for I := 0 to Count - 1 do
  begin
    Result := TIndex(inherited Items[I]);
    if AnsiCompareText(Result.Name, Value) = 0 then Exit;
  end;
  Result := nil;
end;

{$IFDEF VER130}
function TIndexes.GetCollectionOwner: TPersistent;
begin
  Result := GetOwner;
end;
{$ENDIF}

function TIndexes.GetItem(Index: Integer): TIndex;
begin
  Result := TIndex(inherited Items[Index]);
end;

function TIndexes.IsEqual(Value: TIndexes): Boolean;
var
  I: Integer;
begin
  Result := (Count = Value.Count);
  if Result then
    for I := 0 to Count - 1 do
    begin
      Result := TIndex(Items[I]).IsEqual(TIndex(Value.Items[I]));
      if not Result then Break;
    end
end;

procedure TIndexes.SetItem(Index: Integer; const Value: TIndex);
begin
  inherited SetItem(Index, TCollectionItem(Value));
end;

{ TIndex }

procedure TIndex.AddKey(sKey: String; nRec: Integer);
begin
  //
end;

procedure TIndex.Assign(Source: TPersistent);
begin
  if Source is TIndex then
    AssignIndex(TIndex(Source))
  else
    inherited Assign(Source);
end;

procedure TIndex.AssignIndex(oInd: TIndex);
begin
  if oInd <> nil then
  begin
    Name := oInd.Name;
  end;
end;

procedure TIndex.Close;
begin
  //
end;

constructor TIndex.Create(Collection: TCollection);
begin
  inherited Create(Collection);
  FIndexes := TIndexes(Collection);
  b_R := false;
end;

procedure TIndex.CreateIndex(Activate: boolean = true);
begin
  //
end;

procedure TIndex.DeleteKey(sKey: String; nRec: Integer);
begin
  //
end;

destructor TIndex.Destroy;
begin
  inherited Destroy;
end;

function TIndex.EvaluteForExpr: boolean;
begin
  Result := false;
end;

function TIndex.EvaluteKeyExpr: String;
begin
  Result := '';
end;

function TIndex.FillFirstBufRecords(DBFHandler: TProxyStream; FBuffer: pChar;
  FRecordsPerBuf, FRecordSize: Integer;
  FBufInd: pLongint; data_offset: Word): longint;
begin
  Result := 0;
end;

function TIndex.FillLastBufRecords(DBFHandler: TProxyStream; FBuffer: pChar;
  FRecordsPerBuf, FRecordSize: Integer; FBufInd: pLongint;
  data_offset: Word): longint;
begin
  Result := 0;
end;

procedure TIndex.First;
begin
  //
end;

function TIndex.FLock: boolean;
begin
  Result := false;
end;

function TIndex.FUnLock: boolean;
begin
  Result := false;
end;

function TIndex.GetCurrentKey: String;
begin
  Result := '';
end;

function TIndex.GetCurrentRec: DWORD;
begin
  Result := 0;
end;

function TIndex.GetDisplayName: string;
begin
  if Name <> '' then
    Result := Name
  else
    Result := inherited GetDisplayName;
end;

function TIndex.GetFirstByIndex(var cRec: Integer): TGetResult;
begin
  Result := grError;
end;

function TIndex.GetLastByIndex(var cRec: Integer): TGetResult;
begin
  Result := grError;
end;

function TIndex.GetRecordByIndex(GetMode: TGetMode;
  var cRec: Integer): TGetResult;
begin
  Result := grError;
end;

function TIndex.InternalFirst: TGetResult;
begin
  Result := grError;
end;

function TIndex.InternalLast: TGetResult;
begin
  Result := grError;
end;

function TIndex.InternalNext: TGetResult;
begin
  Result := grError;
end;

function TIndex.InternalPrior: TGetResult;
begin
  Result := grError;
end;

function TIndex.IsEqual(Value: TIndex): Boolean;
begin
  Result := false;
end;

function TIndex.IsOpen: boolean;
begin
  Result := false;
end;

procedure TIndex.Last;
begin
  //
end;

function TIndex.LastKey(out LastKey: String; out LastRec: Integer): boolean;
begin
  LastKey := '';
  LastRec := -1;
  Result := false;
end;

procedure TIndex.Next;
begin
  //
end;

function TIndex.NextBuffer(DBFHandler: TProxyStream; FBuffer: pChar; FRecordsPerBuf: Integer; FRecordSize: Integer; FBufInd: pLongint; data_offset: Word): Longint;
begin
  Result := 0;
end;

function TIndex.Open: boolean;
begin
  Result := false;
end;

procedure TIndex.Prior;
begin
  //
end;

function TIndex.PriorBuffer(DBFHandler: TProxyStream; FBuffer: pChar; FRecordsPerBuf: Integer; FRecordSize: Integer; FBufInd: pLongint; data_offset: Word): Longint;
begin
  Result := 0;
end;

function TIndex.Seek(Key: String; SoftSeek: boolean): boolean;
begin
  Result := false;
end;

function TIndex.SeekFields(const KeyFields: string;
  const KeyValues: Variant; SoftSeek: boolean = false;
  PartialKey: boolean = false): Integer;
begin
  Result := 0;
end;

function TIndex.SeekFirst(Key: String; SoftSeek: boolean = false;
                          PartialKey: boolean = false): boolean;
begin
  Result := false;
end;

procedure TIndex.SetActive(const Value: boolean);
var
  i: Integer;
  oW: TVKDBFNTX;
  R: Integer;
begin
  if FActive <> Value then begin
    oW := TVKDBFNTX(FIndexes.Owner);
    if Value then begin
      try
        b_R := true;
        for i := 0 to FIndexes.Count - 1 do
          FIndexes.Items[i].Active := false;
      finally
        b_R := false;
      end;
      FIndexes.FActiveObject := self;
      FActive := true;
      if oW.Active then begin
        R := FindKey(EvaluteKeyExpr, False, True, oW.RecNo);
        if R <> 0 then begin
          oW.RecNo := R;
        end else
          oW.First;
      end;
    end else begin
      if ( FIndexes.FActiveObject <> nil ) and ( FIndexes.FActiveObject = self ) then begin
        FIndexes.FActiveObject := nil;
        if not b_R then if oW.Active then oW.RecNo := oW.RecNo;
      end;
    end;
    FActive := Value;
  end;
end;

function TIndex.SetToRecord: boolean;
begin
  Result := false;
end;

function TIndex.SetToRecord(Key: String; Rec: Integer): boolean;
begin
  Result := false;
end;

procedure TIndex.SetRangeFields(FieldList: String;
  FieldValues: array of const);
begin
  //
end;

procedure TIndex.SetRangeFields(FieldList: String; FieldValues: variant);
begin
  //
end;

function TIndex.SetToRecord(Rec: Integer): boolean;
begin
  Result := false;
end;

function TIndex.SubIndex(LowKey, HiKey: String): boolean;
begin
  Result := false;
end;

function TIndex.SuiteFieldList(fl: String; out m: Integer): Integer;
begin
  m := 0;
  Result := 0;
end;

function TIndex.GetIsRanged: boolean;
begin
  Result := false;
end;

function TIndex.InRange(Key: String): boolean;
begin
  Result := false;
end;

procedure TIndex.Flush;
begin
  //
end;

procedure TIndex.Reindex(Activate: boolean = true);
begin
  //
end;

procedure TIndex.StartUpdate(UnLock: boolean = true);
begin
//
end;

function TIndex.SeekFirstRecord(Key: String; SoftSeek: boolean = false;
                                PartialKey: boolean = false): Integer;
begin
  Result := 0;
end;

procedure TIndex.Truncate;
begin
//
end;

procedure TIndex.BeginCreateIndexProcess;
begin
  //
end;

procedure TIndex.EndCreateIndexProcess;
begin
  //
end;

procedure TIndex.EvaluteAndAddKey(nRec: DWORD);
begin
  //
end;

procedure TIndex.CreateCompactIndex(BlockBufferSize: LongWord;
  Activate: boolean);
begin
  //
end;

function TIndex.InRange: boolean;
begin
  Result := false;
end;

function TIndex.FindKey(  Key: String; PartialKey: boolean = false;
                          SoftSeek: boolean = false; Rec: DWORD = 0): Integer;
begin
  Result := 0;
end;

function TIndex.FindKeyFields(const KeyFields: string;
  const KeyValues: Variant; PartialKey: boolean): Integer;
begin
  Result := 0;
end;

procedure TIndex.ArrayOfConstant2Variant(const InputValue: array of const;
  var Value: Variant);
var
  i: Integer;
begin
  Value := VarArrayCreate([0, High(InputValue)], varVariant);
  for i := 0 to High(InputValue) do begin
    with InputValue[I] do
      case VType of
        vtInteger:    Value[i] := VInteger;
        vtBoolean:    Value[i] := VBoolean;
        vtChar:       Value[i] := VChar;
        vtExtended:   Value[i] := VExtended^;
        vtString:     Value[i] := VString^;
        //vtPChar:      Value[i] := VPChar;
        //vtObject:     Value[i] := VObject;
        //vtClass:      Value[i] := VClass;
        vtAnsiString: Value[i] := string(VAnsiString);
        vtCurrency:   Value[i] := VCurrency^;
        vtVariant:    Value[i] := VVariant^;
        //vtInt64:      Value[i] := VInt64^;
    end;
  end;
end;

function TIndex.FindKeyFields(const KeyFields: string;
  const KeyValues: array of const; PartialKey: boolean): Integer;
begin
  Result := 0;
end;

function TIndex.FindKeyFields(PartialKey: boolean = false): Integer;
begin
  Result := 0;
end;

function TIndex.IsForIndex: boolean;
begin
  Result := False;
end;

function TIndex.IsUniqueIndex: boolean;
begin
  Result := False;
end;

function TIndex.GetOrder: String;
begin
  Result := Name;
end;

procedure TIndex.SetOrder(Value: String);
begin
  Name := Value;
end;

procedure TIndex.DefineBagAndOrder;
begin
  //
end;

procedure TIndex.DefineBag;
begin
  //
end;

{ TVKDBFIndexBag }

procedure TVKDBFIndexBag.Assign(Source: TPersistent);
begin
  inherited Assign(Source);
end;

procedure TVKDBFIndexBag.Close;
begin
  Handler.Close;
end;

constructor TVKDBFIndexBag.Create(Collection: TCollection);
begin
  inherited Create(Collection);
  FName := 'TVKDBFIndexBag' + IntToStr(Index);
  with Collection as TVKDBFIndexDefs do begin
    case FIndexType of
      itNTX: FOrders := TVKDBFOrders.Create(self, TVKNTXOrder);
      //itNDX:
      //itMDX:
      //itIDX:
      itCDX: FOrders := TVKDBFOrders.Create(self, TVKCDXOrder);
    else
      FOrders := TVKDBFOrders.Create(self, TVKDBFOrder);
    end;
  end;
  Handler := TProxyStream.Create;
  FStorageType := pstFile;
end;

function TVKDBFIndexBag.CreateBag: boolean;
begin
  Result := False;
end;

procedure TVKDBFIndexBag.DefineProperties(Filer: TFiler);

  function WriteOrderDataB: Boolean;
  begin
    if Filer.Ancestor <> nil then
      Result := not FOrders.IsEqual(TVKDBFIndexBag(Filer.Ancestor).FOrders)
    else
      Result := (FOrders.Count > 0);
  end;

begin
  inherited DefineProperties(Filer);
  Filer.DefineProperty('Orders', ReadOrderData, WriteOrderData, WriteOrderDataB);
end;

destructor TVKDBFIndexBag.Destroy;
begin
  FOrders.Destroy;
  FOrders := nil;
  inherited Destroy;
end;

function TVKDBFIndexBag.GetDisplayName: string;
begin
  Result := Name;
end;

function TVKDBFIndexBag.GetInnerStream: TStream;
begin
  Result := Handler.InnerStream;
end;

function TVKDBFIndexBag.GetOwnerTable: TDataSet;
begin
  Result := (Collection as TVKDBFIndexDefs).OwnerTable;
end;

function TVKDBFIndexBag.IsEqual(Value: TVKDBFIndexBag): Boolean;
begin
  Result := false;
end;

function TVKDBFIndexBag.IsOpen: boolean;
begin
  Result := False;
end;

function TVKDBFIndexBag.Open: boolean;
begin
  Result := False;
end;

procedure TVKDBFIndexBag.ReadOrderData(Reader: TReader);
begin
  Reader.ReadValue;
  Reader.ReadCollection(FOrders);
end;

procedure TVKDBFIndexBag.SetIndexFileName(const Value: String);
begin
  FIndexFileName := Value;
  if FName = 'TVKDBFIndexBag' + IntToStr(Index) then
    FName := ChangeFileExt(ExtractFileName(FIndexFileName), '');
  Handler.FileName := FIndexFileName;
end;

procedure TVKDBFIndexBag.SetOrders(const Value: TVKDBFOrders);
begin
  FOrders.Assign(Value);
end;

procedure TVKDBFIndexBag.WriteOrderData(Writer: TWriter);
begin
  Writer.WriteCollection(FOrders);
end;

{ TVKDBFIndexDefs }

procedure TVKDBFIndexDefs.AssignValues(Value: TVKDBFIndexDefs);
var
  I: Integer;
  P: TVKDBFIndexBag;
begin
  for I := 0 to Value.Count - 1 do
  begin
    P := FindIndex(Value[I].Name);
    if P <> nil then
      P.Assign(Value[I]);
  end;
end;


constructor TVKDBFIndexDefs.Create(AOwner: TPersistent;
  ItemClass: TCollectionItemClass);
begin
  inherited Create(AOwner, ItemClass);
  if ItemClass.ClassName = 'TVKNTXBag' then
    FIndexType := itNTX
  else if ItemClass.ClassName = 'TVKNDXBag' then
    FIndexType := itNDX
  else if ItemClass.ClassName = 'TVKMDXBag' then
    FIndexType := itMDX
  else if ItemClass.ClassName = 'TVKCDXBag' then
    FIndexType := itCDX
  else
    FIndexType := itNotDefined;
end;

function TVKDBFIndexDefs.FindIndex(const Value: string): TVKDBFIndexBag;
var
  I: Integer;
begin
  for I := 0 to Count - 1 do
  begin
    Result := TVKDBFIndexBag(inherited Items[I]);
    if AnsiCompareText(Result.Name, Value) = 0 then Exit;
  end;
  Result := nil;
end;

{$IFDEF VER130}
function TVKDBFIndexDefs.GetCollectionOwner: TPersistent;
begin
  Result := GetOwner;
end;
{$ENDIF}

function TVKDBFIndexDefs.GetItem(Index: Integer): TVKDBFIndexBag;
begin
  Result := TVKDBFIndexBag(inherited Items[Index]);
end;

function TVKDBFIndexDefs.GetOwnerTable: TDataSet;
begin
  Result := Owner as TDataSet;
end;

function TVKDBFIndexDefs.IsEqual(Value: TVKDBFIndexDefs): Boolean;
var
  I: Integer;
begin
  Result := (Count = Value.Count);
  if Result then
    for I := 0 to Count - 1 do
    begin
      Result := TVKDBFIndexBag(Items[I]).IsEqual(TVKDBFIndexBag(Value.Items[I]));
      if not Result then Break;
    end
end;

procedure TVKDBFIndexDefs.SetItem(Index: Integer;
  const Value: TVKDBFIndexBag);
begin
  inherited SetItem(Index, TCollectionItem(Value));
end;

{ TVKDBFOrders }

procedure TVKDBFOrders.AssignValues(Value: TVKDBFOrders);
var
  I: Integer;
  P: TVKDBFOrder;
begin
  for I := 0 to Value.Count - 1 do
  begin
    P := FindIndex(Value[I].Name);
    if P <> nil then
      P.Assign(Value[I]);
  end;
end;

constructor TVKDBFOrders.Create(AOwner: TPersistent;
  ItemClass: TCollectionItemClass);
begin
  inherited Create(AOwner, ItemClass);
end;

function TVKDBFOrders.FindIndex(const Value: string): TVKDBFOrder;
var
  I: Integer;
begin
  for I := 0 to Count - 1 do
  begin
    Result := TVKDBFOrder(inherited Items[I]);
    if AnsiCompareText(Result.Name, Value) = 0 then Exit;
  end;
  Result := nil;
end;

{$IFDEF VER130}
function TVKDBFOrders.GetCollectionOwner: TPersistent;
begin
  Result := GetOwner;
end;
{$ENDIF}

function TVKDBFOrders.GetItem(Index: Integer): TVKDBFOrder;
begin
  Result := TVKDBFOrder(inherited Items[Index]);
end;

function TVKDBFOrders.GetOwnerTable: TDataSet;
begin
  Result := (Owner as TVKDBFIndexBag).OwnerTable;
end;

function TVKDBFOrders.IsEqual(Value: TVKDBFOrders): Boolean;
var
  I: Integer;
begin
  Result := (Count = Value.Count);
  if Result then
    for I := 0 to Count - 1 do
    begin
      Result := TVKDBFOrder(Items[I]).IsEqual(TVKDBFOrder(Value.Items[I]));
      if not Result then Break;
    end
end;

procedure TVKDBFOrders.SetItem(Index: Integer; const Value: TVKDBFOrder);
begin
  inherited SetItem(Index, TCollectionItem(Value));
end;

{ TVKDBFOrder }

procedure TVKDBFOrder.Assign(Source: TPersistent);
begin
  inherited Assign(Source);
end;

constructor TVKDBFOrder.Create(Collection: TCollection);
begin
  inherited Create(Collection);
  FName := 'TVKDBFOrder' + IntToStr(Index);
end;

function TVKDBFOrder.CreateOrder: boolean;
begin
  Result := False;
end;

destructor TVKDBFOrder.Destroy;
begin
  inherited Destroy;
end;

function TVKDBFOrder.GetDisplayName: string;
begin
  Result := Name;
end;

function TVKDBFOrder.GetOwnerTable: TDataSet;
begin
  Result := (Collection as TVKDBFOrders).OwnerTable;
end;

function TVKDBFOrder.IsEqual(Value: TVKDBFOrder): Boolean;
begin
  Result := false;
end;

end.