The World of Computer Software/World_Of_Computer_Software-02-385-Vol-1of3.iso/r/reindx.zip/REINDEX.PAS

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.