<%
Dim allowmail:allowmail = Application(dbName&"maildll")
%>
<%= Application(dbName&"forumtitle") %>
<%= OutputCSS() %>
>
<%
Dim mode, strSQL, FolderID, strSQL1, key, language
Dim objCon, objRS, objCom
if isGuest or Application(dbName&"maxShortMsg")=0 then
%>
<% call headerHTML() %>
<%= RightViolationMessage %>
<% call footerHTML() %>
<%
response.end
end if
mode = request.queryString("mode")
FolderID = request.queryString("FolderID")
SELECT Case lcase(mode)
Case "checkread"
PMID = request.queryString("PMID")
Dim arrAddresses, iAddress
strSQL = _
"SELECT isRead, p.login FROM pgd_PMreceive m with (nolock) INNER JOIN (SELECT mem, login FROM pgd_members with (nolock)) p ON p.mem = m.mem WHERE PMID="&Clng(PMID)
set objRS = server.createobject("adodb.recordset")
With objRS
.open strSQL, datastore, , , adCmdText
if not (.eof and .bof) then arrAddresses = .getrows
.close
End With
set objRS = nothing
%>
<%
Case "add" 'move pm around folders
Dim memberToAdd, grouping1
grouping1 = request("grouping1")
if grouping1<>"" then
set objCon = server.createobject("adodb.connection")
objCon.open datastore
for each memberToAdd in request.form("addtolist")
set objCom = server.createobject("adodb.command")
With objCom
.activeConnection = objCon
.commandText = dbOwnerPrefix&"spPMAdd"
.commandType = adCmdStoredProc
.Parameters.Append .Createparameter("@mem", adInteger, adParamInput, 0, memID)
.Parameters.Append .Createparameter("@contactID", adInteger, adParamInput, 0, memberToAdd)
.Parameters.Append .Createparameter("@inGroup", adSmallInt, adParamInput, 0, grouping1)
.execute , , adExecuteNoRecords
End With
set objCom = nothing
next
objCon.close
set objCon = nothing
end if
response.clear
response.redirect (request("http_referer"))
Case "delete"
dim grouping, allUpfiles
grouping = Clng(request.queryString("grouping")) 'special name assigned
set objCon = server.createobject("adodb.connection")
set objRS = server.createobject("adodb.recordset")
objCon.open datastore
if grouping=1 then
strSQL = "update pgd_PMsg SET stored=0 WHERE SenderID="&Clng(memID)&" AND "&_
" PMID in ("&CheckDelimitedFormat(request.form("addtolist"),",")&")"
else
strSQL = "delete from pgd_PMreceive WHERE mem = "&Clng(memID)&" AND infolder = "&Clng(grouping)&_
" AND PMID in ("&CheckDelimitedFormat(request.form("addtolist"),",")&") "
end if
' response.write(strSQL)
' response.end
objCon.execute strSQL, , adCmdText + adExecuteNoRecords
strSQL = "SELECT Cast(SenderID as Varchar)+'/'+upfile FROM pgd_PMsg with (nolock) WHERE stored = 0 AND PMID in (SELECT p.PMID FROM pgd_PMsg p with (nolock) LEFT JOIN pgd_PMreceive r with (nolock) ON p.PMID = r.PMID WHERE r.PMID IS NULL)"
set objRS = objCon.execute (strSQL, , adCmdText)
if not (objRS.EOF or objRS.BOF) then allUpfiles = objRS.getrows
strSQL = "delete FROM pgd_PMsg WHERE stored = 0 AND PMID in (SELECT p.PMID FROM pgd_PMsg p with (nolock) LEFT JOIN pgd_PMreceive r with (nolock) ON p.PMID = r.PMID WHERE r.PMID IS NULL)"
objCon.execute strSQL, , adCmdText + adExecuteNoRecords
objCon.close
set objCon = nothing
set objRS = nothing
if isArray(allUpfiles) then
Dim objFSO, ifile, deletefilepath
set objFSO = Server.CreateObject("Scripting.FileSystemObject")
with objFSO
for ifile = 0 to ubound(allUpfiles,2)
deletefilepath = Server.Mappath("upfiles/"&allUpfiles(0,ifile))
if .fileexists(deletefilepath) then .DeleteFile deletefilepath, true
next
end with
set objFSO = nothing
end if
response.clear
response.redirect ("pm.asp?FolderID="&grouping&"&groupName="&Server.URLEncode(request.queryString("groupName")))
Case "addgroup"
Dim addedGroup:addedGroup = trim(request.queryString("addedGroup"))
if addedGroup<>"" then
set objCom = server.createobject("adodb.command")
With objCom
.activeConnection = datastore
.commandText = dbOwnerPrefix&"spPMFolderpAdd"
.commandType = adCmdStoredProc
.Parameters.Append .Createparameter("@mem", adInteger, adParamInput, 0, memID)
.Parameters.Append .Createparameter("@GroupName", adVarChar, adParamInput, 50, addedGroup)
.execute , , adExecuteNoRecords
End With
set objCom = nothing
end if
response.clear
response.redirect ("pm.asp")
Case "editgroup"
if request.form="" then
%>
<%
else
groupName = trim(request.form("groupName"))
FolderID = request.form("FolderID")
if groupName<>"" then
strSQL = "Update pgd_PMFolder set FolderName='"&SQLAccessInput(left(""&groupName,50))&"' WHERE mem="&Clng(memID)&" AND FolderID="&Clng(FolderID)
set objCon = server.createobject("adodb.connection")
objCon.open datastore
objCon.execute strSQL, , adCmdText + adExecuteNoRecords
objCon.close
set objCon = nothing
response.write ("")
else
response.write ("")
end if
end if
Case "deletegroup"
strSQL = " delete from pgd_PMreceive WHERE mem="&Clng(memID)&" AND infolder = "&Clng(FolderID)&_
" delete from pgd_PMFolder WHERE mem="&Clng(memID)&" AND FolderID = "&Clng(FolderID)
set objCon = server.createobject("adodb.connection")
objCon.open datastore
objCon.execute strSQL, , adCmdText + adExecuteNoRecords
objCon.close
set objCon = nothing
response.clear
response.redirect ("pm.asp")
Case else
Dim arrGroups, iGroup, groupName, arrGroupMembers
groupName = request.queryString("groupName")
Dim m:m=request.queryString("m")
if m = "" then
if FolderID="" or isNull(FolderID) then
if groupName = PMInbox or groupName = "" then FolderID = 0
if groupName = PMSentbox then FolderID = 1
end if
SELECT Case cStr(FolderID)
Case "0"
groupName = PMInbox
Case "1"
groupName = PMSentbox
End Select
set objRS = server.createobject("adodb.recordset")
With objRS
.open dbOwnerPrefix&"spShowPM ("&memID&", '"&PMInbox&"', '"&PMSentbox&"', "&FolderID&")", datastore, , , adCmdStoredProc
if not (.eof and .bof) then arrGroups = .getrows
Set objRS = .nextRecordset
if not (objRS.eof and objRS.bof) then arrGroupMembers = objRS.getrows
objRS.close
end with
set objRS = nothing
else
if FolderID="" then FolderID = -1 'to check messages not in Sent Folder
set objRS = server.createobject("adodb.recordset")
objRS.open dbOwnerPrefix&"spShowPMsg ("&memID&", '"&PMInbox&"', '"&PMSentbox&"', "&m&", "&FolderID&")", datastore, , , adCmdStoredProc
if not (objRS.eof and objRS.bof) then arrGroups = objRS.getrows
Set objRS = objRS.nextRecordset
if not objRS Is nothing then
if not (objRS.eof and objRS.bof) then arrGroupMembers = objRS.getrows
objRS.close
Else
Response.redirect (forumdir)
Response.end
end if
if objRS.state <> adStateClosed then objRS.close
if not objRS Is nothing then set objRS = nothing
Dim PMID,SenderID,login,subject,body,sentTo,datesent,msgIcon,withsig,signature, upfile',groupName, FolderID
' 0 1 2 3 4 5 6 7 8 9 10
if isArray(arrGroupMembers) then
PMID = arrGroupMembers(0,0)
SenderID = arrGroupMembers(1,0)
login = arrGroupMembers(2,0)
subject = SQLout(arrGroupMembers(3,0))
body = SQLout(arrGroupMembers(4,0))
sentTo = arrGroupMembers(5,0)
datesent = arrGroupMembers(6,0)
msgIcon = arrGroupMembers(7,0)
withsig = arrGroupMembers(8,0)
signature = arrGroupMembers(9,0)
groupName = arrGroupMembers(10,0)
FolderID = arrGroupMembers(11,0)
upfile = arrGroupMembers(12,0)
end if
if FolderID="" or isNull(FolderID) then
if groupName = PMInbox or groupName = "" or isNull(groupName) then FolderID = 0
if groupName = PMSentbox then FolderID = 1
end if
if upfile<>"" then
upfile = ""&upfile&""
end if
SELECT Case cStr(FolderID)
Case "0"
groupName = PMInbox
Case "1"
groupName = PMSentbox
End Select
end if
set objRS = server.createobject("adodb.recordset")
objRS.open dbOwnerPrefix&"spOnlineBuddyList ("&memID&")", datastore, , , adCmdStoredProc
Dim arrOnlineBuddy
if not (objRS.eof or objRS.bof) then arrOnlineBuddy = objRS.getrows
objRS.close
Set objRS = nothing
%>
<% call headerHTML() %>
<%
Dim PMVolume:PMVolume = 0
for iGroup = 0 to ubound(arrGroups,2)
if not iGroup=1 then PMVolume = PMVolume + arrGroups(2,iGroup)
next
%>
<%
Dim PMVolumePercent:PMVolumePercent = 100*PMVolume/Application(dbName&"maxShortMsg")
if PMVolumePercent >= 90 then %>
>
<% if PMVolumePercent >= 90 and PMVolumePercent < 100 then %>
<%= pmFullPreWarnDesc %>
<% else %>
<%= pmFullWarnDesc %>
<% end If %>
