home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / database / dbsalvag.zip / SEARCH.BAS < prev   
BASIC Source File  |  1986-10-19  |  2KB  |  77 lines
  1. 100 rem:  *** search.bas ***
  2. 110 rem:
  3. 111 rem: This program wil search a dBASE file for the
  4. 112 rem: existence of a user-supplied character string
  5. 113 rem: as the beginning characters of a record.
  6. 130 rem:
  7. 131 rem: Run Filter.bas before running this program to
  8. 132 rem: remove any ^Z's that might exist in the file
  9. 133 rem:
  10. 140 ON ERROR GOTO 640:ESC$=CHR$(27)
  11. 150 PRINT:PRINT
  12. 160 PRINT "String Search Utility"
  13. 180 print
  14. 190 Print "Enter source file name (including extension): ";
  15. 200 line input FILE1$
  16. 210 LW$=FILE1$:GOSUB 1000:FILE1$=LW$
  17. 220 PRINT
  18. 230 INPUT "Enter the RECORD length    : ",RLEN
  19. 240 INPUT "Enter the START byte count : ",START
  20. 250 PRINT
  21. 260 PRINT "Enter String: "
  22. 270 line input SS$:LSS=LEN(SS$):PRINT
  23. 280 IF LSS > 128 OR LSS > RLEN THEN PRINT ">>> String too long. <<<"
  24. 281 IF LSS > 128 OR LSS > RLEN THEN 250
  25. 300 PRINT "Is this data correct (Y/N) ";
  26. 310 q$=input$(1):if q$="Y" or q$ = "y" then goto 500
  27. 320 goto 180
  28. 500 rem:  *** start of search ***
  29. 510 print
  30. 520 print
  31. 530 print "Searching ...";
  32. 540 open "I",1,file1$
  33. 550 gosub 2000:bc=start
  34. 560 a$=input$(lss,#1)
  35. 570 if a$=ss$ then goto 680
  36. 580 for J = 1 to (rlen-lss)
  37. 590 a$=input$(1,#1)
  38. 600 next J
  39. 610 if inkey$=esc$ then print "Search Aborted.":goto 650
  40. 620 bc=bc+rlen
  41. 630 goto 560
  42. 640 if erl=560 or erl=590 theN print "NO FIND."
  43. 650 close #1
  44. 660 print
  45. 670 end
  46. 680 rem: *** found strin ***
  47. 700 print "Location: ";bc
  48. 710 print
  49. 720 print a$;
  50. 730 for J = 1 to (rlen-lss)
  51. 740 a$=input$(1,#1)
  52. 750 print a$;
  53. 760 next J
  54. 770 close #1
  55. 780 print:print
  56. 790 print "Process Complete."
  57. 800 end
  58. 1000 rem: ** Make upper case ***
  59. 1010 rem Entry -> lw$     exit -> lw$
  60. 1020 wrk$ = ""
  61. 1030 for x = 1 to len(lw$)
  62. 1040 a=asc(mid$(lw$,x,1))
  63. 1050 if (A>&H60) and (A<&H7F) then b=(a and &H5F) else b=a
  64. 1060 wrk$=wrk$+chr$(8)
  65. 1070 next x
  66. 1080 lw$=wrk$:return
  67. 2000 rem: *** move pointer to start byte ***
  68. 2010 rem:
  69. 2020 a=int(start/128)
  70. 2030 for I = 1 to a
  71. 2040 a$=input$(128,#1)
  72. 2050 next I
  73. 2060 for I = 1 to (start-(a*128))-1
  74. 2070 a$=input$(1,#1)
  75. 2080 next I
  76. 2090 return
  77.