[Back to TEXTFILE SWAG index] [Back to Main SWAG index] [Original]

    program ReadWord;
    uses dos,crt;
    Const
      delimiters = ' ,./?;:"[]{}!';
      CrLf       = #13#10;
    type
      tfilename = string;
      word_type = string;
      wp_type   = ^word_type;

    var
      i          : word;
      filter     : string;
      sr         : searchrec;
      path       : pathstr;
      dir        : dirstr;
      fname      : namestr;
      ext        : extstr;
      Lines       : word;

    procedure ShowSyntax;
    begin
      writeln('USAGE       OBJDIC     <input fileset>                         ');
      writeln('                                                               ');
      writeln('       <input fileset> is a DOS filename (wildcards allowed)   ');
      writeln('                                                               ');
      writeln('                                                               ');
      writeln('Example    OBJDIC *.TXT                                        ');
      halt;
    end;

    function GetNextWord (buf:string; apos:byte; var aword:word_type; var delim:string) : byte;
    var i,j,ch: byte;
    begin
      i := apos;
      while (i <= length(buf)) and (pos(buf[i],delimiters) = 0) do inc (i);
      aword := copy(buf,apos, i - apos);
      j:= i;
      while (i <= length(buf)) and
           ( ( (upcase(buf[i]) < 'A') or (upcase(buf[i]) > 'Z') ) and
             ( (buf[i] <  '0'       ) or (buf[i] > '9'        ) ) )
            do inc(i);
      delim := copy(buf,j,i-j);
      if i = length(buf) then i := 0;
      GetNextWord :=i;
    end;

    procedure scanfile(filename : string);
    var
      infile : text;
      inbuf  : string;
      aword  : word_type;
      adelim : word_type;
      len    : byte;
      inpos  : byte;
      index  : word;

    begin
      path := fexpand(filename);
      fsplit(path,dir,fname,ext);
      assign(infile,path);
      reset(infile);
      clrscr;
      lines:=0;
      writeln('Scanning ',filename);
      while not eof(infile) do begin
         readln(infile,inbuf); inc(lines);
         inpos := 1;
         while (inpos < length(inbuf)) and (inpos <> 0) do begin
           inpos := GetNextWord(inbuf,inpos,aword,adelim);
           if length(aword) > 0 then write(aword);
           if length(adelim) > 0 then write(adelim);
         end;
         writeln;
       end;
       close(infile);
       writeln;
     end;

     begin
       filter := Paramstr(1);
       FindFirst(Filter,AnyFile,sr);
       while DosError = 0 do with sr do begin
          scanfile(fexpand(name));
          FindNext(sr);
       end;
     end.

[Back to TEXTFILE SWAG index] [Back to Main SWAG index] [Original]