Samtidigt som de ersätts så ska de gamla urlerna och länktexten sparas i en array t ex så vet att klick.asp?id=1 är aftonbladet osv
Har en funktion nu som fungerar, men de ändrar bara i urlena inte sparar ner länktexten,har försökt att ändra men inte fått till det med regexp riktigt!!
call ReplaceLinks3(Bodytext,textout)
response.write textout
Public Function ReplaceLinks3(Value,textout)
Dim RegExp
Dim url
Dim Match
Dim Matches
Set RegExp = New RegExp
RegExp.Global = True
RegExp.IgnoreCase = True
RegExp.Pattern = "<a href\s*=\s*""([^""]*)"""
Set Matches = RegExp.Execute(Value)
ReplaceLinks3 = Value
i = 0
For Each Match In Matches
url = Match.SubMatches(0)
RegExp.Pattern = "(href\s*=\s*"")" & EscapeRegExp(url) & "("")"
if instr(url,"@") > 0 then
response.write "<br>Email"
else
ReplaceLinks3 = RegExp.Replace(ReplaceLinks3, "$1" & TranslateURL(url) & "$2")
end if
i = i +1
response.write url&"<br>"
Next
textout = ReplaceLinks3
End Function
Function TranslateURL(Value)
' sql="insert into Klicks_counter(link) VALUES ('"&Value&"')"
' set rs=conn.execute(sql)
' sql="select IDENT_CURRENT('Klicks_counter') as ref_klick_id"
' set rs=conn.execute(sql)
' ref_klick_id = rs("ref_klick_id")
TranslateURL = "klick.asp?id="&ref_klick_id
End Function
Testa följande (jag har gjort det enkelt för mig genom att använda korta variabelnamn, nästan enbart gemener o.s.v):
function replaceLinks3(v,t)
dim re
set re = new regexp
re.global = true
re.ignorecase = true
re.pattern = "<a href=(""|')?([^>]+)\1>"
dim matches
set matches = re.execute(v)
if matches.count > 0 then
dim i, arr()
i = 1
redim arr(matches.count + 1)
for each match in matches
re.pattern = match
v = re.replace(v, "<a href=""klick.asp?id=" & i & """>")
arr(i) = match.submatches(1)
' Testing
response.write "arr(" & i & ") = " & match.submatches(1) & "<br>"
i = i + 1
next
end if
t = v
end function
function replaceLinks3(v,t)
dim re
set re = new regexp
re.global = true
re.ignorecase = true
re.pattern = "<a href=(""|')?([^>]+)\1>(.*?)</a>"
dim matches
set matches = re.execute(v)
if matches.count > 0 then
dim i, array_url(), array_text()
i = 1
redim array_url (matches.count + 1)
redim array_text(matches.count + 1)
re.global = false
for each match in matches
re.pattern = match
v = re.replace(v, "<a href=""klick.asp?id=" & i & """>" & match.submatches(2) & "</a>")
array_url (i) = match.submatches(1)
array_text(i) = match.submatches(2)
' Testing
response.write "array_url(" & i & ") = " & array_url(i) & "<br>"
response.write "array_text(" & i & ") = " & array_text(i) & "<br><br>"
i = i + 1
next
end if
t = v
end function
En liten "bugg" bara, när man skickar in html koden nedan så fungerar det inte, den klarar inte av test.asp?id=123132
Vad som händer är att den länken inte översätts, utan förblir oändrad, inte så bra!
Finns det någon lösning på det?
t= t&"Länk till <a href="http://www.aftonbladet.se/test.asp?id=123132" target=""_top"">Aftonbladet</a>.Här är <A href=""test.asp"">Test</A>
function replaceLinks3(v,t)
dim re
set re = new regexp
re.global = true
re.ignorecase = true
re.pattern = "<a href=((?:""|')*)([^'"">]+)\1([^>]*)>(.*?)</a>"
dim matches
set matches = re.execute(v)
if matches.count > 0 then
dim i, array_url(), array_text()
i = 1
redim array_url (matches.count + 1)
redim array_text(matches.count + 1)
re.global = false
for each match in matches
re.pattern = replace(match,"?","\?")
v = re.replace(v, "<a href=""klick.asp?id=" & i & """" & match.submatches(2) & ">" & match.submatches(3) & "</a>")
array_url (i) = match.submatches(1)
array_text(i) = match.submatches(3)
' Testing
response.write "array_url(" & i & ") = " & array_url(i) & "<br>"
response.write "array_text(" & i & ") = " & array_text(i) & "<br><br>"
i = i + 1
next
end if
t = v
end function
Jag escape:ar '?' ovan. Du kan även få problem med andra tecken som har speciell betydelse i reguljära uttryck; t.e.x. '+'. Så istället för att ha en replace() i koden ovan, kanske du kan skapa en funktion som hanterar dessa tecken. :)
