You've already forked lazarus-ccr
27aea1d1ad
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5438 8e941d3f-bd1b-0410-a28a-d453659cc2b4
2206 lines
83 KiB
ObjectPascal
2206 lines
83 KiB
ObjectPascal
{NOTES:
|
|
1. Have verification as optional--IFDEF'd out}
|
|
|
|
{*********************************************************}
|
|
{* FlashFiler: Table data dictionary *}
|
|
{*********************************************************}
|
|
|
|
(* ***** BEGIN LICENSE BLOCK *****
|
|
* Version: MPL 1.1
|
|
*
|
|
* The contents of this file are subject to the Mozilla Public License Version
|
|
* 1.1 (the "License"); you may not use this file except in compliance with
|
|
* the License. You may obtain a copy of the License at
|
|
* http://www.mozilla.org/MPL/
|
|
*
|
|
* Software distributed under the License is distributed on an "AS IS" basis,
|
|
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
|
|
* for the specific language governing rights and limitations under the
|
|
* License.
|
|
*
|
|
* The Original Code is TurboPower FlashFiler
|
|
*
|
|
* The Initial Developer of the Original Code is
|
|
* TurboPower Software
|
|
*
|
|
* Portions created by the Initial Developer are Copyright (C) 1996-2002
|
|
* the Initial Developer. All Rights Reserved.
|
|
*
|
|
* Contributor(s):
|
|
*
|
|
* ***** END LICENSE BLOCK ***** *)
|
|
|
|
{$I ffdefine.inc}
|
|
|
|
unit fflldict;
|
|
|
|
interface
|
|
|
|
uses
|
|
Windows,
|
|
SysUtils,
|
|
Classes,
|
|
FFConst,
|
|
ffllbase,
|
|
ffsrixhl,
|
|
ffsrmgr,
|
|
ffllexcp;
|
|
|
|
|
|
{---Data dictionary class---}
|
|
type
|
|
|
|
PffFieldDescriptorArray = ^TffFieldDescriptorArray;
|
|
TffFieldDescriptorArray = array[Word] of PffFieldDescriptor;
|
|
|
|
PffIndexDescriptorArray = ^TffIndexDescriptorArray;
|
|
TffIndexDescriptorArray = array[0..Pred(ffcl_MaxIndexes)] of PffIndexDescriptor;
|
|
|
|
PffIndexHelperArray = ^TffIndexHelperArray;
|
|
TffIndexHelperArray = array[0..Pred(ffcl_MaxIndexes),
|
|
0..Pred(ffcl_MaxIndexFlds)] of TffSrIndexHelper;
|
|
|
|
TffTriBool = (fftbUnknown, fftbTrue, fftbFalse); {!!.03}
|
|
|
|
TffDataDictionary = class(TPersistent)
|
|
protected {private}
|
|
FBLOBFileNumber : Integer; {file number for BLOBs}
|
|
FFieldCapacity : Longint; {the number of fields the FieldDescriptor
|
|
array has been sized to hold }
|
|
FFldCount : Integer; {count of fields--duplicate for speed}
|
|
FHasBLOBs : TffTriBool; {True if table contains any BLOB fields} {!!.03}
|
|
FIndexCapacity : Longint; {the number of indices the IndexDescriptor
|
|
array has been sized to hold }
|
|
FInxCount : Integer; {count of indexes--duplicate for speed}
|
|
FFileCount : Integer; {count of files--duplicate for speed}
|
|
FBaseName : TffTableName;{the base name for the table}
|
|
FLogRecLen : Longint; {logical rec length--dupe for speed}
|
|
FIsEncrypted : Boolean; {true is files are encrypted}
|
|
|
|
ddFileList : TList; {list of files}
|
|
ddDefFldList : TList; {list of field numbers that have defaults}
|
|
|
|
ddReadOnly : Boolean; {true if the dictionary cannot be updated}
|
|
|
|
procedure AnsiStringWriter(const aString : string; {!!.05}
|
|
aWriter : TWriter); {!!.05}
|
|
{ This method is used to bypass D6's TWriter.WriteString's logic
|
|
for writing strings with extended charcters as UTF8 strings.
|
|
Since D3-D5 and C3-C5 don't recognize the UTF8 string type, it
|
|
causes an error when TReader.ReadString tries to read the
|
|
streams created by D6 using the UTF8 string type.}
|
|
procedure ddExpandFieldArray(const minCapacity : Longint);
|
|
procedure ddExpandIndexArray(const minCapacity : Longint);
|
|
function GetBaseRecordLength : Longint;
|
|
function GetBlockSize : Longint;
|
|
function GetBookmarkSize(aIndexID : Integer) : Integer;
|
|
function GetDefaultFldCount : Integer;
|
|
function GetFieldDecPl(aField : Integer) : Longint;
|
|
function GetFieldDesc(aField : Integer) : TffDictItemDesc;
|
|
function GetFieldLength(aField : Integer) : Longint;
|
|
function GetFieldName(aField : integer) : TffDictItemName;
|
|
function GetFieldOffset(aField : integer) : Longint;
|
|
function GetFieldRequired(aField : integer) : boolean;
|
|
function GetFieldType(aField : integer) : TffFieldType;
|
|
function GetFieldUnits(aField : integer) : Longint;
|
|
function GetFieldVCheck(aField : integer) : PffVCheckDescriptor;
|
|
function GetFileBlockSize(aFile : integer) : Longint;
|
|
function GetFileDesc(aFile : integer) : TffDictItemDesc;
|
|
function GetFileDescriptor(aFile : integer) : PffFileDescriptor;
|
|
function GetFileExt(aFile : integer) : TffExtension;
|
|
function GetFileNameExt(aFile : integer) : TffFileNameExt;
|
|
function GetFileType(aFile : integer) : TffFileType;
|
|
function GetHasBLOBs : Boolean; {!!.03}
|
|
function GetIndexAllowDups(aIndexID : integer) : boolean;
|
|
function GetIndexAscend(aIndexID : integer) : boolean;
|
|
function GetIndexDesc(aIndexID : integer) : TffDictItemDesc;
|
|
function GetIndexFileNumber(aIndexID : integer) : Longint;
|
|
function GetIndexKeyLength(aIndexID : integer) : Longint;
|
|
function GetIndexName(aIndexID : integer) : TffDictItemName;
|
|
function GetIndexNoCase(aIndexID : Integer) : Boolean;
|
|
function GetIndexType(aIndexID : Integer) : TffIndexType;
|
|
function GetRecordLength : Longint;
|
|
procedure CheckForDefault(aVCheckDesc : PffVCheckDescriptor;
|
|
aFieldDesc : PffFieldDescriptor);
|
|
procedure SetBlockSize(BS : Longint);
|
|
procedure SetIsEncrypted(IE : Boolean);
|
|
protected
|
|
procedure ClearPrim(InclFileZero : boolean);
|
|
function CreateFieldDesc(const aIdent : TffDictItemName;
|
|
const aDesc : TffDictItemDesc;
|
|
aType : TffFieldType;
|
|
aUnits : Integer;
|
|
aDecPl : Integer;
|
|
aReqFld : Boolean;
|
|
const aValCheck : PffVCheckDescriptor)
|
|
: PffFieldDescriptor;
|
|
function CreateFileDesc(const aDesc : TffDictItemDesc;
|
|
const aExtension : TffExtension;
|
|
aBlockSize : Longint;
|
|
aType : TffFileType) : PffFileDescriptor;
|
|
function CreateIndexDesc(const aIdent : TffDictItemName;
|
|
const aDesc : TffDictItemDesc;
|
|
aFile : Integer;
|
|
aFldCount : Integer;
|
|
const aFldList : TffFieldList;
|
|
const aFldIHList : TffFieldIHList;
|
|
aAllowDups : Boolean;
|
|
aAscend : Boolean;
|
|
aNoCase : Boolean) : PffIndexDescriptor;
|
|
function CreateUserIndexDesc(const aIdent : TffDictItemName;
|
|
const aDesc : TffDictItemDesc;
|
|
aFile : Integer;
|
|
aKeyLength : Integer;
|
|
aAllowDups : Boolean;
|
|
aAscend : Boolean;
|
|
aNoCase : Boolean) : PffIndexDescriptor;
|
|
|
|
public
|
|
FieldDescriptor : PffFieldDescriptorArray;
|
|
{ Array of field information for the fields in this dictionary.
|
|
Declared as a public array for speed reasons. }
|
|
|
|
IndexDescriptor : PffIndexDescriptorArray;
|
|
{ Array of index information for the indexes in this dictionary.
|
|
Declared as a public array for speed reasons. }
|
|
|
|
IndexHelpers: PffIndexHelperArray;
|
|
{ Index helper objects for composite indices
|
|
declared public (instead of private + public propert)
|
|
for speed reasons}
|
|
|
|
class function NewInstance: TObject; override;
|
|
procedure FreeInstance; override;
|
|
|
|
public
|
|
constructor Create(aBlockSize : Longint);
|
|
{-Create the instance, aBlockSize is the eventual block size
|
|
of the data file component of the table}
|
|
destructor Destroy; override;
|
|
{-Destroy the instance}
|
|
|
|
function AddFile(const aDesc : TffDictItemDesc;
|
|
const aExtension : TffExtension;
|
|
aBlockSize : Longint;
|
|
aFileType : TffFileType) : integer;
|
|
{-Add a file to the data dictionary (the actual file name will
|
|
be the base table name plus aExtension); result is the index
|
|
of the newly-added file in the file list}
|
|
procedure AddIndex(const aIdent : TffDictItemName;
|
|
const aDesc : TffDictItemDesc;
|
|
aFile : integer;
|
|
aFldCount : integer;
|
|
const aFldList : TffFieldList;
|
|
const aFldIHList : TffFieldIHList;
|
|
aAllowDups : boolean;
|
|
aAscend : boolean;
|
|
aCaseInsens : boolean);
|
|
{-Add an extended index to the data dictionary}
|
|
procedure AddUserIndex(const aIdent : TffDictItemName;
|
|
const aDesc : TffDictItemDesc;
|
|
aFile : integer;
|
|
aKeyLength : integer;
|
|
aAllowDups : boolean;
|
|
aAscend : boolean;
|
|
aCaseInsens: boolean);
|
|
{-Add a user defined index to the dictionary}
|
|
procedure AddField(const aIdent : TffDictItemName;
|
|
const aDesc : TffDictItemDesc;
|
|
aType : TffFieldType;
|
|
aUnits : Integer;
|
|
aDecPl : Integer;
|
|
aReqFld : Boolean;
|
|
const aValCheck : PffVCheckDescriptor);
|
|
{-Append a field to the end of the data dictionary's field list}
|
|
procedure Assign(Source: TPersistent); override;
|
|
{-Assign a data dictionary's data}
|
|
procedure BindIndexHelpers;
|
|
{-Binds the TffSrIndexHelper objects to the dictionary}
|
|
procedure CheckValid;
|
|
{-Raise an exception if the dictionary is invalid}
|
|
procedure Clear;
|
|
{-Delete all field/index data from the data dictionary}
|
|
procedure ExtractKey(aIndexID : integer;
|
|
aData : PffByteArray;
|
|
aKey : PffByteArray);
|
|
{-Given a record buffer and an index number, extract the key
|
|
for that index from the record}
|
|
function GetFieldFromName(const aFieldName : TffDictItemName) : integer;
|
|
{-Return the field number for a given field name, or -1 if not
|
|
found}
|
|
function GetIndexFromName(const aIndexName : TffDictItemName) : integer;
|
|
{-Return the index number for a given index name, or -1 if not
|
|
found}
|
|
function HasAutoIncField(var aField : integer) : boolean;
|
|
{-Return true and the index of the first autoinc field in the
|
|
dictionary}
|
|
procedure InsertField(AtIndex : Integer;
|
|
const aIdent : TffDictItemName;
|
|
const aDesc : TffDictItemDesc;
|
|
aType : TffFieldType;
|
|
aUnits : Integer;
|
|
aDecPl : Integer;
|
|
aReqFld : Boolean;
|
|
const aValCheck : PffVCheckDescriptor);
|
|
{-Insert a field into the data dictionary's field list}
|
|
function IsIndexDescValid(const aIndexDesc : TffIndexDescriptor) : boolean;
|
|
{-Return true if the given index descriptor defines a valid index}
|
|
procedure RemoveField(aField : Longint);
|
|
{-Remove a field from the data dictionary's field list}
|
|
procedure RemoveFile(aFile : Longint);
|
|
{-Remove a file from the data dictionary; if index file, the
|
|
relevant indexes are also removed}
|
|
procedure RemoveIndex(aIndex : Longint);
|
|
{-Remove an index from the data dictionary's index list}
|
|
|
|
{===Validity check routines===}
|
|
procedure SetValidityCheck(aField : integer;
|
|
var aExists : boolean;
|
|
const aVCheck : TffVCheckDescriptor);
|
|
{-Set a field's validity check record}
|
|
|
|
function HasSameFields(aSrcDict : TffDataDictionary;
|
|
var aBLOBFields : TffPointerList) : boolean;
|
|
{-Use this method to verify a dictionary has the same field types,
|
|
sizes, and ordering as a source dictionary. Returns True if the
|
|
field information matches otherwise returns False. Note that the
|
|
fields may have different names. If the record contains any
|
|
BLOB fields, the number of each BLOB field is stored in output
|
|
parameter aBLOBFields. }
|
|
|
|
function HasSameFieldsEx(aSrcDict : TffDataDictionary;
|
|
aFields : PffLongintArray;
|
|
aNumFields : integer;
|
|
var aBLOBFields : TffPointerList) : boolean;
|
|
{-Use this method to verify a dictionary has the same field types,
|
|
sizes, and ordering as the specified fields within a source
|
|
dictionary. Returns True if the field information matches otherwise
|
|
returns False. Note that the fields may have different names. If the
|
|
record contains any BLOB fields, the number of each BLOB field is
|
|
stored in output parameter aBLOBFields. }
|
|
|
|
{===record utility routines===}
|
|
function CheckRequiredRecordFields(aData : PffByteArray) : boolean;
|
|
{-Given a record buffer, checks that all required fields are
|
|
non-null}
|
|
procedure GetRecordField(aField : integer;
|
|
aData : PffByteArray;
|
|
var aIsNull: boolean;
|
|
aValue : pointer);
|
|
{-Given a record buffer, read the required field; aIsNull is
|
|
set to true if the field is null (no data is written to
|
|
aValue)}
|
|
procedure InitRecord(aData : PffByteArray);
|
|
{-Given a record buffer, initialize it so that all fields are
|
|
null}
|
|
function IsRecordFieldNull(aField : integer;
|
|
aData : PffByteArray) : boolean;
|
|
{-Given a record buffer, return true if the field is null}
|
|
procedure SetRecordField(aField : integer;
|
|
aData : PffByteArray;
|
|
aValue : pointer);
|
|
{-Given a record buffer, write the required field from the
|
|
buffer pointed to by aValue; if aValue is nil, the field is
|
|
set to null}
|
|
procedure SetRecordFieldNull(aField : integer;
|
|
aData : PffByteArray;
|
|
aIsNull : boolean);
|
|
{-Given a record buffer, set the required field to null or
|
|
non-null. Set the field in the record to binary zeros.}
|
|
|
|
procedure SetBaseName(const BN : TffTableName);
|
|
{-Set the internal table base name - used for error messages}
|
|
|
|
{Begin !!.11}
|
|
procedure SetDefaultFieldValue(aData : PffByteArray;
|
|
const aField : Integer);
|
|
{ If the field has a default value, this method sets the field to that
|
|
value. }
|
|
{End !!.11}
|
|
|
|
procedure SetDefaultFieldValues(aData : PffByteArray);
|
|
{-Set any null fields to their default field, if the field
|
|
has a default value}
|
|
|
|
property BLOBFileNumber : integer
|
|
read FBLOBFileNumber;
|
|
{-The file number of the file that holds the BLOBs}
|
|
property BlockSize : Longint
|
|
read GetBlockSize write SetBlockSize;
|
|
{-The block size of the table to which this dictionary refers;
|
|
equals FileBlockSize[0] the block size of the base file}
|
|
property BookmarkSize [aIndexID : integer] : integer
|
|
read GetBookmarkSize;
|
|
{-The length of a bookmark for the given index}
|
|
property DefaultFieldCount : Integer
|
|
read GetDefaultFldCount;
|
|
{-Number of fields with default values}
|
|
property IsEncrypted : boolean
|
|
read FIsEncrypted write SetIsEncrypted;
|
|
{-Whether the files comprising the table are encrypted}
|
|
|
|
property FieldCount : integer
|
|
read FFldCount;
|
|
{-The number of fields in the data dictionary}
|
|
property FieldDecPl [aField : integer] : Longint
|
|
read GetFieldDecPl;
|
|
{-The decimal places value for a given field in the data dictionary}
|
|
property FieldDesc [aField : integer] : TffDictItemDesc
|
|
read GetFieldDesc;
|
|
{-The description of a given field in the data dictionary}
|
|
property FieldLength [aField : integer] : Longint
|
|
read GetFieldLength;
|
|
{-The length in bytes of a given field in the data dictionary}
|
|
property FieldName [aField : integer] : TffDictItemName
|
|
read GetFieldName;
|
|
{-The name of a given field in the data dictionary}
|
|
property FieldOffset [aField : integer] : Longint
|
|
read GetFieldOffset;
|
|
{-The offset of a given field in the record in the data dictionary}
|
|
property FieldRequired [aField : integer] : boolean
|
|
read GetFieldRequired;
|
|
{-Whether the field is required or not}
|
|
property FieldType [aField : integer] : TffFieldType
|
|
read GetFieldType;
|
|
{-The type of a given field in the data dictionary}
|
|
property FieldUnits [aField : integer] : Longint
|
|
read GetFieldUnits;
|
|
{-The units value for a given field in the data dictionary}
|
|
property FieldVCheck [aField : integer] : PffVCheckDescriptor
|
|
read GetFieldVCheck;
|
|
{-The validity check info for a given field}
|
|
|
|
property FileBlockSize [aFile : integer] : Longint
|
|
read GetFileBlockSize;
|
|
{-The block size of a given file in the data dictionary}
|
|
property FileCount : integer
|
|
read FFileCount;
|
|
{-The number of files in the data dictionary}
|
|
property FileDesc [aFile : integer] : TffDictItemDesc
|
|
read GetFileDesc;
|
|
{-The description of a given file in the data dictionary}
|
|
property FileDescriptor [aFile : integer] : PffFileDescriptor
|
|
read GetFileDescriptor;
|
|
{-The descriptor of a given file in the data dictionary}
|
|
property FileExt [aFile : integer] : TffExtension
|
|
read GetFileExt;
|
|
{-The extension of a given file in the data dictionary}
|
|
property DiskFileName [aFile : integer] : TffFileNameExt
|
|
read GetFileNameExt;
|
|
{-The disk name of a given file in the data dictionary}
|
|
property FileType [aFile : integer] : TffFileType
|
|
read GetFileType;
|
|
{-The type of file: data, index or BLOB}
|
|
property HasBLOBFields : Boolean {!!.03}
|
|
read GetHasBLOBs; {!!.03}
|
|
{-Returns True if the table contains any BLOB fields. } {!!.03}
|
|
property IndexAllowDups [aIndexID : integer] : boolean
|
|
read GetIndexAllowDups;
|
|
{-Whether the given index allows duplicate keys}
|
|
property IndexIsAscending [aIndexID : integer] : boolean
|
|
read GetIndexAscend;
|
|
{-Whether the given index has keys in ascending order}
|
|
property IndexIsCaseInsensitive [aIndexID : integer] : boolean
|
|
read GetIndexNoCase;
|
|
{-Whether the given index has keys in ascending order}
|
|
property IndexCount : integer
|
|
read FInxCount;
|
|
{-The number of indexes in the data dictionary}
|
|
property IndexDesc [aIndexID : integer] : TffDictItemDesc
|
|
read GetIndexDesc;
|
|
{-The description of a given index in the data dictionary}
|
|
property IndexFileNumber [aIndexID : integer] : Longint
|
|
read GetIndexFileNumber;
|
|
{-The descriptor of a given index in the data dictionary}
|
|
property IndexKeyLength [aIndexID : integer] : Longint
|
|
read GetIndexKeyLength;
|
|
{-The key length for the given index}
|
|
property IndexName [aIndexID : integer] : TffDictItemName
|
|
read GetIndexName;
|
|
{-The name of a given field in the data dictionary}
|
|
property IndexType [aIndexID : integer] : TffIndexType
|
|
read GetIndexType;
|
|
{-The type of the given index}
|
|
|
|
property RecordLength : Longint
|
|
read GetRecordLength;
|
|
{-The length of the physical record for the data dictionary. Includes
|
|
trailing byte array to identify null fields. }
|
|
property LogicalRecordLength : Longint
|
|
read GetBaseRecordLength;
|
|
{-The length of the logical record for the data dictionary (ie
|
|
just the total size of the fields. }
|
|
|
|
procedure ReadFromStream(S : TStream);
|
|
procedure WriteToStream(S : TStream);
|
|
|
|
end;
|
|
|
|
{===Key manipulation routines===} {moved here from FFTBBASE}
|
|
procedure FFInitKey(aKey : PffByteArray;
|
|
aKeyLen : integer;
|
|
aKeyFldCount : integer);
|
|
function FFIsKeyFieldNull(aKey : PffByteArray;
|
|
aKeyLen : integer;
|
|
aKeyFldCount : integer;
|
|
aKeyFld : integer) : boolean;
|
|
procedure FFSetKeyFieldNonNull(aKey : PffByteArray;
|
|
aKeyLen : integer;
|
|
aKeyFldCount : integer;
|
|
aKeyFld : integer);
|
|
|
|
implementation
|
|
|
|
const
|
|
ffcl_InitialFieldCapacity = 10;
|
|
{ Number of fields dictionary can hold upon creation. The dictionary
|
|
will expand its capacity as necessary. }
|
|
ffcl_InitialIndexCapacity = 5;
|
|
{ Number of indices dictionary can hold upon creation. The dictionary
|
|
will expand its capacity as necessary. }
|
|
|
|
{===TffDataDictionary================================================}
|
|
constructor TffDataDictionary.Create(aBlockSize : Longint);
|
|
var
|
|
NewFileDesc : PffFileDescriptor;
|
|
NewInxDesc : PffIndexDescriptor;
|
|
SeqAccessName : TffShStr;
|
|
begin
|
|
inherited Create;
|
|
FHasBLOBs := fftbUnknown; {!!.03}
|
|
{verify the block size}
|
|
if not FFVerifyBlockSize(aBlockSize) then
|
|
FFRaiseException(EffException, ffStrResGeneral, fferrBadBlockSize,
|
|
[aBlockSize]);
|
|
{create the file list}
|
|
ddFileList := TList.Create;
|
|
{add the first file name (for the data/data dict file)}
|
|
NewFileDesc := CreateFileDesc(ffStrResGeneral[ffscMainTableFileDesc],
|
|
ffc_ExtForData, aBlockSize, ftBaseFile);
|
|
try
|
|
NewFileDesc^.fdNumber := 0;
|
|
ddFileList.Add(pointer(NewFileDesc));
|
|
FFileCount := 1;
|
|
except
|
|
FFFreeMem(NewFileDesc,sizeof(TffFileDescriptor));
|
|
raise;
|
|
end;{try..except}
|
|
|
|
ddDefFldList := TList.Create;
|
|
|
|
{create the field list}
|
|
FFieldCapacity := ffcl_InitialFieldCapacity;
|
|
FFGetMem(FieldDescriptor, SizeOf(PffFieldDescriptor) * FFieldCapacity);
|
|
{create the index list, add index 0: this is the sequential access
|
|
index}
|
|
|
|
FIndexCapacity := ffcl_InitialIndexCapacity;
|
|
FFGetMem(IndexDescriptor, SizeOf(PffIndexDescriptor) * FIndexCapacity);
|
|
SeqAccessName := ffStrResGeneral[ffscSeqAccessIndexName];
|
|
NewInxDesc := CreateUserIndexDesc(SeqAccessName, SeqAccessName, 0,
|
|
sizeof(TffInt64), false, true, true);
|
|
try
|
|
NewInxDesc^.idNumber := 0;
|
|
IndexDescriptor^[0] := NewInxDesc;
|
|
FInxCount := 1;
|
|
except
|
|
FFFreeMem(NewInxDesc,sizeof(TffIndexDescriptor));
|
|
raise;
|
|
end;{try..except}
|
|
|
|
FFGetMem(IndexHelpers,
|
|
SizeOf(TffSrIndexHelper) * ffcl_MaxIndexFlds * FIndexCapacity);
|
|
end;
|
|
{--------}
|
|
destructor TffDataDictionary.Destroy;
|
|
var
|
|
index : integer;
|
|
P : pointer;
|
|
Pfd : PffFieldDescriptor absolute P; {!!.01}
|
|
begin
|
|
|
|
if assigned(IndexHelpers) then
|
|
FFFreeMem(IndexHelpers,
|
|
FIndexCapacity * ffcl_MaxIndexFlds * SizeOf(TffSrIndexHelper));
|
|
|
|
ClearPrim(true);
|
|
|
|
for Index := pred(FInxCount) downto 0 do begin
|
|
P := IndexDescriptor^[index];
|
|
FFFreeMem(P, sizeof(TffIndexDescriptor));
|
|
end;
|
|
FFFreeMem(IndexDescriptor, SizeOf(PffIndexDescriptor) * FIndexCapacity);
|
|
|
|
for Index := pred(FFldCount) downto 0 do begin
|
|
P := FieldDescriptor^[index];
|
|
if Pfd^.fdVCheck <> nil then {!!.01}
|
|
FFFreeMem(Pfd^.fdVCheck, sizeof(TffVCheckDescriptor)); {!!.01}
|
|
FFFreeMem(P, SizeOf(PffFieldDescriptor) * FFieldCapacity);
|
|
end;
|
|
FFFreeMem(FieldDescriptor, SizeOf(PffFieldDescriptor) * FFieldCapacity);
|
|
|
|
for index := (ddFileList.count - 1) downto 0 do begin
|
|
P := PffFileDescriptor(ddFileList[index]);
|
|
FFFreeMem(P, sizeOf(TffFileDescriptor));
|
|
ddFileList.delete(index);
|
|
end;
|
|
|
|
ddFileList.Free;
|
|
ddDefFldList.Free;
|
|
inherited Destroy;
|
|
end;
|
|
{--------}
|
|
class function TffDataDictionary.NewInstance: TObject;
|
|
begin
|
|
FFGetMem(Result, InstanceSize);
|
|
InitInstance(Result);
|
|
end;
|
|
{--------}
|
|
procedure TffDataDictionary.FreeInstance;
|
|
var
|
|
Temp : pointer;
|
|
begin
|
|
Temp := Self;
|
|
FFFreeMem(Temp, InstanceSize);
|
|
end;
|
|
{--------}
|
|
function TffDataDictionary.AddFile(const aDesc : TffDictItemDesc;
|
|
const aExtension : TffExtension;
|
|
aBlockSize : Longint;
|
|
aFileType : TffFileType) : integer;
|
|
var
|
|
NewDesc : PffFileDescriptor;
|
|
i : integer;
|
|
begin
|
|
{can't be done in readonly mode}
|
|
if ddReadOnly then
|
|
FFRaiseException(EffException, ffStrResGeneral, fferrDictReadOnly, [FBaseName]);
|
|
{verify the extension}
|
|
if not FFVerifyExtension(aExtension) then
|
|
FFRaiseException(EffException, ffStrResGeneral, fferrBadExtension, [FBaseName, aExtension]);
|
|
{verify the block size}
|
|
if not FFVerifyBlockSize(aBlockSize) then
|
|
FFRaiseException(EffException, ffStrResGeneral, fferrBadBlockSize, [aBlockSize]);
|
|
{if a base file type, check to see whether file 0 has been added
|
|
already}
|
|
if (aFileType = ftBaseFile) then
|
|
if (FFileCount > 0) then
|
|
FFRaiseException(EffException, ffStrResGeneral, fferrDataFileDefd, [FBaseName]);
|
|
{check to see whether the extension has been used already}
|
|
for i := 0 to pred(FFileCount) do
|
|
if (PffFileDescriptor(ddFileList[i])^.fdExtension = aExtension) then
|
|
FFRaiseException(EffException, ffStrResGeneral, fferrDupExtension, [FBaseName, aExtension]);
|
|
{if a BLOB file type check to see whether we have one already; we
|
|
can ignore file 0: it's the base file (ie data & dictionary)}
|
|
if (aFileType = ftBLOBFile) then
|
|
if (BLOBFileNumber <> 0) then
|
|
FFRaiseException(EffException, ffStrResGeneral, fferrBLOBFileDefd, [FBaseName]);
|
|
{add a new file descriptor}
|
|
NewDesc := CreateFileDesc(aDesc, aExtension, aBlockSize, aFileType);
|
|
try
|
|
Result := FFileCount;
|
|
NewDesc^.fdNumber := FFileCount;
|
|
if (aFileType = ftBLOBFile) then
|
|
FBLOBFileNumber := FFileCount;
|
|
ddFileList.Add(pointer(NewDesc));
|
|
inc(FFileCount);
|
|
except
|
|
FFFreeMem(NewDesc,sizeof(TffFileDescriptor));
|
|
raise;
|
|
end;{try..except}
|
|
end;
|
|
{--------}
|
|
procedure TffDataDictionary.AddIndex(const aIdent : TffDictItemName;
|
|
const aDesc : TffDictItemDesc;
|
|
aFile : integer;
|
|
aFldCount : integer;
|
|
const aFldList : TffFieldList;
|
|
const aFldIHList : TffFieldIHList;
|
|
aAllowDups : boolean;
|
|
aAscend : boolean;
|
|
aCaseInsens: boolean);
|
|
var
|
|
NewDesc : PffIndexDescriptor;
|
|
i : integer;
|
|
begin
|
|
{check for a duplicate index name}
|
|
if (GetIndexFromName(aIdent) <> -1) then
|
|
FFRaiseException(EffException, ffStrResGeneral, fferrDupIndexName,
|
|
[FBaseName, aIdent]);
|
|
{check the file number}
|
|
if (0 > aFile) or (aFile >= FFileCount) then
|
|
FFRaiseException(EffException, ffStrResGeneral, fferrBadFileNumber,
|
|
[FBaseName, aFile]);
|
|
{check all field numbers in field list}
|
|
for i := 0 to pred(aFldCount) do
|
|
if (aFldList[i] < 0) or (aFldList[i] >= FFldCount) then
|
|
FFRaiseException(EffException, ffStrResGeneral, fferrBadFieldRef,
|
|
[FBaseName, aFldList[i]]);
|
|
{create the new index}
|
|
NewDesc := CreateIndexDesc(aIdent, aDesc, aFile, aFldCount, aFldList,
|
|
aFldIHList, aAllowDups, aAscend, aCaseInsens);
|
|
try
|
|
NewDesc^.idNumber := FInxCount;
|
|
IndexDescriptor^[FInxCount] := NewDesc;
|
|
inc(FInxCount);
|
|
{ Have we reached our index capacity? }
|
|
if FInxCount = FIndexCapacity then
|
|
ddExpandIndexArray(0);
|
|
except
|
|
FFFreeMem(NewDesc,sizeof(TffIndexDescriptor));
|
|
raise;
|
|
end;{try..except}
|
|
end;
|
|
{--------}
|
|
procedure TffDataDictionary.AddUserIndex(const aIdent : TffDictItemName;
|
|
const aDesc : TffDictItemDesc;
|
|
aFile : integer;
|
|
aKeyLength : integer;
|
|
aAllowDups : boolean;
|
|
aAscend : boolean;
|
|
aCaseInsens: boolean);
|
|
var
|
|
NewDesc : PffIndexDescriptor;
|
|
begin
|
|
{can't be done in readonly mode}
|
|
if ddReadOnly then
|
|
FFRaiseException(EffException, ffStrResGeneral, fferrDictReadOnly, [FBaseName]);
|
|
{check the file number}
|
|
if (0 > aFile) or (aFile >= FFileCount) then
|
|
FFRaiseException(EffException, ffStrResGeneral, fferrBadFileNumber, [FBaseName, aFile]);
|
|
{check the key length}
|
|
if not FFVerifyKeyLength(aKeyLength) then
|
|
FFRaiseException(EffException, ffStrResGeneral, fferrKeyTooLong, [aKeyLength]);
|
|
{create the new index}
|
|
NewDesc := CreateUserIndexDesc(aIdent, aDesc, aFile, aKeyLength, aAllowDups, aAscend, aCaseInsens);
|
|
try
|
|
NewDesc^.idNumber := FInxCount;
|
|
IndexDescriptor^[FInxCount] := NewDesc;
|
|
inc(FInxCount);
|
|
{ Have we reached our index capacity? }
|
|
if FInxCount = FIndexCapacity then
|
|
ddExpandIndexArray(0);
|
|
except
|
|
FFFreeMem(NewDesc,sizeof(TffIndexDescriptor));
|
|
raise;
|
|
end;{try..except}
|
|
end;
|
|
{--------}
|
|
procedure TffDataDictionary.AddField(const aIdent : TffDictItemName;
|
|
const aDesc : TffDictItemDesc;
|
|
aType : TffFieldType;
|
|
aUnits : Integer;
|
|
aDecPl : Integer;
|
|
aReqFld : Boolean;
|
|
const aValCheck : PffVCheckDescriptor);
|
|
var
|
|
NewDesc : PffFieldDescriptor;
|
|
TempDesc : PffFieldDescriptor;
|
|
begin
|
|
{can't be done in readonly mode}
|
|
if ddReadOnly then
|
|
FFRaiseException(EffException, ffStrResGeneral, fferrDictReadOnly, [FBaseName]);
|
|
{check for a duplicate field name}
|
|
if (GetFieldFromName(aIdent) <> -1) then
|
|
FFRaiseException(EffException, ffStrResGeneral, fferrDupFieldName, [FBaseName, aIdent]);
|
|
{create it}
|
|
NewDesc := CreateFieldDesc(aIdent, aDesc, aType, aUnits, aDecPl, aReqFld, aValCheck);
|
|
try
|
|
NewDesc^.fdNumber := FFldCount;
|
|
if (FFldCount > 0) then begin
|
|
TempDesc := FieldDescriptor^[pred(FFldCount)];
|
|
with TempDesc^ do
|
|
NewDesc^.fdOffset := fdOffset + fdLength;
|
|
end;
|
|
FieldDescriptor^[FFldCount] := NewDesc;
|
|
inc(FFldCount);
|
|
{ Have we reached our field capacity? }
|
|
if FFldCount = FFieldCapacity then
|
|
{ Yes, expand our field array. }
|
|
ddExpandFieldArray(0);
|
|
with NewDesc^ do
|
|
FLogRecLen := fdOffset + fdLength;
|
|
FHasBLOBs := fftbUnknown; {!!.03}
|
|
except
|
|
FFFreeMem(NewDesc,sizeof(TffFieldDescriptor));
|
|
raise;
|
|
end;{try..except}
|
|
end;
|
|
{--------}
|
|
procedure TffDataDictionary.AnsiStringWriter(const aString : string; {!!.05 - Added}
|
|
aWriter : TWriter);
|
|
var
|
|
TempInt : Integer;
|
|
begin
|
|
TempInt := Integer(vaString);
|
|
aWriter.Write(TempInt, SizeOf(vaString));
|
|
|
|
TempInt := Length(aString);
|
|
aWriter.Write(TempInt, SizeOf(Byte));
|
|
|
|
if (TempInt > 0) then
|
|
aWriter.Write(aString[1], TempInt);
|
|
end;
|
|
{--------} {!!.05 - End Added}
|
|
procedure TffDataDictionary.Assign(Source: TPersistent);
|
|
var
|
|
// CheckVal : PffVCheckDescriptor; {!!.01}
|
|
item : integer;
|
|
SelfFldDesc : PffFieldDescriptor;
|
|
SrcDict : TffDataDictionary absolute Source;
|
|
begin
|
|
{can't be done in readonly mode}
|
|
if ddReadOnly then
|
|
FFRaiseException(EffException, ffStrResGeneral, fferrDictReadOnly, [FBaseName]);
|
|
{Source must be one of us}
|
|
if not (Source is TffDataDictionary) then
|
|
FFRaiseException(EffException, ffStrResGeneral, fferrNotADict, [FBaseName]);
|
|
{firstly clear our own lists (remove the base file item as well)}
|
|
ClearPrim(true);
|
|
{copy over the encrypted mode}
|
|
Self.FIsEncrypted := TffDataDictionary(Source).IsEncrypted;
|
|
{ Now duplicate the items in the Source's lists. }
|
|
try
|
|
{ The file list first; do include index 0. }
|
|
for item := 0 to pred(SrcDict.FFileCount) do
|
|
with PffFileDescriptor(SrcDict.ddFileList[item])^ do
|
|
Self.AddFile(fdDesc, fdExtension, fdBlockSize, fdType);
|
|
|
|
{ The field list next. }
|
|
FHasBLOBs := fftbUnknown; {!!.03}
|
|
for item := 0 to pred(SrcDict.FFldCount) do
|
|
with SrcDict.FieldDescriptor^[Item]^ do begin
|
|
if Assigned(fdVCheck) then
|
|
Self.AddField(fdName, fdDesc, fdType, fdUnits, fdDecPl, fdRequired,
|
|
fdVCheck)
|
|
else begin
|
|
// FFGetZeroMem(CheckVal, sizeof(TffVCheckDescriptor)); {Deleted !!.01}
|
|
Self.AddField(fdName, fdDesc, fdType, fdUnits, fdDecPl, fdRequired,
|
|
nil) {!!.01}
|
|
end;
|
|
if assigned(fdVCheck) then begin
|
|
SelfFldDesc := Self.FieldDescriptor^[item];
|
|
if SelfFldDesc^.fdVCheck = nil then {!!.06}
|
|
FFGetMem(SelfFldDesc^.fdVCheck, sizeOf(TffVCheckDescriptor)); {!!.06}
|
|
Move(fdVCheck^, SelfFldDesc^.fdVCheck^, sizeof(fdVCheck^));
|
|
end;
|
|
end;
|
|
|
|
{ The index list next; skip index 0. }
|
|
for item := 1 to pred(SrcDict.FInxCount) do
|
|
with SrcDict.IndexDescriptor^[item]^ do
|
|
if (idCount <> -1) then
|
|
Self.AddIndex(idName, idDesc, idFile, idCount,
|
|
idFields, idFieldIHlprs, idDups, idAscend, idNoCase)
|
|
else
|
|
Self.AddUserIndex(idName, idDesc, idFile, idKeyLen, idDups, idAscend, idNoCase)
|
|
except
|
|
ClearPrim(true);
|
|
raise;
|
|
end;{try..except}
|
|
end;
|
|
{--------}
|
|
procedure TffDataDictionary.BindIndexHelpers;
|
|
var
|
|
i,j : Integer;
|
|
begin
|
|
for i:= 0 to pred(IndexCount) do
|
|
with IndexDescriptor^[i]^do
|
|
if idCount>=0 then begin
|
|
for j:= 0 to Pred(idCount) do
|
|
IndexHelpers[i,j] :=
|
|
TffSrIndexHelper.FindHelper(idFieldIHlprs[j],GetFieldType(idFields[j]));
|
|
end;
|
|
end;
|
|
{--------}
|
|
function TffDataDictionary.CheckRequiredRecordFields(aData : PffByteArray) : Boolean;
|
|
var
|
|
FieldInx : integer;
|
|
BS : PffByteArray;
|
|
begin
|
|
{note: it's probably faster to find all the null fields and then
|
|
check their required status, rather than the other way round
|
|
(getting a field descriptor requires a whole lot more calls
|
|
than checking a bit) but it does depend on a lotta factors.}
|
|
Result := false;
|
|
if (aData = nil) then
|
|
Exit;
|
|
BS := PffByteArray(@aData^[FLogRecLen]);
|
|
for FieldInx := 0 to pred(FFldCount) do begin
|
|
if FFIsBitSet(BS, FieldInx) then
|
|
if FieldDescriptor^[FieldInx]^.fdRequired then
|
|
Exit;
|
|
end;
|
|
Result := true;
|
|
end;
|
|
{--------}
|
|
procedure TffDataDictionary.CheckValid;
|
|
var
|
|
item : integer;
|
|
i : integer;
|
|
Fld : PffFieldDescriptor;
|
|
Indx : PffIndexDescriptor;
|
|
begin
|
|
if (FFldCount <= 0) then
|
|
FFRaiseException(EffException, ffStrResGeneral, fferrNoFields, [FBaseName]);
|
|
if (RecordLength > (BlockSize - ffc_BlockHeaderSizeData - sizeof(Longint))) then
|
|
FFRaiseException(EffException, ffStrResGeneral, fferrRecTooLong, [FBaseName]);
|
|
if (IndexCount > ffcl_MaxIndexes) then
|
|
FFRaiseException(EffException, ffStrResGeneral, fferrMaxIndexes, [FBaseName]);
|
|
{check all field numbers in all indexes, recalc key lengths}
|
|
if (FInxCount > 1) then
|
|
for item := 1 to pred(FInxCount) do
|
|
with IndexDescriptor^[item]^ do
|
|
if (idCount <> -1) then begin
|
|
if (idCount = 0) then
|
|
FFRaiseException(EffException, ffStrResGeneral, fferrNoFieldsInKey, [FBaseName]);
|
|
idKeyLen := 0;
|
|
for i := 0 to pred(idCount) do begin
|
|
if (idFields[i] < 0) or (idFields[i] >= FFldCount) then
|
|
FFRaiseException(EffException, ffStrResGeneral, fferrBadFieldRef, [FBaseName, idFields[i]]);
|
|
inc(idKeyLen, FieldDescriptor^[idFields[i]]^.fdLength);
|
|
end;
|
|
inc(idKeyLen, (idCount + 7) div 8);
|
|
end;
|
|
{field names must be unique}
|
|
for item := 0 to pred(FFldCount) do begin
|
|
Fld := FieldDescriptor^[item];
|
|
if (GetFieldFromName(Fld^.fdName) <> item) then
|
|
FFRaiseException(EffException, ffStrResGeneral, fferrDupFieldName, [FBaseName, Fld^.fdName]);
|
|
end;
|
|
{index names must be unique}
|
|
if (FInxCount > 1) then
|
|
for item := 1 to pred(FInxCount) do begin
|
|
Indx := IndexDescriptor^[item];
|
|
if (GetIndexFromName(Indx^.idName) <> item) then
|
|
FFRaiseException(EffException, ffStrResGeneral, fferrDupIndexName, [FBaseName, Indx^.idName]);
|
|
end;
|
|
end;
|
|
{--------}
|
|
procedure TffDataDictionary.Clear;
|
|
begin
|
|
{can't be done in readonly mode}
|
|
if ddReadOnly then
|
|
FFRaiseException(EffException, ffStrResGeneral, fferrDictReadOnly, [FBaseName]);
|
|
ClearPrim(false);
|
|
end;
|
|
{--------}
|
|
procedure TffDataDictionary.ClearPrim(InclFileZero : boolean);
|
|
var
|
|
item : integer;
|
|
BaseFileDesc : PffFileDescriptor;
|
|
TmpIndexDesc : PffIndexDescriptor;
|
|
FldDesc : PffFieldDescriptor;
|
|
begin
|
|
{clear the entire file list EXCEPT item zero}
|
|
for item := 1 to pred(FFileCount) do begin
|
|
BaseFileDesc := PffFileDescriptor(ddFileList[item]);
|
|
FFFreeMem(BaseFileDesc, sizeof(TffFileDescriptor));
|
|
end;
|
|
{decide what to do about item zero: save it or dispose of it}
|
|
if InclFileZero and (FFileCount > 0) then begin
|
|
BaseFileDesc := PffFileDescriptor(ddFileList[0]);
|
|
FFFreeMem(BaseFileDesc, sizeof(TffFileDescriptor));
|
|
ddFileList.Clear;
|
|
FFileCount := 0;
|
|
end
|
|
else {don't dispose of file 0} begin
|
|
BaseFileDesc := PffFileDescriptor(ddFileList[0]);
|
|
ddFileList.Clear;
|
|
ddFileList.Add(pointer(BaseFileDesc));
|
|
FFileCount := 1;
|
|
end;
|
|
{clear the entire field list}
|
|
for item := 0 to pred(FFldCount) do begin
|
|
FldDesc := FieldDescriptor^[item];
|
|
if (FldDesc^.fdVCheck <> nil) then
|
|
FFFreeMem(FldDesc^.fdVCheck, sizeOf(TffVCheckDescriptor));
|
|
FFFreeMem(FldDesc, sizeOf(TffFieldDescriptor));
|
|
end;
|
|
FFldCount := 0;
|
|
FLogRecLen := 0;
|
|
{clear the entire index list EXCEPT for the first item}
|
|
for item := 1 to pred(FInxCount) do begin
|
|
TmpIndexDesc := IndexDescriptor^[item];
|
|
FFFreeMem(TmpIndexDesc, sizeOf(TffIndexDescriptor));
|
|
IndexDescriptor^[item] := nil;
|
|
end;
|
|
FInxCount := 1;
|
|
|
|
{clear out any old default field values} {!!.03}
|
|
ddDefFldList.Clear; {!!.03}
|
|
FHasBLOBs := fftbUnknown; {!!.03}
|
|
end;
|
|
{--------}
|
|
function TffDataDictionary.CreateFieldDesc(const aIdent : TffDictItemName;
|
|
const aDesc : TffDictItemDesc;
|
|
aType : TffFieldType;
|
|
aUnits : Integer;
|
|
aDecPl : Integer;
|
|
aReqFld : Boolean;
|
|
const aValCheck : PffVCheckDescriptor)
|
|
: PffFieldDescriptor;
|
|
var
|
|
FT : Integer;
|
|
begin
|
|
if (aType = fftAutoInc) then
|
|
aReqFld := false;
|
|
FFGetZeroMem(Result, sizeof(TffFieldDescriptor));
|
|
with Result^ do begin
|
|
fdName := aIdent;
|
|
fdDesc := aDesc;
|
|
fdType := aType;
|
|
fdRequired := aReqFld;
|
|
case aType of
|
|
fftBoolean :
|
|
begin
|
|
fdUnits := 0;
|
|
fdDecPl := 0;
|
|
fdLength := sizeof(Boolean);
|
|
CheckForDefault(aValCheck, Result);
|
|
end;
|
|
fftChar :
|
|
begin
|
|
fdUnits := 1;
|
|
fdDecPl := 0;
|
|
fdLength := sizeof(AnsiChar);
|
|
CheckForDefault(aValCheck, Result);
|
|
end;
|
|
fftWideChar :
|
|
begin
|
|
fdUnits := 1;
|
|
fdDecPl := 0;
|
|
fdLength := sizeof(WideChar);
|
|
CheckForDefault(aValCheck, Result);
|
|
end;
|
|
fftByte :
|
|
begin
|
|
if (aUnits < 0) or (aUnits > 3) then
|
|
fdUnits := 3
|
|
else
|
|
fdUnits := aUnits;
|
|
fdDecPl := 0;
|
|
fdLength := sizeof(byte);
|
|
CheckForDefault(aValCheck, Result);
|
|
end;
|
|
fftWord16 :
|
|
begin
|
|
if (aUnits < 0) or (aUnits > 5) then
|
|
fdUnits := 5
|
|
else
|
|
fdUnits := aUnits;
|
|
fdDecPl := 0;
|
|
fdLength := sizeof(TffWord16);
|
|
CheckForDefault(aValCheck, Result);
|
|
end;
|
|
fftWord32 :
|
|
begin
|
|
if (aUnits < 0) or (aUnits > 10) then
|
|
fdUnits := 10
|
|
else
|
|
fdUnits := aUnits;
|
|
fdDecPl := 0;
|
|
fdLength := sizeof(TffWord32);
|
|
CheckForDefault(aValCheck, Result);
|
|
end;
|
|
fftInt8 :
|
|
begin
|
|
if (aUnits < 0) or (aUnits > 3) then
|
|
fdUnits := 3
|
|
else
|
|
fdUnits := aUnits;
|
|
fdDecPl := 0;
|
|
fdLength := sizeof(shortint);
|
|
CheckForDefault(aValCheck, Result);
|
|
end;
|
|
fftInt16 :
|
|
begin
|
|
if (aUnits < 0) or (aUnits > 5) then
|
|
fdUnits := 5
|
|
else
|
|
fdUnits := aUnits;
|
|
fdDecPl := 0;
|
|
fdLength := sizeof(smallint);
|
|
CheckForDefault(aValCheck, Result);
|
|
end;
|
|
fftInt32 :
|
|
begin
|
|
if (aUnits < 0) or (aUnits > 10) then
|
|
fdUnits := 10
|
|
else
|
|
fdUnits := aUnits;
|
|
fdDecPl := 0;
|
|
fdLength := sizeof(Longint);
|
|
CheckForDefault(aValCheck, Result);
|
|
end;
|
|
fftAutoInc :
|
|
begin
|
|
fdUnits := 10;
|
|
fdDecPl := 0;
|
|
fdLength := sizeof(Longint);
|
|
end;
|
|
fftSingle :
|
|
begin
|
|
fdUnits := aUnits;
|
|
fdDecPl := aDecPl;
|
|
fdLength := sizeof(single);
|
|
CheckForDefault(aValCheck, Result);
|
|
end;
|
|
fftDouble :
|
|
begin
|
|
fdUnits := aUnits;
|
|
fdDecPl := aDecPl;
|
|
fdLength := sizeof(double);
|
|
CheckForDefault(aValCheck, Result);
|
|
end;
|
|
fftExtended :
|
|
begin
|
|
fdUnits := aUnits;
|
|
fdDecPl := aDecPl;
|
|
fdLength := sizeof(extended);
|
|
CheckForDefault(aValCheck, Result);
|
|
end;
|
|
fftComp :
|
|
begin
|
|
fdUnits := aUnits;
|
|
fdDecPl := aDecPl;
|
|
fdLength := sizeof(comp);
|
|
CheckForDefault(aValCheck, Result);
|
|
end;
|
|
fftCurrency :
|
|
begin
|
|
fdUnits := aUnits;
|
|
fdDecPl := aDecPl;
|
|
fdLength := sizeof(comp);
|
|
CheckForDefault(aValCheck, Result);
|
|
end;
|
|
fftStDate :
|
|
begin
|
|
fdUnits := 0;
|
|
fdDecPl := 0;
|
|
fdLength := sizeof(Longint);
|
|
CheckForDefault(aValCheck, Result);
|
|
end;
|
|
fftStTime :
|
|
begin
|
|
fdUnits := 0;
|
|
fdDecPl := 0;
|
|
fdLength := sizeof(Longint);
|
|
CheckForDefault(aValCheck, Result);
|
|
end;
|
|
fftDateTime :
|
|
begin
|
|
fdUnits := 0;
|
|
fdDecPl := 0;
|
|
fdLength := sizeof(double);
|
|
CheckForDefault(aValCheck, Result);
|
|
end;
|
|
fftBLOB,
|
|
fftBLOBMemo,
|
|
fftBLOBFmtMemo,
|
|
fftBLOBOLEObj,
|
|
fftBLOBGraphic,
|
|
fftBLOBDBSOLEObj,
|
|
fftBLOBTypedBin,
|
|
fftBLOBFile :
|
|
begin
|
|
fdUnits := 0;
|
|
fdDecPl := 0;
|
|
fdLength := sizeof(TffInt64);
|
|
end;
|
|
fftByteArray :
|
|
begin
|
|
fdUnits := aUnits;
|
|
fdDecPl := 0;
|
|
fdLength := aUnits;
|
|
end;
|
|
fftShortString, fftShortAnsiStr, fftNullString, fftNullAnsiStr :
|
|
begin
|
|
fdUnits := aUnits;
|
|
fdDecPl := 0;
|
|
fdLength := (aUnits + 1) * sizeof(AnsiChar);
|
|
CheckForDefault(aValCheck, Result);
|
|
end;
|
|
fftWideString :
|
|
begin
|
|
fdUnits := aUnits;
|
|
fdDecPl := 0;
|
|
fdLength := (aUnits + 1) * sizeof(WideChar);
|
|
CheckForDefault(aValCheck, Result);
|
|
end;
|
|
else
|
|
FT := ord(aType);
|
|
FFRaiseException(EffException, ffStrResGeneral, fferrBadFieldType, [FT]);
|
|
end;{case}
|
|
end;
|
|
end;
|
|
{--------}
|
|
function TffDataDictionary.CreateFileDesc(const aDesc : TffDictItemDesc;
|
|
const aExtension : TffExtension;
|
|
aBlockSize : Longint;
|
|
aType : TffFileType)
|
|
: PffFileDescriptor;
|
|
begin
|
|
FFGetZeroMem(Result, sizeof(TffFileDescriptor));
|
|
with Result^ do
|
|
begin
|
|
fdDesc := aDesc;
|
|
fdExtension := aExtension;
|
|
fdBlockSize := aBlockSize;
|
|
fdType := aType;
|
|
end;
|
|
end;
|
|
{--------}
|
|
function TffDataDictionary.CreateIndexDesc(const aIdent : TffDictItemName;
|
|
const aDesc : TffDictItemDesc;
|
|
aFile : integer;
|
|
aFldCount : integer;
|
|
const aFldList : TffFieldList;
|
|
const aFldIHList : TffFieldIHList;
|
|
aAllowDups : boolean;
|
|
aAscend : boolean;
|
|
aNoCase : boolean)
|
|
: PffIndexDescriptor;
|
|
var
|
|
i : integer;
|
|
begin
|
|
FFGetZeroMem(Result, sizeof(TffIndexDescriptor));
|
|
with Result^ do begin
|
|
idName := aIdent;
|
|
idDesc := aDesc;
|
|
idFile := aFile;
|
|
idCount := aFldCount;
|
|
idDups := aAllowDups;
|
|
idKeyLen := 0;
|
|
for i := 0 to pred(aFldCount) do begin
|
|
idFields[i] := aFldList[i];
|
|
inc(idKeyLen, FieldDescriptor^[aFldList[i]]^.fdLength);
|
|
end;
|
|
for i := 0 to pred(aFldCount) do
|
|
idFieldIHlprs[i] := aFldIHList[i];
|
|
inc(idKeyLen, {the key length itself}
|
|
(aFldCount + 7) div 8); {the bit array for nulls}
|
|
idAscend := aAscend;
|
|
idNoCase := aNoCase;
|
|
end;
|
|
end;
|
|
{--------}
|
|
function TffDataDictionary.CreateUserIndexDesc(const aIdent : TffDictItemName;
|
|
const aDesc : TffDictItemDesc;
|
|
aFile : integer;
|
|
aKeyLength : integer;
|
|
aAllowDups : boolean;
|
|
aAscend : boolean;
|
|
aNoCase : boolean)
|
|
: PffIndexDescriptor;
|
|
begin
|
|
FFGetZeroMem(Result, sizeof(TffIndexDescriptor));
|
|
with Result^ do begin
|
|
idName := aIdent;
|
|
idFile := aFile;
|
|
idDups := aAllowDups;
|
|
idCount := -1;
|
|
idKeyLen := aKeyLength;
|
|
idAscend := aAscend;
|
|
idNoCase := aNoCase;
|
|
end;
|
|
end;
|
|
{--------}
|
|
procedure TffDataDictionary.ddExpandFieldArray(const minCapacity : Longint);
|
|
var
|
|
OldCapacity : Longint;
|
|
begin
|
|
OldCapacity := FFieldCapacity;
|
|
{Begin !!.02}
|
|
if minCapacity = 0 then
|
|
inc(FFieldCapacity, ffcl_InitialFieldCapacity * 2)
|
|
else if FFieldCapacity = minCapacity then
|
|
Exit
|
|
else
|
|
FFieldCapacity := minCapacity;
|
|
{End !!.02}
|
|
FFReallocMem(FieldDescriptor, SizeOf(PffFieldDescriptor) * OldCapacity,
|
|
SizeOf(PffFieldDescriptor) * FFieldCapacity);
|
|
end;
|
|
{--------}
|
|
procedure TffDataDictionary.ddExpandIndexArray(const minCapacity : Longint);
|
|
var
|
|
OldCapacity : Longint;
|
|
begin
|
|
OldCapacity := FIndexCapacity;
|
|
{Begin !!.02}
|
|
if minCapacity = 0 then
|
|
inc(FIndexCapacity, ffcl_InitialIndexCapacity * 2)
|
|
else if FIndexCapacity = minCapacity then
|
|
Exit
|
|
else
|
|
FIndexCapacity := minCapacity;
|
|
{End !!.02}
|
|
FFReallocMem(IndexDescriptor, SizeOf(PffIndexDescriptor) * OldCapacity,
|
|
SizeOf(PffIndexDescriptor) * FIndexCapacity);
|
|
FFReallocMem(IndexHelpers,
|
|
SizeOf(TffSrIndexHelper) * ffcl_MaxIndexFlds * OldCapacity,
|
|
SizeOf(TffSrIndexHelper) * ffcl_MaxIndexFlds * FIndexCapacity);
|
|
end;
|
|
{--------}
|
|
procedure TffDataDictionary.ExtractKey(aIndexID : integer;
|
|
aData : PffByteArray;
|
|
aKey : PffByteArray);
|
|
var
|
|
KeyOffset : integer;
|
|
FieldNumber : integer;
|
|
begin
|
|
KeyOffset := 0;
|
|
with IndexDescriptor^[aIndexID]^ do begin
|
|
{clear the entire key - sets all fields to null as well}
|
|
FFInitKey(aKey, idKeyLen, idCount);
|
|
{now build it}
|
|
for FieldNumber := 0 to pred(idCount) do begin
|
|
with FieldDescriptor^[idFields[FieldNumber]]^ do begin
|
|
if not IsRecordFieldNull(idFields[FieldNumber], aData) then begin
|
|
Move(aData^[fdOffset], aKey^[KeyOffset], fdLength);
|
|
FFSetKeyFieldNonNull(aKey, idKeyLen, idCount, FieldNumber);
|
|
end;
|
|
inc(KeyOffset, fdLength);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
{--------}
|
|
function TffDataDictionary.GetBaseRecordLength : Longint;
|
|
begin
|
|
{ A record must be at last ffcl_MinRecordLength bytes in length. This
|
|
is because we need that many bytes in order to store the next deleted
|
|
record when the record becomes part of the deleted record chain. }
|
|
Result := FFMaxL(FLogRecLen, ffcl_MinRecordLength);
|
|
end;
|
|
{--------}
|
|
function TffDataDictionary.GetBlockSize : Longint;
|
|
begin
|
|
if (FFileCount > 0) then
|
|
Result := PffFileDescriptor(ddFileList.Items[0])^.fdBlockSize
|
|
else
|
|
Result := 4096;
|
|
end;
|
|
{--------}
|
|
function TffDataDictionary.GetBookmarkSize(aIndexID : integer) : integer;
|
|
begin
|
|
if not ((0 <= aIndexID) and (aIndexID < FInxCount)) then
|
|
FFRaiseException(EffException, ffStrResGeneral, fferrOutOfBounds, [FBaseName, aIndexID]);
|
|
Result := ffcl_FixedBookmarkSize + IndexDescriptor^[aIndexID]^.idKeyLen;
|
|
end;
|
|
{--------}
|
|
function TffDataDictionary.GetFieldDecPl(aField : integer) : Longint;
|
|
begin
|
|
if (aField < 0) or (aField >= FFldCount) then
|
|
FFRaiseException(EffException, ffStrResGeneral, fferrOutOfBounds, [FBaseName, aField]);
|
|
Result := FieldDescriptor^[aField]^.fdDecPl;
|
|
end;
|
|
{--------}
|
|
function TffDataDictionary.GetFieldDesc(aField : integer) : TffDictItemDesc;
|
|
begin
|
|
if (aField < 0) or (aField >= FFldCount) then
|
|
FFRaiseException(EffException, ffStrResGeneral, fferrOutOfBounds, [FBaseName, aField]);
|
|
Result := FieldDescriptor^[aField]^.fdDesc;
|
|
end;
|
|
{--------}
|
|
function TffDataDictionary.GetFieldFromName(const aFieldName : TffDictItemName) : integer;
|
|
begin
|
|
for Result := 0 to pred(FFldCount) do
|
|
if (FFCmpShStrUC(aFieldName,
|
|
FieldDescriptor^[Result]^.fdName,
|
|
255) = 0) then
|
|
Exit;
|
|
Result := -1;
|
|
end;
|
|
{--------}
|
|
function TffDataDictionary.GetFieldLength(aField : integer) : Longint;
|
|
begin
|
|
if (aField < 0) or (aField >= FFldCount) then
|
|
FFRaiseException(EffException, ffStrResGeneral, fferrOutOfBounds, [FBaseName, aField]);
|
|
Result := FieldDescriptor^[aField]^.fdLength;
|
|
end;
|
|
{--------}
|
|
function TffDataDictionary.GetFieldName(aField : integer) : TffDictItemName;
|
|
begin
|
|
if (aField < 0) or (aField >= FFldCount) then
|
|
FFRaiseException(EffException, ffStrResGeneral, fferrOutOfBounds, [FBaseName, aField]);
|
|
Result := FieldDescriptor^[aField]^.fdName;
|
|
end;
|
|
{--------}
|
|
function TffDataDictionary.GetFieldOffset(aField : integer) : Longint;
|
|
begin
|
|
if (aField < 0) or (aField >= FFldCount) then
|
|
FFRaiseException(EffException, ffStrResGeneral, fferrOutOfBounds, [FBaseName, aField]);
|
|
Result := FieldDescriptor^[aField]^.fdOffset;
|
|
end;
|
|
{--------}
|
|
function TffDataDictionary.GetFieldRequired(aField : integer) : boolean;
|
|
begin
|
|
if (aField < 0) or (aField >= FFldCount) then
|
|
FFRaiseException(EffException, ffStrResGeneral, fferrOutOfBounds, [FBaseName, aField]);
|
|
Result := FieldDescriptor^[aField]^.fdRequired;
|
|
end;
|
|
{--------}
|
|
function TffDataDictionary.GetFieldType(aField : integer) : TffFieldType;
|
|
begin
|
|
if (aField < 0) or (aField >= FFldCount) then
|
|
FFRaiseException(EffException, ffStrResGeneral, fferrOutOfBounds, [FBaseName, aField]);
|
|
Result := FieldDescriptor^[aField]^.fdType;
|
|
end;
|
|
{--------}
|
|
function TffDataDictionary.GetFieldUnits(aField : integer) : Longint;
|
|
begin
|
|
if (aField < 0) or (aField >= FFldCount) then
|
|
FFRaiseException(EffException, ffStrResGeneral, fferrOutOfBounds, [FBaseName, aField]);
|
|
Result := FieldDescriptor^[aField]^.fdUnits;
|
|
end;
|
|
{--------}
|
|
function TffDataDictionary.GetFieldVCheck(aField : integer) : PffVCheckDescriptor;
|
|
begin
|
|
if (aField < 0) or (aField >= FFldCount) then
|
|
FFRaiseException(EffException, ffStrResGeneral, fferrOutOfBounds, [FBaseName, aField]);
|
|
Result := FieldDescriptor^[aField]^.fdVCheck;
|
|
end;
|
|
{--------}
|
|
function TffDataDictionary.GetFileBlockSize(aFile : integer) : Longint;
|
|
begin
|
|
if (aFile < 0) or (aFile >= FFileCount) then
|
|
FFRaiseException(EffException, ffStrResGeneral, fferrOutOfBounds, [FBaseName, aFile]);
|
|
Result := PffFileDescriptor(ddFileList.Items[aFile])^.fdBlockSize;
|
|
end;
|
|
{--------}
|
|
function TffDataDictionary.GetFileDesc(aFile : integer) : TffDictItemDesc;
|
|
begin
|
|
if (aFile < 0) or (aFile >= FFileCount) then
|
|
FFRaiseException(EffException, ffStrResGeneral, fferrOutOfBounds, [FBaseName, aFile]);
|
|
Result := PffFileDescriptor(ddFileList.Items[aFile])^.fdDesc;
|
|
end;
|
|
{--------}
|
|
function TffDataDictionary.GetFileDescriptor(aFile : integer) : PffFileDescriptor;
|
|
begin
|
|
if (aFile < 0) or (aFile >= FFileCount) then
|
|
FFRaiseException(EffException, ffStrResGeneral, fferrOutOfBounds, [FBaseName, aFile]);
|
|
Result := PffFileDescriptor(ddFileList.Items[aFile]);
|
|
end;
|
|
{--------}
|
|
function TffDataDictionary.GetFileExt(aFile : integer) : TffExtension;
|
|
begin
|
|
if (aFile < 0) or (aFile >= FFileCount) then
|
|
FFRaiseException(EffException, ffStrResGeneral, fferrOutOfBounds, [FBaseName, aFile]);
|
|
Result := PffFileDescriptor(ddFileList.Items[aFile])^.fdExtension;
|
|
end;
|
|
{--------}
|
|
function TffDataDictionary.GetFileNameExt(aFile : integer) : TffFileNameExt;
|
|
var
|
|
Temp : PffFileDescriptor;
|
|
begin
|
|
if (aFile < 0) or (aFile >= FFileCount) then
|
|
FFRaiseException(EffException, ffStrResGeneral, fferrOutOfBounds, [FBaseName, aFile]);
|
|
Temp := PffFileDescriptor(ddFileList.Items[aFile]);
|
|
Result := FFMakeFileNameExt(FBaseName, Temp^.fdExtension);
|
|
end;
|
|
{--------}
|
|
function TffDataDictionary.GetFileType(aFile : integer) : TffFileType;
|
|
begin
|
|
if (aFile < 0) or (aFile >= FFileCount) then
|
|
FFRaiseException(EffException, ffStrResGeneral, fferrOutOfBounds, [FBaseName, aFile]);
|
|
Result := PffFileDescriptor(ddFileList.Items[aFile])^.fdType;
|
|
end;
|
|
{Begin !!.03}
|
|
{--------}
|
|
function TffDataDictionary.GetHasBLOBs : Boolean;
|
|
var
|
|
Index : Integer;
|
|
P : PffFieldDescriptor;
|
|
begin
|
|
if FHasBLOBs = fftbUnknown then begin
|
|
FHasBLOBs := fftbFalse;
|
|
for Index := 0 to Pred(FFldCount) do begin
|
|
P := FieldDescriptor^[index];
|
|
if P^.fdType in [fftBLOB..fftBLOBFile] then begin
|
|
FHasBLOBs := fftbTrue;
|
|
Break;
|
|
end; { if }
|
|
end; { for }
|
|
end; { if }
|
|
Result := (FHasBLOBs = fftbTrue);
|
|
end;
|
|
{End !!.03}
|
|
{--------}
|
|
function TffDataDictionary.GetIndexAllowDups(aIndexID : integer) : boolean;
|
|
begin
|
|
if not ((0 <= aIndexID) and (aIndexID < FInxCount)) then
|
|
FFRaiseException(EffException, ffStrResGeneral, fferrOutOfBounds, [FBaseName, aIndexID]);
|
|
Result := IndexDescriptor^[aIndexID]^.idDups;
|
|
end;
|
|
{--------}
|
|
function TffDataDictionary.GetIndexAscend(aIndexID : integer) : boolean;
|
|
begin
|
|
if not ((0 <= aIndexID) and (aIndexID < FInxCount)) then
|
|
FFRaiseException(EffException, ffStrResGeneral, fferrOutOfBounds, [FBaseName, aIndexID]);
|
|
Result := IndexDescriptor^[aIndexID]^.idAscend;
|
|
end;
|
|
{--------}
|
|
function TffDataDictionary.GetIndexDesc(aIndexID : integer) : TffDictItemDesc;
|
|
begin
|
|
if not ((0 <= aIndexID) and (aIndexID < FInxCount)) then
|
|
FFRaiseException(EffException, ffStrResGeneral, fferrOutOfBounds, [FBaseName, aIndexID]);
|
|
Result := IndexDescriptor^[aIndexID]^.idDesc;
|
|
end;
|
|
{--------}
|
|
function TffDataDictionary.GetIndexFileNumber(aIndexID : integer) : Longint;
|
|
begin
|
|
if not ((0 <= aIndexID) and (aIndexID < FInxCount)) then
|
|
FFRaiseException(EffException, ffStrResGeneral, fferrOutOfBounds, [FBaseName, aIndexID]);
|
|
Result := IndexDescriptor^[aIndexId]^.idFile;
|
|
end;
|
|
{--------}
|
|
function TffDataDictionary.GetIndexFromName(const aIndexName : TffDictItemName) : integer;
|
|
begin
|
|
for Result := 0 to pred(FInxCount) do
|
|
if (FFCmpShStrUC(aIndexName,
|
|
indexDescriptor^[Result]^.idName,
|
|
255) = 0) then
|
|
Exit;
|
|
Result := -1;
|
|
end;
|
|
{--------}
|
|
function TffDataDictionary.GetIndexKeyLength(aIndexID : integer) : Longint;
|
|
begin
|
|
if not ((0 <= aIndexID) and (aIndexID < FInxCount)) then
|
|
FFRaiseException(EffException, ffStrResGeneral, fferrOutOfBounds, [FBaseName, aIndexID]);
|
|
Result := IndexDescriptor^[aIndexID]^.idKeyLen;
|
|
end;
|
|
{--------}
|
|
function TffDataDictionary.GetIndexName(aIndexID : integer) : TffDictItemName;
|
|
begin
|
|
if not ((0 <= aIndexID) and (aIndexID < FInxCount)) then
|
|
FFRaiseException(EffException, ffStrResGeneral, fferrOutOfBounds, [FBaseName, aIndexID]);
|
|
Result := IndexDescriptor^[aIndexID]^.idName;
|
|
end;
|
|
{--------}
|
|
function TffDataDictionary.GetIndexNoCase(aIndexID : integer) : boolean;
|
|
begin
|
|
if not ((0 <= aIndexID) and (aIndexID < FInxCount)) then
|
|
FFRaiseException(EffException, ffStrResGeneral, fferrOutOfBounds, [FBaseName, aIndexID]);
|
|
Result := IndexDescriptor^[aIndexID]^.idNoCase;
|
|
end;
|
|
{--------}
|
|
function TffDataDictionary.GetIndexType(aIndexID : integer) : TffIndexType;
|
|
begin
|
|
if not ((0 <= aIndexID) and (aIndexID < FInxCount)) then
|
|
FFRaiseException(EffException, ffStrResGeneral, fferrOutOfBounds, [FBaseName, aIndexID]);
|
|
Result := TffIndexType(IndexDescriptor^[aIndexID]^.idCount = -1);
|
|
end;
|
|
{--------}
|
|
procedure TffDataDictionary.GetRecordField(aField : integer;
|
|
aData : PffByteArray;
|
|
var aIsNull: boolean;
|
|
aValue : pointer);
|
|
begin
|
|
aIsNull := IsRecordFieldNull(aField, aData);
|
|
if (not aIsNull) and (aValue <> nil) then
|
|
with FieldDescriptor^[aField]^ do
|
|
Move(aData^[fdOffset], aValue^, fdLength);
|
|
end;
|
|
{--------}
|
|
function TffDataDictionary.GetRecordLength : Longint;
|
|
begin
|
|
Result := GetBaseRecordLength + {the fields themselves}
|
|
((FFldCount + 7) div 8); {the bit array for nulls}
|
|
end;
|
|
{--------}
|
|
function TffDataDictionary.HasAutoIncField(var aField : integer) : boolean;
|
|
begin
|
|
Result := true;
|
|
aField := 0;
|
|
while (aField < FFldCount) do begin
|
|
if FieldDescriptor^[aField]^.fdType = fftAutoInc then
|
|
Exit;
|
|
inc(aField);
|
|
end;
|
|
Result := false;
|
|
end;
|
|
{--------}
|
|
function TffDataDictionary.HasSameFields(aSrcDict : TffDataDictionary;
|
|
var aBLOBFields : TffPointerList) : boolean;
|
|
var
|
|
anIndex : integer;
|
|
begin
|
|
Result := False;
|
|
if FieldCount <> aSrcDict.FieldCount then
|
|
Exit;
|
|
aBLOBFields.Empty;
|
|
|
|
for anIndex := 0 to pred(FieldCount) do begin
|
|
{ Must have same field type, length, decimal places, & units. }
|
|
Result := (FieldLength[anIndex] = aSrcDict.FieldLength[anIndex]) and
|
|
(FieldType[anIndex] = aSrcDict.FieldType[anIndex]) and
|
|
(FieldDecPl[anIndex] = aSrcDict.FieldDecPl[anIndex]) and
|
|
(FieldUnits[anIndex] = aSrcDict.FieldUnits[anIndex]);
|
|
if (not Result) then
|
|
Exit;
|
|
if FieldType[anIndex] in [fftBLOB..fftBLOBFile] then
|
|
aBLOBFields.Append(Pointer(anIndex));
|
|
end;
|
|
end;
|
|
{--------}
|
|
function TffDataDictionary.HasSameFieldsEx(aSrcDict : TffDataDictionary;
|
|
aFields : PffLongintArray;
|
|
aNumFields : integer;
|
|
var aBLOBFields : TffPointerList) : boolean;
|
|
var
|
|
anIndex, aSrcIndex : integer;
|
|
begin
|
|
Result := False;
|
|
if FieldCount <> aNumFields then
|
|
Exit;
|
|
aBLOBFields.Empty;
|
|
|
|
for anIndex := 0 to pred(aNumFields) do begin
|
|
aSrcIndex := aFields^[anIndex];
|
|
{ Must have same field type, length, decimal places, & units. }
|
|
Result := (FieldLength[anIndex] = aSrcDict.FieldLength[aSrcIndex]) and
|
|
(FieldType[anIndex] = aSrcDict.FieldType[aSrcIndex]) and
|
|
(FieldDecPl[anIndex] = aSrcDict.FieldDecPl[aSrcIndex]) and
|
|
(FieldUnits[anIndex] = aSrcDict.FieldUnits[aSrcIndex]);
|
|
if (not Result) then
|
|
Exit;
|
|
if FieldType[anIndex] in [fftBLOB..fftBLOBFile] then
|
|
aBLOBFields.Append(Pointer(anIndex));
|
|
end;
|
|
end;
|
|
{--------}
|
|
procedure TffDataDictionary.CheckForDefault(aVCheckDesc : PffVCheckDescriptor;
|
|
aFieldDesc : PffFieldDescriptor);
|
|
var
|
|
CheckVal : PffVCheckDescriptor;
|
|
begin
|
|
if Assigned(aVCheckDesc) and aVCheckDesc^.vdHasDefVal then begin
|
|
if (not Assigned(aFieldDesc^.fdVCheck)) then begin
|
|
FFGetZeroMem(CheckVal, sizeof(TffVCheckDescriptor));
|
|
aFieldDesc^.fdVCheck := CheckVal;
|
|
end;
|
|
aFieldDesc^.fdVCheck^.vdHasDefVal := True;
|
|
aFieldDesc^.fdVCheck^.vdDefVal := aVCheckDesc.vdDefVal;
|
|
end;
|
|
end;
|
|
{--------}
|
|
function TffDataDictionary.GetDefaultFldCount: Integer;
|
|
begin
|
|
ddDefFldList.Pack;
|
|
Result := ddDefFldList.Count;
|
|
end;
|
|
{--------}
|
|
procedure TffDataDictionary.InitRecord(aData : PffByteArray);
|
|
begin
|
|
if (aData <> nil) and (FFldCount > 0) then begin
|
|
FillChar(aData^, FLogRecLen + ((FFldCount + 7) div 8), 0);
|
|
FFSetAllBits(PffByteArray(@aData^[LogicalRecordLength]), FFldCount); {!!.02}
|
|
end;
|
|
end;
|
|
{--------}
|
|
procedure TffDataDictionary.InsertField(AtIndex : Integer;
|
|
const aIdent : TffDictItemName;
|
|
const aDesc : TffDictItemDesc;
|
|
aType : TffFieldType;
|
|
aUnits : Integer;
|
|
aDecPl : Integer;
|
|
aReqFld : Boolean;
|
|
const aValCheck : PffVCheckDescriptor);
|
|
var
|
|
NewDesc : PffFieldDescriptor;
|
|
TempDesc : PffFieldDescriptor;
|
|
NewOffset: integer;
|
|
Inx : integer;
|
|
begin
|
|
{can't be done in readonly mode}
|
|
if ddReadOnly then
|
|
FFRaiseException(EffException, ffStrResGeneral, fferrDictReadOnly, [FBaseName]);
|
|
{check for a duplicate field name}
|
|
if (GetFieldFromName(aIdent) <> -1) then
|
|
FFRaiseException(EffException, ffStrResGeneral, fferrDupFieldName, [FBaseName, aIdent]);
|
|
{create it}
|
|
if (0 <= AtIndex) and (AtIndex < FFldCount) then begin
|
|
FHasBLOBs := fftbUnknown; {!!03}
|
|
NewDesc := CreateFieldDesc(aIdent, aDesc, aType, aUnits, aDecPl, aReqFld, aValCheck);
|
|
try
|
|
NewDesc^.fdNumber := AtIndex;
|
|
if (AtIndex > 0) then begin
|
|
TempDesc := FieldDescriptor^[pred(AtIndex)];
|
|
with TempDesc^ do
|
|
NewDesc^.fdOffset := fdOffset + fdLength;
|
|
end;
|
|
{ Shift existing fields up. }
|
|
for Inx := pred(FFldCount) downto AtIndex do
|
|
FieldDescriptor^[succ(Inx)] := FieldDescriptor^[Inx];
|
|
FieldDescriptor^[AtIndex] := NewDesc;
|
|
inc(FFldCount);
|
|
{ Have we reached our field capacity? }
|
|
if FFldCount = FFieldCapacity then
|
|
{ Yes, expand our field array. }
|
|
ddExpandFieldArray(0);
|
|
{patch up all successive descriptors}
|
|
with NewDesc^ do
|
|
NewOffset := fdOffset + fdLength;
|
|
for Inx := succ(AtIndex) to pred(FFldCount) do begin
|
|
TempDesc := FieldDescriptor^[Inx];
|
|
with TempDesc^ do
|
|
begin
|
|
fdNumber := Inx;
|
|
fdOffset := NewOffset;
|
|
inc(NewOffset, fdLength);
|
|
end;
|
|
end;
|
|
FLogRecLen := NewOffset;
|
|
except
|
|
FFFreeMem(NewDesc,sizeof(TffFieldDescriptor));
|
|
raise;
|
|
end;{try..except}
|
|
end;
|
|
end;
|
|
{--------}
|
|
function TffDataDictionary.IsIndexDescValid(const aIndexDesc : TffIndexDescriptor) : boolean;
|
|
var
|
|
i : integer;
|
|
KeyLen : integer;
|
|
begin
|
|
Result := false;
|
|
with aIndexDesc do begin
|
|
if (idName = '') then
|
|
Exit;
|
|
if (0 > idFile) or (idFile >= FFileCount) then
|
|
Exit;
|
|
if (idCount = -1) then begin {user-defined index}
|
|
if (idKeyLen <= 0) then
|
|
Exit;
|
|
end
|
|
else begin {composite index}
|
|
if (idCount = 0) then
|
|
Exit;
|
|
KeyLen := 0;
|
|
for i := 0 to pred(idCount) do begin
|
|
if (idFields[i] < 0) or (idFields[i] >= FFldCount) then
|
|
Exit;
|
|
inc(KeyLen, FieldDescriptor^[idfields[i]]^.fdLength);
|
|
end;
|
|
inc(KeyLen, (idCount + 7) div 8);
|
|
if (KeyLen > ffcl_MaxKeyLength) then
|
|
Exit;
|
|
end;
|
|
end;
|
|
Result := true;
|
|
end;
|
|
{--------}
|
|
function TffDataDictionary.IsRecordFieldNull(aField : integer;
|
|
aData : PffByteArray) : boolean;
|
|
begin
|
|
if (aField < 0) or (aField >= FFldCount) then
|
|
FFRaiseException(EffException, ffStrResGeneral, fferrOutOfBounds,
|
|
[FBaseName, aField]);
|
|
Result := (aData = nil) or
|
|
FFIsBitSet(PffByteArray(@aData^[FLogRecLen]), aField);
|
|
end;
|
|
{--------}
|
|
procedure TffDataDictionary.ReadFromStream(S : TStream);
|
|
var
|
|
Reader : TReader;
|
|
i, j : Integer;
|
|
FileDesc : PffFileDescriptor;
|
|
FldDesc : PffFieldDescriptor;
|
|
InxDesc : PffIndexDescriptor;
|
|
HasVCheck : Boolean;
|
|
begin
|
|
ClearPrim(true);
|
|
Reader := TReader.Create(S, 4096);
|
|
try
|
|
with Reader do begin
|
|
FBLOBFileNumber := 0;
|
|
FIsEncrypted := ReadBoolean;
|
|
FFileCount := ReadInteger;
|
|
try
|
|
for i := 0 to pred(FFileCount) do begin
|
|
FFGetZeroMem(FileDesc, sizeof(TffFileDescriptor));
|
|
with FileDesc^ do begin
|
|
fdNumber := i;
|
|
fdDesc := ReadString;
|
|
fdExtension := ReadString; //<-- Soner fpc raises exception "Invalid Value for property"
|
|
// for embeddedserver in function classes.pas TReader.ReadString
|
|
fdBlockSize := ReadInteger;
|
|
fdType := TffFileType(ReadInteger);
|
|
if (fdType = ftBLOBFile) then
|
|
FBLOBFileNumber := i;
|
|
end;
|
|
ddFileList.Add(pointer(FileDesc));
|
|
FileDesc := nil;
|
|
end;
|
|
except
|
|
if Assigned(FileDesc) then
|
|
FFFreeMem(FileDesc, sizeOf(TffFileDescriptor));
|
|
raise;
|
|
end;{try..except}
|
|
FFldCount := ReadInteger;
|
|
ddExpandFieldArray(FFldCount + 1);
|
|
try
|
|
for i := 0 to pred(FFldCount) do begin
|
|
FFGetZeroMem(FldDesc, sizeof(TffFieldDescriptor));
|
|
with FldDesc^ do begin
|
|
fdNumber := i;
|
|
fdName := ReadString;
|
|
fdDesc := ReadString;
|
|
fdUnits := ReadInteger;
|
|
fdDecPl := ReadInteger;
|
|
fdOffset := ReadInteger;
|
|
fdLength := ReadInteger;
|
|
fdType := TffFieldType(ReadInteger);
|
|
fdRequired := ReadBoolean;
|
|
HasVCheck := ReadBoolean;
|
|
if HasVCheck then begin
|
|
FFGetZeroMem(fdVCheck, sizeof(TffVCheckDescriptor));
|
|
with fdVCheck^ do begin
|
|
vdPicture := ReadString;
|
|
vdHasMinVal := ReadBoolean;
|
|
vdHasMaxVal := ReadBoolean;
|
|
vdHasDefVal := ReadBoolean;
|
|
{if the field has a default value, we add the field
|
|
number to ddDefFldList}
|
|
if vdHasDefVal then begin
|
|
ddDefFldList.Add(Pointer(i));
|
|
end;
|
|
if vdHasMinVal then
|
|
Read(vdMinVal, fdLength);
|
|
if vdHasMaxVal then
|
|
Read(vdMaxVal, fdLength);
|
|
if vdHasDefVal then
|
|
Read(vdDefVal, fdLength);
|
|
end;
|
|
end;
|
|
end;
|
|
FieldDescriptor^[i] := FldDesc;
|
|
FldDesc := nil;
|
|
end;
|
|
except
|
|
if Assigned(FldDesc) then
|
|
FFFreeMem(FldDesc, sizeOf(TffFieldDescriptor));
|
|
raise;
|
|
end;{try..except}
|
|
FLogRecLen := ReadInteger;
|
|
FInxCount := ReadInteger;
|
|
ddExpandIndexArray(FInxCount + 1);
|
|
try
|
|
{note that index 0 is never stored on a stream}
|
|
for i := 1 to pred(FInxCount) do begin
|
|
FFGetZeroMem(InxDesc, sizeof(TffIndexDescriptor));
|
|
with InxDesc^ do begin
|
|
idNumber := i;
|
|
idName := ReadString;
|
|
idDesc := ReadString;
|
|
idFile := ReadInteger;
|
|
idKeyLen := ReadInteger;
|
|
idCount := ReadInteger;
|
|
if (idCount <> -1) then
|
|
for j := 0 to pred(idCount) do begin
|
|
idFields[j] := ReadInteger;
|
|
if NextValue=vaString then
|
|
idFieldIHlprs[j] := ReadString
|
|
else
|
|
idFieldIHlprs[j] := '';
|
|
end;
|
|
idDups := ReadBoolean;
|
|
idAscend := ReadBoolean;
|
|
idNoCase := ReadBoolean;
|
|
end;
|
|
IndexDescriptor^[i] := InxDesc;
|
|
InxDesc := nil;
|
|
end;
|
|
except
|
|
if Assigned(InxDesc) then
|
|
FFFreeMem(InxDesc, sizeOf(TffIndexDescriptor));
|
|
raise;
|
|
end;{try..except}
|
|
end;
|
|
finally
|
|
Reader.Free;
|
|
end;{try..finally}
|
|
end;
|
|
{--------}
|
|
procedure TffDataDictionary.RemoveField(aField : Longint);
|
|
var
|
|
TempDesc : PffFieldDescriptor;
|
|
NewOffset : Integer;
|
|
Inx, {!!.13}
|
|
FldInx : Integer; {!!.13}
|
|
InxDesc : PffIndexDescriptor; {!!.13}
|
|
begin
|
|
{can't be done in readonly mode}
|
|
if ddReadOnly then
|
|
FFRaiseException(EffException, ffStrResGeneral, fferrDictReadOnly, [FBaseName]);
|
|
if (0 <= aField) and (aField < FFldCount) then begin
|
|
{Begin !!.13}
|
|
{ Verify the field is not being used by an index. }
|
|
for Inx := Pred(IndexCount) downto 0 do begin
|
|
InxDesc := IndexDescriptor[Inx];
|
|
for FldInx := 0 to Pred(InxDesc^.idCount) do
|
|
if InxDesc^.idFields[FldInx] = aField then
|
|
FFRaiseException(EffException, ffStrResGeneral, fferrFileInUse,
|
|
[aField]);
|
|
end;
|
|
{End !!.13}
|
|
FHasBLOBs := fftbUnknown; {!!.03}
|
|
TempDesc := FieldDescriptor^[aField];
|
|
NewOffset := TempDesc^.fdOffset;
|
|
FFFreeMem(TempDesc, sizeOf(TffFieldDescriptor));
|
|
{ Shift fields down to cover the empty space. }
|
|
for Inx := aField to (FFldCount - 2) do
|
|
FieldDescriptor^[Inx] := FieldDescriptor^[succ(Inx)]; {!!.01}
|
|
dec(FFldCount);
|
|
{patch up all successive descriptors}
|
|
for Inx := aField to pred(FFldCount) do begin
|
|
TempDesc := FieldDescriptor^[Inx];
|
|
with TempDesc^ do begin
|
|
fdNumber := Inx;
|
|
fdOffset := NewOffset;
|
|
inc(NewOffset, fdLength);
|
|
end;
|
|
end;
|
|
FLogRecLen := NewOffset;
|
|
end;
|
|
end;
|
|
{--------}
|
|
procedure TffDataDictionary.RemoveFile(aFile : Longint);
|
|
var
|
|
TempDesc : PffFileDescriptor;
|
|
Inx : integer;
|
|
begin
|
|
{can't be done in readonly mode}
|
|
if ddReadOnly then
|
|
FFRaiseException(EffException, ffStrResGeneral, fferrDictReadOnly, [FBaseName]);
|
|
{can't remove entry 0: it's the base file}
|
|
if (aFile = 0) then
|
|
FFRaiseException(EffException, ffStrResGeneral, fferrBaseFile, [FBaseName]);
|
|
{remove the entry}
|
|
if (0 < aFile) and (aFile < FFileCount) then begin
|
|
TempDesc := PffFileDescriptor(ddFileList.Items[aFile]);
|
|
{if the BLOB file is being removed from the dictionary then reset
|
|
the BLOB file number field}
|
|
if (TempDesc^.fdType = ftBLOBFile) then
|
|
FBLOBFileNumber := 0;
|
|
{Begin!!.13}
|
|
{ If an index file is being removed from the dictionary then make sure
|
|
it is not referenced by an index. }
|
|
if (TempDesc^.fdType = ftIndexFile) then begin
|
|
for Inx := pred(FInxCount) downto 0 do
|
|
if (IndexDescriptor^[Inx]^.idFile = aFile) then
|
|
FFRaiseException(EffException, ffStrResGeneral, fferrFileInUse,
|
|
[aFile]);
|
|
{ Fixup index descriptors referencing files with higher file numbers. }
|
|
for Inx := Pred(IndexCount) downto 0 do
|
|
if (IndexDescriptor^[Inx]^.idFile > aFile) then
|
|
Dec(IndexDescriptor^[Inx]^.idFile);
|
|
end; { if }
|
|
{End !!.13}
|
|
|
|
FFFreeMem(TempDesc, sizeOf(TffFileDescriptor));
|
|
ddFileList.Delete(aFile);
|
|
dec(FFileCount);
|
|
{patch up all successive descriptors}
|
|
for Inx := aFile to pred(FFileCount) do begin
|
|
TempDesc := PffFileDescriptor(ddFileList[Inx]);
|
|
TempDesc^.fdNumber := Inx;
|
|
end;
|
|
end;
|
|
end;
|
|
{--------}
|
|
procedure TffDataDictionary.RemoveIndex(aIndex : Longint);
|
|
var
|
|
TempDesc : PffIndexDescriptor;
|
|
Inx : integer;
|
|
begin
|
|
(*
|
|
{can't be done in readonly mode}
|
|
if ddReadOnly then
|
|
FFRaiseException(EffException, ffStrResGeneral, fferrDictReadOnly, [FBaseName]);
|
|
*)
|
|
{remove the entry}
|
|
if (0 <= aIndex) and (aIndex < FInxCount) then begin
|
|
TempDesc := IndexDescriptor^[aIndex];
|
|
FFFreeMem(TempDesc, sizeOf(TffIndexDescriptor));
|
|
{Begin !!.02}
|
|
{ Shift the descriptors above the deleted index down to fill in
|
|
the gap. }
|
|
for Inx := aIndex to (FInxCount - 2) do begin
|
|
IndexDescriptor^[Inx] := IndexDescriptor^[succ(Inx)];
|
|
IndexDescriptor^[Inx]^.idNumber := Inx;
|
|
end;
|
|
dec(FInxCount);
|
|
end;
|
|
{End !!.02}
|
|
end;
|
|
{--------}
|
|
procedure TffDataDictionary.SetBaseName(const BN : TffTableName);
|
|
begin
|
|
FBaseName := BN;
|
|
end;
|
|
{--------}
|
|
procedure TffDataDictionary.SetBlockSize(BS : Longint);
|
|
begin
|
|
{can't be done in readonly mode}
|
|
if ddReadOnly then
|
|
FFRaiseException(EffException, ffStrResGeneral, fferrDictReadOnly, [FBaseName]);
|
|
if (BS <> BlockSize) and FFVerifyBlockSize(BS) then
|
|
if (BS > BlockSize) or
|
|
(RecordLength <= (BS - ffc_BlockHeaderSizeData - sizeof(Longint))) then begin
|
|
if (FFileCount > 0) then
|
|
PffFileDescriptor(ddFileList.Items[0])^.fdBlockSize := BS;
|
|
end;
|
|
end;
|
|
{Begin !!.11}
|
|
{--------}
|
|
procedure TffDataDictionary.SetDefaultFieldValue(aData : PffByteArray;
|
|
const aField : Integer);
|
|
var
|
|
i : Integer;
|
|
BS : PffByteArray;
|
|
CurrField : PffByteArray;
|
|
HasDefault : Boolean;
|
|
begin
|
|
if (aData = nil) then
|
|
Exit;
|
|
BS := PffByteArray(@aData^[LogicalRecordLength]);
|
|
HasDefault := False;
|
|
for i := 0 to Pred(ddDefFldList.Count) do begin
|
|
HasDefault := (Integer(ddDefFldList[i]) = aField);
|
|
if HasDefault then begin
|
|
{ If the field is nil and it has a default value, we're going to
|
|
add the default value for the field. }
|
|
if FieldDescriptor^[aField]^.fdVCheck <> nil then
|
|
if FFIsBitSet(BS, aField) and
|
|
FieldDescriptor^[aField]^.fdVCheck^.vdHasDefVal then begin
|
|
CurrField := PffByteArray(@aData^[FieldDescriptor^[aField]^.fdOffset]);
|
|
Move(FieldDescriptor^[aField]^.fdVCheck^.vdDefVal,
|
|
CurrField^,
|
|
FieldDescriptor^[afield]^.fdLength);
|
|
FFClearBit(BS, aField);
|
|
end; { if }
|
|
break;
|
|
end; { if }
|
|
end; { for }
|
|
if not HasDefault then
|
|
SetRecordFieldNull(aField, aData, True);
|
|
end;
|
|
{End !!.11}
|
|
{--------}
|
|
procedure TffDataDictionary.SetDefaultFieldValues(aData : PffByteArray);
|
|
var
|
|
DefFldNo : Integer;
|
|
i : Integer;
|
|
BS : PffByteArray;
|
|
CurrField : PffByteArray;
|
|
begin
|
|
if (aData = nil) then
|
|
Exit;
|
|
BS := PffByteArray(@aData^[LogicalRecordLength]); {!!.06}
|
|
for i := 0 to pred(ddDefFldList.Count) do begin
|
|
{if the field is nil and it has a default value, we're going to
|
|
add the default value for the field}
|
|
DefFldNo := Integer(ddDefFldList[i]);
|
|
if FieldDescriptor^[DefFldNo]^.fdVCheck <> nil then
|
|
if FFIsBitSet(BS, DefFldNo) and
|
|
FieldDescriptor^[DefFldNo]^.fdVCheck^.vdHasDefVal then begin
|
|
CurrField := PffByteArray(@aData^[FieldDescriptor^[DefFldNo]^.fdOffset]);
|
|
Move(FieldDescriptor^[DefFldNo]^.fdVCheck^.vdDefVal,
|
|
CurrField^,
|
|
FieldDescriptor^[DefFldNo]^.fdLength);
|
|
FFClearBit(BS, DefFldNo);
|
|
end;
|
|
end;
|
|
end;
|
|
{--------}
|
|
procedure TffDataDictionary.SetIsEncrypted(IE : Boolean);
|
|
begin
|
|
{can't be done in readonly mode}
|
|
if ddReadOnly then
|
|
FFRaiseException(EffException, ffStrResGeneral, fferrDictReadOnly, [FBaseName]);
|
|
FIsEncrypted := IE;
|
|
end;
|
|
{--------}
|
|
procedure TffDataDictionary.SetRecordField(aField : integer;
|
|
aData : PffByteArray;
|
|
aValue : pointer);
|
|
begin
|
|
if (aField < 0) or (aField >= FFldCount) then
|
|
FFRaiseException(EffException, ffStrResGeneral, fferrOutOfBounds, [FBaseName, aField]);
|
|
with FieldDescriptor^[aField]^ do begin
|
|
if (aValue = nil) then begin
|
|
FFSetBit(PffByteArray(@aData^[FLogRecLen]), aField);
|
|
FillChar(aData^[fdOffset], fdLength, 0);
|
|
end
|
|
else begin
|
|
FFClearBit(PffByteArray(@aData^[FLogRecLen]), aField);
|
|
Move(aValue^, aData^[fdOffset], fdLength);
|
|
end;
|
|
end;
|
|
end;
|
|
{--------}
|
|
procedure TffDataDictionary.SetRecordFieldNull(aField : integer;
|
|
aData : PffByteArray;
|
|
aIsNull : boolean);
|
|
begin
|
|
if (aField < 0) or (aField >= FFldCount) then
|
|
FFRaiseException(EffException, ffStrResGeneral, fferrOutOfBounds, [FBaseName, aField]);
|
|
with FieldDescriptor^[aField]^ do begin
|
|
if aIsNull then
|
|
FFSetBit(PffByteArray(@aData^[FLogRecLen]), aField)
|
|
else
|
|
FFClearBit(PffByteArray(@aData^[FLogRecLen]), aField);
|
|
FillChar(aData^[fdOffset], fdLength, 0);
|
|
end;
|
|
end;
|
|
{--------}
|
|
procedure TffDataDictionary.SetValidityCheck(aField : integer;
|
|
var aExists : boolean;
|
|
const aVCheck : TffVCheckDescriptor);
|
|
begin
|
|
if (aField < 0) or (aField >= FFldCount) then
|
|
FFRaiseException(EffException, ffStrResGeneral, fferrOutOfBounds, [FBaseName, aField]);
|
|
with FieldDescriptor^[aField]^ do begin
|
|
if aExists then begin
|
|
if (fdVCheck = nil) then
|
|
FFGetZeroMem(fdVCheck, sizeOf(TffVCheckDescriptor));
|
|
if (@aVCheck <> fdVCheck) then
|
|
Move(aVCheck, fdVCheck^, sizeof(fdVCheck))
|
|
end
|
|
else {aExists is false} begin
|
|
if (fdVCheck <> nil) then
|
|
FFFreeMem(fdVCheck, sizeOf(TffVCheckDescriptor));
|
|
end;
|
|
end;
|
|
end;
|
|
{--------}
|
|
procedure TffDataDictionary.WriteToStream(S : TStream);
|
|
var
|
|
Writer : TWriter;
|
|
i, j : Integer;
|
|
FileDesc : PffFileDescriptor;
|
|
FldDesc : PffFieldDescriptor;
|
|
InxDesc : PffIndexDescriptor;
|
|
begin
|
|
CheckValid;
|
|
Writer := TWriter.Create(S, 4096);
|
|
try
|
|
with Writer do begin
|
|
WriteBoolean(FIsEncrypted);
|
|
WriteInteger(FFileCount);
|
|
for i := 0 to pred(FFileCount) do begin
|
|
FileDesc := PffFileDescriptor(ddFileList[i]);
|
|
with FileDesc^ do begin
|
|
AnsiStringWriter(fdDesc, Writer); {!!.05}
|
|
AnsiStringWriter(fdExtension, Writer);
|
|
WriteInteger(fdBlockSize);
|
|
WriteInteger(ord(fdType));
|
|
end;
|
|
end;
|
|
WriteInteger(FFldCount);
|
|
for i := 0 to pred(FFldCount) do begin
|
|
FldDesc := FieldDescriptor^[i];
|
|
with FldDesc^ do begin
|
|
AnsiStringWriter(fdName, Writer); {!!.05}
|
|
AnsiStringWriter(fdDesc, Writer); {!!.05}
|
|
WriteInteger(fdUnits);
|
|
WriteInteger(fdDecPl);
|
|
WriteInteger(fdOffset);
|
|
WriteInteger(fdLength);
|
|
WriteInteger(ord(fdType));
|
|
WriteBoolean(fdRequired);
|
|
WriteBoolean(fdVCheck <> nil);
|
|
if (fdVCheck <> nil) then begin
|
|
with fdVCheck^ do begin
|
|
AnsiStringWriter(vdPicture, Writer); {!!.05}
|
|
WriteBoolean(vdHasMinVal);
|
|
WriteBoolean(vdHasMaxVal);
|
|
WriteBoolean(vdHasDefVal);
|
|
if vdHasMinVal then
|
|
Write(vdMinVal, fdLength);
|
|
if vdHasMaxVal then
|
|
Write(vdMaxVal, fdLength);
|
|
if vdHasDefVal then
|
|
Write(vdDefVal, fdLength);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
WriteInteger(FLogRecLen);
|
|
WriteInteger(FInxCount);
|
|
{note we don't write index 0 to the stream}
|
|
for i := 1 to pred(FInxCount) do begin
|
|
InxDesc := IndexDescriptor^[i];
|
|
with InxDesc^ do begin
|
|
AnsiStringWriter(idName, Writer); {!!.05}
|
|
AnsiStringWriter(idDesc, Writer); {!!.05}
|
|
WriteInteger(idFile);
|
|
WriteInteger(idKeyLen);
|
|
WriteInteger(idCount);
|
|
if (idCount <> -1) then
|
|
for j := 0 to pred(idCount) do begin
|
|
WriteInteger(idFields[j]);
|
|
if Length(idFieldIHlprs[j]) > 0 then
|
|
AnsiStringWriter(idFieldIHlprs[j], Writer); {!!.05}
|
|
end;
|
|
WriteBoolean(idDups);
|
|
WriteBoolean(idAscend);
|
|
WriteBoolean(idNoCase);
|
|
end;
|
|
end;
|
|
end;
|
|
finally
|
|
Writer.Free;
|
|
end;{try..finally}
|
|
end;
|
|
{====================================================================}
|
|
|
|
{moved from FFTBBASE}
|
|
{===Composite Key manipulation routines==============================}
|
|
procedure FFInitKey(aKey : PffByteArray;
|
|
aKeyLen : integer;
|
|
aKeyFldCount : integer);
|
|
begin
|
|
if (aKey <> nil) then begin
|
|
FillChar(aKey^, aKeyLen, 0);
|
|
if (aKeyFldCount <= 8) then
|
|
FFSetAllBits(PffByteArray(@aKey^[aKeyLen-1]), aKeyFldCount)
|
|
else
|
|
FFSetAllBits(PffByteArray(@aKey^[aKeyLen-2]), aKeyFldCount);
|
|
end;
|
|
end;
|
|
{--------}
|
|
function FFIsKeyFieldNull(aKey : PffByteArray;
|
|
aKeyLen : integer;
|
|
aKeyFldCount : integer;
|
|
aKeyFld : integer) : boolean;
|
|
begin
|
|
if (aKey = nil) then
|
|
Result := true
|
|
else begin
|
|
if (aKeyFldCount <= 8) then
|
|
Result := FFIsBitSet(PffByteArray(@aKey^[aKeyLen-1]), aKeyFld)
|
|
else
|
|
Result := FFIsBitSet(PffByteArray(@aKey^[aKeyLen-2]), aKeyFld);
|
|
end;
|
|
end;
|
|
{--------}
|
|
procedure FFSetKeyFieldNonNull(aKey : PffByteArray;
|
|
aKeyLen : integer;
|
|
aKeyFldCount : integer;
|
|
aKeyFld : integer);
|
|
begin
|
|
if (aKey <> nil) then begin
|
|
if (aKeyFldCount <= 8) then
|
|
FFClearBit(PffByteArray(@aKey^[aKeyLen-1]), aKeyFld)
|
|
else
|
|
FFClearBit(PffByteArray(@aKey^[aKeyLen-2]), aKeyFld);
|
|
end;
|
|
end;
|
|
{====================================================================}
|
|
end.
|