The Forum has been Updated
The code has been upgraded to the latest .NET core version. Please check instructions in the Community Announcements about migrating your account.
Although I was able to make Sonic's original version work (to a fashion), I could not get it to function embedded into another page, so I made a new one.
This version also has an anti-spam feature and permits the poster and/or admins to delete "shouts". It allows forum admins to set the maximum quantity of "shouts" to be displayed and number of seconds that the same member must wait between posting.
It's fairly easy to install, even easier to configure.
This version also has an anti-spam feature and permits the poster and/or admins to delete "shouts". It allows forum admins to set the maximum quantity of "shouts" to be displayed and number of seconds that the same member must wait between posting.
It's fairly easy to install, even easier to configure.
Postet den
I'd like to enable smilies (with click-able inset) in this, but haven't got the JavaScript working. Can anyone spot the issue?
Code:
<%
Response.Write "<script language=""Javascript"" type=""text/javascript"">" & vbNewLine & _
" <!-- hide" & vbNewLine & _
" function insertsmilie(smilieface) {" & vbNewLine & _
" if (window.opener.document.PostShout.Message.createTextRange && window.opener.document.PostShout.Message.caretPos) {" & vbNewLine & _
" var caretPos = window.opener.document.PostShout.Message.caretPos;" & vbNewLine & _
" caretPos.text = caretPos.text.charAt(caretPos.text.length - 1) == ' ' ? smilieface + ' ' : smilieface;" & vbNewLine & _
" } else {" & vbNewLine & _
" window.opener.document.PostShout.Message.value+=smilieface;" & vbNewLine & _
" }" & vbNewLine & _
" }" & vbNewLine & _
" // -->" & vbNewLine & _
"</script>" & vbNewLine & _
"<form name=""PostShout"" action=""default.asp"" method=""post"">" & vbNewLine & _
" <table height=""120px;"" align=""center"" width=""100%"" bgColor=""" & strAltForumCellColor & """ border=""1"" style=""border-collapse:collapse;"" cellpadding=""4"" cellspacing=""0"">" & vbNewLine & _
" <tr height=""120px;"">" & vbNewLine & _
" <th rowspan=""2"" valign=""bottom"" align=""absmiddle"" style=""width:12px; background:" & strCategoryCellColor & ";""><div style=""position:relative; top:-14px; max-width:10px; ms-transform:rotate(270deg); transform:rotate(270deg); webkit-transform:rotate(270deg);""><font size=""" & strHeaderFontSize & """ color=""" & strCategoryFontColor & """><b>Shoutbox</b></font></div></th>" & vbNewLine & _
" <td rowspan=""2"" width=""100px;"" align=""left"" nowrap><font face=""" & strDefaultFontFace & """ color=""" & strDefaultFontColor & """ size=""" & strDefaultFontSize & """>"
If strAllowForumCode = "1" Then
Response.Write "<a href=""JavaScript:openWindow6('pop_forum_code.asp')"" tabindex=""-1"">Forum Code</a> is ON<br />" & vbNewLine
Else
Response.Write "Forum Code is OFF<br />" & vbNewLine
End If
If strIcons = "1" And strShowSmiliesTable = "1" Then
%>
<!--#INCLUDE FILE="inc_smilies.asp" -->
<%
End If
Response.Write "</font></td>" & vbNewLine & _
" <td valign=""top"" align=""left"">" & vbNewLine & _
" <marquee width=""100%"" height=""100px;"" scrollamount=""2"" onmouseover=""this.stop();"" onmouseout=""this.start();"" direction=""up"">" & vbNewLine
strSql = "SELECT * FROM " & strTablePrefix & "SHOUTBOX ORDER BY S_DATE DESC"
Set rsSB=my_Conn.Execute(strSql)
If Not rsSB.EOF Then
rsSB.MoveFirst
Do While Not rsSB.EOF
If (rsSB("S_NAME") = strDBNTUserName) Or (mLev > 3) Then
Response.Write "<a href=""default.asp?shoutdel=" & rsSB("S_ID") &"""" & dWStatus("Delete") & "><acronym style=""border:none; text-decoration:none"" title=""Delete""><img src="""& strImageURL &"icon_trashcan.gif"" height=""9"" width=""9"" alt=""Delete"" style=""border:none; text-decoration:none;""></acronym></a> "
End If
Response.Write "<font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """><b>"
If strAuthType = "db" Then
strSqlN = "SELECT MEMBER_ID FROM " & strMemberTablePrefix & "MEMBERS WHERE M_NAME = '" & rsSB("S_NAME") & "'"
Set rsN=my_Conn.Execute(strSqlN)
If Not rsN.EOF Then
SBMID=rsN("MEMBER_ID")
If getMemberLevel(rsSB("S_NAME")) > 2 Then
Response.Write "<a style=""text-decoration:none; color:" & strAUAdminColor & ";"" href=""pop_profile.asp?mode=display&id=" & SBMID & """>" & rsSB("S_NAME") & "</font></a>"
ElseIf getMemberLevel(rsSB("S_NAME")) = 2 Then
Response.Write "<a style=""text-decoration:none; color:" & strAUModColor & ";"" href=""pop_profile.asp?mode=display&id=" & SBMID & """>" & rsSB("S_NAME") & "</font></a>"
Else
Response.Write "<a style=""text-decoration:none; color:" & strAUMemColor & ";"" href=""pop_profile.asp?mode=display&id=" & SBMID & """>" & rsSB("S_NAME") & "</font></a>"
End If
rsN.Close
Else
Response.Write rsSB("S_NAME")
End If
Set rsN = Nothing
Else
Response.Write rsSB("S_NAME")
End If
Response.Write "</b>:</font><font face=""garamond"" size=""" & strDefaultFontSize & """> "& FormatStr(rsSB("S_Message")) & "</font><br />"
rsSB.MoveNext
Loop
rsSB.Close
Else
Response.Write "No shout found. Be the first ...."
End If
Set rsSB = Nothing
Response.Write " </marquee>" & vbNewLine & _
" </td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" <tr valign=""middle"">" & vbNewLine & _
" <td align=""center"">" & vbNewLine & _
" <input type=""text"" id=""Message"" name=""Message"" style=""background:" & strForumCellColor & "; color:" & strForumFontColor & "; font-weight:bold; width:90%;"" value="""" onselect=""storeCaret(this);"" onclick=""storeCaret(this);"" onkeyup=""storeCaret(this);"" onchange=""storeCaret(this); />" & vbNewLine
' ## Smile Manager Plus Below
If intMod135 = "1" Then
Response.Write " <a style=""text-decoration:none;"" href=""JavaScript:openWindow3('pop_smiles_noclick.asp')""><img src=""" & strImageURL& "icon_smile.gif"" border=""0"" alt=""Smilies""></a>" & vbNewLine
End If
' ## Smile Manager Plus Above
Response.Write " <input style=""color:" & strHeadFontColor & "; font-weight:bold; padding:3px 6px 3px 6px; border:1px solid " & strTableBorderColor & "; text-shadow:0px 1px 1px #000; text-decoration:none; border-radius:25px; -webkit-border-radius:25px; background:" & strHeadCellColor & ";"" type=""Submit"" class=""button2"" name=""Submit"" value=""Submit"" />" & vbNewLine & _
" </td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" </table></div>" & vbNewLine & _
"</form>" & vbNewLine
%>
Postet den
not sure if this is it, but in your javascript you are referring to the following
window.opener.document.PostShout.Message
however the form PostShout and the textbox Message appear to be in the same page, so you probably don't require window.opener
window.opener.document.PostShout.Message
however the form PostShout and the textbox Message appear to be in the same page, so you probably don't require window.opener
Postet den
Tried removing it earlier, didn't help.
Postet den
what is actually calling the insertsmilie function? As nothing in that code appears to call it
Postet den
The links to the images within the "inc_smilies" page. I also tried replacing the include by inserting a table with them directly into the code (below), didn't help.
Code:
<%
Response.Write "<script language=""Javascript"" type=""text/javascript"">" & vbNewLine & _
" <!-- hide" & vbNewLine & _
" function insertsmilie(smilieface) {" & vbNewLine & _
" if (document.PostShout.Message.createTextRange && document.PostShout.Message.caretPos) {" & vbNewLine & _
" var caretPos = document.PostShout.Message.caretPos;" & vbNewLine & _
" caretPos.text = caretPos.text.charAt(caretPos.text.length - 1) == ' ' ? smilieface + ' ' : smilieface;" & vbNewLine & _
" } else {" & vbNewLine & _
" document.PostShout.Message.value+=smilieface;" & vbNewLine & _
" }" & vbNewLine & _
" }" & vbNewLine & _
" // -->" & vbNewLine & _
"</script>" & vbNewLine & _
"<form name=""PostShout"" action=""default.asp"" method=""post"">" & vbNewLine & _
" <table height=""120px;"" align=""center"" width=""100%"" bgColor=""" & strAltForumCellColor & """ border=""1"" style=""border-collapse:collapse;"" cellpadding=""4"" cellspacing=""0"">" & vbNewLine & _
" <tr height=""120px;"">" & vbNewLine & _
" <th rowspan=""2"" valign=""bottom"" align=""absmiddle"" style=""width:12px; background:" & strCategoryCellColor & ";""><div style=""position:relative; top:-14px; max-width:10px; ms-transform:rotate(270deg); transform:rotate(270deg); webkit-transform:rotate(270deg);""><font size=""" & strHeaderFontSize & """ color=""" & strCategoryFontColor & """><b>Shoutbox</b></font></div></th>" & vbNewLine & _
" <td rowspan=""2"" width=""100px;"" align=""left"" nowrap><font face=""" & strDefaultFontFace & """ color=""" & strDefaultFontColor & """ size=""" & strDefaultFontSize & """>"
If strAllowForumCode = "1" Then
Response.Write "<a href=""JavaScript:openWindow6('pop_forum_code.asp')"" tabindex=""-1"">Forum Code</a> is ON<br />" & vbNewLine
Else
Response.Write "Forum Code is OFF<br />" & vbNewLine
End If
If strIcons = "1" And strShowSmiliesTable = "1" Then
Response.Write " <table><tr align=""center"" valign=""middle"">" & vbNewLine & _
" <td><a href=""Javascript:insertsmilie('
')"" tabindex=""-1"">" & getCurrentIcon(strIconSmile,"Smile ","") & "</a></td>" & vbNewLine & _
" <td><a href=""Javascript:insertsmilie('
')"" tabindex=""-1"">" & getCurrentIcon(strIconSmileBig,"Big Smile ","") & "</a></td>" & vbNewLine & _
" <td><a href=""Javascript:insertsmilie('
')"" tabindex=""-1"">" & getCurrentIcon(strIconSmileCool,"Cool ","") & "</a></td>" & vbNewLine & _
" <td><a href=""Javascript:insertsmilie('
')"" tabindex=""-1"">" & getCurrentIcon(strIconSmileBlush,"Blush ","") & "</a></td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" <tr align=""center"" valign=""middle"">" & vbNewLine & _
" <td><a href=""Javascript:insertsmilie('
')"" tabindex=""-1"">" & getCurrentIcon(strIconSmileTongue,"Tongue ","") & "</a></td>" & vbNewLine & _
" <td><a href=""Javascript:insertsmilie('
')"" tabindex=""-1"">" & getCurrentIcon(strIconSmileEvil,"Evil [):]","") & "</a></td>" & vbNewLine & _
" <td><a href=""Javascript:insertsmilie('
')"" tabindex=""-1"">" & getCurrentIcon(strIconSmileWink,"Wink ","") & "</a></td>" & vbNewLine & _
" <td><a href=""Javascript:insertsmilie('
')"" tabindex=""-1"">" & getCurrentIcon(strIconSmileClown,"Clown ","") & "</a></td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" <tr align=""center"" valign=""middle"">" & vbNewLine & _
" <td><a href=""Javascript:insertsmilie('
')"" tabindex=""-1"">" & getCurrentIcon(strIconSmileBlackeye,"Black Eye ","") & "</a></td>" & vbNewLine & _
" <td><a href=""Javascript:insertsmilie('
')"" tabindex=""-1"">" & getCurrentIcon(strIconSmile8ball,"Eight Ball ","") & "</a></td>" & vbNewLine & _
" <td><a href=""Javascript:insertsmilie('
')"" tabindex=""-1"">" & getCurrentIcon(strIconSmileSad,"Frown ","") & "</a></td>" & vbNewLine & _
" <td><a href=""Javascript:insertsmilie('
')"" tabindex=""-1"">" & getCurrentIcon(strIconSmileShy,"Shy ","") & "</a></td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" <tr align=""center"" valign=""middle"">" & vbNewLine & _
" <td><a href=""Javascript:insertsmilie('
')"" tabindex=""-1"">" & getCurrentIcon(strIconSmileShock,"Shocked ","") & "</a></td>" & vbNewLine & _
" <td><a href=""Javascript:insertsmilie('
')"" tabindex=""-1"">" & getCurrentIcon(strIconSmileAngry,"Angry ","") & "</a></td>" & vbNewLine & _
" <td><a href=""Javascript:insertsmilie('
')"" tabindex=""-1"">" & getCurrentIcon(strIconSmileDead,"Dead ","") & "</a></td>" & vbNewLine & _
" <td><a href=""Javascript:insertsmilie('
')"" tabindex=""-1"">" & getCurrentIcon(strIconSmileSleepy,"Sleepy ","") & "</a></td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" <tr align=""center"" valign=""middle"">" & vbNewLine & _
" <td><a href=""Javascript:insertsmilie('
')"" tabindex=""-1"">" & getCurrentIcon(strIconSmileKisses,"Kisses ","") & "</a></td>" & vbNewLine & _
" <td><a href=""Javascript:insertsmilie('[^]')"" tabindex=""-1"">" & getCurrentIcon(strIconSmileApprove,"Approve [^]","") & "</a></td>" & vbNewLine & _
" <td><a href=""Javascript:insertsmilie('
')"" tabindex=""-1"">" & getCurrentIcon(strIconSmileDisapprove,"Disapprove ","") & "</a></td>" & vbNewLine & _
" <td><a href=""Javascript:insertsmilie('
')"" tabindex=""-1"">" & getCurrentIcon(strIconSmileQuestion,"Question ","") & "</a></td>" & vbNewLine & _
" </tr></table>" & vbNewLine
<%
End If
Response.Write "</font></td>" & vbNewLine & _
" <td valign=""top"" align=""left"">" & vbNewLine & _
" <marquee width=""100%"" height=""100px;"" scrollamount=""2"" onmouseover=""this.stop();"" onmouseout=""this.start();"" direction=""up"">" & vbNewLine
strSql = "SELECT * FROM " & strTablePrefix & "SHOUTBOX ORDER BY S_DATE DESC"
Set rsSB=my_Conn.Execute(strSql)
If Not rsSB.EOF Then
rsSB.MoveFirst
Do While Not rsSB.EOF
If (rsSB("S_NAME") = strDBNTUserName) Or (mLev > 3) Then
Response.Write "<a href=""default.asp?shoutdel=" & rsSB("S_ID") &"""" & dWStatus("Delete") & "><acronym style=""border:none; text-decoration:none"" title=""Delete""><img src="""& strImageURL &"icon_trashcan.gif"" height=""9"" width=""9"" alt=""Delete"" style=""border:none; text-decoration:none;""></acronym></a> "
End If
Response.Write "<font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """><b>"
If strAuthType = "db" Then
strSqlN = "SELECT MEMBER_ID FROM " & strMemberTablePrefix & "MEMBERS WHERE M_NAME = '" & rsSB("S_NAME") & "'"
Set rsN=my_Conn.Execute(strSqlN)
If Not rsN.EOF Then
SBMID=rsN("MEMBER_ID")
If getMemberLevel(rsSB("S_NAME")) > 2 Then
Response.Write "<a style=""text-decoration:none; color:" & strAUAdminColor & ";"" href=""pop_profile.asp?mode=display&id=" & SBMID & """>" & rsSB("S_NAME") & "</font></a>"
ElseIf getMemberLevel(rsSB("S_NAME")) = 2 Then
Response.Write "<a style=""text-decoration:none; color:" & strAUModColor & ";"" href=""pop_profile.asp?mode=display&id=" & SBMID & """>" & rsSB("S_NAME") & "</font></a>"
Else
Response.Write "<a style=""text-decoration:none; color:" & strAUMemColor & ";"" href=""pop_profile.asp?mode=display&id=" & SBMID & """>" & rsSB("S_NAME") & "</font></a>"
End If
rsN.Close
Else
Response.Write rsSB("S_NAME")
End If
Set rsN = Nothing
Else
Response.Write rsSB("S_NAME")
End If
Response.Write "</b>:</font><font face=""garamond"" size=""" & strDefaultFontSize & """> "& FormatStr(rsSB("S_Message")) & "</font><br />"
rsSB.MoveNext
Loop
rsSB.Close
Else
Response.Write "No shout found. Be the first ...."
End If
Set rsSB = Nothing
Response.Write " </marquee>" & vbNewLine & _
" </td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" <tr valign=""middle"">" & vbNewLine & _
" <td align=""center"">" & vbNewLine & _
" <input type=""text"" id=""Message"" name=""Message"" style=""background:" & strForumCellColor & "; color:" & strForumFontColor & "; font-weight:bold; width:90%;"" value="""" />" & vbNewLine
' ## Smile Manager Plus Below
If intMod135 = "1" Then
Response.Write " <a style=""text-decoration:none;"" href=""JavaScript:openWindow3('pop_smiles_noclick.asp')""><img src=""" & strImageURL& "icon_smile.gif"" border=""0"" alt=""Smilies""></a>" & vbNewLine
End If
' ## Smile Manager Plus Above
Response.Write " <input style=""color:" & strHeadFontColor & "; font-weight:bold; padding:3px 6px 3px 6px; border:1px solid " & strTableBorderColor & "; text-shadow:0px 1px 1px #000; text-decoration:none; border-radius:25px; -webkit-border-radius:25px; background:" & strHeadCellColor & ";"" type=""Submit"" class=""button2"" name=""Submit"" value=""Submit"" onselect=""storeCaret(this);"" onclick=""storeCaret(this);"" onkeyup=""storeCaret(this);"" onchange=""storeCaret(this); />" & vbNewLine & _
" </td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" </table></div>" & vbNewLine & _
"</form>" & vbNewLine
%>