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   
Pascal/Delphi Source File  |  1992-10-16  |  14KB  |  414 lines

  1. {*********************************************************}
  2. {*                  VREINDEX.PAS 5.40                    *}
  3. {*     Copyright (c) Enz EDV Beratung GmbH 1986-90.      *}
  4. {*                 All rights reserved.                  *}
  5. {*          Modified and used under license by           *}
  6. {*                 TurboPower Software.                  *}
  7. {*********************************************************}
  8.  
  9. {$S-,R-,V-,I-,B-,F+}
  10.  
  11. {$IFNDEF Ver40}
  12.   {Allow overlays}
  13.   {$I-,O+,A-}
  14. {$ENDIF}
  15.  
  16. {Definition of the network interface and other conditional defines}
  17. {$I BTDEFINE.INC}
  18.  
  19. {BTDEFINE.INC may not change the following options}
  20. {$R-,I-}
  21.  
  22. unit VReindex;
  23.  
  24. interface
  25.  
  26. uses
  27.   Dos,
  28.   Filer,
  29.   VRec;
  30.  
  31. procedure ReindexVFileBlock(FBlName : IsamFileBlockName;
  32.                             DatSLen : LongInt;
  33.                             NumberOfKeys : Integer;
  34.                             IID : IsamIndDescr;
  35.                             FuncBuildKey : Pointer);
  36.   {-This procedure reindexes the fileblock of name <FBlName> with possibly
  37.     different keys. Every non-deleted data record must be preceded by the long
  38.     int 0 in order for this to work. This is similar to the RebuildVFileBlock
  39.     call, except it does not require space for the ".SAV" file.
  40.     ReindexVFileBlock does not compress out deleted records, nor does it
  41.     reconstruct the header of the data file (see NOTE below).
  42.  
  43.     1) Rename the ".DAT" file to ".SAV" if no ".SAV" file exists.
  44.     2) <MakeFileBlock> with the name <FBlName>, data record length <DatSLen>,
  45.        <NumberOfKeys> of keys, and the index descriptor <IID>.
  46.     3) Close the new FileBlock, delete new ".DAT" file, and rename ".SAV"
  47.        file back to ".DAT".
  48.     4) <OpenFileBlock> for the new fileblock, which now contains all of the
  49.        old data but none of the keys.
  50.     5) For every single key (1 to <NumberOfKeys>), read every data record from
  51.        the new ".DAT" file and if not a deleted record add the key with
  52.        <AddKey>.
  53.     6) Close the new fileblock.
  54.  
  55.     The user must write a function that builds the desired key from the data
  56.     record in order to carry out step 5. This function's address must be
  57.     passed in <FuncBuildKey>. This procedure must explicitly declared as FAR
  58.     ($F+ directive) or be exported from another unit (which automatically
  59.     makes it a FAR). An example is given below.
  60.  
  61.     The procedure is immediately aborted if a severe I/O error occurs during
  62.     the construction.
  63.  
  64.     The data record with all the keys that have been entered is deleted from
  65.     the fileblock if a duplicate key is detected during the rebuild. The
  66.     contents of the data record, along with its corresponding keys, are
  67.     written to a file with a ".MSG" extension. This may later be examined with
  68.     "Type." No file with a ".MSG" extension exists after the rebuild if there
  69.     were no duplicate keys found during the reconstruction.
  70.  
  71.     NOTE: unlike REINDEX, VREINDEX cannot verify that the number of
  72.     non-deleted and deleted sections in the data file match the number
  73.     indicated by the header.
  74.  
  75.     The flag maintained within the data file header that indicates whether the
  76.     index file was left open is automatically cleared by ReindexVFileBlock. In
  77.     case the number of keys has changed, the NumberOfKeys passed explicitly to
  78.     ReindexVFileBlock is also written to the data file header.
  79.  
  80.     ReindexVFileBlock should not be used with FileBlocks that have space
  81.     preallocated to them through PreallocateFileBlock.
  82.     }
  83.  
  84. implementation
  85.  
  86.   function NumRecsInFile(IFBPtr : IsamFileBlockPtr) : LongInt;
  87.     {-Returns the number of records in a data file by the following formula:
  88.       NumRecs = (SizeOfFileInBytes div RecordLength) - 1
  89.       NOTE: Will not work correctly if PreallocateFileBlock has been used on
  90.       the FileBlock.}
  91.   var
  92.     Size : LongInt;
  93.   begin
  94.     with IFBPtr^ do begin
  95.       IsamLongSeekEOF(DatF, Size);
  96.       if not IsamOK then begin
  97.         NumRecsInFile := 0;
  98.         Exit;
  99.       end;
  100.       NumRecsInFile := (Size div DIDPtr^[0]^.LenRec)-1;
  101.     end;
  102.   end;
  103.  
  104.   procedure ReindexVFileBlock(FBlName : IsamFileBlockName;
  105.                               DatSLen : LongInt;
  106.                               NumberOfKeys : Integer;
  107.                               IID : IsamIndDescr;
  108.                               FuncBuildKey : Pointer);
  109.   var
  110.     BufPtr : ^Byte;
  111.     LPtr : ^LongInt;
  112.     DLenW : Word;
  113.     CurRecLen : Word;
  114.     L : LongInt;
  115.     NrOfRecs : LongInt;
  116.     DatSRead : LongInt;
  117.     DatSWritten : LongInt;
  118.     I : Integer;
  119.     J : Integer;
  120.     DontUseKey : Integer;
  121.     ReorgIFBPtr : IsamFileBlockPtr;
  122.     IKS : IsamKeyStr;
  123.     ReorgF : IsamFile;
  124.     HeaderRec : IsamSmallInfoRec;
  125.     FNameD : IsamFileBlockName;
  126.     FNameI : IsamFileBlockName;
  127.     FNameS : IsamFileBlockName;
  128.     MessageFileOpened : Boolean;
  129.     MessageFile : Text;
  130.  
  131.     function BuildKey(UserRoutine : Pointer;
  132.                       var DatS; KeyNr : Integer) : IsamKeyStr;
  133.       function CallUserRoutine(var DatS; KeyNr : Integer) : IsamKeyStr;
  134.       inline($FF/$5E/<UserRoutine); {call far dword ptr [bp+<UserRoutine]}
  135.     begin
  136.       BuildKey := CallUserRoutine(DatS, KeyNr);
  137.     end;
  138.  
  139.     procedure ReXUserRoutine(UserRoutine : Pointer; KeyNr : Integer;
  140.                              DatSNrR : LongInt; DatSNrW : LongInt;
  141.                              var DatS; Len : Word);
  142.       procedure CallUserRoutine(KeyNr : Integer;
  143.                                 DatSNrR : LongInt;  DatSNrW : LongInt;
  144.                                 var DatS; Len : Word);
  145.       inline($FF/$5E/<UserRoutine); {call far dword ptr [bp+<UserRoutine]}
  146.     begin
  147.       CallUserRoutine(KeyNr, DatSNrR, DatSNrW, DatS, Len);
  148.     end;
  149.  
  150.     procedure CreateSavFile;
  151.       {-Rename or copy the DAT file to create the SAV file}
  152.     begin
  153.       IsamAssign(ReorgF, IsamForceExtension(FNameD, DatExtension));
  154.       IsamRename(ReorgF, IsamForceExtension(FNameS, SavExtension));
  155.       if not IsamOK then
  156.         if not IsamExists(IsamForceExtension(FNameS, SavExtension)) then begin
  157.           IsamError := 10410;
  158.           Exit;
  159.         end else
  160.           IsamClearOK;
  161.     end;
  162.  
  163.     procedure UnDo(Error : Integer; Free : Boolean);
  164.     var
  165.       Dummy : Integer;
  166.     begin
  167.       IsamClose(ReorgF);
  168.       if Free then
  169.         FreeMem(BufPtr, DLenW);
  170.       BTCloseFileBlock(ReorgIFBPtr);
  171.       if MessageFileOpened then
  172.         Close(MessageFile);
  173.       Dummy := IoResult;
  174.       if Error = 10413 then
  175.         {Reorg was aborted}
  176.         if IsamExists(IsamForceExtension(FNameS, SavExtension)) then
  177.           {Delete DAT and IX files, which are incomplete}
  178.           BTDeleteFileBlock(FBlName)
  179.         else begin
  180.           {Delete IX file, which is incomplete}
  181.           IsamAssign(ReorgF, IsamForceExtension(FNameI, IxExtension));
  182.           IsamDelete(ReorgF);
  183.           {Rename DAT to SAV}
  184.           IsamClearOK;
  185.           CreateSavFile;
  186.           if not IsamOK then
  187.             {A severe error occurred in CreateSavFile}
  188.             Exit;
  189.         end;
  190.       IsamOK := False;
  191.       IsamError := Error;
  192.     end;
  193.  
  194.     function UpdateMessageFile : Boolean;
  195.       {-Open and update message file, returning False if error}
  196.     var
  197.       CPtr : ^Char;
  198.       W : Word;
  199.       IoRes : Integer;
  200.     begin
  201.       UpdateMessageFile := False;
  202.       if not MessageFileOpened then begin
  203.         Assign(MessageFile, IsamForceExtension(FNameD, MsgExtension));
  204.         Rewrite(MessageFile);
  205.         IORes := IoResult;
  206.         if IORes <> 0 then begin
  207.           UnDo(IORes, True);
  208.           Exit;
  209.         end;
  210.         MessageFileOpened := True;
  211.       end;
  212.       WriteLn(MessageFile, 'Key ', IKS);
  213.       WriteLn(MessageFile, 'with the number ', I, ' duplicate!');
  214.       WriteLn(MessageFile, 'Data record - Dump follows');
  215.       CPtr := @BufPtr^;
  216.       for W := 1 to CurRecLen do begin
  217.         Write(MessageFile, CPtr^);
  218.         inc(LongInt(CPtr));
  219.       end;
  220.       WriteLn(MessageFile, ^M^J);
  221.       IoRes := IoResult;
  222.       if IORes <> 0 then begin
  223.         UnDo(IORes, True);
  224.         Exit;
  225.       end;
  226.       UpdateMessageFile := True;
  227.     end;
  228.  
  229.   begin
  230.     {Initialize}
  231.     IsamClearOK;
  232.     MessageFileOpened := False;
  233.  
  234.     {Separate the pathnames}
  235.     IsamExtractFileNames(FBlName, FNameD, FNameI);
  236.     {Note: unique SAV file directory not supported here}
  237.     FNameS := FNameD;
  238.  
  239.     {Validate the record length}
  240.     if DatSLen > LongInt(MaxVariableRecLength) then begin
  241.       IsamOK := False;
  242.       IsamError := 10412;
  243.       Exit;
  244.     end;
  245.  
  246.     {Check that the variable length record buffer was allocated}
  247.     if DatSLen > IsamVRecBufSize then begin
  248.       BTReleaseVariableRecBuffer;
  249.       if not BTSetVariableRecBuffer(DatSLen) then begin
  250.         IsamOK := False;
  251.         IsamError := 10411;
  252.         Exit;
  253.       end;
  254.     end;
  255.  
  256.     {Create the SAV file if necessary}
  257.     CreateSavFile;
  258.     if not IsamOK then
  259.       Exit;
  260.  
  261.     {Create the new output file and close it}
  262.     BTCreateFileBlock(FNameD+';'+FNameI, DatSLen, NumberOfKeys, IID);
  263.     if not IsamOK then
  264.       Exit;
  265.  
  266.     {Allocate the input record buffer. One section only for now}
  267.     DLenW := ILI(DatSLen).Lo;
  268.     if MaxAvail < DLenW then begin
  269.       IsamOK := False;
  270.       IsamError := 10411;
  271.       Exit;
  272.     end;
  273.     GetMem(BufPtr, DLenW);
  274.     LPtr := @BufPtr^;
  275.  
  276.     {Open the SAV file to read the system record}
  277.     IsamAssign(ReorgF, IsamForceExtension(FNameS, SavExtension));
  278.     IsamReset(ReorgF, False, False);
  279.     if not IsamOK then begin
  280.       UnDo(IsamError, True);
  281.       Exit;
  282.     end;
  283.     IsamBlockRead(ReorgF, HeaderRec, SizeOf(HeaderRec));
  284.     if not IsamOK then begin
  285.       UnDo(IsamError, True);
  286.       Exit;
  287.     end;
  288.  
  289.     {Set the (potentially different) number of keys in the header}
  290.     HeaderRec.Gener[5] := LongInt(NumberOfKeys);
  291.     {Clear the index file open flag}
  292.     HeaderRec.ADK := False;
  293.  
  294.     {Write the header back to the SAV file and close it}
  295.     IsamLongSeek(ReorgF, 0);
  296.     IsamBlockWrite(ReorgF, HeaderRec, SizeOf(HeaderRec));
  297.     IsamClose(ReorgF);
  298.     if not IsamOK then begin
  299.       UnDo(IsamError, True);
  300.       Exit;
  301.     end;
  302.  
  303.     {Erase the newly created (empty) data file}
  304.     IsamAssign(ReorgF, IsamForceExtension(FNameD, DatExtension));
  305.     IsamDelete(ReorgF);
  306.     if not IsamOK then begin
  307.       UnDo(IsamError, True);
  308.       Exit;
  309.     end;
  310.  
  311.     {Rename the SAV file to the new DAT file}
  312.     IsamAssign(ReorgF, IsamForceExtension(FNameS, SavExtension));
  313.     IsamRename(ReorgF, IsamForceExtension(FNameD, DatExtension));
  314.     if not IsamOK then begin
  315.       UnDo(IsamError, True);
  316.       Exit;
  317.     end;
  318.  
  319.     {Open the fileblock, which has all the data but none of the indexes}
  320.     BTOpenFileBlock(ReorgIFBPtr, FNameD+';'+FNameI,
  321.                     False, False, False, False);
  322.     if not IsamOK then begin
  323.       UnDo(IsamError, True);
  324.       Exit;
  325.     end;
  326.  
  327.     {Add the keys of each index to the new fileblock}
  328.     NrOfRecs := NumRecsInFile(ReorgIFBPtr);
  329.     for I := 1 to NumberOfKeys do begin
  330.       DatSWritten := 0;
  331.       DatSRead := 0;
  332.       for L := LongInt(1) to NrOfRecs do begin
  333.         {Read just the first section to check the deleted flag}
  334.         BTGetRec(ReorgIFBPtr, L, BufPtr^, False);
  335.         if not IsamOK then begin
  336.           UnDo(IsamError, True);
  337.           Exit;
  338.         end;
  339.  
  340.         if LPtr^ = LongInt(0) then begin
  341.           {The start of a real, non-deleted, variable length record}
  342.  
  343.           {Assure the variable record buffer is large enough}
  344.           BTGetVariableRecLength(ReorgIFBPtr, L, CurRecLen);
  345.           if CurRecLen > DLenW then begin
  346.             FreeMem(BufPtr, DLenW);
  347.             if MaxAvail < CurRecLen then begin
  348.               UnDo(10411, False);
  349.               Exit;
  350.             end;
  351.             DLenW := CurRecLen;
  352.             GetMem(BufPtr, DLenW);
  353.             LPtr := @BufPtr^;
  354.           end;
  355.  
  356.           {Get the actual record now}
  357.           BTGetVariableRec(ReorgIFBPtr, L, BufPtr^, CurRecLen);
  358.           if not IsamOK then begin
  359.             UnDo(IsamError, True);
  360.             Exit;
  361.           end;
  362.           Inc(DatSRead);
  363.  
  364.           {Get the key string and add it to the index}
  365.           IKS := BuildKey(FuncBuildKey, BufPtr^, I);
  366.           if IsamOK then begin
  367.             if AddNullKeys or (IKS <> '') then begin
  368.               BTAddKey(ReorgIFBPtr, I, L, IKS);
  369.               if IsamOK then
  370.                 Inc(DatSWritten)
  371.               else if IsamError = 10230 then begin
  372.                 {Duplicate key: report it, delete this record, and continue}
  373.                 if not UpdateMessageFile then
  374.                   Exit;
  375.                 for J := 1 to I-1 do
  376.                   BTDeleteKey(ReorgIFBPtr, J, L,
  377.                               BuildKey(FuncBuildKey, BufPtr^, J));
  378.                 BTDeleteVariableRec(ReorgIFBPtr, L);
  379.               end else begin
  380.                 UnDo(IsamError, True);
  381.                 Exit;
  382.               end;
  383.             end;
  384.  
  385.             {Call the user routine and check for abort request}
  386.             If IsamOK then
  387.               if IsamReXUserProcPtr <> nil then
  388.                 ReXUserRoutine(IsamReXUserProcPtr, I, DatSRead, DatSWritten,
  389.                                BufPtr^, CurRecLen);
  390.           end;
  391.  
  392.           if not IsamOK then begin
  393.             UnDo(10413, True);
  394.             Exit;
  395.           end;
  396.  
  397.         end; {if LPtr^ = 0}
  398.       end; {for L := 1 to NrOfRecs}
  399.     end; {for I := 1 to NumberOfKeys}
  400.  
  401.     {Free data buffer and close up}
  402.     FreeMem(BufPtr, DLenW);
  403.     if MessageFileOpened then begin
  404.       Close(MessageFile);
  405.       I := IoResult;
  406.     end;
  407.     BTCloseFileBlock(ReorgIFBPtr);
  408.   end;
  409.  
  410.   {$IFDEF InitAllUnits}
  411. begin
  412. {$ENDIF}
  413. end.
  414.