home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 June / SIMTEL_0692.cdr / msdos / txtutl / rembs1.arc / REMBS.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1988-11-21  |  4.6 KB  |  145 lines
  1. {REMBS.BAS, converted to Turbo Pascal
  2.  David Kirschbaum
  3.  Toad Hall
  4.  kirsch@braggvax.ARPA
  5.  
  6. This program removes backspaces - chr$(8) - from text files and
  7. restores text to its corrected state for viewing and printing.
  8.  
  9. rembs.bas -  D.S. Duani 3/87
  10. Microsoft QuickBASIC 2.0
  11. }
  12. {$K-}  {no stack checking}
  13. {$V-}  {no string parm checking}
  14.  
  15. TYPE
  16.   Str255 = STRING[255];
  17.  
  18. CONST
  19.   BS = #$08;     {backspace char}
  20.  
  21. VAR
  22.   InFile,OutFile : TEXT;
  23.   filesopen,                  {nr files opened}
  24.   x,bscnt        : INTEGER;
  25.   S,
  26.   WorkStr : Str255;
  27.   wlen    : Byte Absolute WorkStr;     {sit on length byte}
  28.  
  29.  
  30. PROCEDURE Abort(Msg : Str255);
  31.   BEGIN
  32.     IF Msg <> '' THEN Writeln('REMBS ', Msg, '! Aborting.');
  33.     IF filesopen <> 0 THEN BEGIN       {we have file(s) open}
  34.       {$I-}
  35.       Close(InFile);
  36.       IF filesopen > 1                 {if we opened our output file}
  37.       THEN Close(OutFile);
  38.       IF IOResult <> 0 THEN;           {we don't care}
  39.       {$I+}
  40.     END;
  41.     Halt;
  42.   END;  {of Abort}
  43.  
  44.  
  45. PROCEDURE Open_Files;
  46.   VAR
  47.     err : INTEGER;
  48.     InName,OutName : STRING[128];
  49.     Ch : CHAR;
  50.   BEGIN
  51.     IF ParamCount <> 2 THEN BEGIN      {we demand two filenames
  52.                                         as cmdline parameters}
  53.       Writeln('REMBS - Remove backspace characters from a text file.');
  54.       Writeln('(Useful to edit a log of a BBS or remote editor session.)');
  55.       Writeln('Correct syntax is: REMBS oldfile newfile');
  56.       Halt;
  57.     END;
  58.  
  59.     filesopen := 0;                    {no files to close}
  60.     InName  := ParamStr(1);            {input filename}
  61.     OutName := ParamStr(2);            {output filename}
  62.  
  63.     IF InName = OutName                {dummy's asking for trouble!}
  64.     THEN Abort('Output ' + OutName + ' can''t be Input ' + InName);
  65.  
  66.     Assign(InFile,InName);             {open input file}
  67.     filesopen := 1;                    {just 1 to close}
  68.     {$I-}  Reset(InFile);  {$I+}
  69.     IF IOResult <> 0                   {error, probably doesn't exist}
  70.     THEN Abort(InName + ' Input file error');
  71.  
  72.     Assign(OutFile,OutName);
  73.     {$I-}
  74.     Reset(OutFile);                    {see if it exists}
  75.     err := IOResult;                   {remember that test result}
  76.     Close(OutFile);                    {close in any case}
  77.     IF IOResult <> 0 THEN;             {we don't care}
  78.     {$I+}
  79.     IF err = 0 THEN BEGIN              {oh-oh, it does exist!}
  80.       Write(OutName, ' exists!  Overwrite?  [Y/N] Y',BS);
  81.       Repeat Until Keypressed;  Read(Kbd,Ch);  Writeln(Ch);
  82.       IF (UpCase(Ch) = 'N')            {user abort}
  83.       THEN Abort('User Abort');
  84.  
  85.     END;
  86.     filesopen := 2;                    {now 2 files to close}
  87.     {$I-} Rewrite(OutFile);  {$I+}     {create or set file ptr to start}
  88.     IF IOResult <> 0                   {create error}
  89.     THEN Abort(OutName + ' create error');
  90.  
  91.     {Ok, both input and output files are open and ready to go.}
  92.   END;  {of Open_Files}
  93.  
  94. (*
  95. while not eof(1)
  96.         line input #1,a$
  97.         cnt=1
  98.         b$=string$(len(a$),32)
  99.         for x=1 to len(a$)
  100.                 if mid$(a$,x,1)=chr$(8) then
  101.                         cnt=cnt-1:if cnt=0 then cnt=1
  102.                 else
  103.                         mid$(b$,cnt,1)=mid$(a$,x,1)
  104.                         cnt=cnt+1
  105.                 end if
  106.         next
  107.         print #2,left$(b$,cnt)
  108. wend
  109. *)
  110.  
  111. PROCEDURE Remove_BS;
  112.   BEGIN
  113.     bscnt := 0;                        {initialize backspace counter}
  114.     WHILE NOT EOF(InFile) DO BEGIN
  115.       {$I-}
  116.       Readln(InFile,S);
  117.       IF IOResult <> 0
  118.       THEN Abort('Input file read error'); {close up, die}
  119.  
  120.       wlen := 0;                       {start with 0 length}
  121.       FOR x := 1 TO LENGTH(S) DO BEGIN
  122.         IF S[x] = BS THEN BEGIN        {gobble previous real char, BS}
  123.           bscnt := SUCC(bscnt);        {bump counter}
  124.           Write(#$0D, bscnt:5);        {display}
  125.           wlen := PRED(wlen);
  126.           IF wlen < 0 THEN wlen := 0;
  127.         END
  128.         ELSE BEGIN                     {good char, add to work string}
  129.           wlen := SUCC(wlen);          {bump str length}
  130.           WorkStr[wlen] := S[x];       {stuff str char in workstring}
  131.         END;
  132.       END;
  133.       Writeln(OutFile,WorkStr);        {write to output file}
  134.       IF IOResult <> 0                 {write failed}
  135.       THEN Abort('Output file write error');  {close up, die}
  136.     END;  {while not EOF}
  137.     Writeln(' backspaces removed.');   {neaten up after counter write}
  138.     Abort('');                         {close up, no error msgs}
  139.   END;  {of Remove_BS}
  140.  
  141. BEGIN  {main}
  142.   Open_Files;      {may die}
  143.   Remove_BS;       {do the work}
  144. END.
  145.