<% Dim objRS, sig, bodyquote, PMID, threadID Dim rights,allforum, emnotify, PGDCode, forumID Dim r_do, appid, subject, arrReply, emailview, allowupload, isPostAllowed Dim oriMsgIcon, alwaysSig, toMem, toMemID, body, maxShortMsg, sendto, stored Dim withsig, msgIcons, objCon, objCom, upfile,PMAlwaysSave Dim reportToModerators, reportToAdmins, modIds, adminIds isPostAllowed = true maxShortMsg = Application(dbName&"maxShortMsg") if maxShortMsg = 0 then isPostAllowed = false if isGuest then isPostAllowed = false if request.form<>"" then if not fromThisDomain("pmsend.asp?") then response.redirect (forumdir&"first.asp?error=referer") response.end end if if request.form("jsenabled")="false" then response.redirect (forumdir&"first.asp") response.end end if subject = trim(request.form("subject")) body = trim(request.form("body")) if request.form("postingaction") = "report" then reportToModerators = request.form("reportToModerators") reportToAdmins = request.form("reportToAdmins") modIds = request.form("modIds") adminIds = request.form("adminIds") if reportToModerators = "on" then sendto = modIds if reportToAdmins = "on" then sendto = sendto & adminIds sendto = CheckDelimitedFormat(sendto,",") if sendto = "" then sendto = "0" set objRS = server.createobject("adodb.recordset") With objRS .open "SELECT Login FROM pgd_members WHERE Mem in ("&sendto&")", datastore, , , adCmdText if not (.eof and .bof) then toMem = .getString(adClipString,,"",",","") .close End With set objRS = nothing sendto = CheckDelimitedFormat(toMem,",") else sendto = CheckDelimitedFormat(request.form("toMem"),",") end if ' response.write sendto ' response.end if len(subject) = 0 or len(body) = 0 or len(sendto)=0 then response.write (emptyTextBoxWarning & "
") response.write (""&javascriptBackDesc&"") response.end end if if isPostAllowed then subject = SQLin(subject) body = SQLin(body) stored = request.form("savecopy") withsig = request.form("withsig") msgIcons = request.form("msgIcons") upfile = request.form("upfile") if request.form("embed") = "on" then body=body&vbcrlf&vbcrlf&"[image]local://upfiles/"&memID&"/"&upfile&"[/image]" if stored = "on" then stored = 1 else stored = 0 if withSig = "on" then withSig = 1 else withSig = 0 if stored = 1 then response.cookies(dbName&"PMAlwaysSave") = 1 response.cookies(dbName&"PMAlwaysSave").Expires = date + 1000 else response.cookies(dbName&"PMAlwaysSave").Expires = date - 30 end if set objCon = server.createobject("adodb.connection") objCon.open datastore set objCom = server.createobject("adodb.command") With objCom .activeConnection = objCon .commandText = dbOwnerPrefix&"spPMSend" .commandType = adCmdStoredProc .Parameters.Append .Createparameter("@RETURN_VALUE", adInteger, adParamReturnValue, 0) .Parameters.Append .Createparameter("@PMID", adInteger, adParamOutput, 0) .Parameters.Append .Createparameter("@SenderID", adInteger, adParamInput, 0, memID) .Parameters.Append .Createparameter("@subject", adVarChar, adParamInput, 150, subject) .Parameters.Append .Createparameter("@body", adVarChar, adParamInput, 5000, body) .Parameters.Append .Createparameter("@stored", adUnsignedTinyInt, adParamInput, 0, stored) .Parameters.Append .Createparameter("@sentTo", adVarChar, adParamInput, 1000, sendto) .Parameters.Append .Createparameter("@datesent", adDBTimeStamp, adParamInput, 0, SQLNowDate()) .Parameters.Append .Createparameter("@msgIcon", adUnsignedTinyInt, adParamInput, 0, msgIcons) .Parameters.Append .Createparameter("@withsig", adUnsignedTinyInt, adParamInput, 0, withSig) .Parameters.Append .Createparameter("@upfile", adVarChar, adParamInput, 50, upfile) .execute , , adExecuteNoRecords Dim returned returned = .parameters("@RETURN_VALUE") PMID = .parameters("@PMID") End With set objCom = nothing if returned <> -1 then 'Sent Successfully, now receive.. Dim arrSentTos, iSentTo, ubArrSentTos, delEmails, PMreturnedValue, PMFinalMessage, PMSuccessEmail arrSentTos = Split(sendto,",") ubArrSentTos = ubound(arrSentTos) delEmails = "" for iSentTo = 0 to ubArrSentTos Set objCom = server.createobject("adodb.command") With objCom .activeConnection = objCon .commandText = dbOwnerPrefix&"spPMReceive" .commandType = adCmdStoredProc .Parameters.Append .Createparameter("@RETURN_VALUE", adInteger, adParamReturnValue, 0) .Parameters.Append .Createparameter("@PMID", adInteger, adParamInput, 0, PMID) .Parameters.Append .Createparameter("@recipient", adVarChar, adParamInput, 50, trim(arrSentTos(iSentTo))) .Parameters.Append .Createparameter("@senderID", adInteger, adParamInput, 0, MemID) .Parameters.Append .Createparameter("@maxiAllowed", adSmallInt, adParamInput, 0, maxShortMsg) .Parameters.Append .Createparameter("@email", adVarChar, adParamoutput, 50) .execute , , adExecuteNoRecords PMreturnedValue = .parameters("@RETURN_VALUE") PMSuccessEmail = .parameters("@email") End With set objCom = nothing Dim successPMPic:successPMPic = " " Dim failPMPic:failPMPic = " " SELECT Case PMreturnedValue' = 1 then delEmails = delEmails & .parameters("@email") & ";" Case 1 delEmails = delEmails & PMSuccessEmail & ";" PMFinalMessage = PMFinalMessage &""&successPMPic&""&pmSendingSuccess&trim(arrSentTos(iSentTo))&"" Case -1 PMFinalMessage = PMFinalMessage &""&failPMPic&""&pmSendingProblem&trim(arrSentTos(iSentTo))&pmError_1&"" Case -2 PMFinalMessage = PMFinalMessage &""&failPMPic&""&pmSendingProblem&trim(arrSentTos(iSentTo))&pmError_2&"" Case -3 PMFinalMessage = PMFinalMessage &""&failPMPic&""&pmSendingProblem&trim(arrSentTos(iSentTo))&pmError_3&"" END SELECT next ' response.write ("SendPMNotify("&memLogin&","&PMID&","&delEmails&")") Call SendPMNotify(memLogin,PMID,delEmails,subject,body) end if objCon.close Set objCon = nothing end if %> <%= Application(dbName&"forumtitle") %> <%= NoScript() %> <%= OutputCSS() %>

<%= PMFinalMessage %>


<% else toMemID = request.queryString("toMemID") toMem = request.queryString("toMem") r_do = request.queryString("do") allforum = Application(dbName&"foruminfo") PMID = request.queryString("PMID") PMAlwaysSave = request.cookies(dbName&"PMAlwaysSave") if PMID = "" then PMID = 0' new private message (not reply) if isPostAllowed then if r_do="reply" then set objRS = server.createobject("adodb.recordset") objRS.open dbOwnerPrefix&"spPMPreSend("& MemID &", "& PMID &")", datastore, , ,adCmdStoredProc if not (objRS.EOF and objRS.BOF) then' test if allowed to use private message sig = objRS(0).value alwaysSig = objRS(1).value set objRS = objRS.nextrecordset arrReply = objRS.getRows objRS.close else isPostAllowed = false end if set objRS = nothing if isPostAllowed then subject = SQLout(arrReply(0,0)) bodyquote = vbcrlf & "[quote]" & quotePrefix & " " & HTMLEncode(""&toMem) & vbcrlf & vbcrlf & SQLout(arrReply(1,0)) & vbcrlf &"[/quote]"& vbcrlf end if elseif r_do="event" then Dim EventSubject set objRS = server.createobject("adodb.recordset") with objRS .CacheSize = 150 .open "SELECT subject FROM pgd_events WHERE eventID="&request.queryString("eventID"), datastore, , , adCmdText If not (.EOF or .BOF) then EventSubject = SQLOut(.fields(0)) End if .close end with set objRS=nothing else set objRS = server.createobject("adodb.recordset") objRS.open dbOwnerPrefix&"spPMPreSend("& MemID &", "& PMID &")", datastore, , ,adCmdStoredProc if not (objRS.EOF and objRS.BOF) then sig = objRS(0).value alwaysSig = objRS(1).value else isPostAllowed = false end if objRS.close set objRS = nothing ' if r_do="report" then toMemID = "0,"&Application(dbName&"foruminfo")(11,request.queryString("appid")) end if End if if isPostAllowed then if not (isnull(sig) or sig="") then sig = SQLout(sig) end if if isPostAllowed and toMemID<>"" and toMem = "" and r_do <> "report" then 'response.write "yes" toMemID = CheckDelimitedFormat(toMemID,",") set objRS = server.createobject("adodb.recordset") With objRS .open "SELECT Login FROM pgd_members WHERE Mem in ("&toMemID&")", datastore, , , adCmdText if not (.eof and .bof) then toMem = .getString(adClipString,,"",",","") .close End With set objRS = nothing toMem = CheckDelimitedFormat(toMem,",") end if if trim(toMem)<>"" then toMem = toMem&"," allowUpload = Application(dbName&"enablePMUpload") Dim key, language %> <%= Application(dbName&"forumtitle") %> <%= NoScript() %> <%= OutputCSS() %> <% Dim onload %> <% if isPostAllowed then if r_do="reply" then onload = "onload=""document.forms[0].body.focus(); " else onload = "onload=""document.forms[0].subject.focus(); " end if onload = onload & "if (opener.document.selectedText && opener.document.selectedText.selectedText.value!=''){document.forms[0].body.value += '[quote]'+opener.document.selectedText.selectedText.value+'[/quote]'};""" end if %> <%= tablealt %> <%= Application(dbName&"bodyoption") %> style="margin:0px 0px 0px 0px">
<% if isPostAllowed then %> <% else %> <% end if %>
<% if r_do = "report" then response.write(tmReportDesc) else response.write(memListPM)%>
valign="top" class="c2"><%= tmName %> <%=( memLogin ) %>   <% if not isGuest then %> > <%= signatureDesc %> <% end if %>
valign="top" class="c2"><%= PMSendTo %> > <% if r_do="report" then %> <%= AbuseToMod %> <%= AbuseToAdmin %> <% else %> <% end if %>
class="c2" valign="top"> <%= tmSubject %> > value="<%= replySubjectPre(subject) %>" <% elseif r_do="event" then %> value="<%= EventSubject %>" <% elseif r_do="rejoin" or r_do="joingroup" then %> value="<%= memGroupJoinSubject %>" <% elseif r_do="disapprove" then %> value="<%= memGroupDisapproveSubject %>" <% elseif r_do="report" then %> value="<%= tmReportDesc %>: (<%= request.queryString("messageID") %>)" <% end if %> tabindex="0">
<% call pgdMsgIcons %>
class="c2">

<%= bodyFieldDesc %>

<% call pgdSmiley%>
> <% call pgdCodes%> <% if r_do="reply" then %>    <% end if %>
<% Dim bodyTextArea:bodyTextArea = "" if r_do="report" then bodyTextArea = forumdir&"fb.asp?m="&request.queryString("messageID") elseif r_do = "event" then bodyTextArea = forumdir&"calendar.asp?eventid="&request.queryString("eventID") elseif r_do="rejoin" or r_do="joingroup" then bodyTextArea = request.querystring("groupname")&":" bodyTextArea = bodyTextArea&vbcrlf&forumdir&"memberlist.asp?view=group&gid="&request.queryString("gid") end if response.write(pgdBodyArea(bodyTextArea,"14")) %>
(<%= forumMax %> 4900 char.)
class="c2"><%= uploadFieldDesc %> > <% if lcase(Application(dbName&"upload"))<>"noupload" and allowUpload=1 then%> <%= uploadLinkDesc %>    <%= embedPicDesc %> <% end if %>
class="c2">  > > <%= PMSaveCopy %>
colspan="2" align="center" class="subhead"><%= RightViolationMessage %>

<% if isPostAllowed then %> "> "> <% end if %>

<% call pgdResize(350,"body") %> <% end if %>