convertera text till klickbara länkar

12 svar · 612 visningar · startad av pelk 14 aug. 2006

pelkMedlem sedan juli 2006132 inlägg

Frågan14 aug. 2006 20:22#1

Hej,
efter mycket möda och stort besvär har jag lycakts snickra ihop följande funktion

Function convertLink(ByVal strText)
 Dim mDelimit
 Dim re
 mDelimit = Chr(0)
 Set re = New RegExp
 re.Global = True
 re.IgnoreCase = true

 re.Pattern = "(\w+((-\w+)|(\.\w+))*\@[A-Za-z0-9]+((\.|-)[A-Za-z0-9]+)*\.[A-Za-z0-9]+)"
 strText = re.Replace(strText, "<a href=""mailto" & mDelimit & ":$1"">$1</a>")

 re.Pattern = "(http://|https://|ftp://|mailto:)(\S)(\S+)"
 strText = re.Replace(strText, "<a href=""$1$2" & mDelimit & "$3"" target=""_blank"">$2" & mDelimit & "$3</a>")

 re.Pattern = "(www\.(\S)(\S+))"
 strText = re.Replace(strText, "<a href=""http://$1"" target=""_blank"">$1</a>")
 strText = Replace(strText, mDelimit, "")

 convertLink=strText

End Function

är det rätt/bra sätt?

Men kan inte sy ihop det hela till "utskrift"
Som det är nu så har jag

en smily-funk

Function Smilies(txt)
	txt = Replace(txt, ":)", "<img src=""images/smiley/smile.GIF"" alt=""smile"" title=""smile"" />")
	txt = Replace(txt, ":(", "<img src=""images/smiley/frown.GIF"" alt=""ledsen"" title=""ledsen"" />")
	txt = Replace(txt, ":e", "<img src=""images/smiley/supergrin.GIF"" alt=""stort flin"" title=""stort flin"" />")
	  txt = Replace(txt, ":D", "<img src=""images/smiley/biggrin.GIF"" alt=""biggrin"" title=""biggrin"" />")
	txt = Replace(txt, ":P", "<img src=""images/smiley/blah.GIF"" alt=""busig"" title=""busig"" />")
	txt = Replace(txt, "§jr", "<img src=""images/smiley/devel.GIF"" alt=""små jävlig"" title=""små jävlig"" />") 

	
        Smilies = txt
End Function

och utskrifte sker med

Response.Write "<p class=""meddelande"">" & Replace(rsGbok("mess"), vbCrLf, "<br />" & vbCrLf)  & "</p><br />"

Jag skulle vara evigt tacksam för hjälp med detta :r

pelkMedlem sedan juli 2006132 inlägg

14 aug. 2006 20:27#2

har fösökt utan framgång med

strText=Replace(rsGbok("mess"), vbCrLf, "<br />" & vbCrLf)
Response.Write "<p class=""meddelande"">" & convertLink(strText)  & "</p><br />"

Response.Write "<hr />"

DannyMedlem sedan juli 200412 913 inlägg

14 aug. 2006 20:27#3

kan inte mycket om det där... men jag kör med:

Function Link(strText)
   strText = Server.HTMLEncode(strText)

   Set regExp = New regexp

   regExp.Global = true
   regExp.IgnoreCase = true

   regExp.Pattern = "(http://|www)([\S]*)"
   strText = regExp.Replace(strText,"<a href=""http://$1$2"" target=""_blank"">$1$2</a>")

   regExp.Pattern = "([url]ftp://)([/url][\S]*)"
   strText = regExp.Replace(strText,"<a href=""$1$2"" target=""_blank"">$1$2</a>")

   regExp.Pattern = "([\S]*@[\S]*[.se|.com|.nu|.net|.org])"
   strText = regExp.Replace(strText,"<a href=""mailto:$1"" target=""_blank"">$1</a>")

   regExp.Pattern = "([.|,|!|?|:|;|)|\|&]]*)</a> "
   strText = regExp.Replace(strText,"</a>$1 ")

   regExp.Pattern = "([.|,|!|?|:|;|)|\|&]]*)"" target=""_blank"">([^<]*)</a>"
   strText = regExp.Replace(strText,""">$2</a>")

   strText = Replace(Trim(strText),vbCrLf, "<br>")
   strText = Replace(Trim(strText),"http://http://", "http://")

Link = strText 				' Skriver ut texten, uppdelad och fin!

CatZMedlem sedan jan. 20022 440 inlägg

14 aug. 2006 23:28#4

Det ser bra ut med din smilies ersättning. Jag skulle dock valt ett annat namn på funktionen då VBScript använder Replace.

pelkMedlem sedan juli 2006132 inlägg

15 aug. 2006 07:13#5

CatZ skrev:

Det ser bra ut med din smilies ersättning. Jag skulle dock valt ett annat namn på funktionen då VBScript använder Replace.

min eller Dannys?
vilket förslag har du?

CatZMedlem sedan jan. 20022 440 inlägg

15 aug. 2006 08:17#6

fReplace, ConvertSmilies, ReplaceSmilies eller nagot, och det var din (pelks) replace jag tyckte funka den andra har jag inte ens tittat pa :)

pelkMedlem sedan juli 2006132 inlägg

15 aug. 2006 18:00#7

Så här ser koden ut nu:

Set minCon = Server.CreateObject("ADODB.Connection")
set rsGbok = Server.CreateObject("ADODB.Recordset")
minCon.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath("../data/guests.mdb")
strSQL =" SELECT * FROM coach WHERE dag > dateAdd('d',-55,Now()) ORDER by ID DESC"
rsGbok.Open strSQL, minCon, 3, 3
Do While Not rsGbok.EOF
indag = Cdate(rsGbok("dag"))
vdag = DateAdd("h",0,indag)
dat = FirstVersal(WeekDayName(WeekDay(vdag)))&"en "& " den " & fix(DatePart("d", vdag)) & "  " & MonthName(Month(vdag)) &" kl " & FormatDateTime(vdag,4) 
'//Response.Write "<P>" & dat & " skrev coachen:</P>"
Response.Write "<p>" & dat & " skrevs följande info:</p><br />"
'// i VBScript kan man inte använda sig utav radbrytningar därför behövs följande: Replace(rsGbok("Message"), vbCrLf, "<br />" & vbCrLf)
strText=Replace(rsGbok("mess"), vbCrLf, "<br />" & vbCrLf)
Response.Write "<p class=""meddelande"">" & convertLink(strText)  & "</p><br />"

Response.Write "<hr />"

  rsGbok.MoveNext

  Loop
  rsGbok.Close
  Set rsGbok = Nothing
  minCon.Close
  Set minCon = Nothing

Men om ni kollar på övre länken syns det ngra konstiga tecken..

hur får jag bort dessa?

emissionMedlem sedan dec. 19996 721 inlägg

17 aug. 2006 10:44#8

pelk skrev:

Hej,
efter mycket möda och stort besvär har jag lycakts snickra ihop följande funktion

Ironi?

CatZMedlem sedan jan. 20022 440 inlägg

17 aug. 2006 11:32#9

emission skrev:

Ironi?

Sarkasm?

pelkMedlem sedan juli 2006132 inlägg

17 aug. 2006 17:35#10

Que? är det med ironi jag får bort dessa?
Jag kanske skall lägga till att det rör sig om access-databas, fältet är av typen pm, och originalt står det:

Finns:
http://www.polisenbasket-p93.se/fdsc07.html

http://www.basket.se/stockholm/t2.asp?p=27371&x=1&a=437862

SBMedlem sedan maj 2000194 inlägg

18 aug. 2006 04:39#11

Emission skrev:

Ironi?

Emission menar nog att du inte alls skrivit funktionen själv utan bara kopierat den från ett tidigare inlägg.

http://www.webforum.nu/showthread.php?p=686333#post686333 ;)

pelkMedlem sedan juli 2006132 inlägg

18 aug. 2006 05:02#12

SB skrev:

Emission menar nog att du inte alls skrivit funktionen själv utan bara kopierat den från ett tidigare inlägg.

http://www.webforum.nu/showthread.php?p=686333#post686333 ;)

har aldrig påståt det heller ;)

TravoniMedlem sedan okt. 20041 556 inlägg

18 aug. 2006 06:35#13

pelk skrev:

har aldrig påståt det heller ;)

pelk skrev:

...jag lycakts snickra ihop följande funktion.

... ;)