(*$A+,C-,R-,V-,X-*)

Program TxtFix;   {text file processor
                   (adds cr and strips high bit)}


type
  FnStr = String[14];
const

 BufSiz = 128;

var
 InFile  : file;
 OutFile : text;
 Remains : integer;
 Buf     : array[1..BufSiz] of byte;
 BufPtr  : integer;
 OutStr  : string[255];
 InName,
 OutName : FnStr;
 Got     : byte;

Procedure Capitalize(var S:FnStr);
var i:integer;
begin
  for i := 1 to Length(S) do S[i] := UpCase(S[i]);
end;

function ReadNext:Boolean;
begin
  if (BufPtr > Bufsiz) and (Remains > 0) then
     begin
       Write(^M,'Blocks remaining ',Remains:4);
       BlockRead(Infile,Buf,1);
       BufPtr := 1;
       Remains := pred(Remains);
     end;
  if (BufPtr <= Bufsiz) then
     begin
       Got := Buf[BufPtr];
       BufPtr := succ(BufPtr);
       if Got = $1A then ReadNext := false
         else Readnext := true;
     end
   else
     ReadNext := false;
end;

function Exist(F:FnStr):boolean;
var Fil:file;
begin
  Assign(Fil,F);
  {$I-} Reset(Fil); {$I+}
  Exist := (IoResult = 0);
end;

Function OpenIn:boolean;
begin
  If exist(InName) then
    begin
      Assign(InFile,InName);
      Reset(InFile);
      BufPtr := Succ(BufSiz);
      Remains := filesize(InFile);
      OpenIn := true;
    end
  else
    begin
      Writeln(InName,' was not found!');
      OpenIn := false;
    end;
end;

Function OpenOut:boolean;
var YN:Char;
begin
  YN := 'Y';
  If exist(OutName) then
    begin
      Write(Outname,' exists. Erase (Y/*N) ?');
      repeat until keypressed;
      Read(Kbd,YN);
      YN := UpCase(YN);
      Writeln(YN);
    end;
  if YN = 'Y' then
    begin
      Assign(OutFile,OutName);
      Rewrite(OutFile);
      OpenOut := true;
    end
  else
    OpenOut := false;
end;

Procedure FlushOut;
begin
  Writeln(OutFile,OutStr);
  if Got = $0D then
      if ReadNext then
        if Got <> $0A then BufPtr := Pred(BufPtr);
  OutStr := '';
end;

Procedure BuildOut;
begin
  If Length(OutStr) = 255 then FlushOut;
  OutStr := OutStr + Chr(Got);
end;

Procedure FixFile;
begin
  OutStr := '';
  While ReadNext do
    begin
      Got := Got and 127;
      if (got = $0A) or (got = $0d) then FlushOut
        else BuildOut;
    end;
end;

{*** main ***}
begin
  Write('Name of input file >');
  readln(InName);
  Capitalize(InName);
  Write('Name of output file >');
  readln(OutName);
  Capitalize(OutName);
  if OpenIn then if OpenOut then
    begin
      FixFile;
      Close(InFile);
      Close(OutFile);
      Writeln;
    end;
end.