设为首页
联系站长
加入收藏

您的位置: 首页>>IT业界>>互联网>>正文
 实现支持逻辑搜索/单词搜索/词组搜索+支持OR/AND关键字的VBS CLASS
 日期:2005-6-21 22:12:11  来源:100down.com
CLASS功能.替换传入的字符串成为SQL语句Where关键字后面的表达式:

词语搜索 [例如: 小明]

词组搜索
词组里面每一个词都将被检索
例如: 小强1 小名1 小强强 小小强

逻辑搜索
支持 And 和 Or 运算符.
例如: 小明 And 小强 And 小小强

复合条件:
例如:(小小明 Or 小明) And (小强 Or 小小强)
例如:(小小明 Or 小名) And 小小强
例如: ROOT1 And (广东人 Or 北京人)

-----------------------------------------------------------
Class CreateQueryString

Public objReg
Public intStart
Public strField
Private objNode2
Private strText

Public Property Let QueryString( strValue )
strText = Lcase( strValue )
End Property

Private Sub Class_Initialize()
Set objReg = new RegExp
strField = "(标题+文章)"
End Sub

Private Sub Class_Terminate()
Set objReg = Nothing
End Sub

Public Default Function GetText()
Dim blnRes
Dim strSky
With objReg
.IgnoreCase = true
.Global = True
.Pattern = "\s"
blnRes = .Test( strText )
End With
If (Not blnRes) Then
intStart = 2
GetText = strField & " like '%" & strText & "%'"
Else
objReg.Pattern = "\sand|\sor"
blnRes = objReg.Test( strText )
If blnRes Then
strSky = check()
If strSky = False Then
GetText = wahaha()
Else
GetText = strSky
End if
Else
GetText = wahaha()
End if
End If
End Function

Private Function wahaha()
Dim strTer
Dim strLikes
Dim strOrs
Dim strI
Dim objRe
strTer = ""
strLikes = " or (" & strField & " like '%"
strOrs = "%')"
objReg.Pattern = "(\S*\S)"
Set objRe = objReg.Execute(strText)
For Each strI In objRe
strTer = strTer & strLikes & strI & strOrs
Next
wahaha = Mid( strTer , 4 )
intStart = 3
End Function

Private Function CheckYes( strMode , intCount)
Dim objNode1
objReg.Pattern = strMode
Set objNode1 = objReg.Execute( strText )
If objNode1.Count < 1 Then
CheckYes = True
Else
Set objNode2 = objNode1( 0 )
If objNode2.subMatches.Count < intCount Then
CheckYes = True
End If
End If
End Function

Private Function ORAND()
Dim strSSS
Dim strCCC
Dim strAAA
Dim a143
Dim i
Dim objN
Dim blnTru
Dim blnBBB
strSSS = "(" & strField & " like '%"
strCCC = "%')"
strAAA = ""
n1 = 0
blnTru = True
blnBBB = True

objReg.Pattern = "(\S*\S)"
Set objN = objReg.Execute( strText )
a143 = objN.Count - 1
If (objN.Item( a143 ) = "and") Or (objN.Item( a143 ) = "or") Then
ORAND = False
Exit Function
End if
For Each i In objN
If blnTru Then
If (i <> "and") And (i <> "or") Then
blnTru = False
strAAA = strAAA & strSSS & i & strCCC
Else
blnBBB = false
Exit for
End if
Else
If (i = "and") Or (i = "or") Then
blnTru = True
strAAA = strAAA & i
Else
blnBBB = False
Exit For
End if
End if
Next
If (Not blnBBB) Then
ORAND = False
Else
ORAND = strAAA
intStart = 4
End if
End Function



Private Function check()
Dim re
Dim re1
Dim re2
Dim re3
Dim str
Dim str1
Dim a1
Dim a2
Dim a3
Dim a4
str = strField & " like '%"
str1 = "%'"
With objReg
.Pattern = "^\(.+\)\s(and|or)\s"
re = .Test( strText )
.Pattern = "\s(and|or)\s\(.+\)$"
re3 = .Test( strText )
End With
If re And re3 Then
If CheckYes( "^\((\S*\S) (\bor\b|\band\b) (\S*\S)\) (and|or) \((\S*\S) (\bor\b|\band\b) (\S*\S)\)$" , 6 ) Then
check = False
Else
With objNode2
a1 = .submatches(0)
a2 = .submatches(2)
a3 = .submatches(4)
a4 = .submatches(6)
check = "(" & str & a1 & str1 & " " & .submatches(1) & " " & str & a2 & str1 & ") " &_
.submatches(3) & " (" & str & a3 & str1 & " " & .submatches(5) & " " & str & a4 & str1 & ")"
intStart = 5
End With
End If
ElseIf re Then
If CheckYes( "^\((\S*\S) (\bor\b|\band\b) (\S*\S)\) (and|or) (.+)" , 4 ) Then
check = False
Else
With objNode2
a1 = .submatches(0)
a2 = .submatches(2)
a3 = .submatches(4)
check = "(" & str & a1 & str1 & " " & .submatches(1) & " " & str & a2 & str1 & ") " &_
.submatches(3) & " (" & str & a3 & str1 & ")"
intStart = 5
End With
End If
ElseIf re3 Then
If CheckYes( "(.+) (and|or) \((\S*\S) (\bor\b|\band\b) (\S*\S)\)$" , 4 ) Then
check = False
Else
With objNode2
a1 = .submatches(0)
a2 = .submatches(2)
a3 = .submatches(4)
check = "(" & str & a1 & str1 & ") " & .submatches(1) & " (" & str & a2 & str1 & " " &_
.submatches(3) & " " & str & a3 & str1 & ")"
intStart = 5
End With
End If
Else
check = ORAND()
End If
End Function

End Class
-------------------------注意-----------------------------
替换好的字符串并不是完整的SQL语句.只是生成SQL语句的WHERE关键字后面的表达式.发送到ASP程序的时候.你可以在前面加上
"select id,标题,name,TableName from SearchAll where "
这样类似的SQL语句
-------------------------VBScript例子-----------------------------
Dim objROOT1
Set objROOT1 = new CreateQueryString
objROOT1.QueryString = strText '====传入要替换的字符串
objROOT1.strField = "要查询的字段名字" '===如果不设置.默认值是"(标题+文章)"
strText = objROOT1() '=========得到替换好的SQL语句
If (objQueryString.intStart = 4) Then
Call Msgbox("启动按逻辑搜索")
End If
Set objROOT1 = Nothing

相关文章

·关闭窗口时保存数据的办法
·用正则解析图片地址,并利用XMLHT
·实现搜索结果的关键词变色标注的
·关于处理GET方式提交的含有特殊字
·ASP判断Cookies是否处于开启状态
·NextRecordset 和 GetRows 双簧合
·ASP自动生成编号的方法
·Filter与updatebatch混合使用实现
·asp中利用数组实现数据库记录的批
·asp中通过getrows实现数据库记录


阅读排行

·Win 2000不能访问Win XP的原因及
·解析Windows中的帐户和权限功能
·如何共享Windows XP操作系统
·Windows XP Service Pack 1
·通过 Windows XP 注册表自定义您
·Windows 2000 TCP/IP协议概述
·Windows 2000 Server TCP/IP协议
·dos常用命令使用说明
·Windows变慢原因分析及解决方法(
·Windows变慢原因分析及解决方法(
·WINXP下强行关闭“杀”不了的进程
·Windows XP系统注册表的恢复

最新文档

·创业激情需冷静 网络代理选择应理
·域名交易平台亟需规范 预防域名买
·Travel旅游域名即将引发抢注潮 
·从原理深处分析如何预防arp攻击
·突破建站弊端 企业网络营销大有可
·如何区分进程和病毒?
·java的基础知识,如何学好java
·微机原理与接口技术基础知识
·如何解决青少年沉迷网络的问题,
·全面分析主板BIOS报警信号

请您注意:
·尊重网上道德,遵守中华人民共和国的各项有关法律法规
·您在本站发表的作品,本站有权在网站内转载或引用
·其他网站如果需要转载 本站文章请在贵站著名来源,谢谢合作