בולנט - דברים מיוחדים...     פרוטו - בניית אתרים

Israeli ASP Organization

ארגון ה-ASP הישראלי

מאמרים/דוגמאות קוד
קישורים
ספרות
חיפוש כללי:

חפש!
כלליHTMLASPASP.NETSQLמסדי נתוניםJavaScriptXML * XSLDHTML * CSSעיצוב וגרפיקהשרתיםComponentsפרסום ושיווקקידום אתריםקופירייטינגPHP
פרסומת
דף ראשי מדורים דרושים הרשמה למועדון אודותינו צור קשר
מיקום: מאמרים ודוגמאות קוד > ASP

הפיכת כתובות אתרים ודואר אלקטרוני לקישורים

הדוגמא הבאה יודעת לקחת טקסט מסויים ובעזרת פונקציה להפוך את כל כתובות האתרים והדואר אלקטרוני לקישורים.
דוגמא זו שימושית כאשר אנו רוצים לעבור על טקסט שגולש מכניס וכמו כל תוכנות הדוא"ל להפוך את הכתובות לקישורים חיים.

<%@ Language=VBScript %> <% ' InsertHyperlinks(inText) ' Returns a inText with "<a href="URL" target="_BLANK">URL</a>" ' inserted where there is URL found. ' ' URL can start with "www" or "http" ' or ' URL can be a email address "*@*" '---------------------------------------------- TEXT = Request.QueryString("text") 'The text that you wish to check for hyperlinks if TEXT <> "" Then Function InsertHyperlinks(inText) Dim objRegExp, strBuf Dim objMatches, objMatch Dim Value, ReplaceValue, iStart, iEnd strBuf = "" iStart = 1 iEnd = 1 Set objRegExp = New RegExp objRegExp.Pattern = "\b(www|http|\S+@)\S+\b" ' Match URLs and emails objRegExp.IgnoreCase = True ' Set case insensitivity. objRegExp.Global = True ' Set global applicability. Set objMatches = objRegExp.Execute(inText) For Each objMatch in objMatches iEnd = objMatch.FirstIndex strBuf = strBuf & Mid(inText, iStart, iEnd-iStart+1) If InStr(1, objMatch.Value, "@") Then strBuf = strBuf & GetHref(objMatch.Value, "EMAIL", "_BLANK") Else strBuf = strBuf & GetHref(objMatch.Value, "WEB", "_BLANK") End If iStart = iEnd+objMatch.Length+1 Next strBuf = strBuf & Mid(inText, iStart) InsertHyperlinks = strBuf End Function Function GetHref(url, urlType, Target) Dim strBuf strBuf = "<a href=""" If UCase(urlType) = "WEB" Then If LCase(Left(url, 3)) = "www" Then strBuf = "<a href=""http://" & url & """ Target=""" & _ Target & """>" & url & "</a>" Else strBuf = "<a href=""" & url & """ Target=""" & _ Target & """>" & url & "</a>" End If ElseIf UCase(urlType) = "EMAIL" Then strBuf = "<a href=""mailto:" & url & """ Target=""" & _ Target & """>" & url & "</a>" End If GetHref = strBuf End Function Response.Write "After changin urls to hyperlinks: <B>" Response.Write InsertHyperlinks(TEXT) & "</B>" End if %> <HR> <FORM Method=GET> Your Text: <INPUT Type=Text Name=text> </FORM> <HR>

                  

מחבר: אדם ליבסקירמת קושי: 1  ||  ציון: (6.4)כל הזכויות שמורות ל-IAO ©

חנות לסטלן  |   מתכונים  |   חגי ישראל  |   פורטל משחקים  |   חנויות מחשבים ו-ציוד הקפי  |   מגזין מסטול לסטלן המצוי  |   קליפרים  |   גידול צמחים פרחים  |   ספא פינוק מושלם