home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / MBUG / MBUG075.ARC / STRIP.PAS < prev    next >
Pascal/Delphi Source File  |  1979-12-31  |  2KB  |  71 lines
  1. Program Strip;
  2.               {CPM version.. 13-03-87}
  3.               {              21-03-87}
  4.               {              23-03-87}
  5.               {              25-03-87}
  6. {$C-}
  7.  
  8. Const
  9.      Controls : set of char = [#0..#8,#11..#13,#14..#31,#127..#255];
  10.      Bell     = #07;
  11.      Space    = ' ';
  12.  
  13.   {Remove all control characters except LF, HT}
  14.   {This CPM version formats ok with WordStar and Glass files by
  15.    removing CR's also.}
  16.  
  17. Var
  18.    Old,New         : Text;
  19.    Ch              : Char;
  20.    Oldname,Newname : String[14];
  21.    ControlFlag     : Boolean;
  22.  
  23. Function Control(var ch:char) : Boolean;
  24. begin
  25. ch := chr(ord(ch) and $7F);
  26. control := ch in controls;
  27. end;
  28.  
  29. begin
  30. write('Old name: ');
  31. readln(oldname);
  32. assign(old,oldname);
  33. {$I-}
  34. reset(old);
  35. {$I+}
  36. if ioresult <> 0 then
  37.    begin
  38.    writeln(bell,'ERROR.... This filename does not exist.');
  39.    writeln('Please recheck filename from directory.');
  40.    halt;  {Exit to CP/M if error}
  41.    end;
  42. write('Enter new filename: ');
  43. readln(newname);
  44. assign(new,newname);
  45. rewrite(new);
  46. ControlFlag := false;
  47. while not eof(old) do
  48.    begin
  49.    read(old,ch);
  50.    if (ord(ch) = 16) then {Used to add a space in text when char 16 }
  51.       begin               {is removed, otherwise no gap between these words}
  52.       ch := space;
  53.       end;
  54.    if (ord(ch) = 1) or (ord(ch) = 2) then
  55.       begin
  56.       controlflag := true;
  57.       end
  58.    else if ((ord(ch) = 32) or (ord(ch) = 255)) and (controlflag) then
  59.       begin
  60.       controlflag := false;
  61.       end;
  62.    if not control(ch) and not controlflag then
  63.       begin
  64.       write(ch);
  65.       write(new,ch);
  66.       end;
  67.    end;
  68. close(new);
  69. close(old);
  70. end.
  71.