'DB_INFO - search for info on screens in a given directory

external   dpath messboxwait()

external   strtoary() fgi bgi fgp bgp progress() progtag() sch scw
external   messbox() remove() vunloadif()

public     ptary[1] ptval $file #rec_st #rec_fin ptstr

global     names i nextproj firstline x  $files nextdrive #line #f vloadif()
'  ListCalls()
global     currview f $filename
global     $module $c $out  y $content ListFields() dfchkstr() dpathsep()

MAIN
single-step off
' single-step on
  screen clear box 1 1 sch scw 0 0 no-border
  repaint off
' message "Reading screens in D:\data"
  quiet off
  error off
  $out = "datelist.txt"
  remove($out)
  fopen $out as 2
  fwrite 2 from "Custom screens containing Date fields"&date2(today)
  fwrite 2 from ""
  tools os "dir D:\data\*.vw /O:N /B > D:\programs\viewlist.txt"
  progress(fgp,bgp," Reading fields in custom screens ",1)
  fopen "viewlist.txt" as 4
  while eof(4) = 0
    fread 4 into $file
    $filename=left($file|"            ",15)
    fwrite 2 length 15 from $filename
    if $file = ""
      exit while
    end if
    progtag(fgi,bgi,$file)
    x = ListFields()
    if x = 0
      fwrite 2 from "View has a date field"
    elseif x = 1
      fwrite 2 from "NO date field"
    elseif x = -1
      fwrite 2 from "Cannot load View"
    end if
  end while
  fclose 4
  fclose 2
message "Listing in `DATELIST.TXT'"
END MAIN


FUNCTION ListFields()
  repaint off
  x=vloadif(dpath|$file)
  if x = -1
    return (-1)
  end if

  #f=DBINFO(db_fields)
  for i = 1 to #f
    X=DBFLDINFO(i,dbf_type)
    if x=5
      vunloadif($file)
      return (0)
    end if
  end for
  vunloadif($file)
  return (1)
END FUNCTION' ListFields()


function vloadif(pf)
local p f xpf r ss
'-------------------------------------
'p         = datapath  (as "\dir\subdir\")
'f         = viewname  (as "name.ext"
'e         = error var
'requires  dfchkstr()
'-------------------------------------
'returns   0 = success
'         <0 = error
'         -1 = view.ext not found
'         -2 = unable to load/goto
'-------------------------------------
smartpeek $_step ss                    ' message "ss is:"&str(ss)
single-step off
r = 0
if file(pf) = TRUE
  error off
  clearerror
  xpf = dpathsep(pf)
  f = lower(group(xpf,1))
  p = group(xpf,2)
  if dfchkstr(f,lower(currfiles(1))) = FALSE
    if right(f,1) == "s"
      file activate standard-view p|f
    else
      file activate custom-view p|f
    end if
  end if
  data goto view f
  error on
  if lerror = 0
    currview = f
  else
    r = -2
'     messwait("Unable to load `"|upper(pf)|"' - report to Office",0,0,1)
'     messboxwait(" Unable to load `"|upper(pf)|"' - retry later ",0,0,1)
    screen clear box 1 1 sch scw 0 0 no-border
    repaint off
    file unload all
    error off
    while true
      window close
      if cerror
        exit while
      end if
    end while
    return (-1)
  end if
else
  r = -1
'   messboxwait("File `"|upper(pf)|"' not found - report to Office ",0,0,1)
  screen clear box 1 1 sch scw 0 0 no-border
  repaint off
  file unload all
  error off
  while true
    window close
    if cerror
      exit while
    end if
  end while
  return (-1)
end if
if ss=1
  single-step on
end if
return (r)
end function  'vloadif()


function dfchkstr(s,sl)
local t i
'-------------------------------------
's    = string to check
'sl   = string group
't    = targeted item to check
'i    = counter for group() function
'-------------------------------------
'returns  TRUE  = item is in string group
'         FALSE = item is not in list
'-------------------------------------
i=0
while exact(t,NULL)=FALSE
     i=i+1
     t = group(sl,i)
     if t = s
          return (TRUE)
     end if
end while
return (FALSE)
end function  'dfchkstr()


FUNCTION dpathsep(pf)
local j l f p c r
l = len(pf)
if l > 0
     for j = l to 0 step -1
          c = mid(pf,j,1)
          if c="/" or c=":" or c="\"
               p = left(pf,j)
               f = mid(pf,j+1)
               exit for
          end if
     end for
     if j = -1
          r = pf
     else
          if f = null
               r = -1              'path found but not a filename
          else
               r = f&p
          end if
     end if
else
     r = -2                        'no data passed for evaluation
end if
return (r)
END FUNCTION   'pathsep(pf)