program Strings(input,output);
const
  DEFLEN       = 4;
  RECLEN       = 128;
var
  feof         : boolean;
  ch           : char;
  ADR,
  recptr,
  len,
  err          : integer;
  FN           : string[ 14];
  ASCII        : string[255];
  F            : file;
  DMA          : array[1..RECLEN] of byte;

procedure Help;
Begin
  writeln('Call: STRINGS file {len}');
  writeln;
  writeln('Searches any file for a string with at least len characters');
  writeln('(Len defaults to 4)');
  halt;
End;

procedure iniStrings;
Begin
  feof:=false;
  recptr:=RECLEN+1;
  len:=DEFLEN;
  ADR:=$100;
End;

function notASCII:boolean;
Begin
  notASCII:=ord(ch) in [$00..$1F,$7F..$FF];
End;

function getchar:char;
Begin
  if (recptr>RECLEN) then
  begin
    {$I-}blockread(F,DMA,1);{$I+}
    feof:=IOResult<>0;
    recptr:=0;
  end;
  recptr:=recptr+1;
  if feof then getchar:=^Z
          else getchar:=chr(DMA[recptr]);
End;

procedure hexADR;
const
  HexDigit     : array[0..15] of char='0123456789ABCDEF';
var
  i,
  MyADR        : integer;
  HEX          : string[4];
Begin
  HEX:='0000';
  MyADR:=ADR;
  for i:=4 downto 1 do
  begin
    HEX[i]:=HexDigit[MyADR and $0F];
    MyADR:=MyADR shr 4;
  end;
  write(HEX,': ');
End;

procedure prASCII;
Begin
  if (length(ASCII)>=len) then
  begin
    hexADR;
    writeln(ASCII);
  end;
End;

BEGIN
  iniStrings;
  if (ParamCount in [1..2]) then FN:=ParamStr(1)
                            else Help;
  if (ParamCount=2) then val(ParamStr(2),len,err);
  assign(F,FN);
  {$I-}reset(F);{$I+}
  if (IOResult<>0) then
  begin
    writeln('Cannot find file ',FN);
    halt;
  end;
  while not feof do
  begin
    ASCII:='';
    repeat
      ch:=getchar;
      ADR:=ADR+1;
      if not feof then
      begin
        if notASCII then prASCII
                    else ASCII:=ASCII+ch;
      end;
    until (feof or notASCII);
  end;
  prASCII;
END.