Extraer cadena alrededor de una palabra

[mrgubu]

No me funciona lo de las negritas. No sé que hago mal.

Este es el código del buscador de granadalinks.com, simplificando. Como dije antes, el original procede de webwizguide:

Código:

'Read in all the search words into one variable
strSearchKeywords = Trim(Request.QueryString("search"))

'If the use has not entered a value then let the search words variable contain a space (chr10)
If strSearchKeywords = "" Then strSearchKeywords = chr(10)

'Replace any less than or greater than signs with the HTML equivalent (stops people entering HTML tags)
strSearchKeywords = Replace(strSearchKeywords, "<", "&lt;")
strSearchKeywords = Replace(strSearchKeywords, ">", "&gt;")
strSearchKeywords = Replace(strSearchKeywords, "'", "''")

'Read in the search words to be searched
sarySearchWord = Split(Trim(strSearchKeywords), " ")

'Return the tow '' back to one' for displaying on the screen
strSearchKeywords = Replace(strSearchKeywords, "''", "'")
'Este strSearchKeywords es la variable que utilizo luego en el código de Manoloweb 


'Create a recordset object
Set rsSearchResults = Server.CreateObject("ADODB.Recordset")

'Aquí divido el código: búsqueda de webs (tipo=webs) o de fotonoticias (tipo=fotosemana). Este último es el que nos interesa: 
Select Case Request.QueryString("tipo")

Case "links"
'......

Case "fotosemana"

	strSQL = "SELECT tblFotosemana.* FROM tblFotosemana "

'Get the mode to decide how we are going to buid the SQL Query
Select Case Request.QueryString("mode")

	'If the user has selected to search any words then intalise the strSQL statement to search for any words in the database
	Case "anywords"


		'Search for the first search word in the URL titles
		strSQL = strSQL & "WHERE Titular LIKE '%" & sarySearchWord(0) & "%'"
	
		'Loop to search for each search word entered by the user
		For intSQLLoopCounter = 0 To UBound(sarySearchWord)
			strSQL = strSQL & " OR Titular LIKE '%" & sarySearchWord(intSQLLoopCounter) & "%'"
			strSQL = strSQL & " OR Antetitulo LIKE '%" & sarySearchWord(intSQLLoopCounter) & "%'" 
			strSQL = strSQL & " OR Cuerpo LIKE '%" & sarySearchWord(intSQLLoopCounter) & "%'"
			strSQL = strSQL & " OR Piedefoto LIKE '%" & sarySearchWord(intSQLLoopCounter) & "%'"
			strSQL = strSQL & " OR Fuente LIKE '%" & sarySearchWord(intSQLLoopCounter) & "%'"
		Next
		
		'Order the search results 
		strSQL = strSQL & " ORDER By id DESC;"


	'If the user has selected to search for all words then intalise the strSQL statement to search for entries containing all the search words
	Case "allwords"
	
		'Search for the first word in the Titular		strSQL = strSQL & "WHERE (Titular LIKE '%" & sarySearchWord(0) & "%'"
		
		'Loop to search the URL titles for each word to be searched
		For intSQLLoopCounter = 1 To UBound(sarySearchWord)
			strSQL = strSQL & " AND Titular LIKE '%" & sarySearchWord(intSQLLoopCounter) & "%'"
		Next
		
		
		'OR if the search words are in the Cuerpo
		strSQL = strSQL & ") OR (Cuerpo LIKE '%" & sarySearchWord(0) & "%'"
		
		'Loop to search the URL URL for each word to be searched
		For intSQLLoopCounter = 1 To UBound(sarySearchWord)
			strSQL = strSQL & " AND Cuerpo LIKE '%" & sarySearchWord(intSQLLoopCounter) & "%'"
		
		Next
		
		'Or if the search words are in the piedefoto	
		strSQL = strSQL & ") OR (Piedefoto LIKE '%" & sarySearchWord(0) & "%'"
		
		'Loop to search the URL description for each word to be searched
		For intSQLLoopCounter = 1 To UBound(sarySearchWord)
			strSQL = strSQL & " AND Piedefoto LIKE '%" & sarySearchWord(intSQLLoopCounter) & "%'"
		Next

		
	
		'Order the search results 		strSQL = strSQL & ") ORDER By id DESC;"



End Select

End Select

'Query the database with the strSQL statement
rsSearchResults.Open strSQL, strCon, 3

'Count the number of records found
lngTotalRecordsFound = CLng(rsSearchResults.RecordCount)

'..........

'Ahora viene la parte de los Response.Write

Select Case Request.QueryString("tipo")

Case "links"

'....

Case "fotosemana"

'aqui incluyo la funtion de  tu codigo, aunque como te comenté lo de las negritas no funciona

Function Cambia(ElTexto,LaBusqueda)
Dim Expresion, Patron, Cuenta, Matches, Match, ElResultado
Set Expresion= New RegExp
Expresion.Pattern = ("((\S+\s+){0,5})("&LaBusqueda&"[\.,:;]*)((\s+\S+){0,5})")
Expresion.IgnoreCase = True   
Expresion.Global = True   
Set Matches=Expresion.Execute(ElTexto)
   Cuenta=1
   For Each Match in Matches
   If Cuenta <9 Then 'OJO: Aqui puedes cambiar el valor para decidir cuantas coincidencias muestre
      ElResultado = ElResultado& "..."& Match.Value & "... <br>"
   End If
   Cuenta=Cuenta+1
   Next
   Cambia = ElResultado
End Function

Function Negritas(ElTexto,LaBusqueda)
Dim Expresion
Set Expresion= New RegExp
Expresion.Pattern = ("("&LaBusqueda&"[\.,:;]*)")
Expresion.IgnoreCase = True 
Expresion.Global = True 
Set Matches=Expresion.Execute(ElTexto)
For Each Match in Matches 
ElResultado = Expresion.Replace (ElTexto, "<b>$1</b>")
Next
Negritas = ElResultado
End Function

'aqui sigue el codigo original
If NOT Request.QueryString("mode") = "" Then 

		'For....Next Loop to display the results from the database
		For intRecordLoopCounter = 1 to intRecordsPerPage
		
			'If there are no records left to display then exit loop
			If rsSearchResults.EOF Then Exit For					
		      	
		     'aqui muestro la foto, el titular y, adapto el código de Manoloweb para que muestre las cadenas de texto con la palabra buscada		

						 Response.Write vbCrLf & "  	<a href=""fotosemanaa.asp?id=" & rsSearchResults("id") & """><img style=""margin-right: 5px;"" border=0 src="" "& rsSearchResults("URLp") & """ width="" "& rsSearchResults("widthp") & """ height="" "& rsSearchResults("heightp") & """></a>
		    Response.Write vbCrLf & " 	    <a href=""fotosemanaa.asp?id="  & rsSearchResults("id") & """>" & rsSearchResults("Fecha") & " .&#45 " & rsSearchResults("Titular") & "</a>"
			 
			  'RESPONSE.WRITE DE MANOLOWEB
			  Dim Texto
			  Texto=rsSearchResults("Cuerpo") 
 			  Response.Write vbCrLf & "<p class=normal>" & (Cambia(Texto,strSearchKeywords )) & "</td>"
			  
	   	
		'Move to the next record in the database
			rsSearchResults.MoveNext
		
		'Loop back round   	
		Next

End If