//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
|