home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / FJOIN.ZIP / FJOIN.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1989-06-30  |  6.6 KB  |  262 lines
  1. program FileJoiner;
  2.  
  3. (*
  4.      FJoin (file joiner) re-creates a large source text file, following a
  5.      file splitting by FSplit.  All file to be joined should be typed
  6.      on the command-line.  Default reconstruction using FSplit nomenclature
  7.      can be flagged using the -D option with only the filename (no extension).
  8.      FSplit names use extensions which are sequentially numbered, starting at
  9.      *.@@1 and going up to *.@99.
  10.  
  11.      Robert L. Jones,  CIS [71251,2566]
  12.      Version 1.0 released to the public domain 6/25/89.
  13. *)
  14.  
  15. uses crt,dos;
  16.  
  17. const
  18.   title : string = 'FJOIN (the file joiner)  v1.0 by R. L. Jones';
  19. var
  20.   FName      : array [1..256] of string[80];
  21.   DestFName  : string[80];
  22.   DefaultName,EraseFiles : boolean;
  23.   infile,outfile  : file;
  24.   NumFiles : byte;
  25.   buf : array [1..2048] of char;
  26.   ExitSave : pointer;
  27.  
  28.  
  29. procedure Usage;
  30. var
  31.   s : string;
  32. begin
  33.   s := ParamStr(0);
  34.   repeat
  35.     delete(s,1,pos('\',s));
  36.   until pos('\',s) = 0;
  37.   delete(s,pos('.',s),length(s));
  38.  
  39.   textcolor(lightgreen);
  40.   writeln('  USAGE:    ',s,'  <source> <value>');
  41.   textcolor(lightgray);
  42.   writeln;
  43.   writeln('  ',title);
  44.   writeln;
  45.   writeln('  The purpose of ',s,'.EXE is to join large text files which were');
  46.   writeln('  previously split by FSPLIT.  The user specifies the file names on');
  47.   writeln('  the command line as indicated below.  Default filename extensions, as');
  48.   writeln('  originally provided by FSPLIT, can be chosen using the -D switch.');
  49.   writeln('  The default name scheme is:  *.@@1 - *.@99.  The result of the');
  50.   writeln('  program will be stored in the file "source.$@@".  ',s,' can');
  51.   writeln('  re-connect files previously FSPLIT in either ASCII or binary format.');
  52.   writeln;
  53.   writeln('  examples:');
  54.   textcolor(lightred);
  55.   writeln('           ',s,' filename -D               <-- use default extensions');
  56.   writeln('           ',s,' filename -DE              <-- use default & erase sources');
  57.   writeln('           ',s,' fname1.ext fname2.ext     <-- use specified file names');
  58.   writeln('           ',s,' fname1.ext fname2.ext -E  <-- use specified files & erase');
  59.   textcolor(lightgray);
  60.   halt(1);
  61. end;
  62.  
  63.  
  64. {$F+} PROCEDURE ReturnToDOS; {$F-}
  65. BEGIN
  66.   {$I-}
  67.   CLOSE(infile);
  68.   if (IOResult <> 0) then ;
  69.   CLOSE(outfile);
  70.   if (IOResult <> 0) then ;
  71.   {$I+}
  72.   textcolor(lightgray);
  73.   ExitProc := ExitSave;
  74. END;
  75.  
  76.  
  77. procedure SetUp;
  78. var
  79.   i : byte;
  80.   s : string[80];
  81. begin
  82.   ExitSave := ExitProc;        { Force return to DOS if we crash. }
  83.   ExitProc := @ReturnToDos;
  84.  
  85.   clrscr;
  86.   DefaultName := FALSE;
  87.   EraseFiles := FALSE;
  88.   if (ParamCount < 2) then Usage;
  89.  
  90.   textcolor(yellow);
  91.   write(title);
  92.   textcolor(lightgray);
  93.  
  94.   FillChar(FName,sizeof(FName),0);
  95.   FName[1] := ParamStr(1);
  96.   DestFName := FName[1];
  97.  
  98.   s := ParamStr(2);
  99.   if (((UpCase(s[2]) = 'D') OR (UpCase(s[3]) = 'D')) AND
  100.        (s[1] in ['/','-','\'])) then
  101.     DefaultName := TRUE;
  102.   if (((UpCase(s[2]) = 'E') OR (UpCase(s[3]) = 'E')) AND
  103.        (s[1] in ['/','-','\'])) then
  104.     EraseFiles := TRUE;
  105.   if (pos('.',FName[1]) = 0) OR (DefaultName) then begin
  106.     DefaultName := TRUE;
  107.     if (pos('.',FName[1]) <> 0) then
  108.       delete(FName[1],pos('.',FName[1]),length(FName[1]));
  109.     end
  110.   else begin
  111.     NumFiles := ParamCount;
  112.     dec(NumFiles);
  113.     i := 2;
  114.     repeat
  115.       FName[i] := ParamStr(i);
  116.       s := FName[i];
  117.       if ((UpCase(s[2]) = 'E') AND (s[1] in ['/','-','\'])) then begin
  118.         EraseFiles := TRUE;
  119.         FName[i] := '';
  120.         dec(i);
  121.         end;
  122.       inc(i);
  123.       dec(NumFiles);
  124.     until NumFiles = 0;
  125.     NumFiles := i-1;
  126.     end;
  127.   if (pos('.',DestFName) <> 0) then
  128.       delete(DestFName,pos('.',DestFName),length(DestFName));
  129.   DestFName := DestFName + '.$@@';
  130. end;  {of SetUp}
  131.  
  132.  
  133. function OpenFiles : BOOLEAN;
  134. var
  135.     ch : CHAR;
  136. begin
  137.   OpenFiles := FALSE;
  138.   if (LENGTH(FName[1]) < 1) then EXIT;
  139.  
  140.   ASSIGN(infile,FName[1]);
  141.   {$I-}
  142.   RESET(infile,1);
  143.   if (IOResult <> 0) then begin
  144.     Exit;
  145.     end;
  146.  
  147.   ASSIGN(outfile,DestFName);
  148.   RESET(outfile,1);
  149.   if (IOResult = 0) then begin
  150.     window(10,9,70,12);
  151.     textcolor(lightred);
  152.     write('Output file already exists; overwrite (Y/N)? ');
  153.     ch := readkey;
  154.     if (UpCase(ch) = 'Y') then begin
  155.       REWRITE(outfile,1);
  156.       if (IOResult <> 0) then Exit;
  157.       end
  158.     else begin
  159.       window(1,1,80,25);
  160.       clrscr;
  161.       HALT(1);
  162.       end;
  163.     clrscr;
  164.     textcolor(lightgray);
  165.     window(1,1,80,25);
  166.     end
  167.   else begin
  168.     REWRITE(outfile,1);
  169.     if (IOResult <> 0) then Exit;
  170.     end;
  171.   OpenFiles := TRUE;
  172.   gotoxy(5,4);
  173. END;   { of OpenFiles }
  174.  
  175.  
  176. procedure ProcessFile;
  177. var
  178.   ch : char;
  179.   CurrFile : byte;
  180.   numstrg  : string[2];
  181.   i,numread,numwritten : integer;
  182. begin
  183.   CurrFile := 1;
  184.   repeat
  185.     repeat
  186.       if (KeyPressed) then begin
  187.         ch := ReadKey;
  188.         if upcase(ch) in ['Q',chr(27)] then HALT(1);
  189.         end;
  190.       FillChar(buf,sizeof(buf),0);
  191.       BlockRead(infile,buf,sizeof(buf),numread);
  192.       if (IOResult <> 0) then Exit;
  193.       BlockWrite(outfile,buf,numread,numwritten);
  194.       if (IOResult <> 0) then Exit;
  195.     until (numread = 0) OR (numread <> numwritten);
  196.  
  197.     if (EraseFiles) then begin
  198.       ERASE(infile);
  199.       if (IOResult <> 0) then ;
  200.       end
  201.     else begin
  202.       CLOSE(infile);
  203.       if (IOResult <> 0) then ;
  204.       end;
  205.  
  206.     inc(CurrFile);
  207.     if (DefaultName) then begin
  208.       str(CurrFile,numstrg);
  209.       delete(FName[CurrFile-1],
  210.              pos('.',FName[CurrFile-1]),length(FName[CurrFile-1]));
  211.       if (CurrFile < 10) then
  212.         FName[CurrFile] := FName[CurrFile-1] + '.@@' + numstrg
  213.       else
  214.         FName[CurrFile] := FName[CurrFile-1] + '.@' + numstrg;
  215.       end;
  216.     ASSIGN(infile,FName[CurrFile]);
  217.  
  218.    {
  219.      if DefaultName is true, reset'ing a non-existent file will
  220.      result in an I/O error and exit the procedure
  221.    }
  222.     RESET(infile,1);
  223.     if (IOResult <> 0) then Exit;
  224.   until ((CurrFile > NumFiles) AND not(DefaultName));
  225. end;   { ProcessFile }
  226.  
  227.  
  228. procedure OpeningRemarks;
  229. var
  230.   i : byte;
  231. begin
  232.   gotoxy(1,3);
  233.   write('Processing files:');
  234.   gotoxy(5,4);
  235.   textcolor(lightred);
  236.   if (DefaultName) then begin
  237.     write(FName[1]);
  238.     FName[1] := FName[1] + '.@@1';
  239.     end
  240.   else begin
  241.     for i := 1 to NumFiles-1 do begin
  242.       write(FName[i]);
  243.       write(',');
  244.       end;
  245.     write(FName[NumFiles]);
  246.     end;
  247.   textcolor(lightgray);
  248. end;
  249.  
  250.  
  251. BEGIN
  252.   SetUp;
  253.   OpeningRemarks;
  254.   if (NOT (OpenFiles)) then halt(1);
  255.   ProcessFile;
  256.   textcolor(lightgray);
  257.   writeln;
  258.   writeln;
  259.   write('Done...');
  260. END.
  261.  
  262.