📄 dbf_idxfile.pas
字号:
constructor Create;
procedure Enumerate;
end;
PMdxHdr = ^rMdxHdr;
rMdxHdr = record
MdxVersion : Byte; // 0
Year : Byte; // 1
Month : Byte; // 2
Day : Byte; // 3
FileName : array[0..15] of Char; // 4..19
BlockSize : Word; // 20..21
BlockAdder : Word; // 22..23
ProdFlag : Byte; // 24
NumTags : Byte; // 25
TagSize : Byte; // 26
Dummy1 : Byte; // 27
TagsUsed : Word; // 28..29
Dummy2 : Byte; // 30
Language : Byte; // 31
NumPages : Integer; // 32..35
FreePage : Integer; // 36..39
BlockFree : Integer; // 40..43
UpdYear : Byte; // 44
UpdMonth : Byte; // 45
UpdDay : Byte; // 46
Reserved : array[0..481] of Byte; // 47..528
TagFlag : Byte; // 529 // dunno what this means but it ought to be 1 :-)
end;
// Tags -> I don't know what to with them
// KeyType -> Variable position, db7 different from db4
PMdx4Tag = ^rMdx4Tag;
rMdx4Tag = record
HeaderPageNo : Integer; // 0..3
TagName : array [0..10] of Char; // 4..14 of Byte
KeyFormat : Byte; // 15 00h: Calculated
// 10h: Data Field
ForwardTag1 : Byte; // 16
ForwardTag2 : Byte; // 17
BackwardTag : Byte; // 18
Reserved : Byte; // 19
KeyType : Char; // 20 C : Character
// N : Numerical
// D : Date
end;
PMdx7Tag = ^rMdx7Tag;
rMdx7Tag = record
HeaderPageNo : Integer; // 0..3
TagName : array [0..32] of Char; // 4..36 of Byte
KeyFormat : Byte; // 37 00h: Calculated
// 10h: Data Field
ForwardTag1 : Byte; // 38
ForwardTag2 : Byte; // 39
BackwardTag : Byte; // 40
Reserved : Byte; // 41
KeyType : Char; // 42 C : Character
// N : Numerical
// D : Date
end;
PIndexHdr = ^rIndexHdr;
rIndexHdr = record
RootPage : Integer; // 0..3
NumPages : Integer; // 4..7
KeyFormat : Byte; // 8 00h: Right, Left, DTOC
// 08h: Descending order
// 10h: String
// 20h: Distinct
// 40h: Unique
KeyType : Char; // 9 C : Character
// N : Numerical
// D : Date
Dummy : Word; // 10..11
KeyLen : Word; // 12..13
NumKeys : Word; // 14..15
sKeyType : Word; // 16..17 00h: DB4: C/N; DB3: C
// 01h: DB4: D ; DB3: N/D
KeyRecLen : Word; // 18..19 Length of key entry in page
Version : Word; // 20..21
Dummy2 : Byte; // 22
Unique : Byte; // 23
KeyDesc : array [0..219] of Char; // 24..243
Dummy3 : Byte; // 244
ForExist : Byte; // 245
KeyExist : Byte; // 246
FirstNode : Longint; // 248..251 first node that contains data
LastNode : Longint; // 252..255 last node that contains data
// MDX Header has here a 506 byte block reserved
// and then the FILTER expression, which obviously doesn't
// fit in a NDX page, so we'll skip it
end;
PMdxEntry = ^rMdxEntry;
rMdxEntry = record
RecBlockNo: Longint; // 0..3 either recno or blockno
KeyData : Char; // 4.. first byte of data, context => length
end;
PMdxPage = ^rMdxPage;
rMdxPage = record
NumEntries : Integer;
PrevBlock : Integer;
FirstEntry : rMdxEntry;
end;
PNdxEntry = ^rNdxEntry;
rNdxEntry = record
LowerPageNo: Integer; // 0..3 lower page
RecNo : Integer; // 4..7 recno
KeyData : Char;
end;
PNdxPage = ^rNdxPage;
rNdxPage = record
NumEntries: Integer; // 0..3
FirstEntry: rNdxEntry;
end;
//---------------------------------------------------------------------------
TMdxPage = class(TIndexPage)
protected
function GetEntry(AEntryNo: Integer): Pointer; override;
function GetLowerPageNo: Integer; override;
function GetKeyData: PChar; override;
function GetNumEntries: Integer; override;
function GetKeyDataFromEntry(AEntry: Integer): PChar; override;
function GetRecNo: Integer; override;
function GetIsInnerNode: Boolean; override;
procedure IncNumEntries; override;
procedure SetNumEntries(NewNum: Integer); override;
procedure SetRecLowerPageNo(NewRecNo, NewPageNo: Integer); override;
procedure SetRecLowerPageNoOfEntry(AEntry, NewRecNo, NewPageNo: Integer); override;
{$ifdef TDBF_UPDATE_FIRST_LAST_NODE}
procedure SetPrevBlock(NewBlock: Integer); override;
{$endif}
end;
//---------------------------------------------------------------------------
TNdxPage = class(TIndexPage)
protected
function GetEntry(AEntryNo: Integer): Pointer; override;
function GetLowerPageNo: Integer; override;
function GetKeyData: PChar; override;
function GetNumEntries: Integer; override;
function GetKeyDataFromEntry(AEntry: Integer): PChar; override;
function GetRecNo: Integer; override;
function GetIsInnerNode: Boolean; override;
procedure IncNumEntries; override;
procedure SetNumEntries(NewNum: Integer); override;
procedure SetRecLowerPageNo(NewRecNo, NewPageNo: Integer); override;
procedure SetRecLowerPageNoOfEntry(AEntry, NewRecNo, NewPageNo: Integer); override;
end;
//---------------------------------------------------------------------------
TMdx4Tag = class(TIndexTag)
protected
function GetHeaderPageNo: Integer; override;
function GetTagName: string; override;
function GetKeyFormat: Byte; override;
function GetForwardTag1: Byte; override;
function GetForwardTag2: Byte; override;
function GetBackwardTag: Byte; override;
function GetReserved: Byte; override;
function GetKeyType: Char; override;
procedure SetHeaderPageNo(NewPageNo: Integer); override;
procedure SetTagName(NewName: string); override;
procedure SetKeyFormat(NewFormat: Byte); override;
procedure SetForwardTag1(NewTag: Byte); override;
procedure SetForwardTag2(NewTag: Byte); override;
procedure SetBackwardTag(NewTag: Byte); override;
procedure SetReserved(NewReserved: Byte); override;
procedure SetKeyType(NewType: Char); override;
end;
//---------------------------------------------------------------------------
TMdx7Tag = class(TIndexTag)
function GetHeaderPageNo: Integer; override;
function GetTagName: string; override;
function GetKeyFormat: Byte; override;
function GetForwardTag1: Byte; override;
function GetForwardTag2: Byte; override;
function GetBackwardTag: Byte; override;
function GetReserved: Byte; override;
function GetKeyType: Char; override;
procedure SetHeaderPageNo(NewPageNo: Integer); override;
procedure SetTagName(NewName: string); override;
procedure SetKeyFormat(NewFormat: Byte); override;
procedure SetForwardTag1(NewTag: Byte); override;
procedure SetForwardTag2(NewTag: Byte); override;
procedure SetBackwardTag(NewTag: Byte); override;
procedure SetReserved(NewReserved: Byte); override;
procedure SetKeyType(NewType: Char); override;
end;
var
Entry_Mdx_BOF: rMdxEntry; //(RecBOF, #0);
Entry_Mdx_EOF: rMdxEntry; //(RecBOF, #0);
Entry_Ndx_BOF: rNdxEntry; //(0, RecBOF, #0);
Entry_Ndx_EOF: rNdxEntry; //(0, RecEOF, #0);
LCIDList: TLCIDList;
procedure IncWordLE(var AVariable: Word; Amount: Integer);
begin
AVariable := SwapWordLE(SwapWordLE(AVariable) + Amount);
end;
procedure IncIntLE(var AVariable: Integer; Amount: Integer);
begin
AVariable := SwapIntLE(DWord(Integer(SwapIntLE(AVariable)) + Amount));
end;
//==========================================================
// Locale support for all versions of Delphi/C++Builder
function LocaleCallBack(LocaleString: PChar): Integer; stdcall;
begin
LCIDList.Add(Pointer(StrToInt('$'+LocaleString)));
Result := 1;
end;
constructor TLCIDList.Create;
begin
inherited;
end;
procedure TLCIDList.Enumerate;
begin
Clear;
EnumSystemLocales(@LocaleCallBack, LCID_SUPPORTED);
end;
{ TIndexPage }
constructor TIndexPage.Create(Parent: TIndexFile);
begin
FIndexFile := Parent;
GetMem(FPageBuffer, FIndexFile.RecordSize);
FLowerPage := nil;
Clear;
end;
destructor TIndexPage.Destroy;
begin
// no locks anymore?
assert(FLockCount = 0);
if (FLowerPage<>nil) then
LowerPage.Free;
WritePage;
FreeMemAndNil(FPageBuffer);
inherited Destroy;
end;
procedure TIndexPage.Clear;
begin
FillChar(PChar(FPageBuffer)^, FIndexFile.RecordSize, 0);
FreeAndNil(FLowerPage);
FUpperPage := nil;
FPageNo := -1;
FEntryNo := -1;
FWeight := 1;
FModified := false;
FEntry := FIndexFile.EntryBof;
FLowPage := 0;
FHighPage := 0;
FLowIndex := 0;
FHighIndex := -1;
FLockCount := 0;
end;
procedure TIndexPage.GetNewPage;
begin
FPageNo := FIndexFile.GetNewPageNo;
end;
procedure TIndexPage.Modified;
begin
FModified := true;
end;
procedure TIndexPage.LockPage;
begin
// already locked?
if FLockCount = 0 then
FIndexFile.LockPage(FPageNo, true);
// increase count
inc(FLockCount);
end;
procedure TIndexPage.UnlockPage;
begin
// still in domain?
assert(FLockCount > 0);
dec(FLockCount);
// unlock?
if FLockCount = 0 then
begin
if FIndexFile.NeedLocks then
WritePage;
FIndexFile.UnlockPage(FPageNo);
end;
end;
procedure TIndexPage.LocalInsert(RecNo: Integer; Buffer: PChar; LowerPageNo: Integer);
// *) assumes there is at least one entry free
var
source, dest: Pointer;
size, lNumEntries, numKeysAvail: Integer;
begin
// lock page if needed; wait if not available, anyone else updating?
LockPage;
// check assertions
lNumEntries := GetNumEntries;
// if this is inner node, we can only store one less than max entries
numKeysAvail := SwapWordLE(PIndexHdr(FIndexFile.IndexHeader)^.NumKeys) - lNumEntries;
if FLowerPage <> nil then
dec(numKeysAvail);
// check if free space
assert(numKeysAvail > 0);
// first free up some space
source := FEntry;
dest := GetEntry(FEntryNo + 1);
size := (lNumEntries - EntryNo) * SwapWordLE(PIndexHdr(FIndexFile.IndexHeader)^.KeyRecLen);
// if 'rightmost' entry, copy pageno too
if (FLowerPage <> nil) or (numKeysAvail > 1) then
size := size + FIndexFile.EntryHeaderSize;
Move(source^, dest^, size);
// one entry added
Inc(FHighIndex);
IncNumEntries;
// lNumEntries not valid from here
SetEntry(RecNo, Buffer, LowerPageNo);
// done!
UnlockPage;
end;
procedure TIndexPage.LocalDelete;
function IsOnlyEntry(Page: TIndexPage): boolean;
begin
Result := true;
repeat
if Page.HighIndex > 0 then
Result := false;
Page := Page.UpperPage;
until not Result or (Page = nil);
end;
var
source, dest: Pointer;
size, lNumEntries: Integer;
begin
// get num entries
lNumEntries := GetNumEntries;
// is this last entry? if it's not move entries after current one
if EntryNo < FHighIndex then
begin
source := GetEntry(EntryNo + 1);
dest := FEntry;
size := (FHighIndex - EntryNo) * SwapWordLE(PIndexHdr(FIndexFile.IndexHeader)^.KeyRecLen);
Move(source^, dest^, size);
end else
// no need to update when we're about to remove the only entry
if (UpperPage <> nil) and (FHighIndex > FLowIndex) then
begin
// we are about to remove the last on this page, so update search
// key data of parent
EntryNo := FHighIndex - 1;
UpperPage.SetEntry(0, GetKeyData, FPageNo);
end;
// one entry less now
dec(lNumEntries);
dec(FHighIndex);
SetNumEntries(lNumEntries);
// zero last one out to not get confused about internal or leaf pages
// note: need to decrease lNumEntries and HighIndex first, otherwise
// check on page key consistency will fail
SetRecLowerPageNoOfEntry(FHighIndex+1, 0, 0);
// update bracket indexes
if FHighPage = FPageNo then
dec(FHighBracket);
// check if range violated
if EntryNo > FHighIndex then
EntryNo := FHighIndex;
// check if still entries left, otherwise remove page from parent
if FHighIndex = -1 then
begin
if UpperPage <> nil then
if not IsOnlyEntry(UpperPage) then
UpperPage.LocalDelete;
end;
// go to valid record in lowerpage
if FLowerPage <> nil then
SyncLowerPage;
// flag modified page
FModified := true;
// success!
end;
function TIndexPage.MatchKey: Integer;
// assumes Buffer <> nil
var
keyData: PChar;
begin
// get key data
keyData := GetKeyData;
// use locale dependant compare
Result := FIndexFile.CompareKey(keyData);
end;
function TIndexPage.FindNearest(ARecNo: Integer): Integer;
// pre:
// assumes Key <> nil
// assumes FLowIndex <= FHighIndex + 1
// ARecNo = -2 -> search first key matching Key
// ARecNo = -3 -> search first key greater than Key
// ARecNo > 0 -> search key matching Key and its recno = ARecNo
// post:
// Result < 0 -> key,recno smaller than current entry
// Result = 0 -> key,recno found, FEntryNo = found key entryno
// Result > 0 -> key,recno larger than current entry
var
low, high, current: Integer;
begin
// implement binary search, keys are sorted
low := FLowIndex;
high := GetNumEntries;
// always true: Entry(FEntryNo) = FEntry
// FHighIndex >= 0 because no-entry cases in leaves have been filtered out
// entry HighIndex may not be bigger than rest (in inner node)
// ARecNo = -3 -> search last recno matching key
// need to have: low <= high
// define low - 1 = neg.inf.
// define high = pos.inf
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -