MyDesign | Kod Arivi - Anasayfaya Dn   No banner in farm
Anasayfa Aratr Forum Gelimi Arama Siteniz in En Hit erikler RSS erik Ekle Scriptler Destekleyenler Kadromuz Reklam letiim Giri Sayfas Yap  Sk Kullanlanlara Ekle
Bu Kategorinin En Yeni Kodlar:


Bu Kategorinin En ok Grntlenen Kodlar:






Arama:
Gelimi Arama


No banner in farm



En ok Grntlenen Kodlar:


ye Girii:
 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
Gnderen : mYavuz
Telif :
Tarih : 04 Haziran 2005
rnek Dosya : �ndir
Okunma Says : 41090
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 iin yazlan 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:



Balantlar:



    En Son Yorumlanan erikler:


    Murat Yavuz | Site Haritas | Gizlilik Bildirimi | 34.201.121.213 | 0,12 Saniye
    © Copyright 2004-2019 MyDesign | Kod Arivi. Tm Haklar Sakldr.
    MyDesign | Kod Arivi, en iyi grnm iin, 1024x768 ve zeri znrlk tavsiye eder.