home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Current Shareware 1994 January
/
SHAR194.ISO
/
email
/
slmt100.zip
/
SLMT.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1993-08-19
|
3KB
|
108 lines
program filterlonglinesfromtextfile;
uses dos ;
const
progdata = 'SLMT- Free DOS utility: offline reader ASCII tagline file creator.';
progdat2 = 'V1.00: August 19, 1993. (c) 1993 by David Daniel Anderson - Reign Ware.';
usage = 'Usage: SLMT tag_file [Transform into a short line file and a long line file.]';
usage2 = 'You may use the DOS SET command to change the default "toolong" var of 58 chars';
usage3 = ' -- Ex: "SET toolong=73" will sift out all lines which exceed 72 chars.)';
var
infilepath : pathstr ;
infiledir : dirstr ;
infilename : namestr ;
infileext : extstr ;
outfileSn,
outfileLn : string ;
infile,
outfileS,
outfileL : text ;
aline : string ;
toolongstr : string ;
toolong : byte ;
valerr : integer;
procedure showhelp(problem: char ); {if any *foreseen* errors arise, we are }
var { sent here to give a little help and exit peacefully }
message : string [80];
begin
writeln (usage);
writeln ;
writeln (usage2);
writeln (usage3);
writeln ;
writeln ('Error encountered:');
case problem of
'a' : message := ' Unable to open ' + infilepath + '!';
'b' : message := outfileSn + ' exists! Rename or delete it.';
'c' : message := outfileLn + ' exists! Rename or delete it.';
'd' : message := ' You must specify a filename on the command line.';
'e' : message := ' If you use the "toolong" env var, it must be a number.';
end;
writeln (message);
halt (1);
end;
begin
writeln (progdata);
writeln (progdat2);
writeln ;
toolongstr := getenv ( 'toolong' );
if toolongstr = '' then
toolong := 58
else begin
val ( toolongstr, toolong, valerr );
if valerr <> 0 then
showhelp('e');
end;
if paramcount <> 1 then
showhelp('d');
infilepath := paramstr (1) ;
assign ( infile, infilepath );
{$i-} reset ( infile ); {$i+}
if (ioresult <> 0) then
showhelp('a');
FSplit (infilepath, infiledir, infilename, infileext);
outfileSn := infilename + '.shr' ; {Using same name, different extension.}
outfileLn := infilename + '.lng' ; {Using same name, different extension.}
assign ( outfileS, outfileSn );
{$i-} reset ( outfileS ); {$i+}
if (ioresult <> 0) then
rewrite ( outfileS )
else showhelp('b');
assign ( outfileL, outfileLn );
{$i-} reset ( outfileL ); {$i+}
if (ioresult <> 0) then
rewrite ( outfileL )
else showhelp('c');
write ( ' SPLITTING ', infilepath ,
' INTO ', outfileSn ,
' AND ', outfileLn );
while not eof ( infile ) do begin
readln ( infile, aline );
if length ( aline ) < toolong then
writeln ( outfileS, aline )
else
writeln ( outfileL, aline );
end ;
close ( infile );
close ( outfileS );
close ( outfileL );
writeln (', DONE!');
end.