MyDesign | Kod Arşivi - Anasayfaya Dön   No banner in farm
Anasayfa Araştır Forum Gelişmiş Arama Siteniz İçin En Hit İçerikler RSS İçerik Ekle Scriptler Destekleyenler Kadromuz Reklam İletişim Giriş Sayfası Yap  Sık Kullanılanlara Ekle
Bu Kategorinin En Yeni Kodları:


Bu Kategorinin En Çok Görüntülenen Kodları:






Arama:
Gelişmiş Arama


No banner in farm



En Çok Görüntülenen Kodlar:


Üye Girişi:
 Üye Ol



Anasayfa > Asp > Kodlar

Forum Kodları Fonksiyonu

Uygulamalarınızda [url]link[/url] gibi bazı forum kodlarının çalışması için gerekli fonksiyon

Kategori : Asp
Gönderen : mYavuz
Telif :
Tarih : 04 Haziran 2005
Örnek Dosya : İndir
Okunma Sayısı : 40168
Puan
: 7,8 / 10 (27 Oy)
Puan Verin :
Google Bookmarks  del.icio.us  Digg  Yahoo! MyWeb  Windows Live  Furl
 
 
<%
'|======================================
'| Forum Kodları Fonksiyonu
'| mydesign a.k.a doronty37
'| http://www.mydesign.gen.tr
'| mydesign@mydesign.gen.tr
'|======================================

Function MesajFormatla(strMesaj)

     strMesaj = Replace(strMesaj, "<", "&amp;lt;", 1, -1, 1)
     strMesaj = Replace(strMesaj, ">", "&amp;gt;", 1, -1, 1)
     strMesaj = Replace(strMesaj, Chr(10), "<br />", 1, -1, 1)
     strMesaj = Replace(strMesaj, "[B]", "<b>", 1, -1, 1)
     strMesaj = Replace(strMesaj, "[/B]", "</b>", 1, -1, 1)
     strMesaj = Replace(strMesaj, "[STRONG]", "<b>", 1, -1, 1)
     strMesaj = Replace(strMesaj, "[/STRONG]", "</b>", 1, -1, 1)
     strMesaj = Replace(strMesaj, "[U]", "<u>", 1, -1, 1)
     strMesaj = Replace(strMesaj, "[/U]", "</u>", 1, -1, 1)
     strMesaj = Replace(strMesaj, "[I]", "<i>", 1, -1, 1)
     strMesaj = Replace(strMesaj, "[/I]", "</i>", 1, -1, 1)
     strMesaj = Replace(strMesaj, ":)", "<img src=""img/smiley/smiley1.gif"">", 1, -1, 1)
     strMesaj = Replace(strMesaj, ";)", "<img src=""img/smiley/smiley2.gif"">", 1, -1, 1)
     strMesaj = Replace(strMesaj, ":O", "<img src=""img/smiley/smiley3.gif"">", 1, -1, 1)
     strMesaj = Replace(strMesaj, ":))", "<img src=""img/smiley/smiley4.gif"">", 1, -1, 1)
     strMesaj = Replace(strMesaj, ":S", "<img src=""img/smiley/smiley5.gif"">", 1, -1, 1)
     strMesaj = Replace(strMesaj, ":(", "<img src=""img/smiley/smiley6.gif"">", 1, -1, 1)
     strMesaj = Replace(strMesaj, ":'(", "<img src=""img/smiley/smiley7.gif"">", 1, -1, 1)

     Do While inStr(strMesaj, "[URL=") > 0 And inStr(strMesaj, "[/URL]") > 0

          DeyimBaslangici = inStr(strMesaj, "[URL=")
          DeyimSonu = inStr(DeyimBaslangici, strMesaj, "[/URL]") + 6
          If DeyimSonu < DeyimBaslangici Then DeyimSonu = DeyimBaslangici + 7
          strLink = trim(Mid(strMesaj, DeyimBaslangici, (DeyimSonu - DeyimBaslangici)))
          strGeciciMesaj = strLink
          strGeciciMesaj = Replace(strGeciciMesaj, "[URL=", "<a href=""", 1, -1, 1)
          
          If inStr(strGeciciMesaj, "[/URL]") Then
               strGeciciMesaj = Replace(strGeciciMesaj, "[/URL]", "</a>", 1, -1, 1)
               strGeciciMesaj = Replace(strGeciciMesaj, "]", """ target=""_blank"">", 1, -1, 1)
          Else
               strGeciciMesaj = strGeciciMesaj & ">"
          End If

          strMesaj = Replace(strMesaj, strLink, strGeciciMesaj, 1, -1, 1)
     Loop

     Do While inStr(strMesaj, "[URL]") > 0 And inStr(strMesaj, "[/URL]") > 0

          DeyimBaslangici = inStr(strMesaj, "[URL]")
          DeyimSonu = inStr(DeyimBaslangici, strMesaj, "[/URL]") + 6          
          If DeyimSonu < DeyimBaslangici Then DeyimSonu = DeyimBaslangici + 6
          strLink = trim(Mid(strMesaj, DeyimBaslangici, (DeyimSonu - DeyimBaslangici)))
          strGeciciMesaj = strLink
          strGeciciMesaj = Replace(strGeciciMesaj, "[URL]", "", 1, -1, 1)
          strGeciciMesaj = Replace(strGeciciMesaj, "[/URL]", "", 1, -1, 1)          
          strGeciciMesaj = "<a href=""" & strGeciciMesaj & """ target=""_blank"">" & strGeciciMesaj & "</a>"
          strMesaj = Replace(strMesaj, strLink, strGeciciMesaj, 1, -1, 1)
     Loop


     Do While inStr(strMesaj, "[QUOTE=") > 0 And inStr(strMesaj, "[/QUOTE]") > 0

          DeyimBaslangici = inStr(1, strMesaj, "[QUOTE=", 1) + 7
          DeyimSonu = inStr(DeyimBaslangici, strMesaj, "]", 1)

          If DeyimBaslangici > 6 And DeyimSonu > 0 Then
               strYazan = trim(Mid(strMesaj, DeyimBaslangici, DeyimSonu-DeyimBaslangici))
          End If

          DeyimBaslangici = DeyimBaslangici + Len(strYazan) + 1
          DeyimSonu = inStr(DeyimBaslangici, strMesaj, "[/QUOTE]", 1)

          If DeyimSonu - DeyimBaslangici =< 0 Then DeyimSonu = DeyimBaslangici + Len(strYazan)

          If DeyimSonu > DeyimBaslangici Then

               strAlintiMesaji = trim(Mid(strMesaj, DeyimBaslangici, DeyimSonu-DeyimBaslangici))

               strYazan = Replace(strYazan, """", "", 1, -1, 1)

               strAlinti = "<table width=""95%"" border=""0"" align=""center"" cellpadding=""0"" cellspacing=""0"">"
               strAlinti = strAlinti & vbCrLf & "<tr><td Class=""Text"">Alıntı Sahibi: <b>" & strYazan & "</b><br />"
               strAlinti = strAlinti & vbCrLf & "   <table width=""100%"" border=""0"" cellpadding=""1"" cellspacing=""0"" bgcolor=""#CCCCCC"">"
               strAlinti = strAlinti & vbCrLf & "    <tr>"
               strAlinti = strAlinti & vbCrLf & "    <td><table width=""100%"" border=""0"" cellpadding=""2"" cellspacing=""0"" bgcolor=""#EEEEEE"">"
               strAlinti = strAlinti & vbCrLf & "      <tr>"
               strAlinti = strAlinti & vbCrLf & "       <td Class=""Text"">" & strAlintiMesaji & "</td>"
               strAlinti = strAlinti & vbCrLf & "      </tr>"
               strAlinti = strAlinti & vbCrLf & "     </table></td>"
               strAlinti = strAlinti & vbCrLf & "   </tr>"
               strAlinti = strAlinti & vbCrLf & " </table></td>"
               strAlinti = strAlinti & vbCrLf & "</tr>"
               strAlinti = strAlinti & vbCrLf & "</table>"
          End If

          DeyimBaslangici = inStr(strMesaj, "[QUOTE=")
          DeyimSonu = inStr(DeyimBaslangici, strMesaj, "[/QUOTE]") + 8

          If DeyimSonu - DeyimBaslangici =< 7 Then DeyimSonu = DeyimBaslangici + Len(strYazan) + 8

          strAsilMesaj = trim(Mid(strMesaj, DeyimBaslangici, DeyimSonu-DeyimBaslangici))

          If strAlinti <> "" Then
               strMesaj = Replace(strMesaj, strAsilMesaj, strAlinti, 1, -1, 1)
          Else
               strMesaj = Replace(strMesaj, strAsilMesaj, Replace(strAsilMesaj, "[", "&#91;", 1, -1, 1), 1, -1, 1)
          End If
     Loop


     Do While inStr(strMesaj, "[QUOTE]") > 0 And inStr(strMesaj, "[/QUOTE]") > 0

          DeyimBaslangici = inStr(strMesaj, "[QUOTE]") + 7
          DeyimSonu = inStr(DeyimBaslangici, strMesaj, "[/QUOTE]", 1)

          If DeyimSonu < DeyimBaslangici Then DeyimSonu = DeyimBaslangici + 7

          If DeyimSonu > DeyimBaslangici Then

               strAlintiMesaji = trim(Mid(strMesaj, DeyimBaslangici, DeyimSonu-DeyimBaslangici))

               strAlinti = "<table width=""95%"" border=""0"" align=""center"" cellpadding=""0"" cellspacing=""0"">"
               strAlinti = strAlinti & vbCrLf & "<tr><td Class=""bold"">Alıntı: <br>"
               strAlinti = strAlinti & vbCrLf & "   <table width=""100%"" border=""0"" cellpadding=""1"" cellspacing=""0"" bgcolor=""#CCCCCC"">"
               strAlinti = strAlinti & vbCrLf & "    <tr>"
               strAlinti = strAlinti & vbCrLf & "    <td><table width=""100%"" border=""0"" cellpadding=""2"" cellspacing=""0"" bgcolor=""#EEEEEE"">"
               strAlinti = strAlinti & vbCrLf & "      <tr>"
               strAlinti = strAlinti & vbCrLf & "       <td Class=""Text"">" & strAlintiMesaji & "</td>"
               strAlinti = strAlinti & vbCrLf & "      </tr>"
               strAlinti = strAlinti & vbCrLf & "     </table></td>"
               strAlinti = strAlinti & vbCrLf & "   </tr>"
               strAlinti = strAlinti & vbCrLf & " </table></td>"
               strAlinti = strAlinti & vbCrLf & "</tr>"
               strAlinti = strAlinti & vbCrLf & "</table>"
          End If

          DeyimBaslangici = inStr(strMesaj, "[QUOTE]")
          DeyimSonu = inStr(DeyimBaslangici, strMesaj, "[/QUOTE]", 1) + 8

          If DeyimSonu < DeyimBaslangici Then DeyimSonu = DeyimBaslangici + 7

          strAsilMesaj = trim(Mid(strMesaj, DeyimBaslangici, DeyimSonu-DeyimBaslangici))

          If strAlinti <> "" Then
               strMesaj = Replace(strMesaj, strAsilMesaj, strAlinti, 1, -1, 1)
          Else
               strMesaj = Replace(strMesaj, strAsilMesaj, Replace(strAsilMesaj, "[", "&#91;", 1, -1, 1), 1, -1, 1)
          End If
     Loop

     MesajFormatla = strMesaj

End Function
%>
 
 

Forum Kodları Fonksiyonu için yazılan yorumlar

Oguzhan  { 26 Haziran 2010 }
ARKADAŞLAR BEN HTML KODLARI İLE BİR FORUM YAPMAK İSTİYORUM KODLARI KOYARMISINIZ ...

musa   { 18 Ocak 2010 }
salam

cem   { 20 Temmuz 2007 }
ben de şöyle bir fonksiyon yazdım. yardımcı olabilir.
'Tüm hakları cmg.web'e aittir.
'İstediğiniz gibi kullanabilirsiniz.
'cmg.web@gmail.com
'kod olarak verilen metni html olarak bicimlendirir
Function cHtml(strInput)
Dim strTemp
strTemp = strInput
strTemp = Replace(strTemp, "<", "")
strTemp = Replace(strTemp, ">", "")
strTemp = Replace(strTemp, vbCrLf, "<BR>" & vbCrLf)
strTemp = Replace(strTemp, "[B]", "<b>")
strTemp = Replace(strTemp, "[/B]", "</b>")
strTemp = Replace(strTemp, "[I]", "<i>")
strTemp = Replace(strTemp, "[/I]", "</i>")
strTemp = Replace(strTemp, "[U]", "<u>")
strTemp = Replace(strTemp, "[/U]", "</u>")
strTemp = Replace(strTemp, "[COLOR=", "<font color=")
strTemp = Replace(strTemp, "[/COLOR]", "</font>")
strTemp = Replace(strTemp, "[URL=", "<a target=_blank href=")
strTemp = Replace(strTemp, "[/URL]", "</a>")
strTemp = Replace(strTemp, "]", ">")
cHtml = strTemp
End Function

'veritabanindan gelen veriyi koda cevirir
Function cCode(strInput)
Dim strTemp
strTemp = strInput
strTemp = Replace(strTemp, "<BR>" & vbCrLf, vbCrLf)
strTemp = Replace(strTemp, "<b>", "[B]")
strTemp = Replace(strTemp, "</b>", "[/B]")
strTemp = Replace(strTemp, "<i>", "[I]")
strTemp = Replace(strTemp, "</i>", "[/I]")
strTemp = Replace(strTemp, "<u>", "[U]")
strTemp = Replace(strTemp, "</u>", "[/U]")
strTemp = Replace(strTemp, "<font color=", "<COLOR=")
strTemp = Replace(strTemp, "</font>", "[/COLOR")
strTemp = Replace(strTemp, "<a target=_blank href=", "[URL=")
strTemp = Replace(strTemp, "</a>", "[/URL]")
strTemp = Replace(strTemp, ">", "]")
cCode = strTemp
End Function

Yorum ekleyin

Anasayfa > Asp > Kodlar > Forum Kodları Fonksiyonu
Kategoriler:


Forum:



Bağlantılar:



    En Son Yorumlanan İçerikler:


    Murat Yavuz | Site Haritası | Gizlilik Bildirimi | 54.82.79.137 | 0,16 Saniye
    © Copyright 2004-2018 MyDesign | Kod Arşivi. Tüm Hakları Saklıdır.
    MyDesign | Kod Arşivi, en iyi görünüm için, 1024x768 ve üzeri çözünürlük tavsiye eder.