Searching Text

[Charles Pegge]

Code: OxygenBasic

1.  
2.   '=================================
3.  'SEARCH USING ONE OR MORE KEYWORDS
4.  '=================================
5.  
6.   'when all the keywords are found within close range
7.  'of each other, the region of text is displayed
8.  
9.   string cr,tab
10.  
11.   cr=chr(13)+chr(10)
12.   tab=chr(9)
13.  
14.  
15.  
16.   function sample(string s, sys a,l,*b,*e)
17.   '=======================================
18.  b=a-l
19.   if b<1 then b=1
20.   e=a+l
21.   end function
22.  
23.  
24.  
25.   function display(string s,sys a)
26.   '===============================
27.  sys b,e
28.   sample s,a,200,b,e
29.   print a cr cr mid s,b,e-b
30.   end function
31.  
32.  
33.  
34.   function search(string s, sys pk, sys n) as sys
35.   '==============================================
36.  sys b,c,d,e,n,p,t
37.   if not s then return 0
38.   if pk=0 then return 0
39.   n=1
40.   p=pk
41.   string k at p 'array of keywords
42.  '
43.  NewSearch:
44.   '
45.  a=instr n,s,k 'first keyword
46.  n=a+1
47.   t=0
48.   if a then
49.     sample s,a,200,b,e
50.     '
51.    'the other keywords nearby
52.    '
53.    do
54.       p+=4 'advance pointer for next keyword string
55.      if ++t>n then return a 'max keywords
56.      if not k then return a 'no more keywords
57.      c=instr b,s,k
58.       if c=0 or c>e then
59.         p=pk : goto NewSearch
60.       end if
61.    end do
62.   end if
63.   end function
64.  
65.  
66.  
67.   function getword(string s, sys *i) as string
68.   '===========================================
69.  sys a,j,le
70.   le=len s
71.   j=i
72.   i--
73.   do
74.     i++
75.     if i>le then exit do
76.     a=asc s,i
77.     if a=44 then continue do 'comma
78.    if a>32 then exit do     'non white space
79.  end do
80.   '
81.  j=i
82.   '
83.  do
84.     if i>le then exit do
85.     a=asc s,i
86.     if a=44 then exit do  'comma
87.    if a<=32 then exit do 'white space
88.    i++
89.   end do
90.   '
91.  if i>j then return mid s,j,i-j
92.   '
93.  end function
94.  
95.  
96.  
97.   function wordlist(string s, sys pk, sys n) as sys
98.   '================================================
99.  sys c,i
100.   i=1
101.   string k at pk 'string array
102.  do
103.     k=getword s,i
104.     if not k then exit do
105.     if ++c>=n then exit do 'max list length
106.    pk+=4 'advance string array pointer
107.  end do
108.   return c
109.   end function
110.  
111.  
112.   function splitstring(string s, string d, sys pk, sys n) as sys
113.   '=============================================================
114.  '
115.  'itr not sensitive to quoted text
116.  '
117.  sys a,b,c,i,ld,ls,ex
118.   string k at pk 'string array
119.  ls=len s : if ls=0 then return 0
120.   ld=len d : if ld=0 then return 0
121.   b=1
122.   do
123.     a=instr b,s,d
124.     if a=0 then
125.       a=ls+1
126.       ex=1
127.     end if
128.     k=mid s,b,a-b
129.     if ++c>=n then return c
130.     if ex then return c
131.     b=a+ld
132.     pk+=4 'advance pointer for next string element
133.  end do
134.   end function
135.  
136.  
137.   '======
138.  'TEST
139.  '======
140.  
141.   sys a,c
142.   string f="notes.txt"
143.   string s=lcase getfile f
144.   if not s then
145.     print f " file not found"
146.     jmp fwd done
147.   end if
148.   '
149.  def maxwords 100
150.   string k[maxwords]
151.   c=wordlist "gabriel faur", @k, maxwords
152.   if a:=search s,@k,c then
153.     display s,a
154.   end if
155.   '
156.  done:
157.   '====
158.  
159.  

Charles

[Aurel]

That is cool and easy to translate 

[Peter]

Hi Charles,

sys a,c 
  string f="notes.txt" 
  string s=lcase getfile f 
  if not s then 
    print f " file not found" 

Code: [Select]

    jmp fwd done    end if 

Greetings from Quick Basic   

[Charles Pegge]

Updated

char* prototypes

case insensitive search

Code: OxygenBasic

1.   '=================================
2.  'SEARCH USING ONE OR MORE KEYWORDS
3.  '=================================
4.  
5.   'when all the keywords are found within close range
6.  'of each other, the region of text is displayed
7.  
8.   function sample(sys a,l,*b,*e)
9.   ==============================
10.   b=a-l
11.   if b<1 then b=1
12.   e=a+l
13.   end function
14.  
15.  
16.  
17.   function display(char*s,sys a)
18.   ==============================
19.   sys b,e
20.   sample a,200,b,e
21.   'print a
22.  print mid s,b,e-b
23.   end function
24.  
25.  
26.  
27.   function search(char*ss, sys pk, n) as sys
28.   ==========================================
29.   sys b,c,d,e,n,p,t
30.   if not @ss then return 0
31.   if not pk  then return 0
32.   n=1
33.   p=pk
34.   string s=lcase ss 'for case insensitive
35.  string k at p     'array of keywords
36.  '
37.  NewSearch:
38.   '
39.  a=instr n,s,k 'first keyword
40.  n=a+1
41.   t=0
42.   if a then
43.     sample a,200,b,e
44.     '
45.    'the other keywords nearby
46.    '
47.    do
48.       p+=sizeof sys          'advance pointer for next keyword string
49.      if ++t>n then return a 'max keywords
50.      if not k then return a 'no more keywords
51.      c=instr b,s,k
52.       if c=0 or c>e then
53.         p=pk : goto NewSearch
54.       end if
55.    end do
56.   end if
57.   end function
58.  
59.  
60.  
61.   function GetTextWord(char*s, sys *i) as char*
62.   =============================================
63.   static string w
64.   sys           j
65.   byte          b at @s
66.   j=i
67.   i--
68.   @b--
69.   do
70.     i++
71.     @b++
72.     select b
73.     case 0            : exit do      'end of string
74.    case 33 to 255    : exit do      'non white space
75.    end select
76.   end do
77.   '
78.  j=i
79.   '
80.  do
81.     select b
82.     case 0 to 32 : exit do
83.     end select
84.     i++
85.     @b++
86.   end do
87.   '
88.  if i>j
89.     w=mid s,j,i-j
90.     return w
91.   else
92.     return ""
93.   end if
94.   '
95.  end function
96.  
97.  
98.  
99.   function wordlist(char*s, sys pk, n) as sys
100.   ===========================================
101.   sys c,i
102.   i=1
103.   string k at pk 'string array
104.  do
105.     k=lcase GetTextWord s,i 'for case insensitive
106.    if not k then exit do
107.     if ++c>=n then exit do 'max list length
108.    pk+=4 'advance string array pointer
109.  end do
110.   return c
111.   end function
112.  
113.  
114.   '======
115.  'TEST
116.  '======
117.  
118.   sys a,c
119.   string f="notes.txt"
120.   string s=getfile f
121.   if not s then
122.     print f " file not found"
123.     jmp fwd done
124.   end if
125.   '
126.  def maxwords 100
127.   string k[maxwords]
128.   c=wordlist "gabriel faur", @k, maxwords
129.   if a:=search s,@k,c then
130.     display s,a
131.   end if
132.   '
133.  done:
134.