home *** CD-ROM | disk | FTP | other *** search
/ High Voltage Shareware / high1.zip / high1 / DIR2 / DIZZY102.ZIP / DIZZY.PAS < prev    next >
Pascal/Delphi Source File  |  1994-01-24  |  7KB  |  214 lines
  1. program wrapBBS__FILE_ID_DIZ;  { FILE_ID.DIZ }
  2.                                { is an 8 line by 44 character wide file      }
  3.                                { placed in ZIP's to describe their contents. }
  4.                                { It is mainly used on BBS's, which usually   }
  5.                                { have programs to read it and use it as the  }
  6.                                { published file description.  Thus, the      }
  7.                                { program is described consistently from      }
  8.                                { board to board, no matter who uploads it.   }
  9.                                { THE PRECEDING IS HOW ONE ACTUALLY APPEARS!  }
  10. {------------------------------------------------------------------------------
  11.  
  12.                                 REVISION HISTORY
  13.  
  14. v1.00  : 1993/07/14.  First public release.  DDA
  15. v1.01  : 1993/08/27.  Fixed bug: would not properly process files in
  16.                             directories other than the current one.  DDA
  17. v1.01a : 1993/09/24.  Added ability to set line length.  DDA
  18.                       Improved the "showhelp" procedure.  DDA
  19. v1.02  : 1994/01/24.  Now formats 'file_id.diz' if no parameters found on
  20.                       the command line.  DDA
  21.  
  22. ------------------------------------------------------------------------------}
  23.  
  24. uses dos;
  25. var
  26.    dirinfo         : searchrec ;
  27.    spath           : pathstr ;
  28.    sdir            : dirstr ;
  29.    sname           : namestr ;
  30.    sext            : extstr ;
  31.  
  32.    infile, outfile : text ;
  33.  
  34.    sfn, dfn, tfn   : string [64];
  35.    filesdone       : array [1..512] of string [64];
  36.  
  37.    done            : boolean ;
  38.    i, nmdone       : word ;
  39.    llength, valerr  : integer ;
  40.  
  41. procedure showhelp ( errornum : byte );
  42. const
  43.    progdata = 'DIZZY- Free DOS utility: FILE_ID.DIZ off-line reformatter.';
  44.    progdat2 = 'v1.02: January 24, 1994. (c) 1994 by David Daniel Anderson - Reign Ware.';
  45.    usage = 'Usage:  DIZZY <file_id.diz> [line_length]';
  46. var
  47.     message : string [80];
  48. begin
  49.     writeln ( progdata );
  50.     writeln ( progdat2 );
  51.     writeln ;
  52.     writeln ( usage );
  53.     writeln ;
  54.  
  55.     case errornum of
  56.       1 : message := 'incorrect number of command line parameters.';
  57.       2 : message := 'if you specify a "line_length", it must be between 40 and 127.';
  58.       3 : message := 'you must specify a filename or filespec, not just a drive or path.';
  59.       4 : message := 'error opening a file.  It may be read-only.';
  60.     end;
  61.     writeln ( 'ERROR: (#',errornum,') - ', message );
  62.     halt ( errornum );
  63. end;
  64.  
  65.  
  66. procedure openfiles(var sfile, dfile : text; name1, name2 : string);
  67. begin
  68.      assign (sfile,name1);
  69. {$i-} reset (sfile); {$i+}
  70.      if ( ioresult <> 0) then
  71.      begin
  72.          writeln ('Unable to open "', name1, '".');
  73.          showhelp(4);
  74.      end;
  75.  
  76.      assign (dfile,name2);
  77.      rewrite (dfile);
  78. end;
  79.  
  80. function squeezestr(longstr : string) : string;
  81. begin
  82.     while ((longstr <> '') and (pos('  ',longstr) <> 0)) do
  83.           delete (longstr,pos('  ',longstr),1);
  84.  
  85.     while ((longstr <> '') and (longstr[length(longstr)] = ' ')) do
  86.           delete (longstr,length(longstr),1);
  87.  
  88.     while ((longstr <> '') and ((longstr[1] = ' ') or (longstr[1] = '|'))) do
  89.           delete (longstr,1,1);
  90.     squeezestr := longstr;
  91. end;
  92.  
  93. function wrapline ( var thefile : text ; theline : string ) : string ;
  94. var
  95.    parta,partb  : string ;
  96.    breakchar    : string [1];
  97. begin
  98.      parta := copy (theline,1,(llength+1));
  99.      partb := copy (theline,(llength+2),( length (theline)-(llength+1)));
  100.      breakchar := copy (parta,length (parta),1);
  101.      delete(parta,length (parta),1);
  102.  
  103.      if (breakchar = '-') then begin
  104.           partb := breakchar + partb;
  105.           breakchar := copy (parta,length (parta),1);
  106.           delete (parta,length (parta),1);
  107.      end;
  108.      while ((breakchar <> ' ')
  109.         and (breakchar <> '-')) do
  110.      begin
  111.           partb := breakchar + partb;
  112.           breakchar := copy (parta,length (parta),1);
  113.           delete (parta,length (parta),1);
  114.      end;
  115.      if (breakchar = '-') then
  116.         parta := parta + breakchar;
  117.  
  118.      writeln (thefile,parta);
  119.      partb := squeezestr(partb);
  120.      wrapline := partb;
  121. end;
  122.  
  123. procedure makenewfile( var source, dest : text );
  124. var
  125.     crnline,
  126.     freshline : string ;
  127.  
  128. begin {p}
  129.      crnline := '';
  130. {r1} repeat
  131.         readln (source,freshline);
  132.         freshline := squeezestr(freshline);
  133.  
  134. {i1}    if freshline <> '' then
  135. {i2a}       if ((crnline[ length (crnline)] = '-')
  136.             and (crnline[ length (crnline) - 1] <> ' ')) then
  137.                  crnline := crnline + freshline
  138. {i2b}       else
  139.                  if crnline = '' then
  140.                     crnline := crnline + freshline
  141.                  else
  142.                     crnline := crnline + ' ' + freshline;
  143.  
  144. {w1}    while length (crnline) >= (llength+1) do
  145.                  crnline := wrapline(dest,crnline);
  146.  
  147. {r1} until eof (source);
  148. {i3} if ( length (crnline) > 3) then
  149.         writeln (dest,crnline);
  150. end;  {p}
  151.  
  152. begin {main}
  153.  
  154.      if ( paramcount > 2 ) then
  155.         showhelp(1);
  156.  
  157.      if ( paramcount = 2 ) then begin
  158.         val ( paramstr (2), llength, valerr );
  159.         if ( valerr <> 0 ) then
  160.            showhelp(2);
  161.      end
  162.      else
  163.         llength := 44;
  164.  
  165.      if ( llength < 40 )  or
  166.         ( llength > 127 ) then
  167.         showhelp(2);
  168.  
  169.      nmdone := 1;
  170.      for i := 1 to 512 do
  171.          filesdone[i] := '';
  172.  
  173.      if ( paramcount < 1 ) then
  174.         spath := 'file_id.diz'
  175.      else
  176.         spath := paramstr(1);
  177.  
  178.      fsplit ( fexpand (spath),sdir,sname,sext);
  179.      if (sname = '') then
  180.          showhelp(3);
  181.  
  182.      findfirst (spath, archive, dirinfo);
  183.  
  184.      while doserror = 0 do
  185.      begin
  186.           sfn := sdir+dirinfo.name;
  187.           done := false;
  188.           for i := 1 to 512 do
  189.               if sfn = filesdone[i] then
  190.               done := true;
  191.  
  192.           if done = false then begin
  193.               filesdone[nmdone] := sfn;
  194.               dfn := sdir+'d!#$_$#!.dzy';
  195.               tfn := sdir+'t!#$_$#!.dzy';
  196.  
  197.               write ('Wrapping ',sfn);
  198.  
  199.               openfiles(infile,outfile,sfn,dfn);
  200.               makenewfile(infile,outfile);
  201.  
  202.               writeln (', done!');
  203.  
  204.               close (infile);
  205.               close (outfile);
  206.               rename (infile,tfn);
  207.               rename (outfile,sfn);
  208.               erase (infile);
  209.               nmdone := nmdone + 1;
  210.           end;
  211.           findnext (dirinfo);
  212.      end;
  213. end. {main}
  214.