home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 17 / CD_ASCQ_17_101194.iso / vrac / dvtag101.zip / DVTAG.PAS < prev    next >
Pascal/Delphi Source File  |  1994-09-26  |  5KB  |  174 lines
  1. PROGRAM DivideTAGfile;
  2. USES Dos;
  3. CONST
  4.   progdesc = 'DvTAG - Free DOS utility: Divide TAGfile at specified line length.';
  5.   author   = 'v1.01: September 26, 1994. (c) 1994 by David Daniel Anderson - Reign Ware.';
  6.  
  7. PROCEDURE showhelp (problem:byte);
  8. {----
  9.  If any *foreseen* errors arise, we are sent
  10.   here to give a little help and exit (relatively) peacefully
  11. ----}
  12. CONST
  13.   usage    = ' Usage : DvTAG TagFile [/#]';
  14.   where1   = ' Where : TagFile = file specification (DOS wildcards are allowed).';
  15.   where2   = '  and  :       # = longest line to put in TagFile.SHR (optional, default = 57).';
  16.   example  = 'Example: DvTAG c:\text\tags.new /56';
  17. VAR
  18.   message : STRING[79];
  19. BEGIN
  20.   writeln;
  21.   IF problem > 0 THEN BEGIN
  22.     CASE problem OF
  23.       2 : message:= 'The second parameter is NOT a valid numeric!';
  24.       3 : message:= 'No files found.  First parameter must be a valid file specification.';
  25.       6 : message:= 'You cannot just specify a path, add "*.*" or "\*.*" for all files.';
  26.       7 : message:= 'Error opening or closing a file.';
  27.     ELSE  message:= 'Undefined error.'
  28.     END;
  29.     writeln (#7, 'Error encountered:'); writeln (message); writeln;
  30.   END;
  31.   writeln (usage);
  32.   writeln (where1);
  33.   writeln (where2);
  34.   writeln;
  35.   writeln (example);
  36.   halt (problem);
  37. END;
  38.  
  39. FUNCTION upper (w:STRING) : STRING;
  40. VAR
  41.    cp  :integer;        {the position of the character to change.}
  42. BEGIN
  43.   FOR cp:= 1 TO length (w) DO
  44.     w[cp]:= upcase (w[cp]);
  45.   upper:= w;
  46. END;
  47.  
  48. FUNCTION nameof (fspec:STRING):STRING; {name of file, without period}
  49. VAR
  50.   period:byte;
  51. BEGIN
  52.   period:= pos ('.', fspec);
  53.   IF period > 0 THEN
  54.     nameof:= copy (fspec, 1, period - 1)
  55.   ELSE
  56.     nameof:= fspec;
  57. END;
  58.  
  59. FUNCTION extof (fspec:STRING):STRING;  {extension of file, including period}
  60. VAR
  61.   period:byte;
  62. BEGIN
  63.   period:= pos ('.', fspec);
  64.   IF period > 0 THEN
  65.     extof:= copy (fspec, period, length (fspec) - (period-1))
  66.   ELSE
  67.     extof:= '';
  68. END;
  69.  
  70. PROCEDURE iocheck (iores:byte);
  71. BEGIN
  72.   IF iores <> 0 THEN showhelp (7);
  73. END;
  74.  
  75. PROCEDURE resetfile (VAR textfile:text; fname:STRING);
  76. BEGIN
  77.   assign (textfile, fname);
  78.   reset (textfile);         iocheck (ioresult);
  79. END;
  80.  
  81. PROCEDURE rewritefile (VAR textfile:text; fname:STRING);
  82. BEGIN
  83.   assign (textfile, fname);
  84.   rewrite (textfile);       iocheck (ioresult);
  85. END;
  86.  
  87. PROCEDURE closefile (VAR textfile:text);
  88. BEGIN
  89.   close (textfile);         iocheck (ioresult);
  90. END;
  91.  
  92. VAR
  93.   pstr,
  94.   inpath    : pathstr;
  95.   indir     : dirstr;
  96.   inname    : namestr;
  97.   inext     : extstr;
  98.   dirinfo   : searchrec;  { contains filespec info. }
  99.  
  100.   TagFName, ShortFName, LongFName  : pathstr;
  101.   TagFile,  ShortFile,  LongFile   : text;
  102.  
  103.   TagLine   : STRING;
  104.  
  105.   TLength,
  106.   counter   : byte;
  107.   valerr    : integer;
  108.   numdone   : word; { number of files divided }
  109.  
  110. BEGIN
  111.   writeln (progdesc);
  112.   writeln (author);
  113.   TLength:= 57;
  114.   inpath:= '';
  115.   numdone:= 0;
  116.  
  117.   IF NOT (paramcount IN [1..2]) THEN showhelp (0);
  118.  
  119.   FOR counter:= 1 TO paramcount DO BEGIN
  120.     pstr:= paramstr (counter);
  121.     IF pstr[1] IN ['/', '-'] THEN BEGIN
  122.       val (copy (pstr, 2, length (pstr) - 1), TLength, valerr);
  123.       IF valerr <> 0 THEN showhelp (2);
  124.     END
  125.     ELSE
  126.       inpath:= pstr;
  127.   END;
  128.   IF inpath = '' THEN showhelp (3);
  129.  
  130.   fsplit (fexpand (inpath), indir, inname, inext);
  131.   IF inname = '' THEN showhelp (6);
  132.   findfirst (inpath, archive, dirinfo);
  133.   IF doserror <> 0 THEN showhelp (3);
  134.  
  135. {---- Okay, let's go! ----}
  136.   writeln;
  137.   WHILE doserror = 0 DO BEGIN
  138.  
  139.     IF (NOT (Upper (extof (dirinfo.name)) = '.SHR')) AND
  140.        (NOT (Upper (extof (dirinfo.name)) = '.LNG')) THEN BEGIN
  141.  
  142.       TagFName  := indir + dirinfo.name;
  143.       ShortFName:= indir + nameof (dirinfo.name) +'.shr'; { Using same name, }
  144.       LongFName := indir + nameof (dirinfo.name) +'.lng';{different extension.}
  145.  
  146.       write ('Dividing ', dirinfo.name:12, ' at ', TLength, ' characters');
  147.             { tell user this file is being processed }
  148.  
  149.       resetfile (TagFile, TagFName);
  150.       rewritefile (ShortFile, ShortFName);
  151.       rewritefile (LongFile, LongFName);
  152.  
  153.       WHILE NOT eof (TagFile) DO BEGIN
  154.         readln (TagFile, TagLine);
  155.         IF length (TagLine) <= TLength THEN
  156.           writeln (ShortFile, TagLine)
  157.         ELSE
  158.           writeln (LongFile, TagLine);
  159.       END;
  160.  
  161.       closefile (TagFile);
  162.       closefile (ShortFile);
  163.       closefile (LongFile);
  164.  
  165.       writeln (', done!'); { tell user this file has been processed }
  166.       inc (numdone);
  167.     END;
  168.  
  169.     findnext (dirinfo);
  170.   END;  { now loop back with name of next file to process }
  171.  
  172.   writeln ('Divided ', numdone, ' file(s).');
  173. END.
  174.