PROGRAM Crunch3;              { (c) 1991 John C. Leon   last updated 11/4/91 }

{Handles ONLY standard, fixed length Btrieve files.  Uses Step Next Extended
 to retrieve 5 records at a time, then Insert Extended to insert 5 records at
 a time.}

{$IFDEF production} {$D-,R-,L-,S-} {$ENDIF}

USES
   BTP;

CONST
   NumRecordsinOp  :integer = 5; {MaxInsBufLength = (2+(2*Number of Insertions) + }
   MaxInsBufLength = 20462;      { (MaxFixedRecLength*Number of Insertions)       }

TYPE
   POrgFile      = ^TOrgFile;
   TOrgFile      = object(BFileExt)
                      function BTExt(OpCode, Key: integer): integer; virtual;
                      end;

   TExtDBuffer = record
                    Count: word;
                    Repeater: array[1..MaxInsBufLength-2] of byte;
                    end;
   PCopyFile     = ^TCopyFile;
   TCopyFile     = object(BFixed)
                      ExtDBuffer: TExtDBuffer;
                      function BTExt(OpCode, Key: integer): integer;
                      end;

VAR
   OrgName, CopyName     : string[79];
   OrgFile               : POrgFile;
   CopyFile              : PCopyFile;
   Counter,  Counter1,
   Counter2, CopyOfs,
   OrgOfs, RecordLength,
   Remainder, NumberOps  : integer;
   LoRecordLength,
   HiRecordLength        : byte;


function TOrgFile.BTExt(OpCode, Key: integer): integer;
begin
   {call ancestor method to set buffer lengths & to structure send buffer}
   BStatus := BFileExt.BTExt(OpCode, Key);
   BTExt   := Btrv(OpCode, PosBlk, ExtDBuffer^.Entire, DBufferLen,
                   VarNotRequired, Key);
end;

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(POrgFile, Init(OrgName, ReadOnly));

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;

   RecordLength   := OrgFile^.Specs.RecLen;
   LoRecordLength := lo(RecordLength);
   HiRecordLength := hi(RecordLength);

   {Set up required filter and extractor data fields in OrgFile^.}
   with OrgFile^ do
      begin
      Filter.MaxSkip       := 1;
      Filter.NumLogicTerms := 0;
      Extractor.NumRecords := 5;
      Extractor.NumFields  := 1;
      end;

   {Set up required minimum of one extractor spec in collection.  Note that
    OrgFile's constructor initialized the collection.}
   with OrgFile^.ExtractorSpec^ do
      insert(new(PExtSpec, Init(OrgFile^.Specs.RecLen, 0)));

   {It's SOOoo easy to clone a file on the fly with this unit!}
   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));

   OrgOfs   := 7;  {we know the length of record in this case, and don't
                    care about position, so skip the six lead bytes of each
                    record}
   CopyOfs  := 1;

   Remainder := OrgFile^.NumRecs MOD NumRecordsinOp;
   NumberOps := OrgFile^.NumRecs DIV NumRecordsinOp;
   if Remainder <> 0 then NumberOps := NumberOps + 1;

   Counter2  := Zero;

   for Counter := 1 to NumberOps do
      begin
      BStatus := OrgFile^.BTExt(BStepNextExt, Zero);
      NumRecordsinOp := OrgFile^.ExtDBuffer^.NumRecs; {# recs ret'd by StepNextExt}

      {Build buffer for insertion.}
      for Counter1 := 1 to NumRecordsinOp do
         begin
         CopyFile^.ExtDBuffer.Repeater[CopyOfs] := LoRecordLength;
         inc(CopyOfs);
         CopyFile^.ExtDBuffer.Repeater[CopyOfs] := HiRecordLength;
         inc(CopyOfs);
         move(OrgFile^.ExtDBuffer^.Repeater[OrgOfs],
              CopyFile^.ExtDBuffer.Repeater[CopyOfs], RecordLength);
         CopyOfs := CopyOfs + RecordLength;
         OrgOfs  := OrgOfs + RecordLength + 6;
         end;

      CopyFile^.ExtDBuffer.Count := NumRecordsinOp;
      BStatus := CopyFile^.BTExt(BInsertExt, Zero);

      CopyOfs := 1;
      OrgOfs  := 7;
      Counter2 := Counter2 + NumRecordsinOp;
      writeln('Inserted total of ', Counter2, ' records');

      end; {for Counter := 1 to NumberOps}

   writeln('DONE...');

   BStatus := OrgFile^.Close;
   BStatus := CopyFile^.Close;

   dispose(OrgFile, Done);
   dispose(CopyFile, Done);
   end; {if BStatus <> Zero}

END.
