{ -----------------------------------------------------------------------
Tcl Scripting Language Components (Tslc)
Copyright (C) 1996-2002 William Byrne

This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License, or (at your option) any later version.

This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Lesser General Public License for more details.

You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA

WilliamB@ByrneLitho.com
------------------------------------------------------------------------}
unit BdeClass;

///////////////////////////////////////////////////////////////////////////////
//
//  TclDbTbl.pas
//	Copyright(c) 1996-1997 William Byrne
//		WilliamB@ByrneLitho.com
//		76262.13@CompuServe.com
//
//	All rights reserved.
//  	William Byrne makes no representations about the suitability of this
//    	software for any purpose.  It is provided "as is" without express or
//    	implied warranty.
//
//	Usage
//      I hereby grant to the legal purchasors of the source code contained
//      herein a non-exclusive license for the use of said source code in
//      developing compiled, executable software, and for the distribution of
//      said source code as part of said developed, compiled, executable software.
//
//  Purpose:
//		This file provides for Bde Table Manipulation using the
//		Tcl Scripting Language Components.
//
//	Editor:
//		Tab stops = 4
//		Page width = 132 characters
//		Font = Courier New, 8pt
//
//  Misc:
//      ??? = Note to self



interface
uses SysUtils, Classes, Bde, DynaData, DynaElem, BdeMisc;

const
    cCannotSyncFLDDesc = 'Cannot Synchronize FLDDesc';
    cDescOpParityError = 'Descriptor/Operation Parity Error - Severe';


type

    EBDEClassError = class(Exception);

	TBDEDesc = class
    private
        FOps: TDynaInteger;
		FDirty: boolean;
        FLocale: Pointer; // Readonly. Do not delete/unload.
        function GetCount: integer;
		function GetOp(index: integer): CROpType;
   		procedure SetOp(index: integer; val: CROpType);

	protected
		procedure CheckSyncCount(value: integer); virtual; abstract;

    public
    	constructor Create(DeltaAlloc: integer);
        destructor Destroy; override;
        procedure Close; virtual;
		procedure Deflate(count: integer); virtual;
        function GetDescPointer: Pointer; virtual; abstract;
        function GetDescSize: integer; virtual; abstract;
        function GetOpPointer: Pointer;
        function GetOpSize: integer;
		function Inflate(count: integer): integer; virtual;
        procedure Shift(idxHead, idxTail, offset : integer); virtual;
        procedure Open(hDb: hDBIDb; hCursor: hDbiCur; ALocale: Pointer; pcProps: pCURProps); virtual;
        procedure Purge; virtual;
        procedure Swap(idx1, idx2: integer); virtual;

		property Count: integer read GetCount;
        property Dirty: boolean read FDirty;
        property Locale: Pointer read FLocale;
		property Op[index: integer]: CROpType read GetOp write SetOp;
	end;

	TBDEFLDDesc = class(TBDEDesc)
    private
		FDesc: TDynaData;

		function GetDesc(index: integer):pFLDDesc;

		function GetFldNum(index: integer): integer;
		function GetName(index: integer): string;
		function GetFldType(index: integer): integer;
		function GetSubType(index: integer): integer;
		function GetUnits1(index: integer): integer;
		function GetUnits2(index: integer): integer;
        function GetOffset(index: integer): integer;
		function GetLen(index: integer): integer;
        function GetNullOffset(index: integer): integer;
        function GetVchk(index: integer): FLDVchk;
        function GetRights(index: integer): FLDRights;
        function GetCalcField(index: integer): boolean;

		procedure SetFldNum(index: integer; val: integer);
        procedure SetLen(index: integer; val: integer);
        procedure SetOffset(index: integer; val: integer);
		procedure SetName(index: integer; val: string);
		procedure SetFldType(index: integer; val: integer);
		procedure SetSubType(index: integer; val: integer);
		procedure SetUnits1(index: integer; val: integer);
		procedure SetUnits2(index: integer; val: integer);
        procedure SetVchk(index: integer; val: FLDVchk);
        procedure SetRights(index: integer; val: FLDRights);
        procedure SetCalcField(index: integer; val: boolean);

	protected
		procedure CheckSyncCount(value: integer); override;

	public
    	constructor Create(DeltaAlloc: integer);
        destructor Destroy; override;
        procedure Close; override;
		procedure Deflate(count: integer); override;
        function GetDescPointer: Pointer; override;
        function GetDescSize: integer; override;
		function Inflate(count: integer): integer; override;
        procedure Shift(idxHead, idxTail, offset : integer); override;
        procedure Open(hDb: hDBIDb; hCursor: hDbiCur; ALocale: Pointer; pcProps: pCURProps); override;
        procedure Purge; override;
        procedure Swap(idx1, idx2: integer); override;

		property Desc[index: integer]: pFLDDesc read GetDesc; default;
		property FldNum[index: integer]: integer read GetFldNum write SetFldNum;
		property Name[index: integer]: string read GetName write SetName;
		property FldType[index: integer]: integer read GetFldType write SetFldType;
		property SubType[index: integer]: integer read GetSubType write SetSubType;
		property Units1[index: integer]: integer read GetUnits1 write SetUnits1;
		property Units2[index: integer]: integer read GetUnits2 write SetUnits2;
        property Offset[index: integer]: integer read GetOffset write SetOffset;
		property Len[index: integer]: integer read GetLen write SetLen;
        property NullOffset[index: integer]: integer read GetNullOffset;
        property Vchk[index: integer]: FLDVchk read GetVchk write SetVchk;
        property Rights[index: integer]: FLDRights read GetRights write SetRights;
        property CalcField[index: integer]: boolean read GetCalcField write SetCalcField;
    end;


    TBDEIDXDesc = class(TBDEDesc)
    private
		FDesc: TDynaData;

		function GetDesc(index: integer):pIDXDesc;
        function GetName(index: integer): string;
        function GetIndexId(index: integer): integer;
        function GetTagName(index: integer): string;
        function GetFormat(index: integer): string;
        function GetPrimary(index: integer): boolean;
        function GetUnique(index: integer): boolean;
        function GetDescending(index: integer): boolean;
        function GetMaintained(index: integer): boolean;
        function GetSubset(index: integer): boolean;
        function GetExpIdx(index: integer): boolean;
        function GetCost(index: integer): integer;
        function GetFldsInKey(index: integer): integer;
        function GetKeyLen(index: integer): integer;
        function GetOutOfDate(index: integer): boolean;
        function GetKeyExpType(index: integer): integer;
        function GetKeyFld(index, pos: integer): integer;
        function GetKeyExp(index: integer): string;
        function GetKeyCond(index: integer): string;
        function GetCaseIns(index: integer): boolean;
        function GetBlockSize(index: integer): integer;
        function GetRestrNum(index: integer): integer;
        function GetDescFlds(index, pos: integer): boolean;

        procedure SetName(index: integer; val:  string);
        procedure SetIndexId(index: integer; val: integer);
        procedure SetTagName(index: integer; val: string);
        procedure SetFormat(index: integer; val: string);
        procedure SetPrimary(index: integer; val: boolean);
        procedure SetUnique(index: integer; val: boolean);
        procedure SetDescending(index: integer; val: boolean);
        procedure SetMaintained(index: integer; val: boolean);
        procedure SetSubset(index: integer; val: boolean);
        procedure SetExpIdx(index: integer; val: boolean);
        procedure SetCost(index: integer; val: integer);
        procedure SetFldsInKey(index: integer; val: integer);
        procedure SetKeyLen(index: integer; val: integer);
        procedure SetOutOfDate(index: integer; val: boolean);
        procedure SetKeyExpType(index: integer; val: integer);
        procedure SetKeyFld(index, pos: integer; val: integer);
        procedure SetKeyExp(index: integer; val: string);
        procedure SetKeyCond(index: integer; val: string);
        procedure SetCaseIns(index: integer; val: boolean);
        procedure SetBlockSize(index: integer; val: integer);
        procedure SetDescFlds(index, pos: integer; val: boolean);

	protected
		procedure CheckSyncCount(value: integer); override;

	public
    	constructor Create(DeltaAlloc: integer);
        destructor Destroy; override;
        procedure Close; override;
		procedure Deflate(count: integer); override;
        function GetDescPointer: Pointer; override;
        function GetDescSize: integer; override;
		function Inflate(count: integer): integer; override;
        procedure Shift(idxHead, idxTail, offset : integer); override;
        procedure Open(hDb: hDBIDb; hCursor: hDbiCur; ALocale: Pointer; pcProps: pCURProps); override;
        procedure Purge; override;
        procedure Swap(idx1, idx2: integer); override;


		property Name[index: integer]: string read GetName write SetName;
        property IndexId[index: integer]: integer read GetIndexId write SetIndexId;
        property TagName[index: integer]: string read GetTagName write SetTagName;
        property Format[index: integer]: string read GetFormat write SetFormat;
        property Primary[index: integer]: boolean read GetPrimary write SetPrimary;
        property Unique[index: integer]: boolean read GetUnique write SetUnique;
        property Descending[index: integer]: boolean read GetDescending write SetDescending;
        property Maintained[index: integer]: boolean read GetMaintained write SetMaintained;
        property Subset[index: integer]: boolean read GetSubset write SetSubset;
        property ExpIdx[index: integer]: boolean read GetExpIdx write SetExpIdx;
        property Cost[index: integer]: integer read GetCost write SetCost;
        property FldsInKey[index: integer]: integer read GetFldsInKey write SetFldsInKey; // Fields In Key
        property KeyLen[index: integer]: integer read GetKeyLen write SetKeyLen;
        property OutOfDate[index: integer]: boolean read GetOutOfDate write SetOutOfDate; // Out Of Date
        property KeyExpType[index: integer]: integer read GetKeyExpType write SetKeyExpType;
        property KeyFld[index,pos: integer]: integer read GetKeyFld write SetKeyFld;
        property KeyExp[index: integer]: string read GetKeyExp write SetKeyExp;
        property KeyCond[index: integer]: string read GetKeyCond write SetKeyCond;
        property CaseIns[index: integer]: boolean read GetCaseIns write SetCaseIns;
        property BlockSize[index: integer]: integer read GetBlockSize write SetBlockSize;
        property RestrNum[index: integer]: integer read GetRestrNum;
        property DescFlds[index, pos: integer]: boolean read GetDescFlds write SetDescFlds;

		property Desc[index: integer]: pIDXDesc read GetDesc; default;

	end;

	TBDERINTDesc = class(TBDEDesc)
    private
		FDesc: TDynaData;

		function GetDesc(index: integer):pRINTDesc;
        function GetRintNum(index: integer): integer;
        function GetRintName(index: integer): string;
        function GetRintType(index: integer): RINTType;
        function GetTblName(index: integer): string;
        function GetModOp(index: integer): RINTQual;
        function GetDelOp(index: integer): RINTQual;
        function GetFldCount(index: integer): integer;
        function GetThisTabFld(index, pos: integer): integer;
        function GetOthTabFld(index, pos: integer): integer;

        procedure SetRintNum(index, val: integer);
        procedure SetRintName(index: integer; val: string);
        procedure SetRintType(index: integer; val: RINTType);
        procedure SetTblName(index: integer; val: string);
        procedure SetModOp(index: integer; val: RINTQual);
        procedure SetDelOp(index: integer; val: RINTQual);
        procedure SetFldCount(index, val: integer);
        procedure SetThisTabFld(index, pos, val: integer);
        procedure SetOthTabFld(index, pos, val: integer);

	protected
		procedure CheckSyncCount(value: integer); override;

	public
    	constructor Create(DeltaAlloc: integer);
        destructor Destroy; override;

        procedure Close; override;
		procedure Deflate(count: integer); override;
        function GetDescPointer: Pointer; override;
        function GetDescSize: integer; override;
		function Inflate(count: integer): integer; override;
        procedure Shift(idxHead, idxTail, offset : integer); override;
        procedure Open(hDb: hDBIDb; hCursor: hDbiCur; ALocale: Pointer; pcProps: pCURProps); override;
        procedure Purge; override;
        procedure Swap(idx1, idx2: integer); override;

		property RintNum[index: integer]: integer read GetRintNum write SetRintNum;
        property RintName[index: integer]: string read GetRintName write SetRintName;
        property RintType[index: integer]: RINTType read GetRintType write SetRintType;
        property TblName[index: integer]: string read GetTblName write SetTblName;
        property ModOp[index: integer]: RINTQual read GetModOp write SetModOp;
        property DelOp[index: integer]: RINTQual read GetDelOp write SetDelOp;
        property FldCount[index: integer]: integer read GetFldCount write SetFldCount;
        property ThisTabFld[index, pos: integer]: integer read GetThisTabFld write SetThisTabFld;
        property OthTabFld[index, pos: integer]: integer read GetOthTabFld write SetOthTabFld;

		property Desc[index: integer]: pRINTDesc read GetDesc; default;

    end;

	TBDESECDesc = class(TBDEDesc)
    private
		FDesc: TDynaData;

		function GetDesc(index: integer):pSECDesc;
		function GetSecNum(index: integer): integer;
        function GetTable(index: integer): PRVType;
        function GetFamRights(index: integer): integer;
        function GetPassword(index: integer): string;
        function GetFld(index, pos: integer): PRVType;

        procedure SetSecNum(index, val: integer);
        procedure SetTable(index: integer; val: PRVType);
        procedure SetFamRights(index, val: integer);
        procedure SetPassword(index: integer; val: string);
        procedure SetFld(index, pos: integer; val: PRVType);

	protected
		procedure CheckSyncCount(value: integer); override;

	public
    	constructor Create(DeltaAlloc: integer);
        destructor Destroy; override;

        procedure Close; override;
		procedure Deflate(count: integer); override;
        function GetDescPointer: Pointer; override;
        function GetDescSize: integer; override;
		function Inflate(count: integer): integer; override;
        procedure Shift(idxHead, idxTail, offset : integer); override;
        procedure Open(hDb: hDBIDb; hCursor: hDbiCur; ALocale: Pointer; pcProps: pCURProps; TableName, TableType: string);
        procedure Purge; override;
        procedure Swap(idx1, idx2: integer); override;

        property SecNum[index: integer]: integer read GetSecNum write SetSecNum;
        property Table[index: integer]: PRVType read GetTable write SetTable;
        property FamRights[index: integer]: integer read GetFamRights write SetFamRights;
        property Password[index: integer]: string read GetPassword write SetPassword;
        property Fld[index, pos: integer]: PRVType read GetFld write SetFld;

		property Desc[index: integer]: pSECDesc read GetDesc; default;

    end;

    TSyncFLDDescCallback = procedure(index: integer; var pfd: pFLDDesc) of object;
	TBDEVCHKDesc = class(TBDEDesc)
    private
		FDesc: TDynaData;
        FOnSyncFLDDesc: TSyncFLDDescCallback;

		function GetDesc(index: integer):pVCHKDesc;

		function GetFldNum(index: integer): integer;
		function GetRequired(index: integer): boolean;
		function GetMinVal(index: integer): string;
		function GetMaxVal(index: integer): string;
		function GetDefVal(index: integer): string;
		function GetPict(index: integer): string;

		procedure SetFldNum(index, val: integer);
		procedure SetRequired(index: integer; val: boolean);
		procedure SetMinVal(index: integer; val: string);
		procedure SetMaxVal(index: integer; val: string);
		procedure SetDefVal(index: integer; val: string);
		procedure SetPict(index: integer; val: string);

	protected
		function GetFLDDesc(index: integer): pFLDDesc;
		procedure CheckSyncCount(value: integer); override;

	public
    	constructor Create(DeltaAlloc: integer);
        destructor Destroy; override;

        procedure Close; override;
		procedure Deflate(count: integer); override;
        function GetDescPointer: Pointer; override;
        function GetDescSize: integer; override;
		function Inflate(count: integer): integer; override;
        procedure Shift(idxHead, idxTail, offset : integer); override;
        procedure Open(hDb: hDBIDb; hCursor: hDbiCur; ALocale: Pointer; pcProps: pCURProps); override;
        procedure Purge; override;
        procedure Swap(idx1, idx2: integer); override;

		property FldNum[index: integer]: integer read GetFldNum write SetFldNum;
		property Required[index: integer]: boolean read GetRequired write SetRequired;
		property MinVal[index: integer]: string read GetMinVal write SetMinVal;
		property MaxVal[index: integer]: string read GetMaxVal write SetMaxVal;
		property DefVal[index: integer]: string read GetDefVal write SetDefVal;
		property Pict[index: integer]: string read GetPict write SetPict;
        property OnSyncFLDDesc: TSyncFLDDescCallback read FOnSyncFLDDesc write FOnSyncFLDDesc;

		property Desc[index: integer]: pVCHKDesc read GetDesc; default;
    end;

    TBDEOptDesc = class(TBDEFldDesc)
    private
        FData: TDynaData;
    public
        constructor Create(DeltaDescAlloc, DeltaDataAlloc: integer);
        destructor Destroy; override;

        procedure AddOption(option: string);
        procedure Close; override;
        function Data: pointer;
        procedure ToStrings(list: TStrings);
    end;



function LoadDbLocale(hDb: hDBIDb): Pointer;
procedure UnloadDbLocale(locale: Pointer);


procedure BDEClassError(msg: string);

implementation
uses Db, DbTables;


procedure BDEClassError(msg: string);
begin
	raise EBDEClassError.Create(msg);
end;

procedure CheckRange(val, min, max: integer);
begin
	if ( val < min ) or ( val > max ) then
    	raise ERangeError.Create('Index out of range');
end;

function LoadDbLocale(hDb: hDBIDb): Pointer;
var
   	typ: DBIDRTYPEDESC;
    lang: DBINAME;
    i: UINT16;
    loc: Pointer;
begin
	result := nil;
	Check(DbiGetProp(hDBIObj(hDb), dbDATABASETYPE, @typ, sizeof(typ), i));
	if (stricomp(typ, szCFGDBSTANDARD) <> 0) and
    		(DbiGetLdNameFromDB(hDb, nil, lang) = 0) and
    		(OsLdLoadBySymbName(lang, loc) = 0) then
    	result := loc;
end;

procedure UnloadDbLocale(locale: Pointer);
begin
	OsLdUnloadObj(locale);
end;


{~~~ TBDEDesc ~~~}
constructor TBDEDesc.Create(DeltaAlloc: integer);
begin
	FOps := TDynaInteger.Create(DeltaAlloc);
    FDirty := False;
    FLocale := nil;
end;

destructor TBDEDesc.Destroy;
begin
	Close;
	FOps.Free;
    inherited Destroy;
end;

procedure TBDEDesc.Close;
begin
	FOps.Clear;
//    if FLocale <> nil then
//    	OsLdUnloadObj(FLocale);
    FDirty := False;
end;

procedure TBDEDesc.Deflate(count: integer);
begin
	FOps.Choke(count);
    FDirty := True;
end;

function TBDEDesc.GetOpPointer: Pointer;
begin
	result := FOps.ItemAddress(0, 0);
end;

function TBDEDesc.GetOpSize: integer;
begin
	result := sizeof(integer);
end;

function TBDEDesc.Inflate(count: integer): integer;
begin
	result := FOps.GetNewIdx(count);
    FDirty := True;
end;

function TBDEDesc.GetCount: integer;
begin
	result := FOps.Count;
//???    CheckSyncCount(result);
end;

function TBDEDesc.GetOp(index: integer): CROpType;
begin
	result := CROpType(FOps.Get(index));
end;

procedure TBDEDesc.Shift(idxHead, idxTail, offset : integer);
begin
	FOps.Shift(idxHead, idxTail, offset);
end;

procedure TBDEDesc.Open(hDb: hDBIDb; hCursor: hDbiCur; ALocale: Pointer; pcProps: pCURProps);
begin
	Close;
//    UnloadDbLocale(FLocale);
    FLocale := ALocale;
//    FLocale := LoadDbLocale(hDb);
end;

procedure TBDEDesc.Purge;
var
	x, y, c, del : integer;
begin
    c := Count - 1;
    y := 0;
    del := 0;
    for x:= 0 to c do
    	if Op[x] <> crDrop then
        begin
        	if y < x then
            	Op[y] := Op[x];
            inc(y);
        end else
        	inc(del);
	if del > 0 then
    begin
        FOps.Choke(del);
        FDirty := True;
    end;
end;

procedure TBDEDesc.SetOp(index: integer; val: CROpType);
begin
	FOps.SetValue(index, integer(val));
    FDirty := True;
end;

procedure TBDEDesc.Swap(idx1, idx2: integer);
begin
	FOps.Swap(idx1, idx2);
end;


{~~~TBDEFLDDesc~~~}
constructor TBDEFLDDesc.Create(DeltaAlloc: integer);
begin
	FDesc := TDynaData.Create(sizeof(FLDDesc), DeltaAlloc);
    inherited Create(DeltaAlloc);
end;

destructor TBDEFLDDesc.Destroy;
begin
    inherited Destroy;
	FDesc.Free;
end;

procedure TBDEFLDDesc.CheckSyncCount(value: integer);
begin
	if Value <> FDesc.Count then
    	BDEClassError(cDescOpParityError);
end;

procedure TBDEFLDDesc.Close;
begin
	FDesc.Clear;
    inherited Close;
end;

procedure TBDEFLDDesc.Deflate(count: integer);
begin
	FDesc.Choke(count);
    inherited Deflate(count);
end;

function TBDEFLDDesc.GetDesc(index: integer): pFLDDesc;
begin
	result := pFLDDesc(FDesc.Get(index));
end;

function TBDEFLDDesc.GetDescPointer: Pointer;
begin
	result := FDesc.ItemAddress(0, 0);
end;

function TBDEFLDDesc.GetDescSize: integer;
begin
	result := sizeof(FLDDesc);
end;

function TBDEFLDDesc.GetFldNum(index: integer): integer;
begin
	result := pFLDDesc(FDesc.Get(index))^.iFldNum;
end;

function TBDEFLDDesc.GetName(index: integer): string;
begin
	NativeToAnsi(Locale, pFLDDesc(FDesc.Get(index))^.szName, result);
end;

function TBDEFLDDesc.GetFldType(index: integer): integer;
begin
	result := pFLDDesc(FDesc.Get(index))^.iFldType;
end;

function TBDEFLDDesc.GetSubType(index: integer): integer;
begin
	result := pFLDDesc(FDesc.Get(index))^.iSubType;
end;

function TBDEFLDDesc.GetUnits1(index: integer): integer;
begin
	result := pFLDDesc(FDesc.Get(index))^.iUnits1;
end;

function TBDEFLDDesc.GetUnits2(index: integer): integer;
begin
	result := pFLDDesc(FDesc.Get(index))^.iUnits2;
end;

function TBDEFLDDesc.GetOffset(index: integer): integer;
begin
	result := pFLDDesc(FDesc.Get(index))^.iOffset;
end;

function TBDEFLDDesc.GetLen(index: integer): integer;
begin
	result := pFLDDesc(FDesc.Get(index))^.iLen
end;

function TBDEFLDDesc.GetNullOffset(index: integer): integer;
begin
	result := pFLDDesc(FDesc.Get(index))^.iNullOffset;
end;

function TBDEFLDDesc.GetVchk(index: integer): FLDVchk;
begin
	result := pFLDDesc(FDesc.Get(index))^.efldvVchk;
end;

function TBDEFLDDesc.GetRights(index: integer): FLDRights;
begin
	result := pFLDDesc(FDesc.Get(index))^.efldrRights;
end;

function TBDEFLDDesc.GetCalcField(index: integer): boolean;
begin
	result := pFLDDesc(FDesc.Get(index))^.bCalcField;
end;

procedure TBDEFLDDesc.Purge;
var
	x, y, c, del : integer;
begin
    c := Count - 1;
    y := 0;
    del := 0;
    for x:= 0 to c do
    	if Op[x] <> crDrop then
        begin
        	if y < x then
            	Desc[y]^ := Desc[x]^;
            inc(y);
        end else
        	inc(del);
	if del > 0 then
        FDesc.Choke(del);
    inherited Purge;
end;

procedure TBDEFLDDesc.SetFldNum(index: integer; val: integer);
begin
    if pFLDDesc(FDesc.Get(index))^.iFldNum = val then exit;
	pFLDDesc(FDesc.Get(index))^.iFldNum := val;
    FDirty := True;
end;

procedure TBDEFLDDesc.SetLen(index: integer; val: integer);
begin
    if pFLDDesc(FDesc.Get(index))^.iLen = val then exit;
	pFLDDesc(FDesc.Get(index))^.iLen := val;
    FDirty := True;
end;

procedure TBDEFLDDesc.SetOffset(index: integer; val: integer);
begin
    if pFLDDesc(FDesc.Get(index))^.iOffset = val then exit;
	pFLDDesc(FDesc.Get(index))^.iOffset := val;
    FDirty := True;
end;



procedure TBDEFLDDesc.SetName(index: integer; val: string);
var
	str: string;
begin
	NativeToAnsi(Locale, pFLDDesc(FDesc.Get(index))^.szName, str);
	if str = val then exit;
    AnsiToNative(Locale, val, pFLDDesc(FDesc.Get(index))^.szName, DBIMAXNAMELEN);
	FDirty := True;
end;

procedure TBDEFLDDesc.SetFldType(index: integer; val: integer);
begin
	if pFLDDesc(FDesc.Get(index))^.iFldType = val then exit;
	pFLDDesc(FDesc.Get(index))^.iFldType := val;
    FDirty := True;
end;

procedure TBDEFLDDesc.SetSubType(index: integer; val: integer);
begin
	if pFLDDesc(FDesc.Get(index))^.iSubType = val then exit;
	pFLDDesc(FDesc.Get(index))^.iSubType := val;
    FDirty := True;
end;

procedure TBDEFLDDesc.SetUnits1(index: integer; val: integer);
begin
	if pFLDDesc(FDesc.Get(index))^.iUnits1 = val then exit;
	pFLDDesc(FDesc.Get(index))^.iUnits1 := val;
    FDirty := True;
end;

procedure TBDEFLDDesc.SetUnits2(index: integer; val: integer);
begin
	if pFLDDesc(FDesc.Get(index))^.iUnits2 = val then exit;
	pFLDDesc(FDesc.Get(index))^.iUnits2 := val;
    FDirty := True;
end;

procedure TBDEFLDDesc.SetVchk(index: integer; val: FLDVchk);
begin
	if pFLDDesc(FDesc.Get(index))^.efldvVchk = val then exit;
	pFLDDesc(FDesc.Get(index))^.efldvVchk := val;
    FDirty := True;
end;

procedure TBDEFLDDesc.SetRights(index: integer; val: FLDRights);
begin
	if pFLDDesc(FDesc.Get(index))^.efldrRights = val then exit;
	pFLDDesc(FDesc.Get(index))^.efldrRights := val;
    FDirty := True;
end;

procedure TBDEFLDDesc.SetCalcField(index: integer; val: boolean);
begin
	if pFLDDesc(FDesc.Get(index))^.bCalcField = val then exit;
	pFLDDesc(FDesc.Get(index))^.bCalcField := val;
    FDirty := True;
end;

function TBDEFLDDesc.Inflate(count: integer): integer;
begin
	result := FDesc.GetNewIdx(count);
    inherited Inflate(count);
end;

procedure TBDEFLDDesc.Shift(idxHead, idxTail, offset : integer);
begin
	inherited Shift(idxHead, idxTail, offset);
	FDesc.Shift(idxHead, idxTail, offset);
end;

procedure TBDEFLDDesc.Open(hDb: hDBIDb; hCursor: hDbiCur; ALocale: Pointer; pcProps: pCURProps);
begin
	inherited Open(hDb, hCursor, ALocale, pcProps);
    if pcProps^.iFields <= 0 then exit;
    Inflate(pcProps^.iFields);
	Check(DbiGetFieldDescs(hCursor, pFLDDesc(FDesc.Get(0))));
    FDirty := False;
end;

procedure TBDEFLDDesc.Swap(idx1, idx2: integer);
begin
	inherited Swap(idx1, idx2);
	FDesc.Swap(idx1, idx2);
end;

{~~~TBDEIDXDesc~~~}
constructor TBDEIDXDesc.Create(DeltaAlloc: integer);
begin
	FDesc := TDynaData.Create(sizeof(IDXDesc), DeltaAlloc);
    inherited Create(DeltaAlloc);
end;

destructor TBDEIDXDesc.Destroy;
begin
    inherited Destroy;
	FDesc.Free;
end;

procedure TBDEIDXDesc.CheckSyncCount(value: integer);
begin
	if value <> FDesc.Count then
    	BDEClassError(cDescOpParityError);
end;

procedure TBDEIDXDesc.Close;
begin
	FDesc.Clear;
    inherited Close;
end;

procedure TBDEIDXDesc.Deflate(count: integer);
begin
	FDesc.Choke(count);
    inherited Deflate(count);
end;

function TBDEIDXDesc.GetDesc(index: integer): pIDXDesc;
begin
	result := pIDXDesc(FDesc.Get(index));
end;

function TBDEIDXDesc.GetDescPointer: Pointer;
begin
	result := FDesc.ItemAddress(0, 0);
end;

function TBDEIDXDesc.GetDescSize: integer;
begin
	result := sizeof(IDXDesc);
end;

function TBDEIDXDesc.Inflate(count: integer): integer;
begin
	result := FDesc.GetNewIdx(count);
    inherited Inflate(count);
end;

procedure TBDEIdxDesc.Shift(idxHead, idxTail, offset : integer);
begin
	inherited Shift(idxHead, idxTail, offset);
	FDesc.Shift(idxHead, idxTail, offset);
end;

procedure TBDEIDXDesc.Open(hDb: hDBIDb; hCursor: hDbiCur; ALocale: Pointer; pcProps: pCURProps);
begin
	inherited Open(hDb, hCursor, ALocale, pcProps);
    if pcProps^.iIndexes <= 0 then exit;
    Inflate(pcProps^.iIndexes);
    Check(DbiGetIndexDescs(hCursor, FDesc.Get(0)));
    FDirty := False;
end;

procedure TBDEIDXDesc.Purge;
var
	x, y, c, del : integer;
begin
    c := Count - 1;
    y := 0;
    del := 0;
    for x:= 0 to c do
    	if Op[x] <> crDrop then
        begin
        	if y < x then
            	Desc[y]^ := Desc[x]^;
            inc(y);
        end else
        	inc(del);
	if del > 0 then
        FDesc.Choke(del);
    inherited Purge;
end;

function TBDEIDXDesc.GetName(index: integer): string;
begin
	NativeToAnsi(Locale, pIDXDesc(FDesc.Get(index))^.szName, result);
end;

function TBDEIDXDesc.GetIndexId(index: integer): integer;
begin
	result := pIDXDesc(FDesc.Get(index))^.iIndexId;
end;

function TBDEIDXDesc.GetTagName(index: integer): string;
begin
	NativeToAnsi(Locale, pIDXDesc(FDesc.Get(index))^.szTagName, result);
end;

function TBDEIDXDesc.GetFormat(index: integer): string;
begin
	NativeToAnsi(Locale, pIDXDesc(FDesc.Get(index))^.szFormat, result);
end;

function TBDEIDXDesc.GetPrimary(index: integer): boolean;
begin
	result := pIDXDesc(FDesc.Get(index))^.bPrimary;
end;

function TBDEIDXDesc.GetUnique(index: integer): boolean;
begin
	result := pIDXDesc(FDesc.Get(index))^.bUnique;
end;

function TBDEIDXDesc.GetDescending(index: integer): boolean;
begin
	result := pIDXDesc(FDesc.Get(index))^.BDEscending;
end;

function TBDEIDXDesc.GetMaintained(index: integer): boolean;
begin
	result := pIDXDesc(FDesc.Get(index))^.bMaintained;
end;

function TBDEIDXDesc.GetSubset(index: integer): boolean;
begin
	result := pIDXDesc(FDesc.Get(index))^.bSubset;
end;

function TBDEIDXDesc.GetExpIdx(index: integer): boolean;
begin
	result := pIDXDesc(FDesc.Get(index))^.bExpIdx;
end;

function TBDEIDXDesc.GetCost(index: integer): integer;
begin
	result := pIDXDesc(FDesc.Get(index))^.iCost;
end;

function TBDEIDXDesc.GetFldsInKey(index: integer): integer;
begin
	result := pIDXDesc(FDesc.Get(index))^.iFldsInKey;
end;

function TBDEIDXDesc.GetKeyLen(index: integer): integer;
begin
	result := pIDXDesc(FDesc.Get(index))^.iKeyLen;
end;

function TBDEIDXDesc.GetOutOfDate(index: integer): boolean;
begin
	result := pIDXDesc(FDesc.Get(index))^.bOutOfDate;
end;

function TBDEIDXDesc.GetKeyExpType(index: integer): integer;
begin
	result := pIDXDesc(FDesc.Get(index))^.iKeyExpType;
end;

function TBDEIDXDesc.GetKeyFld(index, pos: integer): integer;
begin
	CheckRange(pos, 0, DBIMAXFLDSINKEY - 1);
	result := pIDXDesc(FDesc.Get(index))^.aiKeyFld[pos];
end;

function TBDEIDXDesc.GetKeyExp(index: integer): string;
begin
	NativeToAnsi(Locale, pIDXDesc(FDesc.Get(index))^.szKeyExp, result);
end;

function TBDEIDXDesc.GetKeyCond(index: integer): string;
begin
	NativeToAnsi(Locale, pIDXDesc(FDesc.Get(index))^.szKeyCond, result);
end;

function TBDEIDXDesc.GetCaseIns(index: integer): boolean;
begin
	result := pIDXDesc(FDesc.Get(index))^.bCaseInsensitive;
end;

function TBDEIDXDesc.GetBlockSize(index: integer): integer;
begin
	result := pIDXDesc(FDesc.Get(index))^.iBlockSize;
end;

function TBDEIDXDesc.GetRestrNum(index: integer): integer;
begin
	result := pIDXDesc(FDesc.Get(index))^.iRestrNum;
end;

function TBDEIDXDesc.GetDescFlds(index, pos: integer): boolean;
begin
	CheckRange(pos, 0, DBIMAXFLDSINKEY - 1);
	result := pIDXDesc(FDesc.Get(index))^.aBDEscending[pos];
end;

procedure TBDEIDXDesc.SetName(index: integer; val:  string);
begin
	if GetName(index) = val then exit;
	AnsiToNative(Locale, val, pIDXDesc( FDesc.Get(index) )^.szName, DBIMAXTBLNAMELEN);
    FDirty := True;
end;

procedure TBDEIDXDesc.SetIndexId(index: integer; val: integer);
begin
	if pIDXDesc( FDesc.Get(index) )^.iIndexId = val then exit;
	pIDXDesc( FDesc.Get(index) )^.iIndexId := val;
    FDirty := True;
end;

procedure TBDEIDXDesc.SetTagName(index: integer; val: string);
begin
	if GetTagName(index) = val then exit;
	AnsiToNative(Locale, val, pIDXDesc( FDesc.Get(index) )^.szTagName, DBIMAXNAMELEN);
    FDirty := True;
end;

procedure TBDEIDXDesc.SetFormat(index: integer; val: string);
begin
	if GetFormat(index) = val then exit;
	AnsiToNative(Locale, val, pIDXDesc( FDesc.Get(index) )^.szFormat, DBIMAXNAMELEN);
    FDirty := True;
end;

procedure TBDEIDXDesc.SetPrimary(index: integer; val: boolean);
begin
	if pIDXDesc( FDesc.Get(index) )^.bPrimary = val then exit;
	pIDXDesc( FDesc.Get(index) )^.bPrimary := val;
    FDirty := True;
end;

procedure TBDEIDXDesc.SetUnique(index: integer; val: boolean);
begin
	if pIDXDesc( FDesc.Get(index) )^.bUnique = val then exit;
	pIDXDesc( FDesc.Get(index) )^.bUnique := val;
    FDirty := True;
end;

procedure TBDEIDXDesc.SetDescending(index: integer; val: boolean);
begin
	if pIDXDesc( FDesc.Get(index) )^.BDEscending = val then exit;
	pIDXDesc( FDesc.Get(index) )^.BDEscending := val;
    FDirty := True;
end;

procedure TBDEIDXDesc.SetMaintained(index: integer; val: boolean);
begin
	if pIDXDesc( FDesc.Get(index) )^.bMaintained = val then exit;
	pIDXDesc( FDesc.Get(index) )^.bMaintained := val;
    FDirty := True;
end;

procedure TBDEIDXDesc.SetSubset(index: integer; val: boolean);
begin
	if pIDXDesc( FDesc.Get(index) )^.bSubset = val then exit;
	pIDXDesc( FDesc.Get(index) )^.bSubset := val;
    FDirty := True;
end;

procedure TBDEIDXDesc.SetExpIdx(index: integer; val: boolean);
begin
	if pIDXDesc( FDesc.Get(index) )^.bExpIdx = val then exit;
	pIDXDesc( FDesc.Get(index) )^.bExpIdx := val;
    FDirty := True;
end;

procedure TBDEIDXDesc.SetCost(index: integer; val: integer);
begin
	if pIDXDesc( FDesc.Get(index) )^.iCost = val then exit;
	pIDXDesc( FDesc.Get(index) )^.iCost := val;
    FDirty := True;
end;

procedure TBDEIDXDesc.SetFldsInKey(index: integer; val: integer);
begin
	if pIDXDesc( FDesc.Get(index) )^.iFldsInKey = val then exit;
	pIDXDesc( FDesc.Get(index) )^.iFldsInKey := val;
    FDirty := True;
end;

procedure TBDEIDXDesc.SetKeyLen(index: integer; val: integer);
begin
	if pIDXDesc( FDesc.Get(index) )^.iKeyLen = val then exit;
	pIDXDesc( FDesc.Get(index) )^.iKeyLen := val;
    FDirty := True;
end;

procedure TBDEIDXDesc.SetOutOfDate(index: integer; val: boolean);
begin
	if pIDXDesc( FDesc.Get(index) )^.bOutOfDate = val then exit;
	pIDXDesc( FDesc.Get(index) )^.bOutOfDate := val;
    FDirty := True;
end;

procedure TBDEIDXDesc.SetKeyExpType(index: integer; val: integer);
begin
	if pIDXDesc( FDesc.Get(index) )^.iKeyExpType = val then exit;
	pIDXDesc( FDesc.Get(index) )^.iKeyExpType := val;
    FDirty := True;
end;

procedure TBDEIDXDesc.SetKeyFld(index, pos: integer; val: integer);
begin
	CheckRange( pos, 0, DBIMAXFLDSINKEY - 1 );
	if pIDXDesc( FDesc.Get(index) )^.aiKeyFld[pos] = val then exit;
    pIDXDesc( FDesc.Get(index) )^.aiKeyFld[pos] := val;
    FDirty := True;
end;

procedure TBDEIDXDesc.SetKeyExp(index: integer; val: string);
begin
	if GetKeyExp(index) = val then exit;
    AnsiToNative(Locale, val, pIDXDesc( FDesc.Get(index) )^.szKeyExp, DBIMAXKEYEXPLEN);
    FDirty := True;
end;


procedure TBDEIDXDesc.SetKeyCond(index: integer; val: string);
begin
	if GetKeyCond(index) = val then exit;
    AnsiToNative(Locale, val, pIDXDesc( FDesc.Get(index) )^.szKeyCond, DBIMAXKEYEXPLEN);
    FDirty := True;
end;

procedure TBDEIDXDesc.SetCaseIns(index: integer; val: boolean);
begin
	if pIDXDesc( FDesc.Get(index) )^.bCaseInsensitive = val then exit;
	pIDXDesc( FDesc.Get(index) )^.bCaseInsensitive := val;
    FDirty := True;
end;

procedure TBDEIDXDesc.SetBlockSize(index: integer; val: integer);
begin
	if pIDXDesc( FDesc.Get(index) )^.iBlockSize = val then exit;
	pIDXDesc( FDesc.Get(index) )^.iBlockSize := val;
    FDirty := True;
end;

procedure TBDEIDXDesc.SetDescFlds(index, pos: integer; val: boolean);
begin
	CheckRange( pos, 0, DBIMAXFLDSINKEY - 1 );
	if pIDXDesc( FDesc.Get(index) )^.abDescending[pos] = val then exit;
	pIDXDesc( FDesc.Get(index) )^.abDescending[pos] := val;
    FDirty := True;
end;

procedure TBDEIDXDesc.Swap(idx1, idx2: integer);
begin
	inherited Swap(idx1, idx2);
	FDesc.Swap(idx1, idx2);
end;

{~~~TBDERINTDesc~~~}
constructor TBDERINTDesc.Create(DeltaAlloc: integer);
begin
	FDesc := TDynaData.Create(sizeof(RINTDesc), DeltaAlloc);
    inherited Create(DeltaAlloc);
end;

destructor TBDERINTDesc.Destroy;
begin
    inherited Destroy;
	FDesc.Free;
end;

procedure TBDERINTDesc.CheckSyncCount(value: integer);
begin
	if value <> FDesc.Count then
    	BDEClassError(cDescOpParityError);
end;

procedure TBDERINTDesc.Close;
begin
	FDesc.Clear;
    inherited Close;
end;

procedure TBDERINTDesc.Deflate(count: integer);
begin
	FDesc.Choke(count);
    inherited Deflate(count);
end;

function TBDERINTDesc.GetDesc(index: integer): pRINTDesc;
begin
	result := pRINTDesc(FDesc.Get(index));
end;

function TBDERINTDesc.GetDescPointer: Pointer;
begin
	result := FDesc.ItemAddress(0, 0);
end;

function TBDERINTDesc.GetDescSize: integer;
begin
	result := sizeof(RINTDesc);
end;

function TBDERINTDesc.Inflate(count: integer): integer;
begin
	result := FDesc.GetNewIdx(count);
    inherited Inflate(count);
end;

procedure TBDERINTDesc.Shift(idxHead, idxTail, offset : integer);
begin
	inherited Shift(idxHead, idxTail, offset);
	FDesc.Shift(idxHead, idxTail, offset);
end;

procedure TBDERINTDesc.Open(hDb: hDBIDb; hCursor: hDbiCur; ALocale: Pointer; pcProps: pCURProps);
var
	x: integer;
begin
	inherited Open(hDb, hCursor, ALocale, pcProps);
    if pcProps^.iRefIntChecks <= 0 then exit;
    Inflate(pcProps^.iRefIntChecks);
	for x:= 1 to pcProps^.iRefIntChecks do
    	Check(DbiGetRintDesc(hCursor, x, FDesc.Get(x-1)));
    FDirty := False;
end;

procedure TBDERINTDesc.Purge;
var
	x, y, c, del : integer;
begin
    c := Count - 1;
    y := 0;
    del := 0;
    for x:= 0 to c do
    	if Op[x] <> crDrop then
        begin
        	if y < x then
            	Desc[y]^ := Desc[x]^;
            inc(y);
        end else
        	inc(del);
	if del > 0 then
        FDesc.Choke(del);
    inherited Purge;
end;

function TBDERINTDesc.GetRintNum(index: integer): integer;
begin
    result := pRINTDesc(FDesc.Get(index))^.iRintNum;
end;

function TBDERINTDesc.GetRintName(index: integer): string;
begin
	NativeToAnsi(Locale, pRINTDesc(FDesc.Get(index))^.szRintName, result);
end;

function TBDERINTDesc.GetRintType(index: integer): RINTType;
begin
	result := pRINTDesc(FDesc.Get(index))^.eType;
end;

function TBDERINTDesc.GetTblName(index: integer): string;
begin
	NativeToAnsi(Locale, pRINTDesc(FDesc.Get(index))^.szTblName, result);
end;

function TBDERINTDesc.GetModOp(index: integer): RINTQual;
begin
	result := pRINTDesc(FDesc.Get(index))^.eModOp;
end;

function TBDERINTDesc.GetDelOp(index: integer): RINTQual;
begin
	result := pRINTDesc(FDesc.Get(index))^.eDelOp;
end;

function TBDERINTDesc.GetFldCount(index: integer): integer;
begin
	result := pRINTDesc(FDesc.Get(index))^.iFldCount;
end;

function TBDERINTDesc.GetThisTabFld(index, pos: integer): integer;
begin
	CheckRange(pos, 0, DBIMAXFLDSINKEY - 1);
	result := pRINTDesc(FDesc.Get(index))^.aiThisTabFld[pos];
end;

function TBDERINTDesc.GetOthTabFld(index, pos: integer): integer;
begin
	CheckRange(pos, 0, DBIMAXFLDSINKEY - 1);
    result := pRINTDesc(FDesc.Get(index))^.aiOthTabFld[pos];
end;

procedure TBDERINTDesc.SetRintNum(index, val: integer);
begin
	if pRINTDesc(FDesc.Get(index))^.iRintNum = val then exit;
    pRINTDesc(FDesc.Get(index))^.iRintNum := val;
    FDirty := True;
end;

procedure TBDERINTDesc.SetRintName(index: integer; val: string);
begin
	if GetRintName(index) = val then exit;
    AnsiToNative(Locale, val, pRINTDesc(FDesc.Get(index))^.szRintName, DBIMAXNAMELEN);
	FDirty := True;
end;

procedure TBDERINTDesc.SetRintType(index: integer; val: RINTType);
begin
	if pRINTDesc(FDesc.Get(index))^.eType = val then exit;
    pRINTDesc(FDesc.Get(index))^.eType := val;
    FDirty := True;
end;

procedure TBDERINTDesc.SetTblName(index: integer; val: string);
begin
	if GetTblName(index) = val then exit;
    AnsiToNative(Locale, val, pRINTDesc(FDesc.Get(index))^.szTblName, DBIMAXPATHLEN);
    FDirty := True;
end;

procedure TBDERINTDesc.SetModOp(index: integer; val: RINTQual);
begin
	if pRINTDesc(FDesc.Get(index))^.eModOp = val then exit;
    pRINTDesc(FDesc.Get(index))^.eModOp := val;
    FDirty := True;
end;

procedure TBDERINTDesc.SetDelOp(index: integer; val: RINTQual);
begin
	if pRINTDesc(FDesc.Get(index))^.eDelOp = val then exit;
    pRINTDesc(FDesc.Get(index))^.eDelOp := val;
    FDirty := True;
end;

procedure TBDERINTDesc.SetFldCount(index, val: integer);
begin
	if pRINTDesc(FDesc.Get(index))^.iFldCount = val then exit;
    pRINTDesc(FDesc.Get(index))^.iFldCount := val;
    FDirty := True;
end;

procedure TBDERINTDesc.SetThisTabFld(index, pos, val: integer);
begin
	CheckRange(pos, 0, DBIMAXFLDSINKEY - 1);
	if pRINTDesc(FDesc.Get(index))^.aiThisTabFld[pos] = val then exit;
    pRINTDesc(FDesc.Get(index))^.aiThisTabFld[pos] := val;
    FDirty := True;
end;

procedure TBDERINTDesc.SetOthTabFld(index, pos, val: integer);
begin
	CheckRange(pos, 0, DBIMAXFLDSINKEY - 1);
    if pRINTDesc(FDesc.Get(index))^.aiOthTabFld[pos] = val then exit;
    pRINTDesc(FDesc.Get(index))^.aiOthTabFld[pos] := val;
    FDirty := True;
end;

procedure TBDERINTDesc.Swap(idx1, idx2: integer);
begin
	inherited Swap(idx1, idx2);
	FDesc.Swap(idx1, idx2);
end;

{~~~TBDESECDesc~~~}
constructor TBDESECDesc.Create(DeltaAlloc: integer);
begin
	FDesc := TDynaData.Create(sizeof(SECDesc), DeltaAlloc);
    inherited Create(DeltaAlloc);
end;

destructor TBDESECDesc.Destroy;
begin
    inherited Destroy;
	FDesc.Free;
end;

procedure TBDESECDesc.CheckSyncCount(value: integer);
begin
	if Count <> FDesc.Count then
    	BDEClassError(cDescOpParityError);
end;

procedure TBDESECDesc.Close;
begin
	FDesc.Clear;
    inherited Close;
end;

procedure TBDESECDesc.Deflate(count: integer);
begin
	FDesc.Choke(count);
    inherited Deflate(count);
end;

function TBDESECDesc.GetDesc(index: integer): pSECDesc;
begin
	result := pSECDesc(FDesc.Get(index));
end;

function TBDESECDesc.GetDescPointer: Pointer;
begin
	result := FDesc.ItemAddress(0, 0);
end;

function TBDESECDesc.GetDescSize: integer;
begin
	result := sizeof(SECDesc);
end;

function TBDESECDesc.Inflate(count: integer): integer;
begin
	result := FDesc.GetNewIdx(count);
    inherited Inflate(count);
end;

procedure TBDESECDesc.Shift(idxHead, idxTail, offset : integer);
begin
	inherited Shift(idxHead, idxTail, offset);
	FDesc.Shift(idxHead, idxTail, offset);
end;

procedure TBDESECDesc.Open(hDb: hDBIDb; hCursor: hDbiCur; ALocale: Pointer; pcProps: pCURProps; TableName, TableType: string);
var
	hSecCur: hDBICur;
    secProp: CurProps;
    buf: pChar;
    result : DBIResult;
begin
	inherited Open(hDb, hCursor, ALocale, pcProps);
	Check(DbiOpenSecurityList(hDb, pChar(TableName), pChar(TableType), hSecCur));
	try
		Check(DbiGetCursorProps(hSecCur, secProp));
	    GetMem(buf, secProp.iRecBufSize);
    	try
	    	while True do
	        begin
				result := DbiGetNextRecord(hSecCur, dbiNOLOCK, buf, nil);
	            if result = DBIERR_EOF then break;
	            Check(result);
	            FDesc.EmbedNew(buf);
	        end;
			if FDesc.Count > 0 then
            	inherited Inflate(FDesc.Count);

	    finally
	    	FreeMem(buf);
        end;
    finally
    	DbiCloseCursor(hSecCur);
    end;
    FDirty := False;
end;

procedure TBDESECDesc.Purge;
var
	x, y, c, del : integer;
begin
    c := Count - 1;
    y := 0;
    del := 0;
    for x:= 0 to c do
    	if Op[x] <> crDrop then
        begin
        	if y < x then
            	Desc[y]^ := Desc[x]^;
            inc(y);
        end else
        	inc(del);
	if del > 0 then
        FDesc.Choke(del);
    inherited Purge;
end;

function TBDESECDesc.GetSecNum(index: integer): integer;
begin
	result := pSECDesc(FDesc.Get(index))^.iSecNum;
end;

function TBDESECDesc.GetTable(index: integer): PRVType;
begin
	result := pSECDesc(FDesc.Get(index))^.eprvTable;
end;

function TBDESECDesc.GetFamRights(index: integer): integer;
begin
	result := pSECDesc(FDesc.Get(index))^.iFamRights;
end;

function TBDESECDesc.GetPassword(index: integer): string;
begin
	NativeToAnsi(Locale, pSECDesc(FDesc.Get(index))^.szPassword, result);
end;

function TBDESECDesc.GetFld(index, pos: integer): PRVType;
begin
	CheckRange(pos, 0, DBIMAXFLDSINSEC - 1);
	result := pSECDesc(FDesc.Get(index))^.aprvFld[pos];
end;

procedure TBDESECDesc.SetSecNum(index, val: integer);
begin
	if pSECDesc(FDesc.Get(index))^.iSecNum = val then exit;
    pSECDesc(FDesc.Get(index))^.iSecNum := val;
    FDirty := True;
end;

procedure TBDESECDesc.SetTable(index: integer; val: PRVType);
begin
	if pSECDesc(FDesc.Get(index))^.eprvTable = val then exit;
    pSECDesc(FDesc.Get(index))^.eprvTable := val;
    FDirty := True;
end;

procedure TBDESECDesc.SetFamRights(index, val: integer);
begin
	if pSECDesc(FDesc.Get(index))^.iFamRights = val then exit;
    pSECDesc(FDesc.Get(index))^.iFamRights := val;
    FDirty := True;
end;

procedure TBDESECDesc.SetPassword(index: integer; val: string);
begin
	if GetPassword(index) = val then exit;
	AnsiToNative(Locale, val, pSECDesc(FDesc.Get(index))^.szPassword, DBIMAXNAMELEN);
    FDirty := True;
end;

procedure TBDESECDesc.SetFld(index, pos: integer; val: PRVType);
begin
	CheckRange(pos, 0, DBIMAXFLDSINSEC - 1);
    if pSECDesc(FDesc.Get(index))^.aprvFld[pos] = val then exit;
    pSECDesc(FDesc.Get(index))^.aprvFld[pos] := val;
    FDirty := True;
end;

procedure TBDESECDesc.Swap(idx1, idx2: integer);
begin
	inherited Swap(idx1, idx2);
	FDesc.Swap(idx1, idx2);
end;

{~~~TBDEVCHKDesc~~~}
constructor TBDEVCHKDesc.Create(DeltaAlloc: integer);
begin
	FOnSyncFLDDesc := nil;
	FDesc := TDynaData.Create(sizeof(VCHKDesc), DeltaAlloc);
    inherited Create(DeltaAlloc);
end;

destructor TBDEVCHKDesc.Destroy;
begin
    inherited Destroy;
	FDesc.Free;
end;

procedure TBDEVCHKDesc.Close;
begin
//	FOnSyncFLDDesc := nil;
	FDesc.Clear;
    inherited Close;
end;

procedure TBDEVCHKDesc.CheckSyncCount(value: integer);
begin
	if value <> FDesc.Count then
    	BDEClassError(cDescOpParityError);
end;

procedure TBDEVCHKDesc.Deflate(count: integer);
begin
	FDesc.Choke(count);
    inherited Deflate(count);
end;

function TBDEVCHKDesc.GetDesc(index: integer): pVCHKDesc;
begin
	result := pVCHKDesc(FDesc.Get(index));
end;

function TBDEVCHKDesc.GetDescPointer: Pointer;
begin
	result := FDesc.ItemAddress(0, 0);
end;

function TBDEVCHKDesc.GetDescSize: integer;
begin
	result := sizeof(VCHKDesc);
end;

function TBDEVCHKDesc.Inflate(count: integer): integer;
begin
	result := FDesc.GetNewIdx(count);
    inherited Inflate(count);
end;

procedure TBDEVCHKDesc.Shift(idxHead, idxTail, offset : integer);
begin
	inherited Shift(idxHead, idxTail, offset);
	FDesc.Shift(idxHead, idxTail, offset);
end;

procedure TBDEVCHKDesc.Open(hDb: hDBIDb; hCursor: hDbiCur; ALocale: Pointer; pcProps: pCURProps);
var
	x: integer;
begin
	inherited Open(hDb, hCursor, ALocale, pcProps);
	if pcProps^.iValChecks <= 0 then exit;
    Inflate(pcProps^.iValChecks);
    for x:= 1 to pcProps.iValChecks do
    	Check(DbiGetVchkDesc(hCursor, x, FDesc.Get(x-1)));
    FDirty := False;
end;

procedure TBDEVCHKDesc.Purge;
var
	x, y, c, del : integer;
begin
    c := Count - 1;
    y := 0;
    del := 0;
    for x:= 0 to c do
    	if Op[x] <> crDrop then
        begin
        	if y < x then
            	Desc[y]^ := Desc[x]^;
            inc(y);
        end else
        	inc(del);
	if del > 0 then
        FDesc.Choke(del);
    inherited Purge;
end;

function TBDEVCHKDesc.GetFLDDesc(index: integer): pFLDDesc;
begin
    if not Assigned(FOnSyncFLDDesc) then
    	BDEClassError(cCannotSyncFLDDesc);
	FOnSyncFLDDesc(index, result);
end;

function TBDEVCHKDesc.GetFldNum(index: integer): integer;
begin
	result := pVCHKDesc(FDesc.Get(index))^.iFldNum;
end;

function TBDEVCHKDesc.GetRequired(index: integer): boolean;
begin
	result := pVCHKDesc(FDesc.Get(index))^.bRequired;
end;

function TBDEVCHKDesc.GetMinVal(index: integer): string;
begin
	with pVCHKDesc(FDesc.Get(index))^ do
    	if bHasMinVal then
        	result := VCHKDescToStr(Locale, @aMinVal, GetFLDDesc(iFldNum-1).iFldType)
        else
        	result := '';
end;

function TBDEVCHKDesc.GetMaxVal(index: integer): string;
begin
	with pVCHKDesc(FDesc.Get(index))^ do
    	if bHasMaxVal then
        	result := VCHKDescToStr(Locale, @aMaxVal, GetFLDDesc(iFldNum-1).iFldType)
        else
        	result := '';
end;

function TBDEVCHKDesc.GetDefVal(index: integer): string;
begin
	with pVCHKDesc(FDesc.Get(index))^ do
    	if bHasDefVal then
        	result := VCHKDescToStr(Locale, @aDefVal, GetFLDDesc(iFldNum-1).iFldType)
        else
        	result := '';
end;

function TBDEVCHKDesc.GetPict(index: integer): string;
begin
	NativeToAnsi(Locale, pVCHKDesc(FDesc.Get(index))^.szPict, result);
end;

procedure TBDEVCHKDesc.SetFldNum(index, val: integer);
begin
	if GetFldNum(index) = val then exit;
	pVCHKDesc(FDesc.Get(index))^.iFldNum := val;
    FDirty := True;
end;

procedure TBDEVCHKDesc.SetRequired(index: integer; val: boolean);
begin
	if GetRequired(index) = val then exit;
    pVCHKDesc(FDesc.Get(index))^.bRequired := val;
    FDirty := True;
end;

procedure TBDEVCHKDesc.SetMinVal(index: integer; val: string);
var
	p: pVCHKDesc;
begin
	p := pVCHKDesc(FDesc.Get(index));
    if (p^.bHasMinVal = (val <> '')) and (GetMinVal(index) = val) then exit;
    p^.bHasMinVal := val <> '';
    if p^.bHasMinVal then
	    StrToVCHK(Locale, val, @(p^.aMinVal), GetFLDDesc(p^.iFldNum-1).iFldType);
    FDirty := True;
end;

procedure TBDEVCHKDesc.SetMaxVal(index: integer; val: string);
var
	p: pVCHKDesc;
begin
	p := pVCHKDesc(FDesc.Get(index));
	if (p^.bHasMaxVal = (val <> '')) and (GetMaxVal(index) = val) then exit;
    p^.bHasMaxVal := val <> '';
    if p^.bHasMaxVal then
	    StrToVCHK(Locale, val, @(p^.aMaxVal), GetFLDDesc(p^.iFldNum-1).iFldType);
    FDirty := True;
end;

procedure TBDEVCHKDesc.SetDefVal(index: integer; val: string);
var
	p: pVCHKDesc;
begin
	p := pVCHKDesc(FDesc.Get(index));
	if (p^.bHasDefVal = (val <> '')) and (GetDefVal(index) = val) then exit;
    p^.bHasDefVal := val <> '';
    if p^.bHasDefVal then
	    StrToVCHK(Locale, val, @(p^.aDefVal), GetFLDDesc(p^.iFldNum-1).iFldType);
    FDirty := True;
end;

procedure TBDEVCHKDesc.SetPict(index: integer; val: string);
begin
	if GetPict(index) = val then exit;
	AnsiToNative(Locale, val, pVCHKDesc(FDesc.Get(index))^.szPict, DBIMAXPICTLEN);
    FDirty := True;
end;

procedure TBDEVCHKDesc.Swap(idx1, idx2: integer);
begin
	inherited Swap(idx1, idx2);
	FDesc.Swap(idx1, idx2);
end;


{~~~ TBDEOptDesc ~~~}
constructor TBDEOptDesc.Create(DeltaDescAlloc, DeltaDataAlloc: integer);
begin
	inherited Create(DeltaDescAlloc);
    FData := TDynaData.Create(sizeOf(char), DeltaDataAlloc);
end;

destructor TBDEOptDesc.Destroy;
begin
	FData.Free;
    inherited Destroy;
end;

procedure TBDEOptDesc.AddOption(option: string);
var
	p, x: integer;
    lhs, rhs: string;
begin
	p := pos('=', option);
    if p = 0 then
    	raise EBDEClassError.CreateFmt('Invalid Option Format: %s', [option]);
	lhs := copy(option, 1, p - 1);
    rhs := copy(option, p + 1, length(option));
    x := Inflate(1);
    Op[x] := crAdd;
    Name[x] := lhs;
    p := longint(FData.Add(pChar(rhs), length(rhs) + 1)) - longint(FData.Get(0));
    Offset[x] := p;
    Len[x] := length(rhs) + 1;
end;

procedure TBDEOptDesc.Close;
begin
	inherited Close;
    FData.Clear;
end;

function TBDEOptDesc.Data: pointer;
begin
    if Count = 0 then
    	result := nil
    else
		result := FData.Get(0);
end;

procedure TBDEOptDesc.ToStrings(list: TStrings);
var
	x: integer;
    str: string;
begin
	for x:= 0 to Count - 1 do
    begin
        SetString(str, pChar(FData.Get(Offset[x])), Len[x] - 1);
        list.Add(format('%s=%s', [Name[x], str]));
    end;
end;

end.
