Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/REINDX.ZIP/VREINDEX.PAS

Pascal/Delphi Source File | 1992-10-16 | 13.6 KB | 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.