home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The World of Computer Software
/
World_Of_Computer_Software-02-385-Vol-1of3.iso
/
r
/
reindx.zip
/
REINDEX.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-10-16
|
14KB
|
399 lines
{*********************************************************}
{* REINDEX.PAS 5.40 *}
{* Copyright (c) Enz EDV Beratung GmbH 1986-90. *}
{* All rights reserved. *}
{* Modified and used under license by *}
{* TurboPower Software. *}
{*********************************************************}
{$S-,R-,V-,I-,B-,F+}
{$IFNDEF Ver40}
{Allow overlays}
{$I-,O+,A-}
{$ENDIF}
{Definition of the network interface and other conditional defines}
{$I BTDEFINE.INC}
{BTDEFINE.INC may not change the following options}
{$R-,I-}
unit Reindex;
interface
uses
Dos,
Filer;
procedure ReIndexFileBlock(FBlName : IsamFileBlockName;
DatSLen : LongInt;
NumberOfKeys : Integer;
IID : IsamIndDescr;
FuncBuildKey : Pointer);
{-This procedure reindexes the fileblock of name <FBlName> with possibly
different keys. Every non-deleted data record must be preceded by the long
int 0 in order for this to work. This is similar to the RebuildFileBlock
call, except it does not require space for the ".SAV" file.
ReindexFileBlock does not compress out deleted records, nor does it
reconstruct the header of the data file (see NOTE below).
1) Rename the ".DAT" file to ".SAV" if no ".SAV" file exists.
2) <MakeFileBlock> with the name <FBlName>, data record length <DatSLen>,
<NumberOfKeys> of keys, and the index descriptor <IID>.
3) Close the new FileBlock, delete new ".DAT" file, and rename ".SAV"
file back to ".DAT".
4) <OpenFileBlock>
5) For every single key (1 to <NumberOfKeys>), read every data record from
the new ".DAT" file and if not a deleted record add the key with
<AddKey>.
6) Close the new fileblock.
7) Verify the data file header record for number of records and deleted
records.
The user must write a function that builds the desired key from the data
record in order to carry out step 5. This function's address must be
passed in <FuncBuildKey>. This procedure must explicitly declared as FAR
($F+ directive) or be exported from another unit (which automatically
makes it a FAR). An example is given below.
The procedure is immediately aborted if a severe I/O error occurs during
the construction.
The data record with all the keys that have been entered is deleted from
the fileblock if a duplicate key is detected during the rebuild. The
contents of the data record, along with its corresponding keys, are
written to a file with a ".MSG" extension. This may later be examined with
"Type." No file with a ".MSG" extension exists after the rebuild if there
were no duplicate keys found during the reconstruction.
NOTE: While the header record is not rebuilt, two critical fields of the
header are verified. The number of deleted records and the number of used
records are counted while rebuilding the keys. These numbers are compared
with the values found in the header of the data file. If they do not
match, a new IsamError 8000 will be generated. If 8000 is generated,
the file will have been reindexed to the best of REINDEX's ability, but
the integrity of the data file is suspect. It is recommended that a
RebuildFileBlock be used to properly recreate the header record in the
event of IsamError 8000.
The flag maintained within the data file header that indicates whether
the index file was left open is automatically cleared by
ReindexFileBlock. In case the number of keys has changed, the NumberOfKeys
passed explicitly to ReindexFileBlock is also written to the data file
header.
ReindexFileBlock should not be used with FileBlocks that have space
preallocated to them through PreallocateFileBlock.
Note that ReindexFileBlock does not support the third pathname that
is normally available for RebuildFileBlock, the SAV file drive/directory.
}
implementation
function NumRecsInFile(IFBPtr : IsamFileBlockPtr) : LongInt;
{-Returns the number of records in a data file by the following formula:
NumRecs = (SizeOfFileInBytes div RecordLength) - 1
NOTE: Will not work correctly if PreallocateFileBlock has been used on
the FileBlock.}
var
Size : LongInt;
begin
with IFBPtr^ do begin
IsamLongSeekEOF(DatF, Size);
if not IsamOK then begin
NumRecsInFile := 0;
Exit;
end;
NumRecsInFile := (Size div DIDPtr^[0]^.LenRec)-1;
end;
end;
procedure ReindexFileBlock(FBlName : IsamFileBlockName;
DatSLen : LongInt;
NumberOfKeys : Integer;
IID : IsamIndDescr;
FuncBuildKey : Pointer);
var
BufPtr : ^Byte;
LPtr : ^LongInt;
DLenW : Word;
L : LongInt;
NrOfRecs : LongInt;
DatSRead : LongInt;
NumberDeleted : LongInt;
DatSWritten : LongInt;
I : Integer;
J : Integer;
DontUseKey : Integer;
ReorgIFBPtr : IsamFileBlockPtr;
IKS : IsamKeyStr;
ReorgF : IsamFile;
HeaderRec : IsamSmallInfoRec;
FNameD : IsamFileBlockName;
FNameI : IsamFileBlockName;
FNameS : IsamFileBlockName;
MessageFileOpened : Boolean;
MessageFile : Text;
function BuildKey(UserRoutine : Pointer;
var DatS; KeyNr : Integer) : IsamKeyStr;
function CallUserRoutine(var DatS; KeyNr : Integer) : IsamKeyStr;
inline($FF/$5E/<UserRoutine); {call far dword ptr [bp+<UserRoutine]}
begin
BuildKey := CallUserRoutine(DatS, KeyNr);
end;
procedure ReXUserRoutine(UserRoutine : Pointer; KeyNr : Integer;
DatSNrR : LongInt; DatSNrW : LongInt;
var DatS; Len : Word);
procedure CallUserRoutine(KeyNr : Integer;
DatSNrR : LongInt; DatSNrW : LongInt;
var DatS; Len : Word);
inline($FF/$5E/<UserRoutine); {call far dword ptr [bp+<UserRoutine]}
begin
CallUserRoutine(KeyNr, DatSNrR, DatSNrW, DatS, Len);
end;
procedure CreateSavFile;
{-Rename or copy the DAT file to create the SAV file}
begin
IsamAssign(ReorgF, IsamForceExtension(FNameD, DatExtension));
IsamRename(ReorgF, IsamForceExtension(FNameS, SavExtension));
if not IsamOK then
if not IsamExists(IsamForceExtension(FNameS, SavExtension)) then begin
IsamError := 10410;
Exit;
end else
IsamClearOK;
end;
procedure UnDo(Error : Integer);
var
Dummy : Integer;
begin
IsamClose(ReorgF);
FreeMem(BufPtr, DLenW);
BTCloseFileBlock(ReorgIFBPtr);
if MessageFileOpened then
Close(MessageFile);
Dummy := IoResult;
if Error = 10413 then
{Reorg was aborted}
if IsamExists(IsamForceExtension(FNameS, SavExtension)) then
{Delete DAT and IX files, which are incomplete}
BTDeleteFileBlock(FBlName)
else begin
{Delete IX file, which is incomplete}
IsamAssign(ReorgF, IsamForceExtension(FNameI, IxExtension));
IsamDelete(ReorgF);
{Rename DAT to SAV}
IsamClearOK;
CreateSavFile;
if not IsamOK then
{A severe error occurred in CreateSavFile}
Exit;
end;
IsamOK := False;
IsamError := Error;
end;
function UpdateMessageFile : Boolean;
{-Open and update message file, returning False if error}
var
CPtr : ^Char;
W : Word;
IoRes : Integer;
begin
UpdateMessageFile := False;
if not MessageFileOpened then begin
Assign(MessageFile, IsamForceExtension(FNameD, MsgExtension));
Rewrite(MessageFile);
IORes := IoResult;
if IORes <> 0 then begin
UnDo(IORes);
Exit;
end;
MessageFileOpened := True;
end;
WriteLn(MessageFile, 'Key ', IKS);
WriteLn(MessageFile, 'with the number ', I, ' duplicate!');
WriteLn(MessageFile, 'Data record - Dump follows');
CPtr := @BufPtr^;
for W := 1 to DLenW do begin
Write(MessageFile, CPtr^);
inc(LongInt(CPtr));
end;
WriteLn(MessageFile, ^M^J);
IoRes := IoResult;
if IORes <> 0 then begin
UnDo(IORes);
Exit;
end;
UpdateMessageFile := True;
end;
begin
{Initialize}
IsamClearOK;
MessageFileOpened := False;
{Separate the pathnames}
IsamExtractFileNames(FBlName, FNameD, FNameI);
{Note: unique SAV file directory not supported here}
FNameS := FNameD;
{Validate the record length}
if DatSLen > LongInt(65535) then begin
IsamOK := False;
IsamError := 10412;
Exit;
end;
{Create the SAV file if necessary}
CreateSavFile;
if not IsamOK then
Exit;
{Create the new output file and close it}
BTCreateFileBlock(FNameD+';'+FNameI, DatSLen, NumberOfKeys, IID);
if not IsamOK then
Exit;
{Allocate the input record buffer}
DLenW := ILI(DatSLen).Lo;
if MaxAvail < DLenW then begin
IsamOK := False;
IsamError := 10411;
Exit;
end;
GetMem(BufPtr, DLenW);
LPtr := @BufPtr^;
{Open the SAV file to read the system record}
IsamAssign(ReorgF, IsamForceExtension(FNameS, SavExtension));
IsamReset(ReorgF, False, False);
if not IsamOK then begin
UnDo(IsamError);
Exit;
end;
IsamBlockRead(ReorgF, HeaderRec, SizeOf(HeaderRec));
if not IsamOK then begin
UnDo(IsamError);
Exit;
end;
{Set the (potentially different) number of keys in the header}
HeaderRec.Gener[5] := LongInt(NumberOfKeys);
{Clear the index file open flag}
HeaderRec.ADK := False;
{Write the header back to the SAV file and close it}
IsamLongSeek(ReorgF, 0);
IsamBlockWrite(ReorgF, HeaderRec, SizeOf(HeaderRec));
IsamClose(ReorgF);
if not IsamOK then begin
UnDo(IsamError);
Exit;
end;
{Erase the newly created (empty) data file}
IsamAssign(ReorgF, IsamForceExtension(FNameD, DatExtension));
IsamDelete(ReorgF);
if not IsamOK then begin
UnDo(IsamError);
Exit;
end;
{Rename the SAV file to the new DAT file}
IsamAssign(ReorgF, IsamForceExtension(FNameS, SavExtension));
IsamRename(ReorgF, IsamForceExtension(FNameD, DatExtension));
if not IsamOK then begin
UnDo(IsamError);
Exit;
end;
{Open the fileblock, which has all the data but none of the indexes}
BTOpenFileBlock(ReorgIFBPtr, FNameD+';'+FNameI,
False, False, False, False);
if not IsamOK then begin
UnDo(IsamError);
Exit;
end;
{Add the keys of each index to the new fileblock}
NrOfRecs := NumRecsInFile(ReorgIFBPtr);
for I := 1 to NumberOfKeys do begin
DatSWritten := LongInt(0);
NumberDeleted := 0;
DatSRead := 0;
for L := LongInt(1) to NrOfRecs do begin
BTGetRec(ReorgIFBPtr, L, BufPtr^, False);
if not IsamOK then begin
UnDo(IsamError);
Exit;
end;
if LPtr^ <> LongInt(0) then
Inc(NumberDeleted)
else begin
Inc(DatSRead);
{Get the key string and add it to the index}
IKS := BuildKey(FuncBuildKey, BufPtr^, I);
if IsamOK then
if AddNullKeys or (IKS <> '') then begin
BTAddKey(ReorgIFBPtr, I, L, IKS);
if IsamOK then
Inc(DatSWritten)
else if IsamError = 10230 then begin
{Duplicate key, report it, delete this record, and continue}
if not UpdateMessageFile then
Exit;
for J := 1 to I-1 do
BTDeleteKey(ReorgIFBPtr, J, L,
BuildKey(FuncBuildKey, BufPtr^, J));
BTDeleteRec(ReorgIFBPtr, L);
end else begin
UnDo(IsamError);
Exit;
end;
end;
end;
{Call the user routine}
if IsamOK then
if IsamReXUserProcPtr <> nil then
ReXUserRoutine(IsamReXUserProcPtr, I, L, DatSWritten,
BufPtr^, DLenW);
if not IsamOK then begin
UnDo(10413);
Exit;
end;
end; {for L := 1 to NrOfRecs}
end; {for I := 1 to NumberOfKeys}
{Free data buffer and close up}
FreeMem(BufPtr, DLenW);
if MessageFileOpened then begin
Close(MessageFile);
I := IoResult;
end;
BTCloseFileBlock(ReorgIFBPtr);
{Check the record counts}
with HeaderRec do
if (DatSRead <> (Gener[3]-Gener[2])) or
(NumberDeleted <> Gener[2]) then begin
IsamOK := False;
IsamError := 8000;
end;
end;
{$IFDEF InitAllUnits}
begin
{$ENDIF}
end.