home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 September / Simtel20_Sept92.cdr / msdos / filutl / scan21.arc / SCAN.PAS < prev    next >
Pascal/Delphi Source File  |  1988-07-05  |  12KB  |  395 lines
  1. Program Scan;
  2. {$D-}
  3. {  SCAN.PAS - A utility to scan binary files for text strings.
  4.  
  5. Usage:  SCAN [-<offswitches>] [+<onswitches>] [input file] [output file]
  6. where:    <offswitches> is the list of switches to turn off,
  7.           <onswitches> is the list of switches to turn on, and
  8.           input file and output file are the source and dest. files.
  9.           To specify an output file you must give an input file.
  10.           If either is not specified, SCAN will use stdin/stdout so
  11.           you can also use command-line redirection.
  12.  
  13. or SCAN ? 
  14.      for a list of switches.
  15.  
  16. For a complete list of switches, see the accompanying documentation.
  17.  
  18. Switches are processed left-to-right both within and between + and - groups.
  19.  
  20. Notes:  The default minimum string length is 4 characters.  The maximum
  21. possible string length is 255 and any which run over will be cut into 255-
  22. har lengths.
  23.  
  24. This program is public domain.  Knock yourself out.
  25. }
  26.  
  27. uses Ecase;  { International version of UpCase }
  28.  
  29. type
  30.      SwitchList = record
  31.           DispEsc, DispTab, ConvTab, DispCR, DispLF, DispFF, AllowNull,
  32.           DispNull, ForceNull, StripLead, StripTrail, HighOk, GraphicOk, 
  33.           ForeignOk, Extended, StripHiIn, ConvSpace, UpperCase, English, 
  34.           ConvBslash, ConvHiNum, ConvHiDot, ShortLine: boolean;
  35.      end;
  36.  
  37.      filename = string[80];      {Input/output files if not stdin/stdout}
  38.      msgstring = string[75];
  39.      HighChars = #128..#255;
  40.      Printset = set of HighChars;
  41. var
  42.      ifile, ofile: filename;
  43.      Sw: SwitchList;
  44.      MinLen: byte;
  45.      Infile: file of char;
  46.      Outfile: text;
  47.  
  48. Const
  49.      ForeignSet: PrintSet = [#128..#154, #160..#165, #168, #173..#175];
  50.      GraphicSet: PrintSet = [#176..#223];
  51.      HibitSet: PrintSet = [#128..#255];
  52.  
  53.      Short = 72;         { Short line length S+ }
  54.      Long = 255;         { Long line length S- }
  55.      SpaceReplace = '_'; { Char to replace Space on ConvSpace }
  56.      DotReplace = '.';   { Char to replace hi-bit on ConvHiDot }
  57.      DefMin = 4;         { Default minimum line length }
  58.      DefInput = '';      { Default input file (console)}
  59.      DefOutput = '';     { Default output file (console)}
  60.  
  61.      Copyright1: MsgString = 
  62. ' SCAN Version 2.1 05-Jul-88 by Kenneth Herron. Placed in the public domain.';
  63. {=============================}
  64. procedure DoHelp;
  65.  
  66. begin
  67.      writeln(Copyright1);
  68.      writeln;
  69.      writeln('Usage: SCAN [-off] [+on] [infile [outfile]]');
  70.      writeln('Switches are:');
  71.      writeln('$  Translate ESC to \$    \  Translate \ to \\');
  72.      writeln('C  Translate CR to \C     L  Translate LF to \L');
  73.      writeln('F  Translate FF to \F     @  Translate TAB to \T');
  74.      writeln('T  Make TAB printable     H  Make ascii 128-255 printable');
  75.      writeln('0  Make NULL printable    ?  Make foreign chars printable');
  76.      writeln('!  Str must end in NULL   G  Make graphic chars printable');
  77.      writeln('%  Strip hi bit (input)   E  Str must have vowel & consonant');
  78.      writeln('{  Strip leading spaces   }  Strip trailing spaces');
  79.      writeln('U  Upper-case output      B  Translate space to ', SpaceReplace);
  80.      writeln('.  Convert hi-bit to ', DotReplace, 
  81.                                    '    #  Convert hi-bit to ASCII');
  82.      writeln('S  Max string length is (-)', Long:3,
  83.              ' or (+)', Short:2,' characters');
  84.      writeln;
  85.      halt;
  86. end;
  87.  
  88. {=============================}
  89. procedure SetSwitches(var Ifile, Ofile: Filename; 
  90.                       var SW: Switchlist; var MinLen: byte);
  91.  
  92. var
  93.      T: filename;
  94.      H, I: byte;
  95.      J: integer;
  96.      Setting: boolean;
  97.  
  98. begin
  99. { Set default switches }
  100. fillchar(SW, SizeOf(SW), false);
  101. with sw do
  102. begin
  103.      DispTab := true;
  104.      StripLead := true;
  105.      ShortLine := true;
  106. end;
  107. for H := 1 to ParamCount do
  108. begin
  109.      T := paramstr(H);
  110.      if (T[1] = '+') or (T[1] = '-') then
  111.      begin
  112.           Setting := T[1] = '+';
  113.           for I := 2 to length(T) do
  114.           with sw do
  115.           case upcase(T[I]) of
  116.           'B': ConvSpace := setting;
  117.           'E': English := setting;
  118.           '\': ConvBslash := setting;
  119.           '$': begin
  120.                     DispEsc := setting;
  121.                     ConvBslash := setting or ConvBslash;
  122.                end;
  123.           'T': begin
  124.                     DispTab := setting;
  125.                     ConvBslash := setting or ConvBslash
  126.                end;
  127.           '@': begin
  128.                     ConvTab := setting;
  129.                     DispTab := setting;
  130.                     ConvBslash := setting or ConvBslash
  131.                end;
  132.           '0': begin
  133.                     DispNull := setting;
  134.                     ConvBslash := setting or ConvBslash
  135.                end;
  136.           '!': ForceNull := setting;
  137.           '{': StripLead := setting;
  138.           '}': StripTrail := setting;
  139.           'H': begin
  140.                     HighOk := setting;
  141.                     GraphicOk := (not setting) and GraphicOk;
  142.                     ForeignOk := (not setting) and ForeignOk
  143.                end;
  144.           '?': begin
  145.                     ForeignOk := setting;
  146.                     HighOk := (not setting) and HighOk
  147.                end;
  148.           'G': begin
  149.                     GraphicOk := setting;
  150.                     HighOk := (not setting) and HighOk
  151.                end;
  152.           'U': UpperCase := setting;
  153.           'C': begin
  154.                     DispCr := setting;
  155.                     ConvBslash := setting or ConvBslash
  156.                end;
  157.           'L': begin
  158.                     DispLf := setting;
  159.                     ConvBslash := setting or ConvBslash
  160.                end;
  161.           'F': begin
  162.                     DispFF := setting;
  163.                     ConvBslash := setting or ConvBslash
  164.                end;
  165.           '#': begin
  166.                     ConvHiNum := setting;
  167.                     ConvBslash := setting or ConvBslash
  168.                end;
  169.           '.': ConvHiDot := setting;
  170.           '%': StripHiIn := setting;
  171.           'S': ShortLine := setting;
  172.           '1'..'9':
  173.                MinLen := ord(T[I]) and 15;
  174.           end
  175.      end
  176.      else { File name }
  177.           if ifile = '' then
  178.                ifile := T
  179.           else
  180.           if ofile = '' then
  181.                ofile := T
  182. end;
  183.  
  184. {perform some housekeeping}
  185. with SW do
  186. begin
  187.      if StripHiIn then
  188.      begin
  189.           HighOk := false;
  190.           ForeignOk := false;
  191.           GraphicOk := false
  192.      end;
  193.      AllowNull := DispNull or ForceNull;
  194.      Extended := HighOk or ForeignOk or GraphicOk
  195. end;
  196. end;  {procedure SetSwitches}
  197. {=============================}
  198. procedure Process;
  199.  
  200. type
  201.      MaxString = string[255];
  202.  
  203. var
  204.      Len: byte;               { Max Length of a string }
  205.      Str: MaxString;
  206.      ch: char;
  207.      Printable: PrintSet;
  208.      StopStr: boolean;
  209.      HighValid: PrintSet;
  210.  
  211. Function Validate(var Str: maxstring): boolean;
  212.  
  213. { check any built strings to see if they shouldn't be printed for
  214. some reason.  Currently two options are checked--E (must contain a
  215. consonant & vowel) and ! (must end in NULL).  Strings may also be
  216. rejected for being too short but we don't check that here. }
  217.  
  218. var foundc, foundv: boolean;
  219.     I: byte;
  220.  
  221. begin
  222.      if sw.ForceNull and (str[length(str)] <> #0) then
  223.           Validate := false
  224.      else
  225.      if SW.English then 
  226.      begin
  227.      { routine to check the string for >= one consonant
  228.        & >= one vowel }
  229.           foundc := false;
  230.           foundv := false;
  231.           I := 1;
  232.           repeat
  233.                foundv := foundv or (upcase(str[I]) in 
  234.                     ['A','E','I','O','U','Y']);
  235.                foundc := foundc or (upcase(str[I]) in 
  236.                     ['B'..'D','F'..'H','J'..'N','P'..'T','V'..'Z']);
  237.                inc(I)
  238.           until (foundv and foundc) or (I > length(str));
  239.           Validate := foundv and foundc
  240.      end
  241.      else Validate := true
  242. end;
  243.  
  244. procedure massage(var str: maxstring);
  245.  
  246. { Perform changes to the string which can be most efficiently done
  247.   all at once.  Currently we strip leading & trailing blanks, remove
  248.   high bits, uppercase letters, and convert spaces to '_'s.
  249. }
  250.  
  251. var I, First, Last: byte;
  252.  
  253. begin
  254. with sw do
  255. begin
  256.      First := 1;
  257.      if StripLead then  {leading spaces}
  258.           while str[First] = ' ' do inc(First);
  259.      Last := length(str);
  260.      if StripTrail then  {trailing spaces}
  261.           while str[Last] = ' ' do dec(Last);
  262.      if StripLead or StripTrail then
  263.           if Last < First then 
  264.                Str := ''
  265.           else
  266.                Str := copy(Str, First, (Last - first) + 1);
  267.      if UpperCase or ConvSpace then
  268.      for I := 1 to length(str) do
  269.           if UpperCase then
  270.                Str[I] := UpCase(Str[I])
  271.           else
  272.                if Str[I] = ' ' then Str[I] := SpaceReplace;
  273. end
  274. end;
  275.  
  276. procedure print(var str: maxstring);
  277.  
  278. var I: byte;
  279.  
  280. begin
  281. for I := 1 to length(Str) do
  282. begin
  283.      case str[I] of
  284.           ' '..'[',
  285.           ']'..'`',
  286.           '{'..'~': write(Outfile, str[I]);
  287.           #128..#255: if sw.ConvHiDot then
  288.                          write(Outfile, '.')
  289.                     else if sw.ConvHiNum then
  290.                          write(Outfile, '\', ord(str[I]):3)
  291.                     else
  292.                          write(Outfile, str[I]);
  293.           #9:       if sw.ConvTab then
  294.                          write(Outfile, '\T')
  295.                     else
  296.                          write(Outfile, #9);
  297.           '\':      if sw.ConvBslash then
  298.                          write(Outfile, '\\')
  299.                     else
  300.                          write(Outfile, '\');
  301.           #27:      write(Outfile, '\$');
  302.           #13:      write(Outfile, '\C');
  303.           #10:      write(Outfile, '\L');
  304.           #12:      write(Outfile, '\F');
  305.           #0:       if sw.DispNull then write(Outfile, '\0');
  306.           else write(Outfile, str[I])
  307.      end;  { case }
  308. end;
  309. writeln(Outfile)
  310. end;
  311.  
  312. begin
  313. { set up the high-character set }
  314. if sw.Extended then
  315. begin
  316.      if sw.HighOk then 
  317.           HighValid := HibitSet
  318.      else
  319.           HighValid := [];
  320.      if sw.ForeignOk then
  321.           HighValid := HighValid + ForeignSet;
  322.      if sw.GraphicOk then
  323.           HighValid := HighValid + GraphicSet
  324. end;
  325.  
  326. { Set up the max string length }
  327. if sw.ShortLine then
  328.      Len := Short
  329. else
  330.      Len := Long;
  331.  
  332. while not eof(infile) do
  333. begin
  334.      { set up to read one string }
  335.      StopStr := false;
  336.      Str := '';
  337.      repeat
  338.           read(infile, ch);
  339.           if sw.StripHiIn then
  340.                ch := char(byte(ch) and $7f);
  341.           if 
  342.           ((ch >= ' ') and (ch <= '~')) or             { printable chars }
  343.           (Sw.DispTab and (ch = #9))    or             { tab }
  344.           (Sw.DispEsc and (ch = #27))   or             { escape }
  345.           (Sw.DispCR and (ch = #13))    or             { carriage ret. }
  346.           (Sw.DispLF and (ch = #10))    or             { line feed }
  347.           (Sw.DispFF and (ch = #12))    or             { form feed }
  348.           (Sw.AllowNull and (ch = #0))  or             { null }
  349.           (sw.Extended and (ch in HighValid)) then     { extended set }
  350.           begin
  351.                Str := str + ch;
  352.                Stopstr := (length(str) = Len) or (ch = #0)
  353.           end
  354.           else
  355.                StopStr := true;
  356.      until stopstr or eof(infile);
  357.      if (length(str) >= MinLen) and Validate(str) then
  358.      begin
  359.           massage(str);
  360.           if length(str) > 0 then print(str);
  361.      end
  362. end { while block }
  363. end;
  364. {=============================}
  365. begin {main}
  366. if (paramcount = 1) and (paramstr(1) = '?') then DoHelp;
  367.      { DOHELP halts when it's finished }
  368. Ifile := DefInput;
  369. Ofile := DefOutput;
  370. Minlen := DefMin;
  371. SetSwitches(Ifile, Ofile, Sw, MinLen);
  372. assign(infile, ifile);
  373. assign(Outfile, ofile);
  374. FileMode := 0;   {read-only}
  375. {$I-}
  376. reset(infile);
  377. if IOResult <> 0 then
  378. begin
  379.      if Ifile = '' then Ifile := 'standard input';
  380.      writeln('Couldn''t open ', Ifile);
  381.      halt(1)
  382. end;
  383. rewrite(Outfile);
  384. if IOResult <> 0 then
  385. begin
  386.      if Ofile = '' then Ofile := 'standard output';
  387.      writeln('Couldn''t open ', Ofile);
  388.      halt(2)
  389. end;
  390. {$i+}
  391. Process;
  392. close(infile);
  393. close(Outfile)
  394. end.
  395.