
  ===========
  'SEARCHUTIL
  ===========

  '22/03/2014
  '17/03/2017
  '17/04/2026
  'Charles E V Pegge

  uses SysUtil

  function instrb(byte*bb,*bk) as int
  ===================================
  int b
  do
    b=bb
    select bk
   case 0    : return 1
    case b    : 'match chars
    case else : return 0
    end select
    @bk++
    @bb++
  end do
  end function


  function instrev(int i,string s,k) as int
  =========================================
  int  a=asc k
  int  lk=len k
  int  ls=len s
  if i<0 then i+=ls+1
  if i=0 then
    i=ls
  elseif i<0 then
    i=1
  elseif i>ls then
    i=ls
  end if
  byte b at strptr s
  byte c at strptr k
  do
    if i<1 then exit do
    select b[i]
    case a : if instrb(b[i],c) then exit do
    end select
    i--
  end do
  return i
  end function



  'FILE PATH AND EXEC FUNCTIONS


  function trimpath(string d) as string
  =====================================
  int a,b,i,e
  e=len d
  do
    i++
    if i>e then exit do
    a=asc d,i
    if a=0 then exit do
    if a=47 or a=92 then b=i
  loop
  b++
  return rtrim mid d,b
  end function


  function dirpath(string d,int rt=0) as string
  =============================================
  int a,b,i,e
  e=len d
  do
    i++
    if i>e then exit do
    a=asc d,i
    if a=0 then exit do
    if a=47 or a=92 then b=i
  loop
  if b
    b-=rt
    return left d,b
  endif
  end function


  ===

  function StartOfLine(string*s,int*i)
  ====================================
  byte *b=strptr s
  indexbase 1
  do
    if i<=0 then exit do
    if b[i]=10 then exit do
    i--
  end do
  i++
  end sub


 function sample(string s, int a,l,*b,*e)
  '=======================================
  b=a-l
  if b<1 then b=1
  e=a+l
  end function



  int wholeword
  '
  function search(string s, int a, sys pk, int mx) as sys
  =======================================================
  int b,c,d,e,n,t
  sys p
  if not s then return 0
  if pk=0 then return 0
  n=a
  string k at p 'array of keywords
  '
  NewSearch:
  '
  p=pk
  a=instr n,s,k 'first keyword

  n=a+len k
  t=0
  if a
    if wholeword
      c=asc s,a-1 'left boundary
      gosub charcheck
      if a
        c=asc s,n 'right boundary
        gosub charcheck
      endif
    endif
  endif
  if a
    sample s,a,200,b,e
    '
    'the other keywords nearby
    '
    do
      p+=sizeof(sys) 'advance pointer for next keyword string
      if ++t>mx then return a 'max keywords
      if not k then return a  'no more keywords
      c=instr b,s,k
      if c=0 or c>e then
        goto NewSearch
      end if
   end do
  end if
  exit function
  '
  charcheck: 'subroutine
  ======================
  'invalid boundary chars for o2basic
  select c
    case 0x30 to 0x39 : a=0 'numbers
    case 0x41 to 0x5a : a=0 'alpha uppercase
    case 35,95        : a=0 '#' '_'
    case 0x61 to 0x7a : a=0 'alpha lowercase
    case 0x80 to 0xff : a=0 'upper ascii
  end select
  ret
  '
  end function


  string wordlist
  '
  function getphrase(string s, int *i) as string
  ==============================================
  int a,j,le
  le=len s
  j=i
  do
    if i>le then exit do
    a=asc s,i
    if a=44
      if asc(s,i+1)=44
        exit do  'two commas
      end if
    end if
    i++
  end do
  '
  if i>j then return mid s,j,i-j
  '
  end function


  
  function wordlistm(sys pk, int n) as sys
  ========================================
  int c,i 
  i=1
  string k at pk 'string array
  do
    k=getphrase wordlist,i
    if not k then exit do
    if ++c>=n then exit do 'max list length
    pk+=sizeof(sys) 'advance string array pointer
  end do
  return c
  end function



  function splitstring(string s, string d, sys pk, int n) as sys
  ==============================================================
  '
  'itr not sensitive to quoted text
  '
  int a,b,c,i,ld,ls,ex
  string k at pk 'string array
  ls=len s : if ls=0 then return 0
  ld=len d : if ld=0 then return 0
  b=1
  do
    a=instr b,s,d
    if a=0 then
      a=ls+1
      ex=1
    end if
    k=mid s,b,a-b
    if ex then return c
    if ++c>=n then return c 
    b=a+ld
    pk+=sizeof(sys) 'advance pointer for next string element
  end do
  end function



  function SearchString(string s) as int
  ======================================
  def MaxPhrases 32
  int a=1,c
  string k[MaxPhrases]
  if not wordlist then return 0
  c=wordlistm @k, MaxPhrases
  a=search s,a,@k,c
  if a then
    return a
  end if
  '
  end function



  function KeywordPosList(string s) as string
  ===========================================
  def MaxPhrases 32
  int a=1,c
  string k[MaxPhrases]
  string line
  int pbo,le, t
  if not wordlist then exit function
  c=wordlistm @k, MaxPhrases
  string posbuf=nuls 0x2000
  do
    a=search s,a,@k,c
    if a then
      t++ 'counter
      if t>200 then exit do
      line=str(a)+cr
      le=len line
      if pbo+le>len(posbuf)
        posbuf+=nuls 0x2000 'stretch buffer
      endif
      mid posbuf,pbo+1,line
      pbo+=le
    else
      exit do
    end if
    a++
  end do
  return left posbuf,pbo
  '
  end function



  function SearchFile(string f) as int
  ====================================
  string s
  's=lcase getfile f
  s=getfile f
  if not s
    'print f " file not found"
    return 0
  end if
  'convert to lowercase
  byte b at strptr s
  int i
  for i=1 to len s
    select b
    case 0x41 to 0x5A : b+=0x20 'A to Z
    end select
    @b++
  next
  return SearchString s
  end function



  function GetFilteredFileList(string filter) as string
  =====================================================
  WIN32_FIND_DATA f
  sys h
  int a,e,i
  zstring dirname[256]
  string dr=dirpath filter
  string fbuf=nuls 0x8000
  int fbe,le,ld
  ld=len dr
  '
  'GetCurrentDirectory 256, @dirname
  'pr="Directory Name: " dirname cr "Filter: " filter cr cr
  '
  h=FindFirstFile filter, @f
  '
  if h>0 then
    do
      a=0
      if not wordlist then
        a=1
      else
        if f.cfilename then 
          a=SearchFile dr+f.cFileName
        end if
      end if
      '
      if a then
        i++
        le=ld+len(f.cFileName)+2
        if fbe+le>len fbuf then fbuf+=nuls 0x8000
        mid fbuf,fbe+1,dr+f.cFileName+cr
        fbe+=le
        'function+=dr f.cFileName cr
      end if
      e=FindNextFile h, @f
      if e=0 then
        e=GetLastError 'should be 18 when no more files
        'print e
        exit do
      end if
    end do
    FindClose h
  end if
  return left fbuf,fbe
  end function


  sub MakeFilterMembers(string *s,w)
  ==================================
  int a,b=1
  string r,lw,rw
  a=instrev(0,w,"\")
  rw=mid(w,a+1)
  lw=left(w,a)
  do
    a=instr(b,s,cr)
    if not a then exit do
    r=lw+mid(s,b,a-b)+"\"+rw
    s=left(s,b-1)+r+mid(s,a)
    b+=len(r)+2
  end do
  end sub
  

  function GetFilteredFileLists(string filterlist) as string
  ==========================================================
  string filter, flist=filterlist, dlist, dfilt, fr
  int a, b=1, c, en, ex, k, n
  '
  en=1+len filterlist
  '
  do
    a=instr b,flist,cr
    if a=0 then a=en : ex=1
    filter=ltrim rtrim mid flist, b,a-b
    if filter then
      c=asc(filter)
      if c<>39 then 'not a comment mark '
        if c=45 then
          'SWITCHES
          c=asc(filter,2)
          filter =ltrim mid filter,3
          if (c=82)or(c=114)or(c=83)or(c=115) then
            'get subdirectories and add to flist
            k=instrev(0,filter,"\")
            if k then
              dfilt=left(filter,k)+"*"
            else
              dfilt="*"
            end if
            dlist=GetFileList(dfilt,n,1) 'dir list
            if dlist then
              if (c=82)or(c=114) then '-r recursive subdirectory searching
                fr="-r "
              else
                fr=""
              end if
              MakeFilterMembers dlist,fr+filter
              flist=left(flist,b-1)+dlist+mid(flist,a+2)
             a=b-2 ' offset adjust
            end if
            'check for subdirectory tree
            'recursive?
          end if
        end if
        function+=GetFilteredFileList filter
      end if
    else
      ex=1 'blank line break
    end if
    if ex then exit do
    b=a+2
  end do
  end function



