<% Dim types:types = request.queryString("types") Dim objCom Dim gid Dim managerID Dim returnedValue Dim usePMtoSend Dim responseStr, responseType Dim groupname Dim sendUseLink SELECT CASE types CASE "showgroupinfo" Dim mem:mem = Clng(request.querystring("mem")) Dim arrGroups,i set objRS = Server.CreateObject("adodb.recordset") with objRS .open dbOwnerPrefix&"spShowGroupMemberInfo ("&mem&","&memID&")", datastore, , ,adCmdStoredProc if not (.eof or .bof) then arrGroups = .getrows .close end with set objRS = nothing Dim yesgif,nogif yesgif = "" nogif = "" %> <%= Application(dbName&"forumtitle") %> <%= OutputCSS() %> >
> <% if isArray(arrGroups) then %> <% for i=0 to ubound (arrGroups,2) %> > <% next %> <% Else %> > <% End If %>
<%= memGroupInfo %>
<%= memGroupNameDesc %> <%= memGroupManagerDesc %>
<%= HTMLEncode(""&arrGroups(0,i)) %> <%= iff(arrGroups(2,i)=1,yesgif,nogif)%>
<%= memNotInAnyGroup %>

<%= javascriptCloseWindow %>
<% response.end CASE "joingroup","rejoin" gid = request.querystring("gid") Set objCom = server.createobject("adodb.command") with objCom .activeconnection = datastore '.commandTimeout = 200 .commandText = dbOwnerPrefix&"spJoinGroup" .commandType = adCmdStoredProc .Parameters.Append .Createparameter("@RETURN_VALUE", adInteger, adParamReturnValue, 0) .Parameters.Append .Createparameter("@gid", adSmallInt, adParamInput, 0, Clng(gid)) .Parameters.Append .Createparameter("@memID", adInteger, adParamInput, 0, memID) .Parameters.Append .Createparameter("@managerID", adInteger, adParamOutput, 0) .Parameters.Append .Createparameter("@usePMtoSend", adUnsignedTinyInt, adParamOutput, 0) .Parameters.Append .Createparameter("@groupname", adVarchar, adParamOutput, 150) .execute , , adExecuteNoRecords usePMtoSend = .parameters("@usePMtoSend") managerID = .parameters("@managerID") groupname = .parameters("@groupname") returnedValue = .parameters("@RETURN_VALUE") '-1 already joined, -2 application not enabled end with Set objCom = nothing if returnedValue = -2 then responseStr = memGroupJoinDenied responseType = 0 elseif returnedValue = -3 then responseStr = memGroupJoinAlreadyMember responseType = 0 else responseStr = memGroupJoinSuccess responseType = 1 end if if types = "rejoin" and returnedValue = -1 then responseStr = memGroupJoinPending responseType = 1 end if sendUseLink = iff(usePMtoSend=1,_ "pmsend.asp?tomemid="&managerID&"&do="&types&"&gid="&gid&"&groupname="&Server.URLEncode(""&groupname),_ "email.asp?memid="&managerID&"&subject="&Server.URLEncode(""&memGroupJoinSubject))&"&body="&Server.URLEncode(""&groupname&":"&vbcrlf&forumdir&"memberlist.asp?view=group&gid="&gid) CASE "disapprove","approve" Dim objcon,strSQL, gMemID:gMemID = Clng(request.querystring("memid")) Dim canApprove gid = Clng(request.querystring("gid")) Dim objRs set objRS = server.createobject("adodb.recordset") with objRS .CacheSize = 150 .open "SELECT GManager FROM pgd_usergroup WHERE gid="&gid, datastore, , , adCmdText If not (.EOF or .BOF) then GManager = objRS(0) End if .close end with set objRS=nothing if isBMan or isUMan or GManager&"" = memID then canApprove = true else canApprove = false if canApprove then strSQL = iff(types="approve",dbOwnerPrefix&"spAddUserToGroup ("&gid&","&gMemID&",'',0)",_ "SELECT allowShortMsg+acceptShortMsg FROM pgd_members WHERE mem = "&gMemID&" DELETE pgd_pendingmember WHERE GID="&gid&" AND Mem="&gMemID) set objcon = server.createobject("adodb.connection") with objcon .open datastore if types = "approve" then .execute strSQL, , adCmdStoredProc+adExecuteNoRecords else Set objRs = .execute (strSQL) usePMtoSend = iff((objRS(0).value=2 or isAdmin) and Application(dbName&"maxShortMsg")>0,1,0) if objRS.state<>adStateClosed then objRS.close Set objRS=nothing end if .close end with set objcon = nothing else response.redirect (forumdir&"redirect.asp") response.end end if if types = "approve" then responseStr = memGroupApproveSuccess responseType = 0 call SendGroupWelcome (gMemID,gid,"") else responseStr = memGroupDisapproveSuccess responseType = 1 end if Application.lock Application(dbName&"updatePMcache") = 1 ' cache needs updating Application.unlock if gid <= 0 then updateAdmin() sendUseLink = iff(usePMtoSend=1,_ "pmsend.asp?tomemid="&gMemID&"&do="&types&"&gid="&gid,_ "email.asp?memid="&gMemID&"&subject="&Server.URLEncode(""&memGroupDisapproveSubject)) CASE "editgroup" Dim Gname, Gdesc, Gtype, GManager, enablewelcome, welcomeMsg, enableApplication if request.form<>"" then if not (isBMan or isUMan or memID=request.form("GManager")) then response.redirect (forumdir&"redirect.asp") response.end end if if not fromThisDomain("memberlistpro.asp?types=editgroup") 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 Dim apply:apply = request.form("apply") Set objCom = server.createobject("adodb.command") with objCom .activeconnection = datastore '.commandTimeout = 200 .commandText = dbOwnerPrefix&"spSetGroupDef" .commandType = adCmdStoredProc .Parameters.Append .Createparameter("@RETURN_VALUE", adInteger, adParamReturnValue, 0 ) .Parameters.Append .Createparameter("@GName", adVarChar, adParamInput, 50, left(""&request.form("Gname"),50)) .Parameters.Append .Createparameter("@GDesc", adVarChar, adParamInput, 500, left(""&request.form("GDesc"),500)) .Parameters.Append .Createparameter("@GType", adSmallInt, adParamInput, 0, request.form("GType")) .Parameters.Append .Createparameter("@GManager", adVarChar, adParamInput, 20, request.form("GManager")) .Parameters.Append .Createparameter("@enableWelcome", adUnsignedTinyInt, adParamInput, 0, CheckedOrNot(request.form("enableWelcome"))) .Parameters.Append .Createparameter("@WelcomeMsg", adVarChar, adParamInput, 2147483647, request.form("WelcomeMsg")) .Parameters.Append .Createparameter("@enableApplication", adUnsignedTinyInt, adParamInput,0, CheckedOrNot(request.form("enableApplication"))) .Parameters.Append .Createparameter("@GID", adSmallInt, adParamInput, 0, request.form("GID")) .execute , , adExecuteNoRecords if .Parameters("@RETURN_VALUE") = -1 then response.redirect("memberlistpro.asp?types=editgroup&gid="&request.form("GID")&"&error=duplicate") end if end with Set objCom = nothing if ucase(apply) = ucase("apply") then response.redirect("memberlistpro.asp?types=editgroup&gid="&request.form("GID")) else response.write("") end if else gid = Clng(request.querystring("gid")) Dim grouperrordesc:grouperrordesc = request.querystring("error") set objRS = server.createobject("adodb.recordset") with objRS .open dbOwnerPrefix&"spGetGroupProperty("&memID&","&gid&")", datastore, , , adcmdStoredProc 'adCmdText If .state <> adStateClosed then If not (.EOF or .BOF) then 'Gname, Gdesc, Gtype, GManager, enablewelcome, welcomeMsg, enableApplication GName = .fields(0) GDesc = .fields(1) Gtype = .fields(2)' GManager = .fields(3)' enableWelcome = .fields(4) welcomemsg = .fields(5) enableApplication = .fields(6) End if End If if .state <> adStateClosed then .close end with set objRS=nothing if not (isBMan or isUMan or memID=""&GManager) then response.redirect (forumdir&"redirect.asp") response.end end if %> <%= Application(dbName&"forumtitle") %> <%= OutputCSS() %> style="margin:0px 0px 0px 0px">
<%= memGroupEditGroup %>
nowrap valign="top"><%= memGroupNameDesc %>   > <% if len(grouperrordesc)<>0 then response.write (""&memGroupEditError&"
") %> " maxLength="50"> *
nowrap valign="top"><%= memGroupDescDesc %>   >
(Max. 500 char)
nowrap valign="top"><%= memGroupWelcomeMsg %>  

#name#
#groupName#
#groupLocation#
#forumtitle#
#forumdir#
#today#
align="top"> > <%= memGroupWelcomeEnable %>
nowrap valign="top"><%= memGroupAllowApplication %>
(<%= memGroupDesc(3) %> & <%= memGroupDesc(2) %> )  
> >
align="center">
<% end if response.end END SELECT %> <%= Application(dbName&"forumtitle") %>