您的位置:首页精文荟萃软件资讯 → 暑期缤纷巨献之~------实现支持逻辑搜索/单词搜索/词组搜索+支持OR/AND关键字! 2

暑期缤纷巨献之~------实现支持逻辑搜索/单词搜索/词组搜索+支持OR/AND关键字! 2

时间:2004/10/7 19:15:00来源:本站整理作者:蓝点我要评论(0)


            
             
              
             
            

               
               

            



            //ROOT1.嘿嘿!!!//

以下代码因为是直接在本人主页上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) (\bor\b|\band\b) (\S*\S)\) (and|or) \((\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)\) (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) (\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


相关阅读 Windows错误代码大全 Windows错误代码查询激活windows有什么用Mac QQ和Windows QQ聊天记录怎么合并 Mac QQ和Windows QQ聊天记录Windows 10自动更新怎么关闭 如何关闭Windows 10自动更新windows 10 rs4快速预览版17017下载错误问题Win10秋季创意者更新16291更新了什么 win10 16291更新内容windows10秋季创意者更新时间 windows10秋季创意者更新内容kb3150513补丁更新了什么 Windows 10补丁kb3150513是什么

文章评论
发表评论

热门文章 360快剪辑怎么使用 36金山词霸如何屏幕取词百度收购PPS已敲定!3

最新文章 微信3.6.0测试版更新了微信支付漏洞会造成哪 360快剪辑怎么使用 360快剪辑软件使用方法介酷骑单车是什么 酷骑单车有什么用Apple pay与支付宝有什么区别 Apple pay与贝贝特卖是正品吗 贝贝特卖网可靠吗

人气排行 xp系统停止服务怎么办?xp系统升级win7系统方电脑闹钟怎么设置 win7电脑闹钟怎么设置office2013安装教程图解:手把手教你安装与qq影音闪退怎么办 QQ影音闪退解决方法VeryCD镜像网站逐个数,电驴资料库全集同步推是什么?同步推使用方法介绍QQ2012什么时候出 最新版下载EDiary——一款好用的电子日记本