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