'===========================================================================
' Subject: FIND TEXT ANYWHERE                Date: 06-09-99 (19:43)       
' Author:  Donald R. Darden                  Code: PB                     
' Origin:  oldefoxx@earthlink.net          Packet: PB.ABC
'===========================================================================
defint a-z
declare function GetStrLoc (BYVAL AllocHandle%) AS LONG
dim a$(20),b%(20)
q$=chr$(34)
'dim subdir as string 'subdir is huge
def seg=GetPSP%
for a=129 to 255
  if peek(a)=13 then exit for
next
a$=peek$(129,a-129)
def seg
b$=a$
b=0
! mov  ax,a$
! push ax
! call GetStrLoc
! or   cx,cx
! jz   loop0
! mov  es,dx
! mov  di,ax
! mov  ah,32
loop1:
! mov  al,byte ptr es:[di]
! cmp  al,ah
! jl   loop2
! cmp  al,123
! jl   loop3
loop2:
! mov  al,ah
loop3:
! stosb
! loop loop1
loop0:

hd$=curdir$
cd$=hd$
sweep=instr(" "+a$+" "," /S ")
if sweep then
  a$=left$(a$,sweep-1)+mid$(a$,sweep+3)
  sweep=-1
end if
down1=instr(" "+a$+" "," /1 ")
if down1 then
  a$=left$(a$,down1-1)+mid$(a$,down1+3)
  down1=-1
  sweep=-1
end if
a=instr(a$,":")
b=instr(a$,"\")
c=instr(a$+" "," ")
if a and a<c or b and b<c then
  cd$=left$(a$,c-1)
  if mid$(cd$,2,1)=":"then chdrive left$(cd$,2)
  chdir cd$
  a$=mid$(a$,c+1)
end if
view text (1,1)-(80,25)
color 15,1
cls
longa=0
longb=25
do
  a$=trim$(a$)
  if a$="" then exit do
  a=instr(a$+" "," ")
  b=instr(a$,chr$(34))
  if b and b<a then a=b
  b=instr(a$,"'")
  if b and b<a then a=b
  b=instr(a$,"`")
  if b and b<a then a=b
  b=instr(a$,"~")
  if b and b<a then a=b
  select case mid$(a$,a,1)
  case ""
    b$=lcase$(a$)
    a$=""
merge1:
    select case b$
    case "/p"
      printer=-1
      iterate do
    case "/f"
      if filename$="" then filename$=mid$(b$,3)
      if filename$="" then filename$="ft.tmp"
      iterate do
    case "/s"
      sweep=-1
      iterate do
    case "/1","-1"
      down1=-1
      sweep=-1
      iterate do
    case "/cr","/lf", "/crlf"
      b$=chr$(10)
      carret=-1
    case else
    end select
    incr i
    a$(i)=b$
    b(i)=0
  case " "
    b$=lcase$(left$(a$,a-1))
    a$=mid$(a$,a+1)
    goto merge1
  case chr$(34),"~"
    b=instr(a+1,a$,mid$(a$,a,1))
    if b=0 then b=len(a$)+2
    incr i
    a$(i)=mid$(a$,a+1,b-a-1)
    b(i)=-1
    a$=mid$(a$,b+1)
  case else
    b=instr(a+1,a$,mid$(a$,a,1))
    if b=0 then b=len(a$)+2
    incr i
    a$(i)=lcase$(mid$(a$,a+1,b-a-1))
    b(i)=0
    a$=mid$(a$,b+1)
  end select
  b=len(a$(i))
  if b then
    if b>longa then longa=b
    longb=longb+b
  else
    decr i
  end if
loop
if i=0 or help then
  cls
  ?"    FIND TEXT, a program by Donald R. Darden, 1999, Released as FreeWare.
  ?
  ?"  This program searches all files in the current or given directory for
  ?"  text matches that can be specified as case sensitive or insensitive.
  ?
  ?"  Further, this program will look for words that are adjacent if they are
  ?"  grouped by quotes (with "q$" ' ` and ~ serving as different types of quote
  ?"  symbols).  The symbols "q$" and ~ preserve the enclosed upper and lower
  ?"  case letters; any other quote symbol implies that either case will match.
  ?"  Groups must start and end with same quote symbol.  Words that are not
  ?"  enclosed by quotes must be within approximately a 64-character limit of
  ?"  each other to be considered valid, and in the same order as entered.
  ?
  ?"  All non-viewable characters are reduced to a single space separation
  ?"  between words for matches and for display purposes, unless you include
  ?"  /CR parameter(s), in which case the carrage return and line feed codes
  ?"  are also considered during matches.  Quotes will preserve spacing.
  ?
  ?"  Using /S means scan subdirectories as well, and -1 means skip scanning
  ?"  the parent or current directory; only do subdirectories.  A /F<filename>
  ?"  and /P means write results to file <filename> and/or printer, respectively.
  ?
  ?"  Example:  ft dim 'is huge'   -- this would search for every file that had
  ?"  the word "q$"dim"q$" and group "q$"is huge"q$", in either case, and in that same order.
  goto abort
end if
view text (1,1)-(80,24)
if right$(cd$,1)<>"\"then cd$=cd$+"\"
cd$=cd$+chr$(0)
if filename$>"" then open filename$ for append as #2
if printer then open "LPT1:" for output as #3
do
resweep:
  if cd$="" then exit do
  a=instr(cd$,chr$(0))
  cdir$=left$(cd$,a-1)
  cd$=mid$(cd$,a+1)
  bd$=""
  b$=dir$(cdir$+"*.*",23)
  do while b$>""
    bd$=bd$+b$+chr$(0)
    b$=dir$
  loop
  do while bd$>""
    a=instr(bd$,chr$(0))
    if a=0 then goto resweep
    b$=left$(bd$,a-1)
    bd$=mid$(bd$,a+1)
    if sweep then
      color 14,1
      locate ,1
      ?space$(8)cdir$space$(80-pos)
      color 15,1
    end if
    select case inkey$
    case ""
    case chr$(3)
      goto abort
    case chr$(27)
      do
        select case inkey$
        case ""
        case " "
          exit do
        case chr$(3)
          goto abort
        case else
        end select
      loop
    case else
    end select
    bad=0
    on error goto override
    open cdir$+b$ for input as #1
    on error goto 0
    close 1
    if bad then
      if bad=75 and sweep then cd$=cd$+cdir$+b$+"\"
      iterate do
    end if
    if down1 then iterate do
    open cdir$+b$ for binary as#1
    if lof(1)=0 then
      close 1
      kill b$
      iterate do
    end if
    row=csrlin
    col=pos
    view text (1,1)-(80,25)
    locate 25,1
    color 14,1
    ?cdir$b$space$(80-pos);
    view text (1,1)-(80,24)
    locate row,col,1
    if found and pos>1 then
      ?
    else
      locate ,1
    end if
    color 15,1
    ?b$"...";
    col=pos
    ?space$(16-pos);
    locate ,col,1
    e$=space$(25)
    a=0
    found=0
    do while seek(1)<lof(1)
      select case inkey$
      case ""
      case chr$(3)
        goto abort
      case chr$(27)
        do
          select case inkey$
          case ""
          case " "
            exit do
          case chr$(3)
            goto abort
          case else
          end select
        loop
      case else
      end select
      if len(e$)<longb or len(e$)<80 then
        if seek(1)+2048>lof(1)then
          d$=space$(lof(1)-seek(1))
        else
          d$=space$(2048)
        end if
        get 1,,d$
        e$=e$+d$
      end if
      ! mov ax,e$
      ! push ax
      ! call GetStrLoc
      ! or   cx,cx
      ! jz   loopa0
      ! mov  bx,carret
      ! push ds
      ! mov  ds,dx
      ! mov  si,ax
      ! mov  es,dx
      ! mov  di,ax
      ! xor  dx,dx
      ! xor  ah,ah
      ! cld
loopa1:
      ! lodsb
      ! cmp  al,32
      ! jge  loopa2
      ! or   bx,bx
      ! jz   loopa2a
      ! cmp  al,10
      ! je   loopa4
      ! cmp  al,13
      ! je   loopa1a
      ! cmp  al,12
      ! jne  loopa2a
loopa1a:
      ! mov  al,10
loopa2:
      ! cmp  al,123
      ! jl   loopa4
loopa2a:
      ! mov  al,32
loopa3:
      ! cmp  al,ah
      ! jne  loopa4
      ! cmp  al,32
      ! je   loopa5
loopa4:
      ! mov  ah,al
      ! inc  dx
      ! stosb
loopa5:
      ! loop loopa1
      ! pop  ds
      ! mov  cx,dx
loopa0:
      ! mov  b,cx
      e$=left$(e$,b)
      if len(e$)<longb and eof(1)=0 then iterate do
      f$=lcase$(e$)
      a=0
      b=25
      c=0
      d=0
      for j=1 to i
        if b(j) then
          b=instr(b+1,e$,a$(j))
        else
          b=instr(b+1,f$,a$(j))
        end if
        if b=0 then exit for
        if b>d then d=b
        if c=0 or b<c then
          if a=0 or c<a then a=c
          c=b
        elseif b<a then
          a=b
        end if
      next
      if c=0 then
        c=len(e$)=longb+1
        if c<longa then c=len(c$)-longa+1
        if c<2 then c=len(e$)+1
        e$=mid$(e$,c-25)
        iterate do
      end if
      if a<=c then a=c+1
      if d-c>60 or j<=i then
        e$=mid$(e$,a-25)
        iterate do
      end if
      if found=0 then
        locate ,1
        found=-1
      elseif pos>1 then
        ?
      end if
      f$=mid$(e$,c)
      ! mov  ax,f$
      ! push ax
      ! call GetStrLoc
      ! or   cx,cx
      ! jz   loopb0
      ! mov  bx,carret
      ! push ds
      ! mov  ds,dx
      ! mov  si,ax
      ! mov  es,dx
      ! mov  di,ax
      ! xor  dx,dx
      ! xor  ah,ah
loopb1:
      ! lodsb
      ! cmp  al,ah
      ! jne  loopb2
      ! cmp  al,32
      ! je   loopb3
loopb2:
      ! mov  ah,al
      ! inc  dx
      ! stosb
loopb3:
      ! loop loopb1
      ! pop  ds
loopb0:
      ! mov  b,dx
      f$=rtrim$(left$(f$,b))
      if carret then replace chr$(10) with " " in f$
      g$=mid$(e$,c-25,25)
      ! mov  ax,g$
      ! push ax
      ! call GetStrLoc
      ! or   cx,cx
      ! jz   loopc0
      ! push ds
      ! mov  ds,dx
      ! mov  si,ax
      ! mov  es,dx
      ! mov  di,ax
      ! xor  ah,ah
      ! xor  dx,dx
      ! cld
loopc1:
      ! lodsb
      ! cmp  al,32
      ! jle  loopc2
      ! cmp  al,123
      ! jl   loopc3
loopc2:
      ! mov  al,32
loopc3:
      ! cmp  al,ah
      ! jne  loopc4
      ! cmp  al,32
      ! je   loopc5
loopc4:
      ! inc  dx
      ! mov  ah,al
      ! stosb
loopc5:
      ! loop loopc1
      ! pop  ds
      ! mov  cx,dx
loopc0:
      ! mov  b,cx
      rset g$=left$(g$,b)
      g$=mid$(g$,15)+f$
      f$=space$(64)
      mid$(f$,1)=g$
      ?b$":"space$(16-pos)f$
      if filename$>"" then ?#2,b$":"tab(16)f$
      if printer then ?#3,b$":"tab(16)f$
      mid$(b$,1)=space$(len(b$))
      e$=mid$(e$,c+32)
    loop
    close 1
    down1=0
  loop
loop
row=csrlin
col=pos
view text (1,1)-(80,25)
locate row,col,1
?
?"Done."space$(80-pos)
abort:
close
chdrive left$(hd$,2)
chdir hd$
if pos>1 then ?
end

override:
bad=err
resume next

FUNCTION GetPSP% LOCAL PUBLIC
  REG 1, &H62*256     ' set AH to 62h
  CALL INTERRUPT &H21 ' call DOS services
  GetPSP% = REG(2)    ' PSP segment is returned in BX
END FUNCTION