PROGRAM CHOP18;
{
Copy a large file into several smaller ones.

* COMPILER END ADDRESSES FOR SMALLEST TPA's

       (with Turbo Pascal v3.0):

3F27 =  4k buffer  |  7F27 = 20k buffer
4F27 =  8k buffer  |  8F27 = 24k buffer
5F27 = 12k buffer  |  9327 = 25k buffer (odd-sized buffer, v1.7)
6F27 = 16k buffer  |  9F27 = 28k buffer

       (with Turbo Pascal v2.0):

3DEF =  4k buffer  |  7DEF = 20k buffer
4DEF =  8k buffer  |  8DEF = 24k buffer
5DEF = 12k buffer  |  91EF = 25k buffer (odd-sized buffer, v1.7)
6DEF = 16k buffer  |  9DEF = 28k buffer

       (with Turbo Pascal v1.0):

3B93 =  4k buffer  |  7B93 = 20k buffer
4B93 =  8k buffer  |  8B93 = 24k buffer
5B93 = 12k buffer  |  8F93 = 25k buffer (odd-sized buffer, v1.7)
6B93 = 16k buffer  |  9B93 = 28k buffer

History of CHOP program:

--------
date unknown
v1.0 (original)
author:  Phillip Hansford, 010685.
credits: Kirby Pressly in TUG LINES Vol. 1 #4

--------
03/18/86
v1.1 (Never released)
Added I/O checking for diskfiles.  Added user-selected
number of lines per file.  Added printing of filename
being processed, and printing of a '.' for each line
processed so user knows what's going on.  Added procedure
to strip the filetype (.EXT) from the outputfile name, if
one was entered by the user.  General cleanup of display.
- Kent Mason

--------
04/07/86
v1.2
Fixed a bug that allowed entering <ret> as an ouput file name.
User must now enter a minimum of 1 for the maximum number of
lines for the output file.  This fixed a bug that would cause
an I/O error if a <ret> was entered at the "Number of Lines
per file" prompt.

- Kent Mason and Barry Wood
Sysops "The General Store"
Z-node #58 (405) 943-8638

--------
02/17/87
v1.6
Change program format to allow chopping up any type of file,
not just text files.  Chopping now takes place via 128 byte
records instead of lines.  Chopped files are read into a 200
x 128 byte memory buffer (25K) then written to the new file.
This increases the transfer speed tremenously.  Any tpye or
size of file is handled.

To Reconstruct Chopped binary files :

PIP [D:]FILENAME.EXT = [D:]FNAME.1[OV],FNAME.2[OV],(etc.)

(To Reconstruct chopped text files, use your favorite word
processor or editor, capable of pulling in remote files.)

- Ed Randolph, contact through
Z-NODE #47  (405) 767-1651
Tom Keith is Sysop

--------
02/24/87
v1.7
Added the ability to process text type files either by line or
by record.

- Ed Randolph

--------
03/01/87
v1.8
Added 3-digit serial file extensions (.001, .002, etc.) for
output files.  Added numeric line count, rather than dots, for
lines copied in text mode.  Added optimal "End Address" settings
to the comments in source code.  Final object file should be com-
piled using the lowest possible compiler End Address to allow
running with smaller sized cp/m TPA's.  Header now announces buffer
size using constant "Buf" to calculate (16k/24k examples in source).

-Mike Dingacci-

---------------------------------
(End history, begin program code)

}

const
   Buf     = 128;       { 16k buffer --- use   192 for 24k buffer }
   BufSize = 16384;     { 16k buffer --- use 24576 for 24k buffer }
type
  String14 =  String[14];
  Str255   =  String[255];

const
  VerNum = '1.8';
  Date   = '(03/01/87)';

var
  Buffer        : Array[1..BufSize] of Byte;
 {buffer        : array[bufsize..1] of byte;  --- if bufsize >= $8000
                                                     and buf >= 256   }
  Remaining,
  NoRecRead,
  ReadRec,
  TotRec     : Integer;
  OldFileVar,
  NewFileVar    : File;
  Otxtfile,
  Ntxtfile      : Text;
  NumbStr       : string[5];
  OldFileName,
  NewFileName,
  TempName      : String14;
  ThisLine      : string[80];
  Count         : byte;
  Numb          : REAL;
  Answer        : Char;
  LinesPerFile,
  TotalLines, j,I,recs,trec,lines : integer;
  x               : Real;
  Flag            : Boolean;

procedure UpperCase(var Strg : String14);
{  This procedure converts all characters in the string to UpperCase  }
begin
  inline ($2A/Strg/
          $46/
          $04/
          $05/
          $CA/*+20/
          $23/
          $7E/
          $FE/$61/
          $DA/*-9/
          $FE/$7B/
          $D2/*-14/
          $D6/$20/
          $77/
          $C3/*-20);

end;

Procedure Inkey;
   Var
      Done : Boolean;
   begin
        repeat
            Done:=True;
            read(kbd,answer);
            if answer = '' then done:=false
        until done;
        Answer:= UpCase(Answer);
    end; (* of inkey *)

procedure StripFileType(var OutFileName : String14);
{  This procedure deletes the '.' and all characters
   after it, from the filename }
var
  index    : integer;
begin
   Index:= Pos('.',OutFileName);
   If Index <> 0 then
       Delete(OutFileName,Index,Length(OutFileName));
end;

procedure init;
{  This procedure gets the filenames from the user, 'cleans them up', and
   does a little i/o checking on the input file.                           }

begin
  Flag:= False;
  writeln;
  writeln('CHOP v ',VerNum,' -- ',(buf/8):1:2,'k buffer.');
  writeln(Date,' -- chops files of any type.');
  writeln;
  write('D:oldfilename.typ (file to be chopped)?      : ');
  readln(OldFileName);
  uppercase(OldFileName);
  assign(OldFileVar, OldFileName);
  {$I-}
  reset(OldFileVar);
  {$I+}
  i := ioresult;
  if i <> 0 then
    begin
      writeln;
      Writeln(^G,OldFileName,' not found');
      halt
    end
  else
  Recs:= FileSize(OldFileVar);
  Writeln('File size in records (8 recs. per Kb)        : ',recs);
  TempName := '';
  while length(TempName) < 1 do
  begin
    write('D:newfilename (no type)?                     : ');
    readln(TempName);
  end;
  UpperCase(TempName);
  StripFileType(TempName);
  LinesPerFile := 0;
  while LinesPerFile < 1 do
    begin
       Write('If file is TEXT - Chop by [L]ine or [R]ecord : ');
       Repeat
          Inkey;
       Until Answer in['R','L'];
       writeln(answer);
       Numb:= 0.001; Count:= 1; TotalLines := 0;
       str(Numb:0:3, NumbStr);
       numbstr:=copy(numbstr,2,4);       { drop the leading zero  }

       If Answer = 'R' then
          Begin
             write('Number of records per file?                  : ');
             readln(LinesPerFile);
             Flag:= True;
             NewFileName:= TempName + NumbStr;
             assign(NewFileVar, NewFileName);
             rewrite(NewFileVar);  {erases any existing file of that name}
          end
       Else
          Begin
             Assign(Otxtfile,OldFileName);
             Reset(OtxtFile);
             Write('Number of lines per file?                    : ');
             ReadLn(LinesPerFile);
             NewFileName:= TempName + NumbStr;
             assign(NtxtFile, NewFileName);
             rewrite(Ntxtfile);  {erases any existing file of that name}
          End;
    end;
    Writeln('Processing ',NewFileName);

  end;                 { procedure init }

Procedure ReadIt;
   Begin
      BlockRead(OldFileVar,Buffer,ReadRec);
      BlockWrite(NewFileVar,Buffer,ReadRec);
   End;

Procedure Junkit;
   Begin
      Recs:= Recs - ReadRec;
      TotRec:=TotRec + ReadRec;
      ReadRec := 0;
      If Recs > 0 then
         Begin
            close(NewFileVar);
            Numb:= Numb + 0.001;
            str(Numb:0:3, NumbStr);
            numbstr:=copy(numbstr,2,4);      { drop the leading zero  }
            NewFileName:= TempName + NumbStr;
            assign(NewFileVar, NewFileName);
            rewrite(NewFileVar);
            writeln;
            writeln('Processing ',NewFileName);
         End;
   End;

Procedure Oversize;
   Begin
      IF LinesPerFile > Recs then Lines:= Recs else Lines:= LinesPerFile;
      Trec:= 0;
      Repeat
         If Lines > buf then readrec:= buf
         else ReadRec:= lines;
         Readit;
         Lines:=Lines - readrec;
         trec:=trec + readrec;
         readrec:=0;
      Until Lines = 0;
      ReadRec:=trec;
      Junkit;
   End;

Procedure NormSize;
   Begin
      If LinesPerFile > Recs then ReadRec:= Recs;
      ReadIt;
      Junkit;
   End;

Procedure BustTextFile;
   Begin
  while not eof(OtxtFile) do
    begin
      for Count:= 1 to LinesPerFile do begin
        readln(OtxtFile, ThisLine);
        writeln(NtxtFile, ThisLine);
        TotalLines := TotalLines + 1;
        Write(totallines,^m);
        if eof(OtxtFile) then begin
          close(NtxtFile);
          writeln;writeln;
          writeln(^G,TotalLines,' total lines processed!');
          halt;
        end;
      end;
      if not eof(OtxtFile) then begin
        close(NtxtFile);
        Numb:= Numb + 0.001;
        str(Numb:0:3, NumbStr);
        numbstr:=copy(numbstr,2,4);       { drop the leading zero  }
        NewFileName:= TempName + NumbStr;
        assign(NtxtFile, NewFileName);
        rewrite(NtxtFile);
        writeln;writeln;
        writeln('Processing ',NewFileName);
      end;     {if not eof}
    end;
    close(NtxtFile);
  End;

Procedure ProcessBinary;
   Begin
      TotRec:= 0;
      If Recs <> 0 then
         Begin
            Repeat
               ReadRec:= LinesPerFile;
               If LinesPerFile > Buf then OverSize Else NormSize;
            Until Recs = 0;
            Writeln('Total number of records processed = ',totrec);
         End;
      Close(NewFileVar);
      Close(OldFileVar);
   End;

begin                  {main program}
   init;
   If Flag then ProcessBinary else BustTextFile;

end.  {program}