home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / TEXT / UTILITY / FOLD10.ZIP / FOLD.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1991-04-21  |  4.8 KB  |  147 lines
  1. Program fold;
  2. { Unix-fold-lookalike: inserts CR/LF after each <n> bytes                    }
  3. { Optionally removes all CR/LFs already in the file                          }
  4. { For usage hints, type fold ?                                               }
  5. { Free Software by TapirSoft Gisbert W.Selke, Apr 1991                       }
  6. {$A+,B-,D+,E+,F-,I-,L+,N-,O-,R-,S-,V- }
  7. {$M 65520,0,16384 }
  8.  
  9.   Uses Dos;
  10.  
  11.   Const progname = 'FOLD';
  12.         version  = '1.0';
  13.         copyright = 'Free Software by TapirSoft Gisbert W.Selke, Apr 1991';
  14.         bufsize = 64000;
  15.         LF      = 10;
  16.         CR      = 13;
  17.         crlf : Array [1..2] Of byte = (CR, LF);
  18.  
  19.   Type iobuffer = Array [1..bufsize] Of byte;
  20.  
  21.   Var inf, outf : File;
  22.       inbuffer : iobuffer;
  23.       linlen : longint;
  24.       iread, i, k, offset, start : word;
  25.       zstrip : boolean;
  26.  
  27.   Procedure writerr(s : string);
  28.   { display a string on StdErr                                               }
  29.     Var regs : Registers;
  30.   Begin                                                            { writerr }
  31.     Move(crlf,s[Succ(Length(s))],SizeOf(crlf));
  32.     With regs Do
  33.     Begin
  34.       ah := $40;
  35.       bx := 2;
  36.       cx := Length(s) + SizeOf(crlf);
  37.       ds := Seg(s[1]);
  38.       dx := Ofs(s[1]);
  39.     End;
  40.     MsDos(regs);
  41.   End;                                                             { writerr }
  42.  
  43.   Procedure abort(errmsg : string; errcode : byte);
  44.   { display error message and die with error code                            }
  45.   Begin                                                              { abort }
  46.     If errmsg <> '' Then writerr(progname+' '+version+': '+errmsg);
  47.     Halt(errcode);
  48.   End;                                                               { abort }
  49.  
  50.   Procedure usage;
  51.   { show usage info and die                                                  }
  52.     Var temp : string;
  53.   Begin                                                              { usage }
  54.     writerr(progname+' '+version);
  55.     writerr('Filter to fold text file into CR/LF-terminated lines of '+
  56.             'specified length');
  57.     writerr(copyright);
  58.     writerr('');
  59.     writerr('Usage: '+progname+'  [linelength]  [/s]  < infilename  > '+
  60.             'outfilename');
  61.     writerr('');
  62.     Str(bufsize,temp);
  63.     writerr('linelenth must be <= '+temp+'; default is 256. If /s is '+
  64.             'specified,');
  65.     writerr('all CRs and LFs that may already be contained in the file '+
  66.             'are stripped.');
  67.     Halt(1);
  68.   End;                                                               { usage }
  69.  
  70.   Procedure getargs;
  71.   { process command line                                                     }
  72.     Var temp : string;
  73.         ival : longint;
  74.         icode : integer;
  75.         i : byte;
  76.   Begin                                                            { getargs }
  77.     zstrip := False;
  78.     linlen := 0;
  79.     For i := 1 To ParamCount Do
  80.     Begin
  81.       temp := ParamStr(i);
  82.       If Length(temp) < 2 Then usage;
  83.       If (Length(temp) = 2) And (temp[1] In ['-','/']) Then
  84.       Begin
  85.         If UpCase(temp[2]) = 'S' Then zstrip := True
  86.                                  Else usage;
  87.       End
  88.       Else
  89.       Begin
  90.         If linlen <> 0 Then usage;
  91.         Val(temp,ival,icode);
  92.         If (icode = 0) And (ival > 0) And (ival <= bufsize) Then linlen := ival
  93.                                                             Else usage;
  94.       End;
  95.     End;
  96.     If linlen = 0 Then linlen := 256;
  97.   End;                                                             { getargs }
  98.  
  99. Begin                                                                 { main }
  100.   getargs;
  101.   i := FileMode;
  102.   FileMode := 0;
  103.   Assign(inf,'');
  104.   Reset(inf,1);
  105.   FileMode := i;
  106.   Assign(outf,'');
  107.   Rewrite(outf,1);
  108.   offset := 1;
  109.   While Not EoF(inf) Do
  110.   Begin
  111.     BlockRead(inf,inbuffer[offset],bufsize-offset+1,iread);
  112.     If IOResult <> 0 Then abort('Error while reading',2);
  113.     iread := iread + offset - 1;
  114.     If zstrip Then
  115.     Begin
  116.       k := 0;
  117.       For i := 1 To iread Do
  118.       Begin
  119.         If (inbuffer[i] <> CR) And (inbuffer[i] <> LF) Then
  120.         Begin
  121.           Inc(k);
  122.           inbuffer[k] := inbuffer[i];
  123.         End;
  124.       End;
  125.       iread := k;
  126.     End;
  127.     start := 1;
  128.     While start+linlen-1 <= iread Do
  129.     Begin
  130.       BlockWrite(outf,inbuffer[start],linlen,i);
  131.       BlockWrite(outf,crlf,2,k);
  132.       If IOResult <> 0 Then abort('Error while writing',3);
  133.       start := start + i;
  134.     End;
  135.     offset := iread - start + 2;
  136.     Move(inbuffer[start],inbuffer[1],Pred(offset));
  137.   End;
  138.   If offset <> 1 Then
  139.   Begin
  140.     BlockWrite(outf,inbuffer,offset-1,i);
  141.     BlockWrite(outf,crlf,2,k);
  142.     If IOResult <> 0 Then abort('Error while writing',3);
  143.   End;
  144.   Close(inf);
  145.   Close(outf);
  146. End.
  147.