top
Loading...
實現支持邏輯搜索/單詞搜索/詞組搜索+支持OR/AND關鍵字!
前言:
比如你正在寫一個搜索界面,讓網友能有更多搜索選擇.
代碼是直接在俺主頁上COPY下來的.和頁面結合,所以
比較難看懂.呵呵:)
這里我用ACCESS.


我的是這樣的,我有10來個表,都是存儲各個班的同學所發表的
文章.于是我在ACCESS里建立一個聯合查詢..查詢文章是就在聯合
查詢里查詢標題和內容,或者按作者查詢//我都不知道怎么說了...


處理查詢的ASP文件就懶得寫出來了,等遲點有空在COPY上來:)

先說說功能:

詞語搜索 [例如: 小明]

詞組搜索
詞組里面每一個詞都將被檢索
例如: 小強1 小名1 小強強 小小強

邏輯搜索
支持 And 和 Or 運算符.
例如: 小明 And 小強 And 小小強

復合條件:
例如:(小小明 Or 小明) And (小強 Or 小小強)
例如:(小小明 Or 小名) And 小小強
例如: ROOT1 And (廣東人 Or 北京人)

下一編放上根據用戶的搜索條件動態生成SQL語句的VBS文件.

以下代碼因為是直接在本人主頁上COPY下來的,已經和頁面結合,所以比較難看懂.因為這個文件我是比較久以前寫的..現在搞到自己也看得不大懂了~~呵呵!!!因為最近準備把電腦給暫時戒了,好好學習.所以把本人寫過的一些自己認為過得去的代碼貼出來...呵呵

---------遲點有時間我再把處理SQL 語句得ASP文件COPY上來--------
---------根據網友輸入的搜索條件動態生成SQL 語句的VBS文件-----

Sub Show(numbers)
Dim Str
Select Case numbers
Case 1
Str="∷啟動按作者搜索∷"
window.document.all("show").innerHTML=Str
Case 2
Str="∷啟動按單詞搜索∷"
window.document.all("show").innerHTML=Str
Case 3
Str="∷啟動按詞組搜索∷"
window.document.all("show").innerHTML=Str
Case 4
Str="∷啟動按邏輯搜索∷"
window.document.all("show").innerHTML=Str
Case 5
Str="∷按復合邏輯搜索∷"
window.document.all("show").innerHTML=Str
End Select
End Sub
'----------------------------------------------全局變量
Dim a7
a7=" "

'-------------------------------------------------------
Function checkhaha(haha)
text=replace(trim(haha.search.value),"'","''")
If text="" Then
alert("Sorry.請輸入你的搜索關鍵字")
haha.search.value=""
haha.search.focus()
Exit Function
End if
haha.search.value=text
haha.SearchString.value=GetText(text,haha)
haha.submit()
End Function


Function GetText(text,haha)
Dim reg
Dim res
Dim sky

If haha.radiobutton.checked Then '*************************************如果按作者則提交推出
Call Show(1)
GetText="name='" & text &"'"
Exit Function
End if
'*********************************************************************
Set reg=new regexp
reg.IgnoreCase = true
reg.Global = True
reg.Pattern="s"
res=reg.test(text)
'*********************************************************如果關鍵字不包含空格就進行單詞搜索
If Not res Then
Call Show(2)
GetText="(標題+文章) like '%" & text & "%'"
Exit Function
End if
'********************************************************************************************

reg.Pattern="sand|sor"
res=reg.test(text)
If res Then '*************************************************檢查邏輯表達式,正確則返回SQL語句,否則返回假,按詞組搜索
sky=check(reg,text)
If sky=false Then '**************************************如果邏輯搜索不正確則進行詞組搜索
GetText=wahaha(reg,text)
Else '**************************************************提交邏輯搜索
GetText=sky
End if
Else '****************************************************如果沒有AND或者OR關鍵字就進行詞組搜索
GetText=wahaha(reg,text)
End if
End Function

Function wahaha(reg,text)'*****************************************詞組搜索
Dim ter
Dim ter1
Dim likes
Dim ors
ter=""
ter1=""
likes=" or ((標題+文章) like '%"
ors="%')"
reg.Pattern="(S*S)"
Set re=reg.Execute(text)
for each i in re
ter=ter & likes & i & ors
ter1=ter1 & i & a7
next
Call Show(3)
wahaha=mid(ter,4)
End Function


Function check(reg2,text2)
Dim re
Dim i
Dim bbb
Dim tru
Dim re1
Dim re2
Dim re3
Dim str
Dim str1
Dim a1
Dim a2
Dim a3
Dim a4
str="(標題+文章) like '%"
str1="%'"
tru=true
bbb=true
reg2.Pattern="^(.+)s(and|or)s"
re=reg2.test(text2)
reg2.Pattern="s(and|or)s(.+)$"
re3=reg2.test(text2)

If re and re3 Then '***********************************如果為全復合邏輯,就返回SQL語句
reg2.Pattern="^((S*S) (or|and) (S*S)) (and|or) ((S*S) (or|and) (S*S))$"
Set re1=reg2.Execute(text2)
If re1.count<1 Then
check=false
Exit Function
End if
Set re2=re1(0)
If re2.submatches.count<6 Then
check=false
Exit Function
End if
a1=re2.submatches(0)
a2=re2.submatches(2)
a3=re2.submatches(4)
a4=re2.submatches(6)
check="("&str&a1&str1&" "&re2.submatches(1)&" "&str&a2&str1&") "&_
re2.submatches(3)&" ("&str&a3&str1&" "&re2.submatches(5)&" "&str&a4&str1&")"
Call Show(5)
Exit Function
End if


If re Then '**********************************************前面有括號后面沒有就返回SQL語句
reg2.Pattern="^((S*S) (or|and) (S*S)) (and|or) (.+)"
Set re1=reg2.Execute(text2)
If re1.count<1 Then
check=false
Exit Function
End if
Set re2=re1(0)
If re2.submatches.count<4 Then
check=false
Exit Function
End if
a1=re2.submatches(0)
a2=re2.submatches(2)
a3=re2.submatches(4)
check="(" & str & a1 & str1 & " " & re2.submatches(1) & " " & str & a2 & str1 & ") "& re2.submatches(3) & " (" & str & a3 & str1 & ")"
Call Show(5)
Exit Function
End if

If re3 Then '**********************************************前面沒有括號后面有就反會SQL語句
reg2.Pattern="(.+) (and|or) ((S*S) (or|and) (S*S))$"
Set re1=reg2.Execute(text2)
If re1.count<1 Then
check=false
Exit Function
End if
Set re2=re1(0)
If re2.submatches.count<4 Then
check=false
Exit Function
End if
a1=re2.submatches(0)
a2=re2.submatches(2)
a3=re2.submatches(4)
check="("&str&a1&str1&") "&re2.submatches(1)&" ("&str&a2&str1&" "&re2.submatches(3)&" "&str&a3&str1&")"
Call Show(5)
Exit Function
End if

Dim sss
Dim ccc
Dim aaa
sss="((標題+文章) like '%"
ccc="%')"
aaa=""
n1=0
reg2.pattern="(S*S)"
Set re=reg2.execute(text2)
Dim a143
a143=re.count-1
If re.item(a143)="and" or re.item(a143)="or" Then
check=false
Exit Function
End if

for each i in re

If tru Then

If i<>"and" and i<>"or" Then
tru=false
aaa=aaa & sss & i & ccc
else
bbb=false
Exit for
End if

else
If i="and" or i="or" Then
tru=true
aaa=aaa & i
else
bbb=false
Exit for
End if
End if
next
If not bbb Then
check=false
else
check=aaa
Call Show(4)
End if
End Function

北斗有巢氏 有巢氏北斗