home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / enterprs / cpm / utils / f / fixtext.lbr / FIXTEXT.PZS / FIXTEXT.PAS
Encoding:
Pascal/Delphi Source File  |  1993-05-17  |  2.6 KB  |  139 lines
  1. (*$A+,C-,R-,V-,X-*)
  2.  
  3. Program TxtFix;   {text file processor
  4.                    (adds cr and strips high bit)}
  5.  
  6.  
  7. type
  8.   FnStr = String[14];
  9. const
  10.  
  11.  BufSiz = 128;
  12.  
  13. var
  14.  InFile  : file;
  15.  OutFile : text;
  16.  Remains : integer;
  17.  Buf     : array[1..BufSiz] of byte;
  18.  BufPtr  : integer;
  19.  OutStr  : string[255];
  20.  InName,
  21.  OutName : FnStr;
  22.  Got     : byte;
  23.  
  24. Procedure Capitalize(var S:FnStr);
  25. var i:integer;
  26. begin
  27.   for i := 1 to Length(S) do S[i] := UpCase(S[i]);
  28. end;
  29.  
  30. function ReadNext:Boolean;
  31. begin
  32.   if (BufPtr > Bufsiz) and (Remains > 0) then
  33.      begin
  34.        Write(^M,'Blocks remaining ',Remains:4);
  35.        BlockRead(Infile,Buf,1);
  36.        BufPtr := 1;
  37.        Remains := pred(Remains);
  38.      end;
  39.   if (BufPtr <= Bufsiz) then
  40.      begin
  41.        Got := Buf[BufPtr];
  42.        BufPtr := succ(BufPtr);
  43.        if Got = $1A then ReadNext := false
  44.          else Readnext := true;
  45.      end
  46.    else
  47.      ReadNext := false;
  48. end;
  49.  
  50. function Exist(F:FnStr):boolean;
  51. var Fil:file;
  52. begin
  53.   Assign(Fil,F);
  54.   {$I-} Reset(Fil); {$I+}
  55.   Exist := (IoResult = 0);
  56. end;
  57.  
  58. Function OpenIn:boolean;
  59. begin
  60.   If exist(InName) then
  61.     begin
  62.       Assign(InFile,InName);
  63.       Reset(InFile);
  64.       BufPtr := Succ(BufSiz);
  65.       Remains := filesize(InFile);
  66.       OpenIn := true;
  67.     end
  68.   else
  69.     begin
  70.       Writeln(InName,' was not found!');
  71.       OpenIn := false;
  72.     end;
  73. end;
  74.  
  75. Function OpenOut:boolean;
  76. var YN:Char;
  77. begin
  78.   YN := 'Y';
  79.   If exist(OutName) then
  80.     begin
  81.       Write(Outname,' exists. Erase (Y/*N) ?');
  82.       repeat until keypressed;
  83.       Read(Kbd,YN);
  84.       YN := UpCase(YN);
  85.       Writeln(YN);
  86.     end;
  87.   if YN = 'Y' then
  88.     begin
  89.       Assign(OutFile,OutName);
  90.       Rewrite(OutFile);
  91.       OpenOut := true;
  92.     end
  93.   else
  94.     OpenOut := false;
  95. end;
  96.  
  97. Procedure FlushOut;
  98. begin
  99.   Writeln(OutFile,OutStr);
  100.   if Got = $0D then
  101.       if ReadNext then
  102.         if Got <> $0A then BufPtr := Pred(BufPtr);
  103.   OutStr := '';
  104. end;
  105.  
  106. Procedure BuildOut;
  107. begin
  108.   If Length(OutStr) = 255 then FlushOut;
  109.   OutStr := OutStr + Chr(Got);
  110. end;
  111.  
  112. Procedure FixFile;
  113. begin
  114.   OutStr := '';
  115.   While ReadNext do
  116.     begin
  117.       Got := Got and 127;
  118.       if (got = $0A) or (got = $0d) then FlushOut
  119.         else BuildOut;
  120.     end;
  121. end;
  122.  
  123. {*** main ***}
  124. begin
  125.   Write('Name of input file >');
  126.   readln(InName);
  127.   Capitalize(InName);
  128.   Write('Name of output file >');
  129.   readln(OutName);
  130.   Capitalize(OutName);
  131.   if OpenIn then if OpenOut then
  132.     begin
  133.       FixFile;
  134.       Close(InFile);
  135.       Close(OutFile);
  136.       Writeln;
  137.     end;
  138. end.
  139.