<%= OutputCSS() %> <% dim objRS, arrGrp, action, disHead, disTitle, objCom, i action = lcase(request.queryString("actions")) if action = "" then action = "usergroups" SELECT Case action Case "addusergroup" disTitle = "Add User Group" Case "viewusergroup" disTitle = "View Users in Group" Case "deleteusergroup" disTitle = "Delete User Group" Case "viewgroupdefinition" disTitle = "Group Definition" Case else disTitle = "User Groups" End SELECT disHead = _ "
"&disTitle&" :       "&_ "

" SELECT Case action '================== Case "addusergroup" '================== response.write (disHead) if request.queryString("GroupName")="" then %>
Group Name :
>
*Maximum 50 characters


<% else Dim newID set objCom = server.createobject("adodb.command") With objCom .activeConnection = datastore .commandText = dbOwnerPrefix&"spUserGroupPro" .commandType = adCmdStoredProc .Parameters.Append .Createparameter("@RETURN_VALUE", adInteger, adParamReturnValue, 0) .Parameters.Append .Createparameter("@id", adInteger, adParamInput, 0, 0) .Parameters.Append .Createparameter("@groupName", adVarChar, adParamInput, 50, left(""&request.queryString("GroupName"),50)) .Parameters.Append .Createparameter("@action", adInteger, adParamInput, 0, 1) .execute , , adExecuteNoRecords newID = .Parameters("@RETURN_VALUE") End With set objCom = nothing if newID = -1 then response.write ("There is a duplicate Group Name, please try again.

") response.write ("") else response.redirect("admin_usergroup.asp?actions=viewgroupdefinition&gid="&newID) end if end if '================== Case "sync" '================== Dim customTitle:customTitle = request.queryString("customTitle") GID = request.queryString("gid") set objCon = server.createobject("adodb.connection") With objCon .open datastore .execute "UPDATE pgd_Members Set customTitle = '"&SQLAccessInput(customTitle)&"' WHERE Mem in (SELECT Mem FROM pgd_GroupMember WHERE GID = "&GID&")", , adCmdText+adExecuteNoRecords .close End With set objCon = nothing response.redirect ("admin_usergroup.asp?actions=viewusergroup&gid="&GID) '================== Case "viewusergroup" '================== response.write (disHead) dim arrGroupMember, GID, groupname, p, istart, iend, totalPages, rdcount, perpage, GmanagerMem,GmanagerLogin p = request.queryString("p") GID = request.queryString("gid") set objRS = server.createobject("adodb.recordset") With objRS .open dbOwnerPrefix&"spViewUserGroup ("&GID&")", datastore, , , adCmdStoredProc if not (.eof and .bof) then arrGroupMember = .getrows End With set objRS = objRS.nextRecordset groupname = objRS("Gname") objRS.close objRS.open "SELECT GManager,m.login FROM pgd_usergroup u inner join pgd_members m on m.mem=u.GManager where gid="&GID, datastore, , , adCmdText if not (objRS.eof and objRS.bof) then GmanagerMem = objRS(0) GmanagerLogin = objRS(1) end if objRS.close set objRS = nothing perpage = 50 if isArray(arrGroupMember) then rdcount = ubound(arrGroupMember,2)+1 if p = "" or not isNumeric(p) then p = 1 else p = cint(p) else p=0 end if if (rdcount mod perpage) <> 0 then totalPages = (rdcount\perpage)+1 else totalPages = (rdcount\perpage) istart = (p-1)*perpage if p*perpage-1>rdcount-1 then iend = rdcount-1 else iend = p*perpage-1 %>

     

   
Page <%= p %> of <%= totalpages %>
Page: <% for i = 1 to totalPages %> <%= i %> <% next %>
Group Manager: <%= GmanagerLogin %> (indicated by *)
&actions=userlookup&gid=<%= GID %>&lookupName='+escape(document.forms[1].lookupName.value))" value="Lookup" class="buttons" name="lookup">
> <% if isArray(arrGroupMember) then for i = istart to iend %> > <% next else%> > <%end if%>
Users in "<%= HTMLEncode(""&groupname) %>":
Member ID Login First Name Last Name E-mail
Remove Member from Group <%= arrGroupMember(0,i) %> <%= arrGroupMember(1,i) %> <% if CStr(GmanagerMem&"")= CStr(arrGroupMember(0,i)) then response.write ("*") %> <%= arrGroupMember(2,i) %> <%= arrGroupMember(3,i) %> <%= arrGroupMember(4,i) %>
There is no member in the list yet.
Page <%= p %> of <%= totalpages %>
Page: <% for i=1 to totalPages %> <%= i %> <% next %>



<% '==================== Case "setgroupmanager" '==================== gid = request.queryString("gid") mem = request.queryString("mem") SET objCon = server.createObject("ADODB.connection") with objCon .open datastore .execute "Update pgd_usergroup set GManager="&mem&" WHERE GID="&gid, , adExecuteNoRecords + adCmdtext 'adCmdStoredProc .close end with Set objCon = nothing %> <% response.end '==================== Case "addusertogroup" '==================== dim idchecked, arrChecked, objCon, strSQL idchecked=request("idcheck") gid= request.queryString("grouping1") arrChecked = split(idchecked,",") set objcon = server.createobject("adodb.connection") with objcon .open datastore for i = 0 to ubound(arrChecked) strSQL = dbOwnerPrefix&"spAddUserToGroup ("&gid&","&trim(arrChecked(i))&",'',0)" .execute strSQL, , adCmdStoredProc+adExecuteNoRecords next .close end with set objcon = nothing Application.lock Application(dbName&"updatePMcache") = 1 ' cache needs updating Application.unlock if cint(gid) <= 0 then updateAdmin() call SendGroupWelcome (idchecked,gid,"") response.redirect("admin_usergroup.asp?actions=viewusergroup&gid="&gid) '===================== Case "banuseringroup" '===================== set objCom = server.createobject("adodb.command") With objCom .activeConnection = datastore .commandText = dbOwnerPrefix&"spBanUserInGroup" .commandType = adCmdStoredProc .Parameters.Append .Createparameter("@id", adInteger, adParamInput, 0, request.queryString("gid")) .Parameters.Append .Createparameter("@id", adInteger, adParamInput, 0, request.queryString("do")) .execute , , adExecuteNoRecords End With set objCom = nothing response.redirect("admin_usergroup.asp?actions=viewusergroup&gid="&request.queryString("gid")) '===================== Case "userlookup" '===================== Dim lookupName:lookupName = trim(request.querystring("lookupName")&"") gid = request.querystring("gid") if len(lookupName) = 0 then %>
Member Lookup:
>
type the desired member name to search (% = wildcard).


">
<% else set objRS = server.createobject("adodb.recordset") with objRS .CacheSize = 150 .open _ "SELECT mem, login from pgd_members where (mem in (SELECT mem from pgd_groupmember where gid="&gid&_ ")) AND (login like '"&SQLAccessInput(lookupName)&"') order by login", datastore, , , adCmdText If not (.EOF or .BOF) then allData = .getrows End if .close end with set objRS=nothing if isArray(allData) then %>
Lookup Results :
> Please select the desired member from the drop down list.



<% if request.querystring("from")<>"viewgroupdefinition" then %>

<% End If %>


'">
<% else %>
Lookup Result:
> No member matches the search criteria OR
you don't currently have any member in the Group.


<% end if end if '===================== Case "deleteusergroup" '===================== set objCom = server.createobject("adodb.command") With objCom .activeConnection = datastore .commandText = dbOwnerPrefix&"spUserGroupPro" .commandType = adCmdStoredProc .Parameters.Append .Createparameter("@RETURN_VALUE", adInteger, adParamReturnValue, 0) .Parameters.Append .Createparameter("@id", adInteger, adParamInput, 0, request.queryString("gid")) .Parameters.Append .Createparameter("@groupName", adVarChar, adParamInput, 50, "any Name") .Parameters.Append .Createparameter("@action", adInteger, adParamInput, 0, 2) .execute , , adExecuteNoRecords End With set objCom = nothing Application.lock Application(dbName&"updatePMcache") = 1 ' cache needs updating Application.unlock response.redirect("admin_usergroup.asp") '========================= Case "deleteuserfromgroup" '========================= dim mem gid = request.queryString("gid") mem = request.queryString("mem") strSQL = " DELETE FROM pgd_GroupMember WHERE GID = "&gid&" AND mem = "&mem&_ " Update pgd_UserGroup Set GManager=null WHERE GID = "&gid&" AND GManager = "&mem set objcon = server.createobject("adodb.connection") with objcon .open datastore .execute strSQL, , adCmdText+adExecuteNoRecords .close end with set objcon = nothing Application.lock Application(dbName&"updatePMcache") = 1 ' cache needs updating Application.unlock if cint(gid) <= 0 then updateAdmin() response.redirect("admin_usergroup.asp?actions=viewusergroup&gid="&gid) '========================= Case "viewgroupdefinition" '========================= Dim allData, grouperrordesc grouperrordesc = request.querystring("error") gid = request.queryString("gid") strSQL = "SELECT Gname, Gdesc, Gtype, GManager, enablewelcome, welcomeMsg, enableApplication, m.login from pgd_usergroup p "&_ " left join pgd_members m on p.GManager = m.mem "&_ " WHERE GID="&gid set objRS = server.createobject("adodb.recordset") with objRS .CacheSize = 150 .open strSQL, datastore, , , adCmdText If not (.EOF or .BOF) then allData = .getrows End if .close end with set objRS=nothing response.write (disHead) %>
<% if gid <=0 then%> <% SELECT Case gid Case "0" response.write("Special group for all administrators") Case "-1" response.write("Special group for all User Account Managers") Case "-2" response.write("Special group for all Forum and Category Managers") END SELECT %> <% end if %>
Group Definition:
nowrap valign="top">Group Name   > <% if len(grouperrordesc)<>0 then response.write ("*Duplicate Group Name
") %> " maxLength="50"> *
nowrap valign="top">Group Description   >
(Max. 500 char)
nowrap valign="top">Group Type   >
nowrap valign="top">Group Manager   > " maxLength="50" readonly>
nowrap valign="top">Welcome Message   > > Enable Welcome Message?
nowrap valign="top">Allow membership application?
(public and private group only)   		> > Yes?


<% Case "setgroupdefinition" 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("admin_usergroup.asp?actions=viewgroupdefinition&gid="&request.form("GID")&"&error=duplicate") end if end with Set objCom = nothing if ucase(apply) = ucase("apply") then response.redirect("admin_usergroup.asp?actions=viewgroupdefinition&gid="&request.form("GID")) else response.redirect ("admin_usergroup.asp") end if '================== Case else '================== Dim GroupType:GroupType = 3 Dim GroupTypeDesc(3) GroupTypeDesc(3) = "Public Groups" GroupTypeDesc(2) = "Private Groups" GroupTypeDesc(1) = "Hidden Groups" set objRS = server.createobject("adodb.recordset") With objRS .open "Select U.GID, U.GName, "&_ "(SELECT Count(*) FROM pgd_GroupMember o WHERE o.GID=U.GID) as 'asCount',U.GDesc,U.GType "&_ " FROM pgd_UserGroup U ORDER BY U.Gtype DESC,U.GName" _ , datastore, , , adCmdText if not (.eof and .bof) then arrGrp = .getrows .close End With set objRS = nothing response.write (disHead) %>
<% if isArray(arrGrp) then %> <% for GroupType = 3 to 1 step -1 %> <% for i = 0 to ubound(arrGrp,2) if arrGrp(4,i) = GroupType then if not isBMan and arrGrp(0,i) <= 0 then response.write("") else %> > <% end if %> <% end if %> <% next %> <% next %> <% else %> > <% end if %>
User Groups:
><%= GroupTypeDesc(GroupType) %>
<%= HTMLEncode(""&arrGrp(1,i)) %> (<%= arrGrp(2,i) %>) <%= HTMLEncode(""&arrGrp(3,i)) %> <% if arrGrp(0,i) > 0 then %> <% else %> <% end if %>
There is no user groups currently.
= Default Admin Groups (can't delete) <% End SELECT %>