<%' GROUP utils 'This function takes the GROUP_ID to return a count of Contacts for all the groups seperatly Function GetContactCount(intGroupId) On Error Resume Next dim cmd set cmd = Server.CreateObject("ADODB.Command") set cmd.ActiveConnection = conn cmd.CommandText = "SP_GET_CONTACT_COUNT" cmd.CommandType = adCmdStoredProc cmd.Parameters.Append cmd.CreateParameter("PARENT_GROUP_COUNT", adInteger, adParamOutput) cmd.Parameters.Append cmd.CreateParameter("PARENT_ID", adInteger, adParamInput, , intGroupId) cmd.execute GetContactCount = cmd.Parameters("PARENT_GROUP_COUNT") 'if an error has occured report it If err.number <> 0 Then Call ReportError("GetContactCount", err.number, err.description) End If 'release cmd object from memory set cmd = nothing On Error Goto 0 End Function 'This function gets the number of contacts for the "All groups" group 'which is basically the total of contacts Function GetAllGroupsCount() On Error Resume Next dim cmd set cmd = Server.CreateObject("ADODB.Command") set cmd.ActiveConnection = conn cmd.CommandText = "SP_GET_CONTACT_COUNT_ALLGROUPS" cmd.CommandType = adCmdStoredProc cmd.Parameters.Append cmd.CreateParameter("GROUP_COUNT", adInteger, adParamOutput) cmd.execute GetAllGroupsCount = cmd.Parameters("GROUP_COUNT") 'if an error has occured report it If err.number <> 0 Then Call ReportError("GetAllGroupsCount", err.number, err.description) End If 'release cmd object from memory set cmd = nothing On Error Goto 0 End Function 'This function takes the GROUP_ID to return a count of Contacts for the given Group Function GetContactCountForOneGroup(intGroupId) On Error Resume Next dim cmd set cmd = Server.CreateObject("ADODB.Command") set cmd.ActiveConnection = conn cmd.CommandText = "SP_GET_CONTACT_COUNT_FOR_A_GROUP" cmd.CommandType = adCmdStoredProc cmd.Parameters.Append cmd.CreateParameter("GROUP_COUNT", adInteger, adParamOutput) cmd.Parameters.Append cmd.CreateParameter("GROUPLOOKUP_GROUP_ID", adInteger, adParamInput, , CInt(intGroupId)) cmd.execute GetContactCountForOneGroup = cmd.Parameters("GROUP_COUNT") 'if an error has occured report it If err.number <> 0 Then Call ReportError("GetContactCountForOneGroup", err.number, err.description) End If 'release cmd object from memory set cmd = nothing On Error Goto 0 End Function 'This function gets the group from the Group ID supplied Function GetGroups(intGroupID) On Error Resume Next dim cmd set cmd = Server.CreateObject("ADODB.Command") set cmd.ActiveConnection = conn cmd.CommandText = "SP_GET_GROUPS" cmd.CommandType = adCmdStoredProc cmd.Parameters.Append cmd.CreateParameter("GROUP_ID", adInteger, adParamInput, , intGroupID) set GetGroups = cmd.execute 'if an error has occured report it If err.number <> 0 Then Call ReportError("GetGroups", err.number, err.description) End If 'release cmd object from memory set cmd = nothing On Error Goto 0 End Function 'Gets all the groups and subgroups for groups.asp Function ManageGroups() dim cmd dim rsGroup1 dim rsGroup2 dim rsGroup3 dim strResponse dim bolHasChildren Dim bolIsAssociatedToDynamicForm set rsGroup1 = GetGroups(1) strResponse = ""& vbCRLF strResponse = strResponse & "" & vbCRLF strResponse = strResponse & "" & vbCRLF strResponse = strResponse & "" & vbCRLF 'include link to download contact list strResponse = strResponse & "" & vbCRLF strResponse = strResponse & "" & vbCRLF strResponse = strResponse & "" strResponse = strResponse & "" & vbCRLF strResponse = strResponse & "" & vbCRLF strResponse = strResponse & "" Do while not rsGroup1.EOF set rsGroup2 = GetGroups(rsGroup1("GROUP_ID")) 'Check if the Group has children, prevent the user from Deleting it 'without deleting the child group first if rsGroup2.EOF then bolHasChildren = 0 else bolHasChildren = 1 end if strResponse = strResponse & "" & vbCRLF strResponse = strResponse & "" & vbCRLF strResponse = strResponse & "" & vbCRLF strResponse = strResponse & "" & vbCRLF strResponse = strResponse & "" & vbCRLF strResponse = strResponse & "" & vbCRLF 'include link to download contact list strResponse = strResponse & "" & vbCRLF bolIsAssociatedToDynamicForm = Not(IsNull(GetGroupDynamicFormId(rsGroup1("GROUP_ID")))) 'if the group is not associated to a form then... If Not bolIsAssociatedToDynamicForm Then if bolHasChildren = 1 then strResponse = strResponse & "" & vbCRLF elseif Trim(LCase(rsGroup1("GROUP_NAME"))) = Lcase("Other") then strResponse = strResponse & "" & vbCRLF else strResponse = strResponse & "" & vbCRLF end if 'if the group is associated to a form then... Else if Trim(LCase(rsGroup1("GROUP_NAME"))) = Lcase("Other") then strResponse = strResponse & "" & vbCRLF else strResponse = strResponse & "" & vbCRLF end if 'if the group is not associated to a form then... End If strResponse = strResponse & "" & vbCRLF strResponse = strResponse & "" & vbCRLF Do while not rsGroup2.EOF strResponse = strResponse & "" & vbCRLF strResponse = strResponse & "" & vbCRLF strResponse = strResponse & "" & vbCRLF strResponse = strResponse & "" & vbCRLF strResponse = strResponse & "" & vbCRLF strResponse = strResponse & "" & vbCRLF strResponse = strResponse & "" & vbCRLF 'include link to download contact list strResponse = strResponse & "" & vbCRLF strResponse = strResponse & "" & vbCRLF strResponse = strResponse & "" & vbCRLF strResponse = strResponse & "" & vbCRLF strResponse = strResponse & "" & vbCRLF strResponse = strResponse & "" & vbCRLF strResponse = strResponse & "" & vbCRLF rsGroup2.MoveNext Loop rsGroup1.MoveNext Loop strResponse = strResponse & "

All Groups ("& GetContactCount(1) &" contacts)	Edit	Download Contact List using:    [ Word | Excel ]	Merge Groups
" &rsGroup1("GROUP_NAME")& " ("&GetContactCount(rsGroup1("GROUP_ID"))&" contacts)	Edit	Download Contact List using:    [ Word | Excel ]	Delete		Delete		Delete
	"& rsGroup2("GROUP_NAME")&" ("& GetCOntactCount(rsGroup2("GROUP_ID"))&" contacts)	Edit	Download Contact List using:    [ Word | Excel ]	Delete

" 'Write to the web page Response.write (strResponse) 'if an error has occured report it If err.number <> 0 Then Call ReportError("ManageGroups", err.number, err.description) End If 'release cmd object from memory rsGroup1.close set rsGroup1 = nothing set cmd = nothing On Error Goto 0 End Function 'Get all the available users for the "Add a new group" mode in the "Available contacts" select box 'Passed on to GetAllAvailableUsersOptions() Function GetAllAvailableUsers() On Error Resume Next dim cmd set cmd = Server.CreateObject("ADODB.Command") set cmd.ActiveConnection = conn cmd.CommandText = "SP_GET_ALL_SUBSCRIBERS" cmd.CommandType = adCmdStoredProc set GetAllAvailableUsers = cmd.execute 'if an error has occured report it If err.number <> 0 Then Call ReportError("GetAllAvailableUsers", err.number, err.description) End If 'release cmd object from memory set cmd = nothing On Error Goto 0 End Function 'Writes the user options for the "Add a new group" mode in the "Available contacts" select box Sub GetAllAvailableUsersOptions() On Error Resume Next dim cmd ' dim strAllAvailableOptions dim rsOptions set rsOptions = GetAllAvailableUsers() ' strAllAvailableOptions = "" If Not rsOptions.EOF Then 'loop through the rsOptions recordset and concatenate the option list string Do While Not rsOptions.Eof Response.Write "" & rsOptions("SUBSCRIBER_LAST_NAME") &", " & rsOptions("SUBSCRIBER_FIRST_NAME") & "" & vbCRLF rsOptions.MoveNext Loop End If 'if an error has occured report it If err.number <> 0 Then Call ReportError("GetAllAvailableUsersOptions", err.number, err.description) End If 'release the recordset from memory rsOptions.Close set rsOptions = Nothing 'return the option list string ' GetAllAvailableUsersOptions = strAllAvailableOptions On Error Goto 0 End Sub 'The DeleteGroup procedure takes the GROUP_ID and deletes the related group from the database. Sub DeleteGroup(intGroupToDeleteId) On Error Resume Next dim cmd set cmd = Server.CreateObject("ADODB.Command") set cmd.ActiveConnection = conn cmd.CommandText = "SP_DELETE_GROUP" cmd.CommandType = adCmdStoredProc cmd.Parameters.Append cmd.CreateParameter("GROUP_ID", adInteger, adParamInput, , CInt(intGroupToDeleteId)) cmd.execute 'if an error has occured report it If err.number <> 0 Then Call ReportError("DeleteGroup", err.number, err.description) End If 'release cmd object from memory set cmd = nothing On Error Goto 0 End Sub Function PopulateGroupEditForm(intGroupId) On Error Resume Next dim cmd dim GetEditGroups set cmd = Server.CreateObject("ADODB.Command") set cmd.ActiveConnection = conn cmd.CommandText = "SP_GET_EDITGROUPS" cmd.CommandType = adCmdStoredProc cmd.Parameters.Append cmd.CreateParameter("GROUP_ID", adInteger, adParamInput, , CInt(intGroupId)) set PopulateGroupEditForm = cmd.execute 'if an error has occured report it If err.number <> 0 Then Call ReportError("EditGroup", err.number, err.description) End If 'release cmd object from memory set cmd = nothing On Error Goto 0 End Function Function GetAllSelectedUsers(intGroupID) dim cmd set cmd = Server.CreateObject("ADODB.Command") set cmd.ActiveConnection = conn cmd.CommandText = "SP_GET_SUBSCRIBERS_SELECTEDGROUP" cmd.CommandType = adCmdStoredProc cmd.Parameters.Append cmd.CreateParameter("GROUP_ID", adInteger, adParamInput, , CInt(intGroupID)) set GetAllSelectedUsers = cmd.execute 'if an error has occured report it If err.number <> 0 Then Call ReportError("GetAllSelectedUsers", err.number, err.description) End If 'release cmd object from memory set cmd = nothing On Error Goto 0 End Function 'The GetAllSelectedUsers function takes the Group id and returns all selected Users as a recordset. Sub GetAllSelectedUsersOptions(intIDpassed) On Error Resume Next dim rsOptions ' dim strAllSelectedOptions set rsOptions = GetAllSelectedUsers(intIDpassed) ' strAllSelectedOptions = "" If Not rsOptions.EOF Then 'loop through the rsOptions recordset and concatenate the option list string Do While Not rsOptions.Eof Response.Write "" & rsOptions("SUBSCRIBER_LAST_NAME") &", " & rsOptions("SUBSCRIBER_FIRST_NAME") & "" & vbCRLF rsOptions.MoveNext Loop End If 'if an error has occured report it If err.number <> 0 Then Call ReportError("GetAllSelectedUsersOptions", err.number, err.description) End If 'release the recordset from memory rsOptions.Close set rsOptions = Nothing 'return the option list string ' GetAllSelectedUsersOptions = strAllSelectedOptions On Error Goto 0 End Sub 'The GetNonSelectedUsers function takes the Group id and returns all non selected Users as a recordset. Function GetNonSelectedUsers(intGroupId) On Error Resume Next dim intParentId intParentId = HasParent(intGroupId) dim cmd set cmd = Server.CreateObject("ADODB.Command") set cmd.ActiveConnection = conn cmd.CommandText = "SP_GET_SUBSCRIBERS_NONSELECTEDGROUP" cmd.CommandType = adCmdStoredProc cmd.Parameters.Append cmd.CreateParameter("GROUP_ID", adInteger, adParamInput, , CInt(intGroupId)) cmd.Parameters.Append cmd.CreateParameter("PARENT_ID", adInteger, adParamInput, , CInt(intParentId)) 'return the posting type recordset set GetNonSelectedUsers = cmd.execute 'if an error has occured report it If err.number <> 0 Then Call ReportError("GetNonSelectedUsers", err.number, err.description) End If 'release cmd object from memory set cmd = nothing On Error Goto 0 End Function 'The Function GetNonSelectedUsersOptions gets all the users that arent part of a give group Sub GetNonSelectedUsersOptions(intGroupId) On Error Resume Next dim rsOptions ' dim strNonSelectedOptions dim intIDpassed dim intTempID dim intNewID intIDpassed=intGroupId set rsOptions = GetNonSelectedUsers(intIDpassed) ' strNonSelectedOptions = "" 'Get all the users that arent part of a give group If Not rsOptions.Eof Then 'loop through the rsOptions recordset and concatenate the option list string Do While Not rsOptions.Eof 'intNewID = rsOptions("SUBSCRIBER_ID") Response.Write "" & rsOptions("SUBSCRIBER_LAST_NAME") &", " & rsOptions("SUBSCRIBER_FIRST_NAME") & "" & vbCRLF rsOptions.MoveNext Loop End If 'if an error has occured report it If err.number <> 0 Then Call ReportError("GetNonSelectedUsersOptions", err.number, err.description) End If 'release the recordset from memory rsOptions.Close set rsOptions = Nothing 'return the option list string ' GetNonSelectedUsersOptions = strNonSelectedOptions On Error Goto 0 End Sub 'The CheckIfUserInParentGroup checks to see if a user is already in a Parent Group as to not add him to a child group Function CheckIfUserInParentGroup(intGroupId, intSubscriberID) On error Resume Next dim cmd dim intParentId dim rsGetGroup dim intIsInGroup intParentId = HasParent(intGroupId) set cmd = Server.CreateObject("ADODB.Command") set cmd.ActiveConnection = conn cmd.CommandText = "SP_GET_IS_USER_IN_PARENT_GROUP" cmd.CommandType = adCmdStoredProc cmd.Parameters.Append cmd.CreateParameter("GROUPLOOKUP_GROUP_ID", adInteger, adParamInput, , intParentId) cmd.Parameters.Append cmd.CreateParameter("GROUPLOOKUP_SUBSCRIBER_ID", adInteger, adParamInput, , intSubscriberID) set rsGetGroup = cmd.Execute if not rsGetGroup.EOF then 'if the user is in a parent group intIsInGroup = 1 else 'if the user is NOT in a parent group intIsInGroup = 0 end if CheckIfUserInParentGroup = intIsInGroup 'Close the recordset and release the memory rsGetGroup.close set rsGetGroup = nothing End Function 'The HasChildren function finds out if a group has children to see if it can be reassigned to a Parent Group. 'If it does, then the EDIT is stopped. Function HasChildren(intGroupId) On Error Resume Next dim cmd dim rsFindChild dim intHasChild set cmd = Server.CreateObject("ADODB.Command") set cmd.ActiveConnection = conn cmd.CommandText = "SP_GET_CHILDREN_OF_GROUP" cmd.CommandType = adCmdStoredProc cmd.Parameters.Append cmd.CreateParameter("GROUP_ID", adInteger, adParamInput, , intGroupId) 'return recordset of subscriber info Set rsFindChild = cmd.execute If Not rsFindChild.EOF then 'it has a child intHasChild = 0 else intHasChild = 1 end if 'Return the value HasChildren = intHasChild 'release cmd object from memory set cmd = nothing 'if an error has occured report it If err.number <> 0 Then Call ReportError("HasChildren", err.number, err.description) End If rsFindChild.close set rsFindChild = nothing On Error Goto 0 End Function 'This function checks if the group is part of a parent group and returns the parent ID Function HasParent(intGroupId) On Error Resume Next dim cmd dim rsFindParent dim intHasParent set cmd = Server.CreateObject("ADODB.Command") set cmd.ActiveConnection = conn cmd.CommandText = "SP_GET_PARENT_OF_CHILD" cmd.CommandType = adCmdStoredProc cmd.Parameters.Append cmd.CreateParameter("GROUP_ID", adInteger, adParamInput, , intGroupId) 'return recordset of subscriber info Set rsFindParent = cmd.execute Do while Not rsFindParent.EOF 'If it has a parent group, assign the parent ID to intHasParent intHasParent = rsFindParent("GROUP_PARENT_ID") rsFindParent.MoveNext Loop 'Return the value HasParent = intHasParent 'release cmd object from memory set cmd = nothing 'if an error has occured report it If err.number <> 0 Then Call ReportError("HasParent", err.number, err.description) End If rsFindParent.close set rsFindParent = nothing On Error Goto 0 End Function 'Function updates a group's old parent ID with a new parent ID if it has been edited by the user Function ModifyParent(intGroupID, intNewParentId) On Error Resume Next dim cmd set cmd = Server.CreateObject("ADODB.Command") set cmd.ActiveConnection = conn cmd.CommandText = "SP_SET_NEW_PARENT" cmd.CommandType = adCmdStoredProc cmd.Parameters.Append cmd.CreateParameter("GROUP_ID", adInteger, adParamInput, , intGroupID) cmd.Parameters.Append cmd.CreateParameter("NEW_PARENT_ID", adInteger, adParamInput, , intNewParentId) cmd.execute 'if an error has occured report it If err.number <> 0 Then Call ReportError("ModifyParent", err.number, err.description) End If On Error Goto 0 set cmd = nothing End Function 'Function Updates the group table with a new name and description of the chosen group in edit mode Function ModifyGroupInfo(intGroupID, strGroupName, strGroupDescription) On Error Resume Next dim cmd set cmd = Server.CreateObject("ADODB.Command") set cmd.ActiveConnection = conn cmd.CommandText = "SP_SET_NEW_GROUP_INFO" cmd.CommandType = adCmdStoredProc cmd.Parameters.Append cmd.CreateParameter("GROUP_ID", adInteger, adParamInput, , intGroupID) cmd.Parameters.Append cmd.CreateParameter("GROUP_NAME", adVarChar, adParamInput, 100, strGroupName) cmd.Parameters.Append cmd.CreateParameter("GROUP_DESCRIPTIONS", adVarChar, adParamInput, 4000, strGroupDescription) cmd.execute 'if an error has occured report it If err.number <> 0 Then Call ReportError("ModifyGroupInfo", err.number, err.description) End If On Error Goto 0 set cmd = nothing End Function 'This function inserts a new group's info in the database Function AddGroupInfo(intParentID, strGroupName, strGroupDescription, datDateCreated) On Error Resume Next dim cmd set cmd = Server.CreateObject("ADODB.Command") set cmd.ActiveConnection = conn cmd.CommandText = "SP_INSERT_NEW_GROUP_INFO" cmd.CommandType = adCmdStoredProc cmd.Parameters.Append cmd.CreateParameter("GROUP_ID", adInteger, adParamOutput) cmd.Parameters.Append cmd.CreateParameter("GROUP_PARENT_ID", adInteger, adParamInput, , intParentID) cmd.Parameters.Append cmd.CreateParameter("GROUP_NAME", adVarChar, adParamInput, 100, strGroupName) cmd.Parameters.Append cmd.CreateParameter("GROUP_DESCRIPTIONS", adVarChar, adParamInput, 4000, strGroupDescription) cmd.Parameters.Append cmd.CreateParameter("GROUP_DATE_CREATED", adDBTimeStamp, adParamInput, , datDateCreated) cmd.execute AddGroupInfo = cmd.Parameters("GROUP_ID") 'if an error has occured report it If err.number <> 0 Then Call ReportError("AddGroupInfo", err.number, err.description) End If set cmd = nothing On Error Goto 0 End Function 'The Add_ContactsToGroup procedure adds all the users and their respective groups after an edit of a group has 'been performed Sub Add_ContactsToGroup(intContactID, intGroupID) On Error Resume Next dim cmd set cmd = Server.CreateObject("ADODB.Command") set cmd.ActiveConnection = conn cmd.CommandText = "SP_INSERT_CONTACTS_IN_IDX_GROUP_LOOKUP" cmd.CommandType = adCmdStoredProc cmd.Parameters.Append cmd.CreateParameter("GROUPLOOKUP_GROUP_ID", adInteger, adParamInput, , intGroupID) cmd.Parameters.Append cmd.CreateParameter("GROUPLOOKUP_SUBSCRIBER_ID", adInteger, adParamInput, , intContactID) cmd.execute 'release cmd object from memory set cmd = nothing 'if an error has occured report it If err.number <> 0 Then Call ReportError("Add_ContactsToGroup", err.number, err.description) End If On Error Goto 0 End Sub 'The Delete_LookUpGroup procedure deletes group ID records related to the supplied subscriber id Sub Delete_LookUpGroup(intGroupId) On Error Resume Next dim cmd set cmd = Server.CreateObject("ADODB.Command") set cmd.ActiveConnection = conn cmd.CommandText = "SP_DELETE_IDX_LOOKUPGROUP" cmd.CommandType = adCmdStoredProc cmd.Parameters.Append cmd.CreateParameter("GROUPLOOKUP_GROUP_ID", adInteger, adParamInput, , intGroupId) cmd.execute 'if an error has occured report it If err.number <> 0 Then Call ReportError("Delete_LookUpGroup", err.number, err.description) End If 'release cmd object from memory set cmd = nothing On Error Goto 0 End Sub Function GetGroupSubscribers(intGroupId) On Error Resume Next dim cmd Set cmd = Server.CreateObject("ADODB.Command") Set cmd.ActiveConnection = conn cmd.CommandText = "SP_GET_GROUP_SUBSCRIBERS" cmd.CommandType = adCmdStoredProc cmd.Parameters.Append cmd.CreateParameter("GROUP_ID", adInteger, adParamInput, , intGroupId) Set GetGroupSubscribers = cmd.execute 'if an error has occured report it If err.number <> 0 Then Call ReportError("GetGroupSubscribers", err.number, err.description) End If 'release cmd object from memory Set cmd = nothing On Error Goto 0 End Function %>