home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS - Coast to Coast / simteldosarchivecoasttocoast2.iso / sprint / sp2a10.zip / SP2A.PAS < prev   
Pascal/Delphi Source File  |  1988-08-06  |  6KB  |  169 lines
  1. program sp2a ;
  2.   { Convert Sprint document files to pure ASCII.  Sprint exports to ASCII;
  3.     this is for when you have a Sprint file but not Sprint itself.  The
  4.     program reads the input file a byte at a time and only writes out ASCII
  5.     characters.  It attempts to eliminate format commands, and converts
  6.     Sprint's newline character to a hard carriage-return and line-feed.
  7.  
  8.     Public domain, no copyright.  Turbo Pascal 4.0.
  9.     If you make improvments, please send me a copy.
  10.  
  11.     Wm. Meacham
  12.     1004 Elm Street
  13.     Austin, Tx  78703
  14.     CIS:  73577,2175
  15.  
  16.     Revision history
  17.  
  18.     Date       Programmer          Revisions made
  19.     --------------------------------------------------------------------
  20.      8/ 6/88 | Bill Meacham      | First release
  21.              |                   |
  22.   }
  23.  
  24. {$V- Turn off strict type checking for string length }
  25.  
  26. uses crt ;
  27.  
  28. const
  29.     cr        : char = ^M ;
  30.     lf        : char = ^J ;
  31.     eof_mark  : char = ^Z ;
  32.  
  33. type
  34.     filename  = string[52] ;
  35.  
  36. var
  37.     in_fname,
  38.     out_fname : filename ;
  39.     in_file,
  40.     out_file  : file of char ;
  41.     ch        : char ;
  42.     in_ruler,
  43.     in_format : boolean ;
  44.  
  45. { ---------------------------------------------------------------- }
  46.  
  47. function UpcaseStr(S : String) : String;
  48. { Converts all characters in the string S to their upper case
  49.   equivalents.   From Turbo Database Toolbox 4.0 }
  50. var
  51.   P : byte;
  52. begin
  53.   for P := 1 to Length(S) do
  54.     S[P] := Upcase(S[P]);
  55.   UpcaseStr := S;
  56. end;
  57.  
  58. { ---------------------------------------------------------------- }
  59.  
  60. {->>>>Deedle<<<<-----------------------------------------------}
  61. {                                                              }
  62. { Filename: DEEDLE.SRC -- Last Modified 10/20/85               }
  63. {                                                              }
  64. { This routine makes a sound not unlike certain electronic     }
  65. { telephone ringers you hear in lawyers' offices.  The number  }
  66. { of "deedles" is given by the value passed in Deedles.        }
  67. {                                                              }
  68. {        From: TURBO PASCAL SOLUTIONS by Jeff Duntemann        }
  69. {    Scott, Foresman & Co., Inc. 1987   ISBN 0-673-18584-2     }
  70. {--------------------------------------------------------------}
  71.  
  72. PROCEDURE Deedle(Deedles : Integer);
  73.  
  74. VAR I : Integer;
  75.  
  76. BEGIN
  77.   FOR I := 1 TO Deedles DO
  78.     BEGIN
  79.       Sound(800); Delay(50); Sound(500); Delay(50)
  80.     END;
  81.   NoSound
  82. END;
  83.  
  84. { ---------------------------------------------------------------- }
  85.  
  86. begin  { program sp2a }
  87.     writeln ('This program converts a Sprint document file to a pure ASCII file') ;
  88.     in_fname  := '';
  89.     out_fname := '';
  90.                                          { get file names }
  91.     if paramcount < 2 then
  92.       begin
  93.         if paramcount < 1 then
  94.           begin
  95.             write  (' Input file? ') ;
  96.             readln (in_fname) ;
  97.           end
  98.         else
  99.           in_fname := paramstr(1) ;
  100.  
  101.         write  ('Output file? ') ;
  102.         readln (out_fname)
  103.       end
  104.     else
  105.       begin
  106.         in_fname  := paramstr(1) ;
  107.         out_fname := paramstr(2) ;
  108.       end;
  109.  
  110.     in_fname  := upcasestr(in_fname) ;
  111.     out_fname := upcasestr(out_fname) ;
  112.  
  113.     if in_fname = out_fname then
  114.       begin
  115.         writeln ('File names must be different.', ^G) ;
  116.         halt
  117.       end ;
  118.     assign  (in_file, in_fname) ;
  119.     assign  (out_file, out_fname) ;
  120.  
  121.     {$i-}                                { Turn off auto i/o check }
  122.     reset   (in_file) ;
  123.     if not (ioresult = 0) then
  124.       begin
  125.         writeln ('Can''t find file ',in_fname, ^G) ;
  126.         halt
  127.       end ;
  128.     rewrite (out_file) ;
  129.     if not (ioresult = 0) then
  130.       begin
  131.         writeln ('Can''t create file ',out_fname, ^G) ;
  132.         halt
  133.       end ;
  134.     {$i+}                                { Turn it back on }
  135.  
  136.     in_ruler  := false ;
  137.     in_format := false ;
  138.     writeln ('Converting ... ') ;        { Convert the file a char at a time }
  139.     while not(eof(in_file)) do
  140.       begin
  141.         read (in_file,ch) ;
  142.         case ch of
  143.           ^K : in_ruler := true ;        { Begin ruler line }
  144.           ^O,^V : in_format := true ;    { What else?  I got these from trial }
  145.                                          { and error, but I have not looked }
  146.                                          { at all possible formats. }
  147.           ^N : in_format := false ;      { End format command }
  148.           ^M : if not in_ruler then      { Hard carriage-return. Write it out }
  149.                    write (out_file,ch) ; { only if it's not part of a ruler. }
  150.           ^J : if in_ruler then          { Hard line-feed. Either write it }
  151.                    in_ruler := false     { out or end ruler line. }
  152.                else
  153.                    write (out_file,ch) ;
  154.           ^_ : write (out_file,cr,lf) ;  { Soft newline.  Write out hard }
  155.                                          { carriage-return and line-feed. }
  156.           ^I, ^L : write (out_file,ch) ; { Tab and Formfeed }
  157.         else   if  (ch >= ' ')           { Eliminate all other control chars }
  158.                and (not in_format)       { Eliminate all format commands }
  159.                and (not in_ruler) then   { and ruler lines }
  160.                   write (out_file,ch) ;
  161.         end   { case }
  162.       end ; { while }
  163.     write (out_file, eof_mark) ;         { Write Ctrl-Z }
  164.     close (in_file) ;                    
  165.     close (out_file) ;
  166.     writeln ('All done!') ;
  167.     deedle (4)                           { Notify user }
  168. end.
  169.