home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The World of Computer Software
/
World_Of_Computer_Software-02-385-Vol-1of3.iso
/
r
/
reindx.zip
/
VREINDEX.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1992-10-16
|
14KB
|
414 lines
{*********************************************************}
{* VREINDEX.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 VReindex;
interface
uses
Dos,
Filer,
VRec;
procedure ReindexVFileBlock(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 RebuildVFileBlock
call, except it does not require space for the ".SAV" file.
ReindexVFileBlock 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> for the new fileblock, which now contains all of the
old data but none of the keys.
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.
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: unlike REINDEX, VREINDEX cannot verify that the number of
non-deleted and deleted sections in the data file match the number
indicated by the header.
The flag maintained within the data file header that indicates whether the
index file was left open is automatically cleared by ReindexVFileBlock. In
case the number of keys has changed, the NumberOfKeys passed explicitly to
ReindexVFileBlock is also written to the data file header.
ReindexVFileBlock should not be used with FileBlocks that have space
preallocated to them through PreallocateFileBlock.
}
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 ReindexVFileBlock(FBlName : IsamFileBlockName;
DatSLen : LongInt;
NumberOfKeys : Integer;
IID : IsamIndDescr;
FuncBuildKey : Pointer);
var
BufPtr : ^Byte;
LPtr : ^LongInt;
DLenW : Word;
CurRecLen : Word;
L : LongInt;
NrOfRecs : LongInt;
DatSRead : 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; Free : Boolean);
var
Dummy : Integer;
begin
IsamClose(ReorgF);
if Free then
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, True);
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 CurRecLen do begin
Write(MessageFile, CPtr^);
inc(LongInt(CPtr));
end;
WriteLn(MessageFile, ^M^J);
IoRes := IoResult;
if IORes <> 0 then begin
UnDo(IORes, True);
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(MaxVariableRecLength) then begin
IsamOK := False;
IsamError := 10412;
Exit;
end;
{Check that the variable length record buffer was allocated}
if DatSLen > IsamVRecBufSize then begin
BTReleaseVariableRecBuffer;
if not BTSetVariableRecBuffer(DatSLen) then begin
IsamOK := False;
IsamError := 10411;
Exit;
end;
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. One section only for now}
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, True);
Exit;
end;
IsamBlockRead(ReorgF, HeaderRec, SizeOf(HeaderRec));
if not IsamOK then begin
UnDo(IsamError, True);
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, True);
Exit;
end;
{Erase the newly created (empty) data file}
IsamAssign(ReorgF, IsamForceExtension(FNameD, DatExtension));
IsamDelete(ReorgF);
if not IsamOK then begin
UnDo(IsamError, True);
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, True);
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, True);
Exit;
end;
{Add the keys of each index to the new fileblock}
NrOfRecs := NumRecsInFile(ReorgIFBPtr);
for I := 1 to NumberOfKeys do begin
DatSWritten := 0;
DatSRead := 0;
for L := LongInt(1) to NrOfRecs do begin
{Read just the first section to check the deleted flag}
BTGetRec(ReorgIFBPtr, L, BufPtr^, False);
if not IsamOK then begin
UnDo(IsamError, True);
Exit;
end;
if LPtr^ = LongInt(0) then begin
{The start of a real, non-deleted, variable length record}
{Assure the variable record buffer is large enough}
BTGetVariableRecLength(ReorgIFBPtr, L, CurRecLen);
if CurRecLen > DLenW then begin
FreeMem(BufPtr, DLenW);
if MaxAvail < CurRecLen then begin
UnDo(10411, False);
Exit;
end;
DLenW := CurRecLen;
GetMem(BufPtr, DLenW);
LPtr := @BufPtr^;
end;
{Get the actual record now}
BTGetVariableRec(ReorgIFBPtr, L, BufPtr^, CurRecLen);
if not IsamOK then begin
UnDo(IsamError, True);
Exit;
end;
Inc(DatSRead);
{Get the key string and add it to the index}
IKS := BuildKey(FuncBuildKey, BufPtr^, I);
if IsamOK then begin
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));
BTDeleteVariableRec(ReorgIFBPtr, L);
end else begin
UnDo(IsamError, True);
Exit;
end;
end;
{Call the user routine and check for abort request}
If IsamOK then
if IsamReXUserProcPtr <> nil then
ReXUserRoutine(IsamReXUserProcPtr, I, DatSRead, DatSWritten,
BufPtr^, CurRecLen);
end;
if not IsamOK then begin
UnDo(10413, True);
Exit;
end;
end; {if LPtr^ = 0}
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);
end;
{$IFDEF InitAllUnits}
begin
{$ENDIF}
end.