PROGRAM Crunch2;              { (c) 1991 John C. Leon   last updated 11/4/91 }

{Handles ONLY standard, fixed length Btrieve files.}

{$IFDEF production} {$D-,R-,L-,S-} {$ENDIF}

USES
   BTP;

CONST
   NumInsertions =     5; {MaxInsBufLen = (2+(2*Number of Insertions) +   }
   MaxInsBufLen  = 20462; { (MaxFixedRecLength*Number of Insertions)      }

TYPE
   TExtDBuffer = record
                    Count: word;
                    Repeater: array[1..MaxInsBufLen-2] of byte;
                    end;
   PCopyFile   = ^TCopyFile;
   TCopyFile   = object(BFixed)
                    ExtDBuffer: TExtDBuffer;
                    function BTExt(OpCode, Key: integer): integer;
                    end;

VAR
   OrgName, CopyName   : string[79];
   OrgFile             : PBFixed;
   CopyFile            : PCopyFile;
   Counter,  Counter1,
   DBuffOfs,
   RecordLength        : integer;
   LoRecordLength,
   HiRecordLength      : byte;


function TCopyFile.BTExt(OpCode, Key: integer): integer;
var
   ExtBufLen: integer;
begin
   ExtBufLen := 2 + (2 * ExtDBuffer.Count) + (Specs.RecLen * ExtDBuffer.Count);
   BTExt := Btrv(OpCode, PosBlk, ExtDBuffer, ExtBufLen, KBuffer, Key);
end;


(* Begin MAIN program code *)
(* ------------------------------------------------------------------------ *)
BEGIN

write('Name of file to copy from: ');
readln(OrgName);
for Counter := 1 to length(OrgName) do
   OrgName[Counter] := upcase(OrgName[Counter]);

write('Name of file to create and populate from file ''', OrgName,''': ');
readln(CopyName);
for Counter := 1 to length(CopyName) do
   CopyName[Counter] := upcase(CopyName[Counter]);

{ Open original file in read only mode }
OrgFile  := new(PBFixed, Init(OrgName, ReadOnly));
RecordLength   := OrgFile^.Specs.RecLen;
LoRecordLength := lo(RecordLength);
HiRecordLength := hi(RecordLength);

if BStatus <> Zero then

   writeln('Error opening ', OrgName)

   else

   begin                     {if original file exists and no error on open op}

   if OrgFile^.NumRecs = 0 then            {don't proceed if empty file}
      begin
      writeln('No records in ', OrgName, '.  CRUNCH aborted.');
      halt;
      end;

   if (OrgFile^.Specs.FileFlags and 1) = 1 then    {don't do var length files}
      begin
      writeln(OrgName, ' is a variable length file.  Can''t process.');
      halt;
      end;

   BStatus := CloneFile(OrgName, CopyName);
   if BStatus = Zero then
      writeln(CopyName, ' created successfully.')
      else
      begin
      writeln('Error creating ', CopyName, '.  Status = ', BStatus, '.');
      halt;
      end;

   {Open new copy of file in accelerated mode.}
   CopyFile := new(PCopyFile, Init(CopyName, Accel));

   Counter1  := Zero;
   DBuffOfs  := 1;

   for Counter := 1 to OrgFile^.NumRecs do
      begin
      BStatus := OrgFile^.BT(BStepNext, Zero);
      CopyFile^.ExtDBuffer.Repeater[DBuffOfs] := LoRecordLength;
      inc(DBuffOfs);
      CopyFile^.ExtDBuffer.Repeater[DBuffOfs] := HiRecordLength;
      inc(DBuffOfs);
      move(OrgFile^.DBuffer[1],
           CopyFile^.ExtDBuffer.Repeater[DBuffOfs], RecordLength);
      DBuffOfs := DBuffOfs + RecordLength;
      if ((Counter MOD NumInsertions) = Zero) then
         begin
         CopyFile^.ExtDBuffer.Count := NumInsertions;
         BStatus := CopyFile^.BTExt(BInsertExt, Zero);
         DBuffOfs := 1;
         Counter1 := Counter1 + NumInsertions;
         writeln('Inserted total of ', Counter1, ' records');
         end;
      end; {for Counter := 1 to OrgFile^.NumRecs do}

   if ((OrgFile^.NumRecs MOD NumInsertions) <> Zero) then
      begin
      CopyFile^.ExtDBuffer.Count := (OrgFile^.NumRecs MOD NumInsertions);
      Counter1 := Counter1 + CopyFile^.ExtDBuffer.Count;
      BStatus  := CopyFile^.BTExt(BInsertExt, Zero);
      writeln('Inserted total of ', Counter1, ' records');
      writeln('DONE...');
      end;

   BStatus := OrgFile^.Close;
   BStatus := CopyFile^.Close;

   dispose(OrgFile, Done);
   dispose(CopyFile, Done);

   end; {if BStatus <> Zero}

END.
