暑期缤纷巨献之~------实现支持逻辑搜索/单词搜索/词组搜索+支持OR/AND关键字! (2)
以下代码因为是直接在本人主页上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(andor)\s"
re=reg2.test(text2)
reg2.Pattern="\s(andor)\s\(.+\)$"
re3=reg2.test(text2)
If re and re3 Then ''***********************************如果为全复合逻辑,就返回SQL语句
reg2.Pattern="^\((\S*\S) (\bor\b\band\b) (\S*\S)\) (andor) \((\S*\S) (\bor\b\band\b) (\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) (\bor\b\band\b) (\S*\S)\) (andor) (.+)"
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="(.+) (andor) \((\S*\S) (\bor\b\band\b) (\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
Tags:
作者:佚名评论内容只代表网友观点,与本站立场无关!
评论摘要(共 0 条,得分 0 分,平均 0 分)
查看完整评论