home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Media Share 9
/
MEDIASHARE_09.ISO
/
pcboard
/
pcbwrap.zip
/
PCBWRAP.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-07-14
|
18KB
|
326 lines
program wrapPCBoardDirfile;
uses dos; { for file accesss, such as findfirst and findnext }
const
progdata = 'PCBWrap- Free DOS utility: PCBoard filelist reformatter.';
progdat2 = 'V1.00: July 14, 1993. (c) 1993 by David Daniel Anderson - Reign Ware.';
usage = 'Usage: PCBWrap file(s)_to_wrap [left_margin[:padding] (1..31, default = 1:1)]';
{
example of a description, with two possible margin specifications (min/max)
PKZ204G.EXE 203019 02-08-93 PKZIP/PKUNZIP v2.04g; PKWare's compression
| utilities. More, minor bug fixes relative to version 2.04e See V204G.NEW for
| details; by Phil Katz/PKWare
^
^= margin of 1:1
PKZ204G.EXE 203019 02-08-93 PKZIP/PKUNZIP v2.04g; PKWare's compression
| utilities. More, minor bug fixes relative to
| version 2.04e See V204G.NEW for details; by
| Phil Katz/PKWare
^
^= margin of 31:1
}
var
dirinfo : searchrec; { contains filespec info. }
spath : pathstr; { source file path, }
sdir : dirstr; { directory, }
sname : namestr; { name, }
sext : extstr; { extension. }
infile, outfile : text; { file read from/ written to }
nostrip : boolean; { do we remove "Files: " and "Uploaded by: " ?? }
{ (read from a DOS environment variable) }
sfn, dfn, tfn : string[64]; { Source/ Dest/ Temp FileName, including dir }
filesdone : array[1..512] of string[64]; { table of each dir+name }
done : boolean; { done is used so a file is not processed twice }
{ used with the array "filesdone" because a bug }
{ (in DOS I think) causes files to be selected }
{ based on FAT placement, rather than name when }
{ wildcards are implemented. The BUG allows }
{ files to be done repeatedly, every time they }
{ are encountered. }
i, nmdone : word; { i is a counter, }
{nmdone is number of files wrapped }
margin, { spaces before the "|" char }
padding : string; { spaces after the "|" char }
procedure showhelp(problem:char); {if any *foreseen* errors arise, we are sent}
var { here to give a little help and exit peacefully }
message : string[80];
begin
writeln(usage);
writeln;
writeln('Error encountered:');
case problem of
'a' : message := 'The entire left margin cannot exceed 32 characters!';
'b' : message := 'The second parameter is NOT a valid numeric!';
'c' : message := 'The first parameter must be a VALID filename!';
'd' : message := 'You must have at least ONE parameter!';
'e' : message := 'You cannot have more than TWO parameters!';
'f' : message := 'You cannot just specify a path, add "*.*" or "\*.*" for all files.';
'g' : message := 'Original file was read only, is renamed to "t!#$_$#!.pcw". PCBWrap aborts.'
else
message := 'Unknown error.';
end;
writeln(message);
halt;
end;
procedure getleftmargin(var lmargin, lpad : string);
const { determine spaces before and after "|" }
space = ' ';
var
slm,slp, { string of leftmargin/ leftpad }
pstr : string[5]; { entire string containing numbers needed }
vlm,vlp, { numeric of leftmargin/ leftpad }
pval : byte; { numeric of string containing numbers needed }
pcode : integer; { error code, will be non-zero if strings are not numbers }
begin
pstr := paramstr(2); { first parameter is filespec }
if ((pos(':',pstr)) <> 0) then begin { determine position of }
slm := copy(pstr,1,((pos(':',pstr))-1)); { any colon, and divide }
slp := copy(pstr,((pos(':',pstr))+1),length(pstr)); { at that point }
val(slm,vlm,pcode); { convert first part of string }
if (pcode = 0) then { into numeric }
if (vlm < 32) then { and from numeric create string of }
for i := 2 to vlm do { spaces of specified length }
lmargin := lmargin + space
else showhelp('a') { showhelp if any errors }
else showhelp('b');
val(slp,vlp,pcode); { convert second part of string }
if (pcode = 0) then { into numeric }
if (vlp < 32) then { and from numeric create string of }
for i := 2 to vlp do { spaces of specified length }
lpad := lpad + space
else showhelp('a') { showhelp if any errors }
else showhelp('b');
if ((vlm + vlp) > 32) then { I won't allow creation of shorter }
showhelp('a'); { lines than original "short" lines }
end
else begin { if colon not present, lmargin should be entire parameter }
val(pstr,pval,pcode); { convert entire of string }
if (pcode = 0) then { into numeric }
if (pval < 32) then { and from numeric create string of }
for i := 2 to pval do { spaces of specified length }
lmargin := lmargin + space
else showhelp('a') { showhelp if any errors }
else showhelp('b');
end;
end;
procedure openfiles(var sfile, dfile : text; name1, name2 : string);
begin { open the file to process, and another for output }
assign(sfile,name1); { we know names of both, }
{$i-} reset(sfile); {$i+} { but if source does not exist, }
if (ioresult <> 0) then { show help }
showhelp('c');
assign(dfile,name2); { create output file regardless }
rewrite(dfile);
end;
function squeezestr(longstr : string) : string; { remove extra spaces }
{ from string }
begin
while ((longstr <> '') and (pos(' ',longstr) <> 0)) do
delete(longstr,pos(' ',longstr),1); { double spaces into single }
while ((longstr <> '') and (longstr[length(longstr)] = ' ')) do
delete(longstr,length(longstr),1); { from end }
while ((longstr <> '') and ((longstr[1] = ' ') or (longstr[1] = '|'))) do
delete(longstr,1,1); { from front remove spaces and "|" }
squeezestr := longstr; { assign result to function ! }
end;
function wrapline(var thefile : text; theline : string) : string;
var { split line at 79th character or nearest preceding space }
parta,partb : string; { first and second part of line }
breakchar : string[1]; { character which will eventually be a space }
begin
parta := copy(theline,1,80); { split line }
partb := copy(theline,81,(length(theline)-80));
breakchar := copy(parta,length(parta),1); { get last char of first part }
delete(parta,length(parta),1); { and remove it, since we either }
{ discard or re-attach to a part }
if (breakchar = '-') then begin { a hyphen is a valid breakpoint }
partb := breakchar + partb; { but since it must be saved, it }
breakchar := copy(parta,length(parta),1); { cannot be used if it is }
delete(parta,length(parta),1); { the 80th character }
end;
while ((breakchar <> ' ') { now either a space or a hyphen }
and (breakchar <> '-')) do { will suffice, so cycle breakchar }
begin { by removing it from first part }
partb := breakchar + partb; { and attaching it to second part }
breakchar := copy(parta,length(parta),1); { while checking validity }
delete(parta,length(parta),1);
end;
if (breakchar = '-') then { cannot discard breakchar if it }
parta := parta + breakchar; { is a hyphen, so append to parta }
writeln(thefile,parta); { write first part, without the space }
partb := squeezestr(partb); { second part should be cleaned up }
wrapline := (margin + '|' + padding + partb); { put in desired format }
end;
procedure makenewfile(var source, dest : text); { handles writing of new file }
var
fdat, fdes, { first/ second part of first descriptive line }
crnline, { the line currently on hold, already processed }
freshline : string; { line just read, now being processed }
indesc : boolean; { have we found a valid first line ? }
strsize : string[7]; { First line has 7-digit string of.... }
valsize : longint; { valid numbers in column 15 }
valcode : integer; { will show error if not }
begin {p}
crnline := ''; { initialize it }
indesc := false; { ditto }
nostrip := (getenv('nostrip') = 'true'); { read DOS env. var. }
{r1} repeat
readln(source,freshline); { read line to process }
{i1a} if (freshline[1] = ' ') then { process as part of description }
begin
{i2a} if indesc then begin { unless we have non-valid descriptor lines }
{i3} if (not (nostrip)) then { unless otherwise instructed }
{i3x} if (length(freshline) > 40) then { remove these lines }
{i4} if ((pos('Files: ',freshline) = 34)
or (pos('Uploaded by: ',freshline) = 34))
{i3,i3x,i4} then freshline := copy(freshline,1,33);
freshline := squeezestr(freshline); { clean line (remove spaces)}
{i5} if freshline <> '' then { only if line still exists }
{i6a} if ((crnline[length(crnline)] = '-') { DO NOT add a space if}
and (crnline[length(crnline) - 1] <> ' ')) then { a hyphen }
crnline := crnline + freshline { is following a char }
{i6b} else { other than another space }
crnline := crnline + ' ' + freshline; { we need a space}
{ in between words }
{w1} while length(crnline) >= 80 do { now split long lines, the }
crnline := wrapline(dest,crnline); { primary function }
{i2a} end { of the entire program }
{i2b} else begin { if not in a description, }
{ix} if (length(crnline) > 3) then { write entire previously }
{ix} writeln(dest,crnline); { processed line as is unless it is }
crnline := freshline; { too short to be considered valid }
{i2b} end; { ^ consider this one processed, prepare to move on }
{i1a} end
{i1b} else begin
{i7} if (length(crnline) > 3) then { if first char is non-space, end }
{i7} writeln(dest,crnline); { old desc by writing last line of old }
crnline := freshline; { unless too short to be considered valid }
{ ^ consider this one processed, prepare to move on }
{ * since we MAY be in a new description, }
strsize := copy(crnline,15,7); { we must check for a valid line by }
val(strsize,valsize,valcode); {converting filesize field to numeric}
{i8a} if ((crnline[26] = '-') { hyphens in the 26th and 29th position, }
and (crnline[29] = '-') { which is the date field }
and (crnline[22] = ' ') { and spaces between the size and date }
and (crnline[23] = ' ') { fields, and, finally, a valid numeric }
and (valcode = 0 )) then begin { in the filesize field }
indesc := true; { YES!, we are in a new description! }
crnline[32] := ' '; { changes the * to a space }
fdat := copy(crnline,1,33); { these five lines pack the }
fdes := copy(crnline,34,length(crnline));
{ last part of the first line }
fdes := squeezestr(fdes) ; { by separating it after the }
crnline := ''; { date and then reattaching }
crnline := fdat + fdes; { it once done }
{w2} while (crnline[length(crnline)] = ' ') do { strip all right }
delete(crnline,length(crnline),1); { end spaces }
{w3} while length(crnline) >= 80 do
crnline := wrapline(dest,crnline); { wrap if needed }
{i8a} end
{i8b} else
indesc := false; { if any test in i8a was false, we have an }
{i1b} end { invalid first line, and we do nothing with it }
{r1} until eof(source); { process all lines }
{i9} if (length(crnline) > 3) then { write last line, which has already }
writeln(dest,crnline); { been processed if valid }
end; {p}
begin
writeln(progdata); { just tell user what this program }
writeln(progdat2); { is and who wrote it }
writeln;
margin := ' '; { initialize margin to a single space }
padding := ' '; { initialize padding to a single space }
if paramcount < 1 then { program must have a filename, }
showhelp('d');
if paramcount > 2 then { and can have a margin specification }
showhelp('e');
if (paramcount = 2) then { second parameter should be the }
getleftmargin(margin,padding); { margin specification }
nmdone := 1; { initialize number done to one since }
{ count is incremented after process ends }
for i := 1 to 512 do { initialize array }
filesdone[i] := ''; { (I'm not sure if this is needed) }
spath := paramstr(1); { source path is first parameter }
fsplit(fexpand(spath),sdir,sname,sext); { break up path into components }
if (sname = '') then { - but quit if only a path and no }
showhelp('f'); { name is given }
findfirst(spath, archive, dirinfo); { find the first match of filespec }
if doserror <> 0 then
showhelp('c');
while doserror = 0 do { process all specified files }
begin
sfn := sdir+dirinfo.name; { should have dir info so we are not }
{ confused with current directory (?) }
{ IS needed for dest and temp filenames }
done := false; { initialize for each "new" file found }
for i := 1 to 512 do
if sfn = filesdone[i] then { check entire array to see if we }
done := true; { have done this file already }
if done = false then begin { if not, then }
filesdone[nmdone] := sfn; { say we have now }
dfn := 'd!#$_$#!.pcw'; { give both dest and }
tfn := 't!#$_$#!.pcw'; { and temp files unique names }
write('Wrapping ',sfn); { tell user we are busy on this file }
openfiles(infile,outfile,sfn,dfn); { open the files, given names}
makenewfile(infile,outfile); { do actual work in a procedure }
writeln(', done!'); { tell user this file has been processed }
close (infile); { close in }
close (outfile); { and out files }
rename(infile,tfn); { rename in to temp and }
rename(outfile,sfn); { out to in, thereby SWITCHING }
{$I-} erase (infile); {$I+} { in with out so we can erase in (!) }
if (ioresult <> 0) then
showhelp('g');
nmdone := nmdone + 1; { increment number processed }
end;
findnext(dirinfo); { go to next (until no more) }
end;
end.