Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/BTP20.ZIP/CRUNCH2.PAS

Pascal/Delphi Source File | 1993-06-10 | 8.7 KB | 297 lines

PROGRAM Crunch2;               { (c) 1993 John C. Leon   last updated 6/9/93 }

{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}
{$X+}

USES
   Crt, DOS, Objects {for FNameStr}, BTP;

CONST
   NOTICE1 = 'Crunch2                   (C) 1993 John C. Leon.  All Rights Reserved.';
   NOTICE2 = '----------------------------------------------------------------------';
   NumRecordsinOp  :integer = 5; {MaxInsBufLength = (2+(2*Number of Insertions) + }
   MaxInsBufLength = 20462;      { (MaxFixedRecLength*Number of Insertions)       }
   OwnerName  : string = '';
   NumInserted: longint = 0;

TYPE
   POrgFile      = ^TOrgFile;
   TOrgFile      = object(BFileExt)
                      function BTExt(OpCode, Key: integer): integer; virtual;
                      end;

   TCopyBuffer = record
                    Count: word;
                    Repeater: array[1..MaxInsBufLength-2] of byte;
                    end;
   PCopyFile     = ^TCopyFile;
   TCopyFile     = object(BSized)
                      ExtDBuffer: ^TCopyBuffer;
                      constructor Init(UserFileName: FNameStr; OpenMode: integer;
                                       OName: TOwnerName; BuffSize:integer);
                      function BTExt(OpCode, Key: integer): integer; virtual;
                      destructor Done; virtual;
                      end;

VAR
   OrgName, CopyName     : string[79];
   OrgFile               : POrgFile;
   CopyFile              : PCopyFile;
   Counter,  Counter1,
   CopyOfs, OrgOfs,
   RecordLength,
   Remainder, x, y       : integer;
   NumberOps             : longint;
   LoRecordLength,
   HiRecordLength        : byte;


function TOrgFile.BTExt(OpCode, Key: integer): integer;
begin
   {call ancestor method to set buffer lengths & to structure send buffer}
   inherited BTExt(OpCode, Key);
   BTExt   := Btrv(OpCode, PosBlk, ExtDBuffer^.Entire, DBufferLen,
                   VarNotRequired, Key);
end;

constructor TCopyFile.Init(UserFileName: FNameStr; OpenMode: integer;
                                         OName: TOwnerName; BuffSize: integer);
begin
   inherited Init(UserFileName, OpenMode, OName, BuffSize);
   ExtDBuffer := DBuffer;         { Force a record structure on the DBuffer. }
end;

destructor TCopyFile.Done;
begin
   inherited Done;
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;

procedure VerifyTargetOverWrite;
var
   Response: string;
   DirInfo : SearchRec;
begin
findfirst(CopyName, archive, DirInfo);
if doserror = 0 then
   begin
   writeln;
   write('Target file ', CopyName, ' exists.  Overwrite? (Y/N): ');
   readln(Response);
   Response[1] := upcase(Response[1]);
   if Response[1] = 'N' then
      begin
      OrgFile^.Close;
      dispose(OrgFile, Done);
      writeln('Program aborted.');
      halt(4);
      end;
   if Response[1] <> 'Y' then
      begin
      writeln;
      writeln('Invalid response ... program aborted.');
      OrgFile^.Close;
      dispose(OrgFile, Done);
      writeln('Program aborted');
      halt(5);
      end;
   end;
end;

procedure PrintNotices;
begin
   writeln(NOTICE1);
   writeln(NOTICE2);
   writeln;
end;


(* Begin MAIN program code *)
(* ------------------------------------------------------------------------ *)
BEGIN

if not IsBtrieveLoaded then
   begin
   writeln('Please load Btrieve before loading this program.');
   halt(1);
   end;

clrscr;
PrintNotices;

write('Name of file to copy from: ');
readln(OrgName);
if OrgName = '' then
   begin
   writeln('No source file name entered ... program aborted');
   halt(2);
   end;
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);
if CopyName = '' then
   begin
   writeln('No target file name entered ... program aborted');
   halt(3);
   end;
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, OwnerName));
case BStatus of
   51:  begin
        dispose(OrgFile, Done);
        write('Enter source file''s owner name: ');
        readln(OwnerName);
        if OwnerName = '' then
           begin
           writeln('Owner name not provided ... program aborted');
           halt(6);
           end;
        OrgFile := new(POrgFile, Init(OrgName, ReadOnly, OwnerName));
        if BStatus = 51 then
           begin
           writeln(OwnerName, ' not accepted by Btrieve as owner name.');
           writeln('Program aborted.');
           dispose(OrgFile, Done);
           halt(6);
           end;
        end;
    FileNotFound: begin
                  writeln('Source file ', OrgName, ' not found.');
                  writeln('Program aborted.');
                  dispose(OrgFile, Done);
                  halt(7);
                  end;
    0:    {Don't do anything if object initialized w/no errors, but}
    else  {catch all other errors w/following code.}
       begin
        writeln('Error opening ', OrgName, '.  Status: ', BStatus);
        writeln('Program aborted.');
        halt(8);
        end;
    end;


if OrgFile^.NumRecs = 0 then                     {don't proceed if empty file}
   begin
   writeln('No records in ', OrgName, '.  CRUNCH aborted.');
   OrgFile^.Close;
   dispose(OrgFile, Done);
   halt(9);
   end;

if (OrgFile^.Specs.FileFlags and VarLength) = VarLength then
   begin
   writeln(OrgName, ' is a variable length file.  Can''t process.');
   OrgFile^.Close;
   dispose(OrgFile, Done);
   halt(10);
   end;

RecordLength   := OrgFile^.Specs.RecLen;
LoRecordLength := lo(RecordLength);
HiRecordLength := hi(RecordLength);

{Set up required filter and extractor data fields in OrgFile^:
   Max number of records to skip, # logic terms, # records to retrieve w/
   each call, and number of fields to extract.}

OrgFile^.SetTerms(1, 0, 5, 1);

{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)));

{Exit if target exists, and user doesn't wanna overwrite.}
VerifyTargetOverWrite;

BStatus := CloneFile(OrgName, CopyName, Retain, '');
if BStatus = Zero then
   begin
   writeln(CopyName, ' created successfully.');
   writeln;
   end
   else
   begin
   writeln('Error creating ', CopyName, '.  Status = ', BStatus, '.');
   OrgFile^.Close;
   dispose(OrgFile, Done);
   halt(11);
   end;

{Open new copy of file in accelerated mode.}
CopyFile := new(PCopyFile, Init(CopyName, Accel, '', sizeof(TExtDBuffer)));

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 inc(NumberOps);

writeln('Total # records in ', OrgName, ': ', OrgFile^.NumRecs);
write('Number records inserted in ', CopyName, ': ');
x := wherex;
y := wherey;

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);
   inc(NumInserted, NumRecordsinOp);
   if (NumInserted) MOD 5 = 0 then
      begin
      gotoxy(x, y);
      write(NumInserted);
      end;
   CopyOfs := 1;
   OrgOfs  := 7;

   end; {for Counter := 1 to NumberOps}

gotoxy(1, y);
clreol;
writeln('Inserted ', NumInserted, ' records in ', CopyName);
writeln('DONE...');

BStatus := OrgFile^.Close;
BStatus := CopyFile^.Close;
dispose(OrgFile, Done);
dispose(CopyFile, Done);

END.