home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
DP Tool Club 17
/
CD_ASCQ_17_101194.iso
/
vrac
/
dvtag101.zip
/
DVTAG.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1994-09-26
|
5KB
|
174 lines
PROGRAM DivideTAGfile;
USES Dos;
CONST
progdesc = 'DvTAG - Free DOS utility: Divide TAGfile at specified line length.';
author = 'v1.01: September 26, 1994. (c) 1994 by David Daniel Anderson - Reign Ware.';
PROCEDURE showhelp (problem:byte);
{----
If any *foreseen* errors arise, we are sent
here to give a little help and exit (relatively) peacefully
----}
CONST
usage = ' Usage : DvTAG TagFile [/#]';
where1 = ' Where : TagFile = file specification (DOS wildcards are allowed).';
where2 = ' and : # = longest line to put in TagFile.SHR (optional, default = 57).';
example = 'Example: DvTAG c:\text\tags.new /56';
VAR
message : STRING[79];
BEGIN
writeln;
IF problem > 0 THEN BEGIN
CASE problem OF
2 : message:= 'The second parameter is NOT a valid numeric!';
3 : message:= 'No files found. First parameter must be a valid file specification.';
6 : message:= 'You cannot just specify a path, add "*.*" or "\*.*" for all files.';
7 : message:= 'Error opening or closing a file.';
ELSE message:= 'Undefined error.'
END;
writeln (#7, 'Error encountered:'); writeln (message); writeln;
END;
writeln (usage);
writeln (where1);
writeln (where2);
writeln;
writeln (example);
halt (problem);
END;
FUNCTION upper (w:STRING) : STRING;
VAR
cp :integer; {the position of the character to change.}
BEGIN
FOR cp:= 1 TO length (w) DO
w[cp]:= upcase (w[cp]);
upper:= w;
END;
FUNCTION nameof (fspec:STRING):STRING; {name of file, without period}
VAR
period:byte;
BEGIN
period:= pos ('.', fspec);
IF period > 0 THEN
nameof:= copy (fspec, 1, period - 1)
ELSE
nameof:= fspec;
END;
FUNCTION extof (fspec:STRING):STRING; {extension of file, including period}
VAR
period:byte;
BEGIN
period:= pos ('.', fspec);
IF period > 0 THEN
extof:= copy (fspec, period, length (fspec) - (period-1))
ELSE
extof:= '';
END;
PROCEDURE iocheck (iores:byte);
BEGIN
IF iores <> 0 THEN showhelp (7);
END;
PROCEDURE resetfile (VAR textfile:text; fname:STRING);
BEGIN
assign (textfile, fname);
reset (textfile); iocheck (ioresult);
END;
PROCEDURE rewritefile (VAR textfile:text; fname:STRING);
BEGIN
assign (textfile, fname);
rewrite (textfile); iocheck (ioresult);
END;
PROCEDURE closefile (VAR textfile:text);
BEGIN
close (textfile); iocheck (ioresult);
END;
VAR
pstr,
inpath : pathstr;
indir : dirstr;
inname : namestr;
inext : extstr;
dirinfo : searchrec; { contains filespec info. }
TagFName, ShortFName, LongFName : pathstr;
TagFile, ShortFile, LongFile : text;
TagLine : STRING;
TLength,
counter : byte;
valerr : integer;
numdone : word; { number of files divided }
BEGIN
writeln (progdesc);
writeln (author);
TLength:= 57;
inpath:= '';
numdone:= 0;
IF NOT (paramcount IN [1..2]) THEN showhelp (0);
FOR counter:= 1 TO paramcount DO BEGIN
pstr:= paramstr (counter);
IF pstr[1] IN ['/', '-'] THEN BEGIN
val (copy (pstr, 2, length (pstr) - 1), TLength, valerr);
IF valerr <> 0 THEN showhelp (2);
END
ELSE
inpath:= pstr;
END;
IF inpath = '' THEN showhelp (3);
fsplit (fexpand (inpath), indir, inname, inext);
IF inname = '' THEN showhelp (6);
findfirst (inpath, archive, dirinfo);
IF doserror <> 0 THEN showhelp (3);
{---- Okay, let's go! ----}
writeln;
WHILE doserror = 0 DO BEGIN
IF (NOT (Upper (extof (dirinfo.name)) = '.SHR')) AND
(NOT (Upper (extof (dirinfo.name)) = '.LNG')) THEN BEGIN
TagFName := indir + dirinfo.name;
ShortFName:= indir + nameof (dirinfo.name) +'.shr'; { Using same name, }
LongFName := indir + nameof (dirinfo.name) +'.lng';{different extension.}
write ('Dividing ', dirinfo.name:12, ' at ', TLength, ' characters');
{ tell user this file is being processed }
resetfile (TagFile, TagFName);
rewritefile (ShortFile, ShortFName);
rewritefile (LongFile, LongFName);
WHILE NOT eof (TagFile) DO BEGIN
readln (TagFile, TagLine);
IF length (TagLine) <= TLength THEN
writeln (ShortFile, TagLine)
ELSE
writeln (LongFile, TagLine);
END;
closefile (TagFile);
closefile (ShortFile);
closefile (LongFile);
writeln (', done!'); { tell user this file has been processed }
inc (numdone);
END;
findnext (dirinfo);
END; { now loop back with name of next file to process }
writeln ('Divided ', numdone, ' file(s).');
END.