home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / database / moss.zip / FIND.PRG < prev    next >
Text File  |  1986-11-09  |  2KB  |  99 lines
  1. store .t. to retr
  2. do while retr
  3. store .f. to retr
  4. fn=1
  5. fnu=0
  6. public donn,aa,de
  7. clear
  8. e=0
  9. tr=.f.
  10. don=0
  11. do while .t.
  12. cond=".t."
  13. if e=1
  14.  return
  15. endif
  16. CLEAR
  17. @ 2,24 say "FIND AN INDIVIDUAL RECORD:"
  18. @ 2,55 say "DATABASE IN USE:"
  19. @ 3,55 SAY DBF()
  20. @ 1,53 TO 4,79
  21. @ 21,1 SAY "Use the arrow keys to move to fields you wish to match, and enter characters" 
  22. @ 22,1 SAY " to match.  You may search on up to 3 fields. Upper or lower case is fine."
  23. store "           " to f1,f2,f3,f4,f5,f6,f7,f8,f9,f10,f11,f12,f13,f14,F15
  24. store "------------------------------" to li
  25. store "<PgDn> or <Ctrl><End> to start search" to b
  26. @ 24,15 say "  " get b
  27. clear gets
  28. do while fn<16
  29. fie="f"+ltrim(str(fn,2))
  30.  
  31.  @ fn+3,23 say left(field(fn)+"        ",9) get &fie
  32.  fn=fn+1
  33. enddo
  34. @ 3,21 to 20,50 
  35. @ 1,22 TO 3,49 DOUBLE
  36. read
  37. if len(trim(f1+f2+f3+f4+f5+f6+f7+f8+f9+f10+f11+f12+f13+f14+F15))<1 
  38.  e=1
  39. donn=1
  40.  return
  41. endif
  42.       if len(trim(ndx(1)))>1.and.len(trim(f1))>1
  43.          seek upper(trim(f1))
  44.       else
  45. fa=1
  46. do while fa<16
  47.  de=.f.
  48.  fie="f"+ltrim(str(fa,2))
  49.  fiz=trim(chr(34)+&fie+chr(34))
  50.  if len(trim(&fie))>0
  51.   fiel=field(fa)
  52.  con="con"+ltrim(str(fa,2))
  53.  &con=upper(trim(&fiz))
  54.  
  55.   on error do lerror 
  56.    store &con$upper(&fiel) to tr  
  57.  if .not. de 
  58.  cond=cond+".and. &con$upper(&fiel)"
  59.  endif  
  60. on error 
  61. endif 
  62. fa=fa+1
  63. enddo
  64. locate for &cond
  65. endif
  66. if .not.found()
  67.  ?"Sorry, no match was found.  Try again."+chr(7)
  68. don=1
  69. store .t. to retr
  70. wait
  71. exit
  72. endif
  73. clear
  74. f1=field(1)
  75. f2=field(2)
  76. f3=field(3)
  77. ? &f1,&f2,&f3
  78. ? "Press return to use this record, 'C' to continue looking for"
  79. ?" next match" 
  80. wait to c
  81. do while upper(c)="C"
  82.  cont
  83. if eof()
  84. ? "Sorry.  No more matches.  Try again."+chr(7)
  85. don=1
  86. store .t. to retr
  87. wait
  88. store " " to c
  89. loop
  90. endif
  91. ? &f1,&f2,&f3
  92. ?  "Press return to use this record, or `C' to continue looking" 
  93. ?  " for the next match"
  94. wait to c
  95. enddo
  96. return
  97. enddo
  98. enddo
  99. return