home *** CD-ROM | disk | FTP | other *** search
/ Current Shareware 1994 January / SHAR194.ISO / email / slmt100.zip / SLMT.PAS < prev   
Pascal/Delphi Source File  |  1993-08-19  |  3KB  |  108 lines
  1. program filterlonglinesfromtextfile;
  2. uses dos ;
  3. const
  4.  progdata = 'SLMT- Free DOS utility: offline reader ASCII tagline file creator.';
  5.  progdat2 = 'V1.00: August 19, 1993. (c) 1993 by David Daniel Anderson - Reign Ware.';
  6.  usage    = 'Usage: SLMT tag_file [Transform into a short line file and a long line file.]';
  7.  usage2   = 'You may use the DOS SET command to change the default "toolong" var of 58 chars';
  8.  usage3   = ' -- Ex:  "SET toolong=73" will sift out all lines which exceed 72 chars.)';
  9.  
  10. var
  11.     infilepath  : pathstr ;
  12.     infiledir   : dirstr ;
  13.     infilename  : namestr ;
  14.     infileext   : extstr ;
  15.  
  16.     outfileSn,
  17.     outfileLn   : string ;
  18.  
  19.     infile,
  20.     outfileS,
  21.     outfileL    : text ;
  22.  
  23.     aline       : string ;
  24.  
  25.     toolongstr  : string ;
  26.     toolong     : byte ;
  27.     valerr      : integer;
  28.  
  29. procedure showhelp(problem: char ); {if any *foreseen* errors arise, we are }
  30. var                   { sent here to give a little help and exit peacefully }
  31.    message : string [80];
  32. begin
  33.    writeln (usage);
  34.    writeln ;
  35.    writeln (usage2);
  36.    writeln (usage3);
  37.    writeln ;
  38.    writeln ('Error encountered:');
  39.    case problem of
  40.         'a' : message := ' Unable to open ' + infilepath + '!';
  41.         'b' : message := outfileSn + ' exists!  Rename or delete it.';
  42.         'c' : message := outfileLn + ' exists!  Rename or delete it.';
  43.         'd' : message := ' You must specify a filename on the command line.';
  44.         'e' : message := ' If you use the "toolong" env var, it must be a number.';
  45.    end;
  46.    writeln (message);
  47.    halt (1);
  48. end;
  49.  
  50. begin
  51.      writeln (progdata);
  52.      writeln (progdat2);
  53.      writeln ;
  54.  
  55.      toolongstr := getenv ( 'toolong' );
  56.      if toolongstr = '' then
  57.         toolong := 58
  58.      else begin
  59.         val ( toolongstr, toolong, valerr );
  60.         if valerr <> 0 then
  61.            showhelp('e');
  62.      end;
  63.  
  64.      if paramcount <> 1 then
  65.         showhelp('d');
  66.  
  67.      infilepath := paramstr (1) ;
  68.  
  69.      assign ( infile, infilepath );
  70. {$i-} reset ( infile ); {$i+}
  71.      if (ioresult <> 0) then
  72.          showhelp('a');
  73.  
  74.      FSplit (infilepath, infiledir, infilename, infileext);
  75.      outfileSn := infilename + '.shr' ;  {Using same name, different extension.}
  76.      outfileLn := infilename + '.lng' ;  {Using same name, different extension.}
  77.  
  78.      assign ( outfileS, outfileSn );
  79. {$i-} reset ( outfileS ); {$i+}
  80.      if (ioresult <> 0) then
  81.      rewrite ( outfileS )
  82.         else showhelp('b');
  83.  
  84.      assign ( outfileL, outfileLn );
  85. {$i-} reset ( outfileL ); {$i+}
  86.      if (ioresult <> 0) then
  87.      rewrite ( outfileL )
  88.         else showhelp('c');
  89.  
  90.      write ( ' SPLITTING ', infilepath ,
  91.              ' INTO ',      outfileSn ,
  92.              ' AND ',       outfileLn );
  93.  
  94.      while not eof ( infile ) do begin
  95.            readln ( infile, aline );
  96.            if length ( aline ) < toolong then
  97.               writeln ( outfileS, aline )
  98.            else
  99.               writeln ( outfileL, aline );
  100.      end ;
  101.  
  102.      close ( infile );
  103.      close ( outfileS );
  104.      close ( outfileL );
  105.      writeln (', DONE!');
  106.  
  107. end.
  108.