home *** CD-ROM | disk | FTP | other *** search
/ Media Share 9 / MEDIASHARE_09.ISO / pcboard / pcbwrap.zip / PCBWRAP.PAS < prev    next >
Pascal/Delphi Source File  |  1993-07-14  |  18KB  |  326 lines
  1. program wrapPCBoardDirfile;
  2. uses dos;  { for file accesss, such as findfirst and findnext }
  3. const
  4.  progdata = 'PCBWrap- Free DOS utility: PCBoard filelist reformatter.';
  5.  progdat2 = 'V1.00: July 14, 1993. (c) 1993 by David Daniel Anderson - Reign Ware.';
  6.  usage = 'Usage:  PCBWrap file(s)_to_wrap [left_margin[:padding] (1..31, default = 1:1)]';
  7.  
  8. {
  9.  example of a description, with two possible margin specifications (min/max)
  10. PKZ204G.EXE    203019  02-08-93  PKZIP/PKUNZIP v2.04g; PKWare's compression
  11.  | utilities. More, minor bug fixes relative to version 2.04e See V204G.NEW for
  12.  | details; by Phil Katz/PKWare
  13.  ^
  14.  ^= margin of 1:1
  15.  
  16.  
  17. PKZ204G.EXE    203019  02-08-93  PKZIP/PKUNZIP v2.04g; PKWare's compression
  18.                                | utilities. More, minor bug fixes relative to
  19.                                | version 2.04e See V204G.NEW for details; by
  20.                                | Phil Katz/PKWare
  21.                                ^
  22.                                ^= margin of 31:1
  23. }
  24. var
  25.    dirinfo         : searchrec; { contains filespec info.    }
  26.    spath           : pathstr;   { source file path,          }
  27.    sdir            : dirstr;    {             directory,     }
  28.    sname           : namestr;   {             name,          }
  29.    sext            : extstr;    {             extension.     }
  30.  
  31.    infile, outfile : text;    { file read from/ written to }
  32.  
  33.    nostrip         : boolean; { do we remove "Files: " and "Uploaded by: " ?? }
  34.                               { (read from a DOS environment variable)        }
  35.  
  36.    sfn, dfn, tfn   : string[64]; { Source/ Dest/ Temp FileName, including dir }
  37.    filesdone       : array[1..512] of string[64];   { table of each dir+name  }
  38.    done            : boolean; { done is used so a file is not processed twice }
  39.                               { used with the array "filesdone" because a bug }
  40.                               { (in DOS I think) causes files to be selected  }
  41.                               { based on FAT placement, rather than name when }
  42.                               { wildcards are implemented.  The BUG allows    }
  43.                               { files to be done repeatedly, every time they  }
  44.                               { are encountered.                              }
  45.  
  46.    i, nmdone       : word;    { i is a counter,  }
  47.                               {nmdone is number of files wrapped }
  48.  
  49.    margin,                          { spaces before the "|" char }
  50.    padding  : string;               { spaces after the "|" char }
  51.  
  52. procedure showhelp(problem:char); {if any *foreseen* errors arise, we are sent}
  53. var                          { here to give a little help and exit peacefully }
  54.    message : string[80];
  55. begin
  56.    writeln(usage);
  57.    writeln;
  58.    writeln('Error encountered:');
  59.    case problem of
  60.         'a' : message := 'The entire left margin cannot exceed 32 characters!';
  61.         'b' : message := 'The second parameter is NOT a valid numeric!';
  62.         'c' : message := 'The first parameter must be a VALID filename!';
  63.         'd' : message := 'You must have at least ONE parameter!';
  64.         'e' : message := 'You cannot have more than TWO parameters!';
  65.         'f' : message := 'You cannot just specify a path, add "*.*" or "\*.*" for all files.';
  66.         'g' : message := 'Original file was read only, is renamed to "t!#$_$#!.pcw".  PCBWrap aborts.'
  67.    else
  68.         message := 'Unknown error.';
  69.    end;
  70.    writeln(message);
  71.    halt;
  72. end;
  73.  
  74. procedure getleftmargin(var lmargin, lpad : string);
  75. const                  { determine spaces before and after "|" }
  76.    space = ' ';
  77. var
  78.    slm,slp,            { string of leftmargin/ leftpad }
  79.    pstr  : string[5];  { entire string containing numbers needed }
  80.    vlm,vlp,            { numeric of leftmargin/ leftpad }
  81.    pval  : byte;       { numeric of string containing numbers needed }
  82.    pcode : integer; { error code, will be non-zero if strings are not numbers }
  83.  
  84. begin
  85.      pstr := paramstr(2);  { first parameter is filespec }
  86.  
  87.      if ((pos(':',pstr)) <> 0) then begin           { determine position of }
  88.         slm := copy(pstr,1,((pos(':',pstr))-1));    { any colon, and divide }
  89.         slp := copy(pstr,((pos(':',pstr))+1),length(pstr)); { at that point }
  90.  
  91.         val(slm,vlm,pcode);          { convert first part of string         }
  92.         if (pcode = 0) then          { into numeric                         }
  93.            if (vlm < 32) then        { and from numeric create string of    }
  94.               for i := 2 to vlm do   { spaces of specified length           }
  95.                   lmargin := lmargin + space
  96.            else showhelp('a')          { showhelp if any errors               }
  97.         else showhelp('b');
  98.  
  99.         val(slp,vlp,pcode);          { convert second part of string        }
  100.         if (pcode = 0) then          { into numeric                         }
  101.            if (vlp < 32) then        { and from numeric create string of    }
  102.               for i := 2 to vlp do   { spaces of specified length           }
  103.                   lpad := lpad + space
  104.            else showhelp('a')          { showhelp if any errors               }
  105.         else showhelp('b');
  106.  
  107.         if ((vlm + vlp) > 32) then   { I won't allow creation of shorter    }
  108.            showhelp('a');              { lines than original "short" lines    }
  109.      end
  110.  
  111.      else begin  { if colon not present, lmargin should be entire parameter }
  112.         val(pstr,pval,pcode);        { convert entire of string             }
  113.         if (pcode = 0) then          { into numeric                         }
  114.            if (pval < 32) then       { and from numeric create string of    }
  115.               for i := 2 to pval do  { spaces of specified length           }
  116.                   lmargin := lmargin + space
  117.            else showhelp('a')          { showhelp if any errors               }
  118.         else showhelp('b');
  119.      end;
  120. end;
  121.  
  122. procedure openfiles(var sfile, dfile : text; name1, name2 : string);
  123. begin                     { open the file to process, and another for output }
  124.      assign(sfile,name1);     { we know names of both, }
  125. {$i-} reset(sfile); {$i+}     { but if source does not exist, }
  126.      if (ioresult <> 0) then  { show help                     }
  127.          showhelp('c');
  128.  
  129.      assign(dfile,name2);     { create output file regardless }
  130.      rewrite(dfile);
  131. end;
  132.  
  133. function squeezestr(longstr : string) : string;  { remove extra spaces }
  134.                                                  {     from string     }
  135. begin
  136.     while ((longstr <> '') and (pos('  ',longstr) <> 0)) do
  137.           delete(longstr,pos('  ',longstr),1);  { double spaces into single }
  138.  
  139.     while ((longstr <> '') and (longstr[length(longstr)] = ' ')) do
  140.           delete(longstr,length(longstr),1);         {  from end  }
  141.  
  142.     while ((longstr <> '') and ((longstr[1] = ' ') or (longstr[1] = '|'))) do
  143.           delete(longstr,1,1);            { from front remove spaces and "|" }
  144.     squeezestr := longstr;                { assign result to function !      }
  145. end;
  146.  
  147. function wrapline(var thefile : text; theline : string) : string;
  148. var                { split line at 79th character or nearest preceding space }
  149.    parta,partb  : string;        { first and second part of line }
  150.    breakchar    : string[1];     { character which will eventually be a space }
  151. begin
  152.      parta := copy(theline,1,80);                       { split line }
  153.      partb := copy(theline,81,(length(theline)-80));
  154.      breakchar := copy(parta,length(parta),1);  { get last char of first part }
  155.      delete(parta,length(parta),1);          { and remove it, since we either }
  156.                                              { discard or re-attach to a part }
  157.  
  158.      if (breakchar = '-') then begin         { a hyphen is a valid breakpoint }
  159.           partb := breakchar + partb;        { but since it must be saved, it }
  160.           breakchar := copy(parta,length(parta),1); { cannot be used if it is }
  161.           delete(parta,length(parta),1);                 { the 80th character }
  162.      end;
  163.      while ((breakchar <> ' ')               { now either a space or a hyphen }
  164.         and (breakchar <> '-')) do         { will suffice, so cycle breakchar }
  165.      begin                                   { by removing it from first part }
  166.           partb := breakchar + partb;       { and attaching it to second part }
  167.           breakchar := copy(parta,length(parta),1); { while checking validity }
  168.           delete(parta,length(parta),1);
  169.      end;
  170.      if (breakchar = '-') then               { cannot discard breakchar if it }
  171.         parta := parta + breakchar;         { is a hyphen, so append to parta }
  172.  
  173.      writeln(thefile,parta);           { write first part, without the space }
  174.      partb := squeezestr(partb);       { second part should be cleaned up    }
  175.      wrapline := (margin + '|' + padding + partb);  { put in desired format  }
  176. end;
  177.  
  178. procedure makenewfile(var source, dest : text); { handles writing of new file }
  179. var
  180.     fdat, fdes,              { first/ second part of first descriptive line  }
  181.     crnline,                 { the line currently on hold, already processed }
  182.     freshline : string;      { line just read, now being processed           }
  183.  
  184.     indesc    : boolean;     { have we found a valid first line ?            }
  185.     strsize   : string[7];   { First line has 7-digit string of....          }
  186.     valsize   : longint;     {       valid numbers in column 15              }
  187.     valcode   : integer;     {             will show error if not            }
  188.  
  189. begin {p}
  190.      crnline := '';          { initialize it }
  191.      indesc := false;        { ditto         }
  192.      nostrip := (getenv('nostrip') = 'true');    { read DOS env. var. }
  193. {r1} repeat
  194.         readln(source,freshline);                { read line to process }
  195. {i1a}   if (freshline[1] = ' ') then   { process as part of description }
  196.         begin
  197. {i2a}      if indesc then begin  { unless we have non-valid descriptor lines }
  198.  
  199. {i3}          if (not (nostrip)) then         { unless otherwise instructed }
  200. {i3x}            if (length(freshline) > 40) then   { remove these lines    }
  201. {i4}                if ((pos('Files: ',freshline) = 34)
  202.                     or  (pos('Uploaded by: ',freshline) = 34))
  203. {i3,i3x,i4}             then freshline := copy(freshline,1,33);
  204.  
  205.               freshline := squeezestr(freshline); { clean line (remove spaces)}
  206.  
  207. {i5}          if freshline <> '' then             { only if line still exists }
  208. {i6a}             if ((crnline[length(crnline)] = '-') { DO NOT add a space if}
  209.                   and (crnline[length(crnline) - 1] <> ' ')) then { a hyphen  }
  210.                        crnline := crnline + freshline  { is following a char  }
  211. {i6b}             else                             { other than another space }
  212.                        crnline := crnline + ' ' + freshline; { we need a space}
  213.                                                          { in between words  }
  214.  
  215. {w1}          while length(crnline) >= 80 do     { now split long lines, the }
  216.                        crnline := wrapline(dest,crnline); { primary function }
  217. {i2a}      end                                   { of the entire program     }
  218.  
  219. {i2b}      else begin                            { if not in a description,  }
  220. {ix}       if (length(crnline) > 3) then         { write entire previously   }
  221. {ix}          writeln(dest,crnline);     { processed line as is unless it is }
  222.               crnline := freshline;      { too short to be considered valid  }
  223. {i2b}      end;          { ^ consider this one processed, prepare to move on }
  224. {i1a}   end
  225.  
  226. {i1b}   else begin
  227. {i7}       if (length(crnline) > 3) then    { if first char is non-space, end }
  228. {i7}          writeln(dest,crnline);  { old desc by writing last line of old  }
  229.            crnline := freshline;   { unless too short to be considered valid  }
  230.                           { ^ consider this one processed, prepare to move on }
  231.  
  232.                                     { * since we MAY be in a new description, }
  233.            strsize := copy(crnline,15,7); { we must check for a valid line by }
  234.            val(strsize,valsize,valcode); {converting filesize field to numeric}
  235. {i8a}      if ((crnline[26] = '-')   { hyphens in the 26th and 29th position, }
  236.            and (crnline[29] = '-')   { which is the date field                }
  237.            and (crnline[22] = ' ')   { and spaces between the size and date   }
  238.            and (crnline[23] = ' ')   { fields, and, finally, a valid numeric  }
  239.            and (valcode     =  0 )) then begin  { in the filesize field       }
  240.                 indesc := true;        { YES!, we are in a new description!   }
  241.                 crnline[32] := ' ';           { changes the * to a space      }
  242.                 fdat := copy(crnline,1,33);     { these five lines pack the   }
  243.                 fdes := copy(crnline,34,length(crnline));
  244.                                                 { last part of the first line }
  245.                 fdes := squeezestr(fdes) ;      { by separating it after the  }
  246.                 crnline := '';                  { date and then reattaching   }
  247.                 crnline := fdat + fdes;         { it once done                }
  248.  
  249. {w2}            while (crnline[length(crnline)] = ' ') do   { strip all right }
  250.                       delete(crnline,length(crnline),1);    { end spaces }
  251. {w3}            while length(crnline) >= 80 do
  252.                       crnline := wrapline(dest,crnline);  { wrap if needed }
  253. {i8a}      end
  254. {i8b}      else
  255.                 indesc := false;  { if any test in i8a was false, we have an  }
  256. {i1b}   end                   { invalid first line, and we do nothing with it }
  257. {r1} until eof(source);                  { process all lines }
  258. {i9} if (length(crnline) > 3) then       { write last line, which has already }
  259.         writeln(dest,crnline);           { been processed if valid            }
  260. end;  {p}
  261.  
  262. begin
  263.      writeln(progdata);                  { just tell user what this program   }
  264.      writeln(progdat2);                  { is and who wrote it                }
  265.      writeln;
  266.      margin  := ' ';                    { initialize margin to a single space }
  267.      padding := ' ';                   { initialize padding to a single space }
  268.      if paramcount < 1 then             { program must have a filename,       }
  269.         showhelp('d');
  270.      if paramcount > 2 then             { and can have a margin specification }
  271.         showhelp('e');
  272.      if (paramcount = 2) then           { second parameter should be the      }
  273.         getleftmargin(margin,padding);  { margin specification                }
  274.  
  275.      nmdone := 1;                       { initialize number done to one since }
  276.                                     { count is incremented after process ends }
  277.  
  278.      for i := 1 to 512 do               { initialize array                    }
  279.          filesdone[i] := '';            { (I'm not sure if this is needed)    }
  280.  
  281.      spath := paramstr(1);              { source path is first parameter      }
  282.  
  283.      fsplit(fexpand(spath),sdir,sname,sext); { break up path into components  }
  284.      if (sname = '') then               { - but quit if only a path and no    }
  285.          showhelp('f');                   { name is given                       }
  286.  
  287.      findfirst(spath, archive, dirinfo); { find the first match of filespec   }
  288.      if doserror <> 0 then
  289.         showhelp('c');
  290.  
  291.      while doserror = 0 do              { process all specified files         }
  292.      begin
  293.           sfn := sdir+dirinfo.name;    { should have dir info so we are not   }
  294.                                        { confused with current directory (?)  }
  295.                                       { IS needed for dest and temp filenames }
  296.  
  297.           done := false;               { initialize for each "new" file found }
  298.           for i := 1 to 512 do
  299.               if sfn = filesdone[i] then { check entire array to see if we    }
  300.               done := true;              { have done this file already        }
  301.  
  302.           if done = false then begin    { if not, then                        }
  303.               filesdone[nmdone] := sfn; { say we have now                     }
  304.               dfn := 'd!#$_$#!.pcw';    { give both dest and                  }
  305.               tfn := 't!#$_$#!.pcw';    {       and temp files unique names   }
  306.  
  307.               write('Wrapping ',sfn);   { tell user we are busy on this file  }
  308.  
  309.               openfiles(infile,outfile,sfn,dfn); { open the files, given names}
  310.               makenewfile(infile,outfile);    { do actual work in a procedure }
  311.  
  312.               writeln(', done!');   { tell user this file has been processed  }
  313.  
  314.               close (infile);           { close in                            }
  315.               close (outfile);          {   and out files                     }
  316.               rename(infile,tfn);       { rename in to temp and               }
  317.               rename(outfile,sfn);      {       out to in, thereby SWITCHING  }
  318.         {$I-} erase (infile); {$I+}     { in with out so we can erase in (!)  }
  319.               if (ioresult <> 0) then
  320.                  showhelp('g');
  321.               nmdone := nmdone + 1;     { increment number processed          }
  322.           end;
  323.           findnext(dirinfo);            { go to next (until no more)          }
  324.      end;
  325. end.
  326.