home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / FSPLIT.ZIP / FSPLIT.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1989-06-30  |  10.1 KB  |  405 lines
  1. program FileSplitter;
  2.  
  3. (*
  4.      Fsplit (file splitter) creates sub-divisions of a source text file,
  5.      using a command-line file size.  The file size should reflect the size
  6.      of the destination media.  That is, specifying '1440' for a 1.44M
  7.      3.5" floppy is OK, as is the parameter '360', in order to make the
  8.      files small enough to fit onto a 360K 5.25" floppy.  All file names
  9.      are sequentially numbered, starting at *.@@1 and going up to *.@99.
  10.  
  11.      A binary file mode is also implimented, using a -B switch; this enables
  12.      BlockRead/BlockWrite commands, processing binary files a little faster.
  13.  
  14.      The complimentary FJOIN program can re-connect files previously FSPLIT
  15.      in either ASCII or binary format.
  16.  
  17.      Robert L. Jones,  CIS [71251,2566]
  18.      Version 1.1 released to the public domain 6/25/89.
  19. *)
  20.  
  21. uses crt,dos;
  22.  
  23. const
  24.   title : string = 'FSPLIT (the file splitter)  v1.1 by R. L. Jones';
  25.   maxsize = 2048;
  26. var
  27.   FName,DestFName  : string;
  28.   BinaryMode : boolean;
  29.   infile,outfile   : text;
  30.   Binfile,Boutfile : file;
  31.   buf : array [1..maxsize] of char;
  32.   floppysize : longint;
  33.   sr  : searchrec;
  34.   spf : longint;     { size per floppy }
  35.   ExitSave : pointer;
  36.  
  37.  
  38. procedure Usage;
  39. var
  40.   s : string;
  41. begin
  42.   s := ParamStr(0);
  43.   repeat
  44.     delete(s,1,pos('\',s));
  45.   until pos('\',s) = 0;
  46.   delete(s,pos('.',s),length(s));
  47.  
  48.   textcolor(lightgreen);
  49.   writeln('  USAGE:    ',s,'  <source> <value> <option: -B>');
  50.   textcolor(lightgray);
  51.   writeln;
  52.   writeln('  ',title);
  53.   writeln;
  54.   writeln('  The purpose of ',s,'.EXE is to split large text files into segments');
  55.   writeln('  which will fit onto floppy disks.  User specifies size of the segments.');
  56.   writeln('  Copying proceeds with a given file until 95% of the portion is used.');
  57.   writeln('  The copying will continue using another file, incrementally numbered');
  58.   writeln('  using the scheme:   *.@@1 - *.@99.  The user will be prompted before');
  59.   writeln('  overwriting a previously stored file.  The <-B> switch will override');
  60.   writeln('  the default ASCII text file mode, and use binary copying techniques');
  61.   writeln('  for non-ASCII files (the complimentary program FJOIN can be used to');
  62.   writeln('  re-connect files split in either ASCII or binary format).');
  63.   writeln;
  64.   writeln('  examples:');
  65.   textcolor(lightred);
  66.   writeln('           ',s,' filename.ext 360      <--  for 360K  floppies');
  67.   writeln('           ',s,' filename.ext 1440     <--  for 1.44M floppies');
  68.   writeln('           ',s,' filename.ext 1440 -B  <--  for 1.44M in binary mode');
  69.   textcolor(lightgray);
  70.   halt(1);
  71. end;
  72.  
  73.  
  74. {$F+} PROCEDURE ReturnToDOS; {$F-}
  75. BEGIN
  76.   {$I-}
  77.   if (BinaryMode) then begin
  78.     CLOSE(Binfile);
  79.     if (IOResult <> 0) then ;
  80.     CLOSE(Boutfile);
  81.     if (IOResult <> 0) then ;
  82.     end
  83.   else begin
  84.     CLOSE(infile);
  85.     if (IOResult <> 0) then ;
  86.     CLOSE(outfile);
  87.     if (IOResult <> 0) then ;
  88.     end;
  89.   {$I+}
  90.   textcolor(lightgray);
  91.   ExitProc := ExitSave;
  92. END;
  93.  
  94.  
  95. procedure SetUp;
  96. var
  97.   code : integer;
  98.   s    : string[80];
  99. begin
  100.   ExitSave := ExitProc;        { Force return to DOS if we crash. }
  101.   ExitProc := @ReturnToDos;
  102.  
  103.   clrscr;
  104.   if (ParamCount < 2) then Usage;
  105.  
  106.   textcolor(yellow);
  107.   write(title);
  108.   BinaryMode := FALSE;
  109.   FName := ParamStr(1);
  110.   DestFName := FName;
  111.   if (pos('.',DestFName) <> 0) then
  112.     delete(DestFName,pos('.',DestFName),length(DestFName));
  113.   DestFName := DestFName + '.@@1';
  114.  
  115.   val(ParamStr(2), floppysize, code);
  116.   if (code <> 0) OR (floppysize < 1) then Usage;
  117.   floppysize := floppysize * 1000;  { set to 95%; not 1024 }
  118.  
  119.   if (ParamCount = 3) then begin
  120.     s := ParamStr(3);
  121.     if ((UpCase(s[2]) = 'B') AND (s[1] in ['/','-','\'])) then
  122.       BinaryMode := TRUE;
  123.     end;
  124. end;  {of SetUp}
  125.  
  126.  
  127. function OpenFiles : BOOLEAN;
  128. var
  129.   ch : CHAR;
  130. begin
  131.   OpenFiles := FALSE;
  132.   if (LENGTH(FName) < 1) then EXIT;
  133.  
  134.   FindFirst(FName,$3F,sr);
  135.   if (DosError <> 0) then Exit;
  136.   spf := round(sr.size/floppysize);
  137.   ASSIGN(infile,FName);
  138.   {$I-}
  139.   RESET(infile);
  140.   if (IOResult <> 0) then Exit;
  141.  
  142.   ASSIGN(outfile,DestFName);
  143.   RESET(outfile);
  144.   if (IOResult = 0) then begin
  145.     window(10,9,70,12);
  146.     write('Output file already exists; overwrite (Y/N)? ');
  147.     ch := readkey;
  148.     if (UpCase(ch) = 'Y') then begin
  149.       REWRITE(outfile);
  150.       if (IOResult <> 0) then Exit;
  151.       end
  152.     else HALT(1);
  153.     clrscr;
  154.     window(1,1,80,25);
  155.     end
  156.   else begin
  157.     REWRITE(outfile);
  158.     if (IOResult <> 0) then Exit;
  159.     end;
  160.   OpenFiles := TRUE;
  161. END;   { of OpenFiles }
  162.  
  163.  
  164. function BinaryOpenFiles : BOOLEAN;
  165. var
  166.   ch : CHAR;
  167. begin
  168.   BinaryOpenFiles := FALSE;
  169.   if (LENGTH(FName) < 1) then EXIT;
  170.  
  171.   FindFirst(FName,$3F,sr);
  172.   if (DosError <> 0) then Exit;
  173.   if (floppysize < maxsize) then
  174.     floppysize := maxsize;
  175.   spf := round(sr.size/floppysize) + 1;
  176.  
  177.   ASSIGN(Binfile,FName);
  178.   {$I-}
  179.   RESET(Binfile,1);
  180.   if (IOResult <> 0) then Exit;
  181.  
  182.   ASSIGN(Boutfile,DestFName);
  183.   RESET(Boutfile,1);
  184.   if (IOResult = 0) then begin
  185.     window(10,9,70,12);
  186.     write('Output file already exists; overwrite (Y/N)? ');
  187.     ch := readkey;
  188.     if (UpCase(ch) = 'Y') then begin
  189.       REWRITE(Boutfile,1);
  190.       if (IOResult <> 0) then Exit;
  191.       end
  192.     else begin
  193.       window(1,1,80,25);
  194.       HALT(1);
  195.       end;
  196.     clrscr;
  197.     textcolor(lightgray);
  198.     window(1,1,80,25);
  199.     end
  200.   else begin
  201.     REWRITE(Boutfile,1);
  202.     if (IOResult <> 0) then Exit;
  203.     end;
  204.   BinaryOpenFiles := TRUE;
  205. END;   { of BinaryOpenFiles }
  206.  
  207.  
  208. procedure ProcessFile;
  209. var
  210.   ch : char;
  211.   counter  : byte;
  212.   currsize,line : longint;
  213.   numstrg  : string[2];
  214.   s        : string;
  215. begin
  216.   counter := 1;
  217.   line := 0;
  218.   currsize := 0;
  219.   textcolor(lightgray);
  220.   gotoxy(1,6);
  221.   write('Processing line:');
  222.   textcolor(lightgreen);
  223.   gotoxy(18,5);
  224.   write(counter);
  225.  
  226.   repeat
  227.     inc(line);
  228.     gotoxy(18,6);
  229.     write(line);
  230.     if (KeyPressed) then begin
  231.       ch := ReadKey;
  232.       if upcase(ch) in ['Q',chr(27)] then HALT(1);
  233.       end;
  234.     ReadLn(infile,s);
  235.     if (IOResult <> 0) then Exit;
  236.     inc(currsize,length(s)*sizeof(char));
  237.  
  238.     if (currsize < floppysize) then begin
  239.       WriteLn(outfile,s);
  240.       if (IOResult <> 0) then Exit;
  241.       end
  242.     else begin
  243.       currsize := length(s)*sizeof(char);
  244.       CLOSE(outfile);
  245.       if (IOResult <> 0) then ;
  246.       delete(DestFName,pos('.',DestFName),length(DestFName));
  247.       inc(counter);
  248.       str(counter,numstrg);
  249.       if (counter < 10) then
  250.         DestFName := DestFName + '.@@' + numstrg
  251.       else
  252.         DestFName := DestFName + '.@' + numstrg;
  253.       ASSIGN(outfile,DestFName);
  254.       RESET(outfile);
  255.       if (IOResult = 0) then begin
  256.         window(10,9,70,12);
  257.         write('Output file already exists; overwrite (Y/N)? ');
  258.         ch := readkey;
  259.         if (UpCase(ch) = 'Y') then begin
  260.           REWRITE(outfile);
  261.           if (IOResult <> 0) then Exit;
  262.           end
  263.         else begin
  264.           clrscr;
  265.           window(1,1,80,25);
  266.           Exit;
  267.           end;
  268.         clrscr;
  269.         window(1,1,80,25);
  270.         end
  271.       else begin
  272.         REWRITE(outfile);
  273.         if (IOResult <> 0) then Exit;
  274.         end;
  275.  
  276.         WriteLn(outfile,s);
  277.         if (IOResult <> 0) then Exit;
  278.         gotoxy(18,5);
  279.         write(counter);
  280.       end;  { of else }
  281.    until EOF(infile);
  282. end;   { ProcessFile }
  283.  
  284.  
  285. procedure ProcessBinaryFile;
  286. var
  287.   ch : char;
  288.   counter,x,y  : byte;
  289.   currsize,block : longint;
  290.   numstrg  : string[2];
  291.   i,numread,numwritten : integer;
  292. begin
  293.   counter := 1;
  294.   block := 0;
  295.   currsize := 0;
  296.   textcolor(lightgray);
  297.   gotoxy(1,6);
  298.   write('Processing ',maxsize,'-block:  ');
  299.   x := wherex;
  300.   y := wherey;
  301.   textcolor(lightgreen);
  302.   gotoxy(18,5);
  303.   write(counter);
  304.  
  305.   repeat
  306.     inc(block);
  307.     gotoxy(x,y);
  308.     write(block);
  309.  
  310.     if (KeyPressed) then begin
  311.       ch := ReadKey;
  312.       if upcase(ch) in ['Q',chr(27)] then HALT(1);
  313.       end;
  314.     FillChar(buf,sizeof(buf),0);
  315.     BlockRead(Binfile,buf,sizeof(buf),numread);
  316.  
  317.     if (IOResult <> 0) then Exit;
  318.     inc(currsize,numread);
  319.  
  320.     if (currsize <= floppysize) then begin
  321.       BlockWrite(Boutfile,buf,numread,numwritten);
  322.       if (IOResult <> 0) then Exit;
  323.       end
  324.     else begin
  325.       currsize := numread;
  326.       CLOSE(Boutfile);
  327.       if (IOResult <> 0) then ;
  328.       delete(DestFName,pos('.',DestFName),length(DestFName));
  329.       inc(counter);
  330.       str(counter,numstrg);
  331.       if (counter < 10) then
  332.         DestFName := DestFName + '.@@' + numstrg
  333.       else
  334.         DestFName := DestFName + '.@' + numstrg;
  335.       ASSIGN(Boutfile,DestFName);
  336.       RESET(Boutfile,1);
  337.       if (IOResult = 0) then begin
  338.         window(10,9,70,12);
  339.         write('Output file already exists; overwrite (Y/N)? ');
  340.         ch := readkey;
  341.         if (UpCase(ch) = 'Y') then begin
  342.           REWRITE(Boutfile,1);
  343.           if (IOResult <> 0) then Exit;
  344.           end
  345.         else begin
  346.           clrscr;
  347.           window(1,1,80,25);
  348.           Exit;
  349.           end;
  350.         clrscr;
  351.         window(1,1,80,25);
  352.         end
  353.       else begin
  354.         REWRITE(Boutfile,1);
  355.         if (IOResult <> 0) then Exit;
  356.         end;
  357.  
  358.       BlockWrite(Boutfile,buf,numread,numwritten);
  359.       if (IOResult <> 0) then Exit;
  360.       gotoxy(18,5);
  361.       write(counter);
  362.     end;  { of else }
  363.   until (numread = 0) OR (numread <> numwritten);
  364. end;   { ProcessBinaryFile }
  365.  
  366.  
  367. procedure OpeningRemarks;
  368. begin
  369.   if (BinaryMode) then begin
  370.     if (NOT (BinaryOpenFiles)) then halt(1);
  371.     end
  372.   else begin
  373.     if (NOT (OpenFiles)) then halt(1);
  374.     end;
  375.   gotoxy(1,3);
  376.   textcolor(lightgray);
  377.   write('Spliting file ');
  378.   textcolor(lightred);
  379.   write(FName);
  380.   textcolor(lightgray);
  381.   write(' into ');
  382.   textcolor(lightgreen);
  383.   write(spf);
  384.   textcolor(lightgray);
  385.   write('-',floppysize,' byte files.');
  386.  
  387.   gotoxy(1,5);
  388.   write('Writing file:');
  389. end;
  390.  
  391.  
  392. BEGIN
  393.   SetUp;
  394.   OpeningRemarks;
  395.   if (BinaryMode) then
  396.     ProcessBinaryFile
  397.   else
  398.     ProcessFile;
  399.   textcolor(lightgray);
  400.   writeln;
  401.   writeln;
  402.   write('Done...');
  403. END.
  404.  
  405.