Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/PRALOC.ZIP/PREALLOC.PAS

Pascal/Delphi Source File | 1992-10-16 | 6.2 KB | 227 lines

{$S-,R-,I-,V-,B-,F-}

{$IFNDEF Ver40}
  {$F+,O+,A-}     {Force far calls, allow overlays, avoid byte mismatches}
{$ENDIF}

{*********************************************************}
{*                  PREALLOC.PAS 5.40                    *}
{*        Copyright (c) TurboPower Software 1990.        *}
{*                 All rights reserved.                  *}
{*********************************************************}

unit PreAlloc;
  {-Routines to preallocate disk space for IsamFileBlocks}

interface

uses
  Dos,
  Filer;

const
  DummyFillChar : Byte = 0;

procedure PreAllocateFileblock(IFBPtr : IsamFileBlockPtr;
                               TotalDataRecs : LongInt);
  {-Preallocates space for TotalDataRecs in both data and index file. If the
    specified IFBPtr refers to a FileBlock opened in a Net mode, then the
    FileBlock must be locked before making this call. If it is not locked,
    an IsamError of 10398 will be returned. Only appends to data or
    index if the file in question is smaller than the number specified.}

procedure PreAllocateVRecFileBlock(IFBPtr : IsamFileBlockPtr;
                                   TotalSections : LongInt;
                                   TotalIndexRecs : LongInt);
{-Preallocates space for the specified number of sections in the data file
 and the specified number of Index reocrds. Only appends if necessary, never
 truncates. If the specified IFBPtr refers to a FileBlock opened in a Net
 mode, then the FileBlock must be locked before making this call. If it is
 not locked locked, an IsamError of 10398 will be returned.}

implementation

  procedure IsamFlush ( Var F        : IsamFile;
                        Var WithDUP  : Boolean;
                            NetUsed  : Boolean );

  Var
    Regs : Registers;

  Begin
    With Regs Do Begin
      AH := $45;
      BX := F.Handle;
      MsDos ( Regs );   {DUP the handle}
      If Not Odd (Flags) Then Begin
        WithDUP := True;
        BX := AX;
        AH := $3E;
        MsDos (Regs);   {Close the DUP handle}
        If Odd (Flags) Then Begin
          IsamOK := False;
          If AX = 6 Then Begin
            IsamError := 9904;
          End Else Begin
            IsamError := 10140;
          End;
        End;
      End Else Begin
        WithDUP := False;
        If NetUsed Then Begin
          IsamOK := False;
          IsamError := 10150;
        End Else Begin
          IsamClose ( F );
          If Not IsamOK Then Exit;
          IsamReset ( F, False, False );
        End;
      End;
    End;
  End;

  procedure IsamPutDummyBlock(var F : IsamFile; Ref, Len : LongInt);

  const
    EmptyArrLen = 1024;

  var
    EmptyArr : array[1..EmptyArrLen] of Char;

  begin
    FillChar(EmptyArr, SizeOf(EmptyArr), DummyFillChar);
    IsamLongSeek(F, Ref);
    if not IsamOK then
      Exit;
    while Len > EmptyArrLen do begin
      IsamBlockWrite(F, EmptyArr, SizeOf(EmptyArr));
      if not IsamOK then
        Exit;
      Len := Len-LongInt(SizeOf(EmptyArr));
    end;
    IsamBlockWrite(F, EmptyArr, Word(Len));
  end;

  procedure ExpandFile(F : IsamFile; NumBytes : LongInt);
    {-Appends NumBytes to the end of the specified file}
  var
    Ref : LongInt;
    SavFill : Byte;
  begin
    if NumBytes = 0 then
      Exit;
    IsamLongSeekEOF(F, Ref);
    if IsamOK then begin
      SavFill := DummyFillChar;
      DummyFillChar := $FF;
      IsamPutDummyBlock(F, Ref, NumBytes);
      DummyFillChar := SavFill;
    end;
  end;

  procedure ExpandFileBlock(IFBPtr : IsamFileBlockPtr;
                            NumBytesData : LongInt;
                            NumBytesIndex : LongInt);
  var
    Dummy : Boolean;
  begin
    with IFBPtr^ do begin
      if NumBytesData > 0 then begin
        ExpandFile(DatF, NumBytesData);
        if not IsamOK then
          Exit;
        IsamFlush(DatF, Dummy, (NSP <> nil) and (BTNetSupported <> NoNet));
        if not IsamOK then
          Exit;
      end;
      if (NumBytesIndex > 0) then begin
        ExpandFile(IndF, NumBytesIndex);
        if not IsamOK then
          Exit;
        IsamFlush(IndF, Dummy, (NSP <> nil) and (BTNetSupported <> NoNet));
      end;
    end;
  end;

  procedure PreAllocateFileblock(IFBPtr : IsamFileBlockPtr;
                                 TotalDataRecs : LongInt);

  var
    NumData,
    FSize,
    NumIndex : LongInt;

  begin
    IsamClearOK;
    if BTIsNetFileBlock(IFBPtr) then
      if not BTFileBlockIsLocked(IFBPtr) then begin
        IsamOK := False;
        IsamError := 10398;
        Exit;
      end;
    NumData := TotalDataRecs*BTDatRecordSize(IFBPtr);
    IsamLongSeekEOF(IFBPtr^.DatF, FSize);
    if not IsamOK then
      Exit;
    if NumData > FSize then
      NumData := NumData-FSize
    else
      NumData := 0;

    NumIndex := BTKeyRecordSize(IFBPtr);
    if not IsamOK then
      Exit;
    IsamLongSeekEOF(IFBPtr^.IndF, FSize);
    if not IsamOK then
      Exit;
    NumIndex := ((TotalDataRecs div LongInt(PageSize))+1)*NumIndex;
    if NumIndex > FSize then
      NumIndex := NumIndex-FSize
    else
      NumIndex := 0;

    ExpandFileBlock(IFBPtr, NumData, NumIndex);
  end;

  procedure PreAllocateVRecFileBlock(IFBPtr : IsamFileBlockPtr;
                                     TotalSections : LongInt;
                                     TotalIndexRecs : LongInt);
  var
    NumData,
    FSize,
    NumIndex : LongInt;

  begin
    IsamClearOK;
    if BTIsNetFileBlock(IFBPtr) then
      if not BTFileBlockIsLocked(IFBPtr) then begin
        IsamOK := False;
        IsamError := 10398;
        Exit;
      end;
    NumData := TotalSections*BTDatRecordSize(IFBPtr);
    IsamLongSeekEOF(IFBPtr^.DatF, FSize);
    if not IsamOK then
      Exit;
    if NumData > FSize then
      NumData := NumData-FSize
    else
      NumData := 0;

    IsamLongSeekEOF(IFBPtr^.IndF, FSize);
    if not IsamOK then
      Exit;
    NumIndex := BTKeyRecordSize(IFBPtr);
    if not IsamOK then
      Exit;
    NumIndex := ((TotalIndexRecs div LongInt(PageSize))+1)*NumIndex;
    if NumIndex > FSize then
      NumIndex := NumIndex-FSize
    else
      NumIndex := 0;

    ExpandFileBlock(IFBPtr, NumData, NumIndex);
  end;

end.