PROGRAM CHOP18A 					03/03/87
{
Copies a large file into several smaller ones, with size specified by
user.  Written in Turbo PASCAL.

------------------------------------------------------------------------
		     updates, most recent first

03/03/87  Added 3-digit serial file extensions (.001, .002, .003, etc.)
  v1.8A   for output files.  Added numeric line count for lines copied
	  in text mode (replaces dots).  Optimal "End Address" settings
	  for Turbo Pascal v2.0 added to these comments above. Final
	  object file should be compiled using the lowest compiler End
	  Address possible to allow running with smaller sized TPA's.
	  Header now announces buffer size using constant "Buf" to cal-
	  culate.

	* COMPILER END ADDRESSES FOR SMALLEST TPA's (if using Borlund's
	  Turbo Pascal v2.0):

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


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


02/17/87  Change program format to allow chopping up any type of file,
  v1.6	  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


04/07/86  Fixed a bug that allowed entering <ret> as an ouput file name.
  v1.2	  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

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 know whats going on.  Aded prprocedure to
	  strip the filetype (.EXT) from the outputfile name if one was
	  entered by the user.	General cleanup of display
					- Kent Mason

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

------------------------------------------------------------------------
}
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}