boolske operatører i søgning
Hej...Jeg faldt over en funktion der kan søge med boolske operatører. Og da jeg er ved at lave min egen søgemaskine til min side, ville jeg gerne give mulighed for at søge med OR AND osv..
Funktionen er for mig bare en smule uoverskuelig, og ved ikke helt hvordan jeg kan hæfte den ind i min nuværende søgefunktion.
Så HJÆLP!....
Jeg poster først koden med søgefunktionen med boolske operatøter og bagefter mit søgescript. Så hvis der er nogen derude som kan guide mig lidt vil jeg være dybt taknemmelig. Og så er der jo også gode point at hente her! :O)
<%
'Function GetSQLSearchString(Str As String, Records As String) As String
Function GetSQLSearchString(Str, Records)
Do While CBool(InStr(1, Str, "( ")) Or CBool(InStr(1, Str, " )")) Or CBool(InStr(1, Str, " "))
Str = Replace(Str, " )", ")")
Str = Replace(Str, "( ", "(")
Str = Replace(Str, " ", " ")
Loop
' Dim bExp As Boolean, BoolStop As Boolean, i As Integer, nStr As String, strExp As String, BoolStart As Boolean
bExp = False
BoolStop = False
Str = Str & " "
For i = 1 To Len(Str)
s = Mid(Str, i, 1)
If s = Chr(34) Then bExp = Not bExp
If s = " " Then
If Not bExp Then
If strExp <> "" Then
If nStr = "" Then
nStr = strExp
t = UCase(strExp)
If (CBool(InStr(1, t, "AND")) Or CBool(InStr(1, t, "OR")) Or CBool(InStr(1, t, "NOT"))) Then BoolStart = True
Else
t = UCase(strExp)
If Not ((t = "AND") Or (t = "OR") Or (t = "NOT")) Then
If BoolStop Or BoolStart Then
nStr = nStr & " " & strExp & " "
BoolStop = False
BoolStart = False
Else
nStr = nStr & " AND " & strExp & " "
End If
Else
BoolStop = True
nStr = nStr & " " & t & " "
End If
End If
End If
strExp = ""
Else
strExp = strExp & " "
End If
Else
strExp = strExp & s
End If
Next
nStr = nStr & strExp
nStr = Replace(nStr, " ", " ")
Str = Replace(nStr, "'", "")
' Dim ReplExp As String, rec() As String
If InStr(1, Records, ",") Then
rec = Split(Records, ",")
ReplExp = "("
For i = 0 To UBound(rec)
ReplExp = ReplExp & "(" & rec(i) & " LIKE '%<exp>%')"
If i <> UBound(rec) Then
ReplExp = ReplExp & " OR "
Else
ReplExp = ReplExp & ")"
End If
Next
Else
ReplExp = "(" & Records & " = '<exp>')"
End If
' Dim SQLSearch As String, ParanWritten As Boolean
ParanWritten = False
bExp = False
SQLSearch = ""
If InStr(1, Str, " ") Then
For i = 1 To Len(Str)
s = Mid(Str, i, 1)
If s = Chr(34) Then bExp = Not bExp
If (s = "(") Or (s = ")") Or (s = " ") Or (s = Chr(34)) Then
If Not bExp Then
If strExp <> "" Then
t = UCase(strExp)
If (t = "AND") Or (t = "OR") Or (t = "NOT") Then
SQLSearch = SQLSearch & " " & t & " "
Else
SQLSearch = SQLSearch & Replace(ReplExp, "<exp>", strExp)
End If
strExp = ""
SQLSearch = SQLSearch & s
Else
If (s = "(") Then
SQLSearch = SQLSearch & "("
ParanWritten = True
End If
End If
Else
strExp = strExp & " "
End If
Else
If s <> Chr(34) Then strExp = strExp & s
End If
Next
Else
SQLSearch = Replace(ReplExp, "<exp>", Str)
End If
Do While InStr(1, SQLSearch, " ")
SQLSearch = Replace(SQLSearch, " ", " ")
Loop
Do While CBool(InStr(1, SQLSearch, "% ")) Or CBool(InStr(1, SQLSearch, " %"))
SQLSearch = Replace(SQLSearch, "% ", "%")
SQLSearch = Replace(SQLSearch, " %", "%")
Loop
SQLSearch = Replace(SQLSearch, Chr(34), "")
SQLSearch = Trim(SQLSearch)
If UCase(Left(SQLSearch, 2)) = "OR" Then SQLSearch = Right(SQLSearch, Len(SQLSearch) - 2)
If UCase(Left(SQLSearch, 3)) = "AND" Then SQLSearch = Right(SQLSearch, Len(SQLSearch) - 3)
GetSQLSearchString = "(" & Trim(SQLSearch) & ")"
GetSQLSearchString = Trim(SQLSearch)
End Function
%>
--------------------------------------------------------------------------------------------------------------
Mit søgescript:
<% Response.Buffer = True %>
<html><head>
<title>Søgeresultat</title>
<link rel="stylesheet" type="text/css" href="default.css">
</head>
<body>
<%
' Henter værdien fra index.asp
dim strKeyword
strKeyword = Trim(Request.Form("Keyword"))
If Len(strKeyword) = 0 Then
'Hvis der ikke er skrevet i feltet
'Response.Clear
Response.Write("Søgeord mangler. Indtast et søgeord for at søge...")
Else
' Hvis der er skrevet i feltet
strKeyword = Replace(strKeyword,"'","''")
' Opbygger en dynamisk SQL streng
strSQL = "SELECT ID, Title, Article FROM Articles WHERE"
strSQL = strSQL & " (Title LIKE '%" & strKeyword & "%')"
strSQL = strSQL & " OR (Article LIKE '%" & strKeyword & "%')"
' Skaber DSNLess forbindelse til DBen
strDSN = "DRIVER={Microsoft Access Driver (*.mdb)};DBQ="&Server.MapPath("CMS.mdb")
Set myConn = Server.CreateObject("ADODB.Connection")
myConn.Open strDSN
' Skaber et recordset udfra SQL strengen
Set rs = myConn.Execute(strSQL)
Function RegReplace(inStr)
Dim regEx
Set regEx = New RegExp
regEx.Global = True
regEx.IgnoreCase = True
regEx.Pattern = "<[^>]+>"
inStr=regEx.Replace(inStr, "")
RegReplace=inStr
End Function
Function Highlight(strText, strFind, strBefore, strAfter)
' Parameters:
' strText - string to search in
' strFind - string to look for
' strBefore - string to insert before the strFind
' strAfter - string to insert after the strFind
Dim nPos
Dim nLen
Dim nLenAll
nLen = Len(strFind)
nLenAll = nLen + Len(strBefore) + Len(strAfter) + 1
Highlight = strText
If nLen > 0 And Len(Highlight) > 0 Then
nPos = InStr(1, Highlight, strFind, 1)
Do While nPos > 0
Highlight = Left(Highlight, nPos - 1) & _
strBefore & Mid(Highlight, nPos, nLen) & strAfter & _
Mid(Highlight, nPos + nLen)
nPos = InStr(nPos + nLenAll, Highlight, strFind, 1)
Loop
End If
End Function
If Not (rs.BOF Or rs.EOF) Then
' Hvis der er fundet poster på søgningen
Response.Write "<p>Søgeresultat</p>"
Response.Write "<table border=0>"
Do While Not rs.EOF
databasetekst = RegReplace(rs("article"))
FindStrKeyword = instr(databasetekst, strKeyword)
hvorersoegeord = (FindStrKeyword-50)
if hvorersoegeord < 1 Then
hvorersoegeord = 1
End If
strOutput = mid(databasetekst,hvorersoegeord ,(Len(strKeyword)+200))
'formaterer strengen med highlight af søgeord + ... ved slut
VarWord = strKeyword
strOutput = strOutput + "<b>...</b>"
HighlightText = Highlight(strOutput, VarWord, "<Span style='\background-color:#FFFF00;\'>", "</Span>")
'Her udskriver vi vores søgeresultat
Response.Write "<tr><td style='\border-bottom: 1 dotted #000000'\><b>" & rs("Title") & "</b></td></tr>"
Response.Write "<tr><td>" & HighlightText & "</td></tr>"
Response.Write "<tr><td><a href=""index.asp?id=" & rs("id") & """( target=""_parent"">Link til siden</a></td></tr>"
rs.MoveNext
Loop
Response.Write "</table>"
Else
' Hvis der ikke er fundet poster på søgningen
Response.Write "<p>Der er ikke fundet noget på denne søgning</p>"
End If
' Rydder op efter os
myConn.Close
Set myConn = Nothing
End If
%>
</body>
