Foros del Web - resaltar parámetros de busqueda

Foros del Web (http://www.forosdelweb.com/)

- ASP Clásico (http://www.forosdelweb.com/f15/)

- - resaltar parámetros de busqueda (http://www.forosdelweb.com/f15/resaltar-parametros-busqueda-577140/)

resaltar parámetros de busqueda

Hola, el asunto es que quiero resaltar los parámetros de una busqueda. A traves de la query llega la id de los registros en los que hay que buscar y que palabras hay que buscar en dichos registros.
Como observación decir que esta id no es autoincrementable, es decir, la id -10- la puede tener 200 registros.

Bueno esto es lo que tengo hecho, y no da ningún error pero tampoco imprime nada, deja la página en blanco :patada:

Código PHP:

   <%
Dim ExplDoc, registros, i, marca, array_cadena, strOriginal
ExplDoc = 0 ' Este campo es de texto
Call Registro (rs2)
SQL="SELECT ExplDoc, IBol from table where IBol =   ...."
rs2.Open SQL, fconn
registros=rs2.getrows
Call LimpiarRS (rs2)
Call LimpiarConexion (fconn)
 
For i=0 to UBound(registros,2) ' Listo los resultados
marca = Trim(Request.QueryString("clave")) ' Recoge los parámetros de la busqueda
IF marca = "" then
%>
<%=registros(ExplDoc,i))%>
<%
ELSE
array_cadena  = Split(marca," ")
%>
<%=ResaltaParam(StrOriginal)%>
<%
END IF
Next ' i
%>

En un include

Código PHP:

   <%
Dim registros, n, ExplDoc, array_cadena, marca
Dim n, objRegExp 
array_cadena  = Split(marca," ")
Function ResaltaParam (strMarcado)
For n=0 to UBound(array_cadena) 
      Set objRegExp = new RegExp
      With objRegExp
      .Pattern = "\b("&array_cadena(n)&")+\b"
      .IgnoreCase = True
     .Global = True
      End With
     strMarcado = objRegExp.replace(registros(ExplDoc,i)), "<span class=""bgC"&n&""">$1</span>")
     ResaltaParam = strMarcado
     Set objRegExp = nothing
Next n
End Function
%>

He probado muchas cosas y estas son las únicas lineas de código que no dan error.

Gracias

Re: resaltar parámetros de busqueda

Yo uso esta funcioncita en mis proyectos:

Primero crea un array con las palabras a buscar (arrBusqueda).
StringAMostrar es donde quieres resaltar las palabras; puede ser un campo "Descripcion" o "Nombre" de una base de datos

Código:

                        arrBusqueda = split(strBusqueda," ")

                        StringAMostrar = rsBusqueda("nombre")

                        Dim pos

                        Dim FndPos

                        pos = 1

                        FndPos = 1

                        For z = 0 To UBound(arrBusqueda)

                                FndPos = instr(1, StringAMostrar, arrBusqueda(z),1)

                                Do While FndPos<>0

                                        str = Mid(StringAMostrar, 1, (FndPos-1)+len(arrBusqueda(z)))

                                        newstr = Mid(str, 1, FndPos - 1) & "<span style=background:yellow;font-weight:bold>" & Mid(str, FndPos, len(arrBusqueda(z))) & "</span>"

                                        StringAMostrar = replace(StringAMostrar, str, newstr)

                                        pos = FndPos+len(arrBusqueda(z)) + 47

                                        FndPos = instr(pos, StringAMostrar, arrBusqueda(z),1)

                                Loop

                        Next

                        Response.Write(StringAMostrar)

Saludos! :adios:

Re: resaltar parámetros de busqueda

Hey, gracias a ambos por responder, me habeis sido de gran ayuda

El código finalmente ha quedado así

Código PHP:

   <%
Dim ExplDoc, registros, i, marca, array_cadena, strOriginal
ExplDoc = 0 ' Este campo es de texto
Call Registro (rs2)
SQL="SELECT ExplDoc, IBol from table where IBol =   ...."
rs2.Open SQL, fconn
registros=rs2.getrows
Call LimpiarRS (rs2)
Call LimpiarConexion (fconn)
 
For i=0 to UBound(registros,2) ' Listo los resultados
marca = Trim(Request.QueryString("clave")) ' Recoge los parámetros de la busqueda
IF marca = "" then
%>
<%=registros(ExplDoc,i)%>
<%
ELSE
array_cadena  = Split(marca," ")
StrOriginal = registros(ExplDoc,i)
%>
<%=ResaltaParam(StrOriginal)%>
<%
END IF
Next ' i
%>

El include

Código PHP:

   Dim marca, array_cadena
Dim n, Coincidencia, strCadena, strMarcado
Function ResaltaParam(strOriginal)
marca = Trim(Request.QueryString("clave"))
array_cadena  = Split(marca," ")
For n=0 to UBound(array_cadena)
Dim objRegExp 
Set objRegExp = new RegExp
With objRegExp
.Pattern = ("\b("&array_cadena(n)&")+\b")
.IgnoreCase = True
.Global = True
End With
Set strCadena = objRegExp.Execute(strOriginal)
For Each Coincidencia in strCadena
strMarcado = objRegExp.replace(strOriginal, "<span class=""bgC"&n&""">$1</span>")
Next
ResaltaParam = strMarcado
Set objRegExp = nothing
Next n
End Function

Ahora me surge otro problemas con el que no habia contado, si el valor que le paso a expresión está acentuado, repite el registro anterior tantas veces como el número de registros que han de ser mostrados.

Un supuesto

Se han de mostrar 100 registros coincidentes con la consulta. Si el registro número 20 lleva una palabra acentuada y esa palabra hay que resaltarla por que es una de las palabras que llegaron a traves de la query, hasta el registro 19 se muestran correctamente y después se repite ese mismo registro hasta que acabe el ciclo, en este caso 81 veces.

¿Alguna idea?

Gracias

Re: resaltar parámetros de busqueda

antes de enviar el criterio

Código PHP:

   Function Acentos(texto)
    Dim ComponerTexto
    For x = 1 To Len(texto)
        ComponerTexto = Mid(texto, x, 1)
        Select Case ComponerTexto
            Case "a", "à", "á", "À", "Á"    Acentos = Acentos & "[aàáâÀÁÂ]"
            Case "e", "é", "è", "È", "É"    Acentos = Acentos & "[eéèêÈÉÊ]"
            Case "i", "ì", "í", "Ì", "Í"    Acentos = Acentos & "[iìíîÌÍÎ]"
            Case "o", "ò", "ó", "Ò", "Ó"    Acentos = Acentos & "[oòóôÒÓÔ]"
            Case "u", "ù", "ú", "Ù", "Ú"    Acentos = Acentos & "[uùúûÙÚÛ]"
            Case Else                        Acentos = Acentos & ComponerTexto
        End Select
    Next
End Function

modo de uso

Cita:

sebusca=lCase(Acentos(sebusca))

:adios:

Re: resaltar parámetros de busqueda

Gracias Shiryu por responder.

Esa función no me es válida ya que, aunque en el código que imprimí anteriormente no aparace estoy usando escape.

¿Alguna otra idea?

Siguiendo con el tema, estoy teniendo problemas con otro código muy parecido.
En esta ocasión la consulta solo encuentra un registro, pero ese registros puede llegar a tener hasta 20000 palabras, así que para ficilitarle al usuario que encuentre en el doc los terminos que ingreso en el buscado, pues quiero resaltarlos

El problema está en que solamente resalta el último termino ingresado

Código PHP:

   marca = Trim(Request.QueryString("clave")) ' recoge los terminos de query
array_cadena  = Split(marca," ")
plbraClave = unescape(rs.Fields("Clave")) ' este es un listado de palabras claves si alguno de los terminos de la busqueda no encaja con estas palabras claves, se eliminan con la funcion Encuentra
strOriginal = unescape(rs.Fields("Cuerpo"))  sobre este texto se busca los terminos resultantes de la funcion Encuentra
PLlave = Encuentra(plbraClave)
Dim arr
arr = Split(Trim(PLlave), " ")
%>
<%=ResaltaParam(PLlave, strOriginal)%>

Estas son las funciones

Código PHP:

   Dim n, objRegExp, strClave, Coincidencia, strLlave, strCadena, strMarcado
Function Encuentra (plbraClave) ' elimina terminos prohibidos
For n=0 to UBound(array_cadena)
Set objRegExp = new RegExp
objRegExp.Pattern = "\b("&array_cadena(n)&")+\b"
objRegExp.IgnoreCase = True
objRegExp.Global = True
Set strClave = objRegExp.Execute(plbraClave)
For Each Coincidencia in strClave
strLlave = strLlave  & Coincidencia.Value & " "
Next
Encuentra = strLlave
Set strClave = nothing
Set objRegExp = nothing
Next 'n
End Function

Function ResaltaParam (PLlave, strOriginal) ' resalta terminos
For n=0 to UBound(arr)
Set objRegExp = new RegExp
objRegExp.Pattern = "\b("&arr(n)&")+\b"
objRegExp.IgnoreCase = True
objRegExp.Global = True
Set strCadena = objRegExp.Execute(strOriginal)
For Each Coincidencia in strCadena
strMarcado = objRegExp.replace(strOriginal, "<span class=""bgC"&n&""">$1</span>")
Next
ResaltaParam =  strMarcado
Set strCadena = nothing
Set objRegExp = nothing
Next 'n
End Function

Gracias

Re: resaltar parámetros de busqueda

Después de dejarlo reposar unas horas logré que funcionar el segundo problema :borracho:. La sulución era cambiar únicamente cambiar el nombre al segundo argumento que se le pasa a la función ResaltaParam :patada:

Function ResaltaParam (PLlave, strMarcado):si: ' Cambiar strOriginal por strMarcado

Con respecto al primer problemas, lo de las palabras acentuadas aún continuo con el :neurotico

Agradezco cualquier sugerencia

Gracias