PROGRAM SPLITFIL; { SPLIT LARGE FILE > 1.44 MEG INTO SMALLER CHUNKS}
USES DOS;
CONST min_disk_space       : longint = 100000;
VAR
  SOURCE, DESTINATION      : FILE;
  SOURCENAME,
  DESTINATIONNAME          : STRING[12];
  NAME                     : STRING[8];
  CLUSTER                  : ARRAY[1..1024] OF BYTE;
  CL_INDEX                 : WORD;
  REMAINING                : LONGINT;
  THIS_DISK_FREE           : LONGINT;
  SECTION_COUNT, V         : WORD;
  ERR                      : INTEGER;
  go_on                    : string[4];
  SUFFIX                   : STRING[3];

    function upstr(v: string): string;
    var i: integer;
    begin
      for i := 1 to length(v) do v[i] := upcase(v[i]);
      upstr := v
    end;

    PROCEDURE SYNTHESIZE_NAME;
    BEGIN
      STR(SECTION_COUNT,SUFFIX);
      WHILE LENGTH(SUFFIX) < 3 DO SUFFIX := '0'+SUFFIX;
      DESTINATIONNAME := NAME + '.' + SUFFIX;
    END; {SYNTHESIZE_NAME}

{$I-}
  procedure put_file_name;
  var fn: text;
  begin
    assign(fn, 'A:\'+name+'.000');
    rewrite(fn); err := ioresult;
    if err <> 0 then halt(err);
    writeln(fn,sourcename);
    close(fn)
  end;
  procedure change_disk;
    begin
      writeln('The disk in drive A: is not blank.');
      writeln('Change disk and press ENTER key when ready.');
      readln;
    end;

  procedure quit(msg: string); begin
    writeln(msg); halt
  end;
  var curr_disksize: longint;

BEGIN
  SECTION_COUNT := 1;
  while diskfree(1) =-1 do begin
    writeln('Please load your A: drive with a blank floppy.');
    writeln('Press ENTER key when ready.');
    readln end;
  curr_disksize := disksize(1);
  remaining := diskfree(1);
  if remaining > curr_disksize then quit('Available free space greater than disk size. halted')
  else if remaining < curr_disksize then change_disk;
  REPEAT
    WRITE('Enter name for file to save:  ');
    READLN(SOURCENAME);
    sourcename := upstr(sourcename);
    ASSIGN(SOURCE,SOURCENAME); ERR := IORESULT;
    RESET(SOURCE,1); ERR := IORESULT;
    IF ERR = 0 THEN BEGIN
      REMAINING := FILESIZE(SOURCE);
      WRITELN('Filesize: ',REMAINING);
      writeln((remaining div curr_disksize)+1,' disks needed.');
      writeln('Press ENTER key to continue.');
      readln END
    ELSE WRITELN(' FILE NOT FOUND. PLEASE CHECK AND RETYPE NAME.');
  UNTIL ERR = 0;
  IF (REMAINING <= 100000000) THEN {GO ON} ELSE quit('Sorry current limit for file size is 100MB.');
  NAME := COPY (SOURCENAME,1,POS('.',SOURCENAME)-1);
  put_file_name;
  repeat
    SYNTHESIZE_NAME;
    REPEAT
      REPEAT
        THIS_DISK_FREE := DISKFREE(1);
        ERR := IORESULT;
        IF THIS_DISK_FREE < min_disk_space THEN begin
          WRITELN('Please put a new formatted but blank diskette in drive A:');
          writeln('Press ENTER to go on.');
          readln(go_on); end {disk full}
      UNTIL THIS_DISK_FREE > min_disk_space;
      writeln(' Writing data...');
      ASSIGN(DESTINATION,'A:\'+NAME+'.'+SUFFIX);
      REWRITE(DESTINATION,1);
      REPEAT { WRITE CLUSTERS UNTIL DISK_FREE < 1024}
        BLOCKREAD(SOURCE,CLUSTER,SIZEOF(CLUSTER),V);
        BLOCKWRITE(DESTINATION,CLUSTER,V);
        THIS_DISK_FREE := THIS_DISK_FREE - V;
        REMAINING := REMAINING - V;
        WRITE('.')
      UNTIL (THIS_DISK_FREE < 1024) OR (V <= 0);
    UNTIL (THIS_DISK_FREE < 1024) OR (V <= 0);
    CLOSE(DESTINATION);
    SECTION_COUNT := SUCC(SECTION_COUNT);
  until remaining = 0;
  CLOSE(SOURCE);
 END.