<%'Include Data Connection%>
<%'Include ADO constants include file for VBScript%>
<%
'open data connection
Call OpenConn()
%>
<%'Include Utility Scripts%>
<%
'close data connection
Call CloseConn()
Function CIntNumber(strString, strReturnValueIfNotNumeric)
If strString <> "" And IsNumeric(strString) Then
CIntNumber = CLng(strString)
Else
CIntNumber = strReturnValueIfNotNumeric
End If
End Function
'The GetSubscribersSearch function takes a string value (either 'test' or 'live') and returns a recordset of related subscribers.
Function GetSubscribersSearch(strSubscriberType, strSearchString, intSearchType)
'On Error Resume Next
dim cmd
dim intIsLive
'if strSubscriberType variable is equal to 'live'...
If strSubscriberType = "live" Then
'set intIsLive variable to 1
intIsLive = 1
'if strSubscriberType variable is not equal to 'live' (is equal to 'test')...
Else
'set intIsLive variable to 0
intIsLive = 0
End If
set cmd = Server.CreateObject("ADODB.Command")
set cmd.ActiveConnection = conn
cmd.CommandText = "SP_GET_SUBSCRIBERS_SEARCH2"
cmd.CommandType = adCmdStoredProc
cmd.Parameters.Append cmd.CreateParameter("SUBSCRIBER_IS_LIVE", adInteger, adParamInput, , intIsLive)
cmd.Parameters.Append cmd.CreateParameter("SEARCH_STRING", adVarchar, adParamInput, 150, strSearchString)
cmd.Parameters.Append cmd.CreateParameter("FIRST_NAME_SEARCH", adInteger, adParamInput, , intSearchType)
'return the posting type recordset
set GetSubscribersSearch = cmd.execute
'if an error has occured report it
If err.number <> 0 Then
Call ReportError("GetSubscribersSearch", err.number, err.description)
End If
'release cmd object from memory
set cmd = nothing
On Error Goto 0
End Function
Function ManageSearcheableSubscribers(intSearch_PostingTypeId, strSubscriberType, strSearchString, intSearchType, bolSearching, intIndex, byVal strUserLanguage, intSearch_GroupId)
'On Error Resume Next
dim strSubscriberLinks
dim rsSubscribers
dim intSubscriberCount
dim intSubscriberId
dim strEmail
dim strFirstName
dim strLastName
dim strOrganization
dim intCounter
dim intIndexCounter
'get number of (test or live) subscribers
intSubscriberCount = GetSubscriberCount(strSubscriberType)
'if there are no subscribers of the selected type (test or live)...
If intSubscriberCount = 0 Then
'alert the user that there are no subscribers of the selected type
'Response.Write "
There are currently no " & UCase(Left(strSubscriberType, 1)) & LCase(Mid(strSubscriberType, 2, Len(strSubscriberType)-1)) & " Subscribers.
"
'if there are subscribers of the selected type (test or live)
Else
If bolSearching Then
'--------------------------------------------
Dim intX1, arRecordset1
'get list of (test or live) subscribers
' If intSearchType = 2 Then
' Set rsSubscribers = GetSubscribersByPostingType(strSubscriberType, intSearch_PostingTypeId)
' Else
' Set rsSubscribers = GetSubscribersSearch(strSubscriberType, strSearchString, intSearchType)
' End If
Select Case intSearchType
Case 2
Set rsSubscribers = GetSubscribersByPostingType(strSubscriberType, intSearch_PostingTypeId)
Case 3
Set rsSubscribers = GetSubscribersByGroup(strSubscriberType, intSearch_GroupId)
Case Else
Set rsSubscribers = GetSubscribersSearch(strSubscriberType, strSearchString, intSearchType)
End Select
'if the recordset is not empty then...
If Not rsSubscribers.Eof Then
'get recordset fields into array
arRecordset1 = rsSubscribers.GetRows(,,Array("SUBSCRIBER_EMAIL", "SUBSCRIBER_FIRST_NAME", "SUBSCRIBER_ID", "SUBSCRIBER_LAST_NAME", "SUBSCRIBER_ORGANIZATION"))
End If
'close recordset
rsSubscribers.Close
Set rsSubscribers = Nothing
'if there is at least one item then...
If IsArray(arRecordset1) Then
'start writing the table that will contain the list of subscribers
Dim intRowCounter
intRowCounter = 0
strSubscriberLinks = "
"
If intIndex > 1 Then
'if the user language is english then...
If strUserLanguage = "en" Then
strSubscriberLinks = strSubscriberLinks & " "
'if the user language is french then...
Else
strSubscriberLinks = strSubscriberLinks & " "
End If
Else
'if the user language is english then...
If strUserLanguage = "en" Then
strSubscriberLinks = strSubscriberLinks & " "
'if the user language is french then...
Else
strSubscriberLinks = strSubscriberLinks & " "
End If
End If
strSubscriberLinks = strSubscriberLinks & "
" & vbCRLF
'if the user language is french then...
Else
strSubscriberLinks = strSubscriberLinks & "Abonnés" & vbCRLF
strSubscriberLinks = strSubscriberLinks & "
" & vbCRLF
End If
strSubscriberLinks = strSubscriberLinks & "
" & vbCRLF
'initialize subscriber counter
intCounter = 0
'for each item in the array:
For intX1 = 0 To UBound(arRecordset1, 2)
'increment subscriber counter
intCounter = intCounter + 1
If intCounter <= ((50 * intIndex -1) + 1) And intCounter >= (50 * (intIndex - 1) + 1) Then
'get subscriber info into relevant variables
intSubscriberId = arRecordset1(2,intX1)
strFirstName = arRecordset1(1,intX1)
strLastName = arRecordset1(3,intX1)
strEmail = arRecordset1(0,intX1)
'if the current subscriber (in the recordset) has entered his organization when entering the form...
If Not IsNull(arRecordset1(4,intX1)) Then
'set his org into the strOrganiztion variable
strOrganization = arRecordset1(4,intX1)
'if the current subscriber (in the recordset) has not entered his organization when entering the form...
Else
'set the strOrganiztion variable to an empty string
strOrganization = " "
End If
intRowCounter = intRowCounter + 1
strSubscriberLinks = strSubscriberLinks & "
"
'if the user language is english then...
If strUserLanguage = "en" Then
strSubscriberLinks = strSubscriberLinks & ""
'if the user language is french then...
Else
strSubscriberLinks = strSubscriberLinks & ""
End If
strSubscriberLinks = strSubscriberLinks & "
"
strSubscriberLinks = strSubscriberLinks & "
"
'if the user language is english then...
'If strUserLanguage = "en" Then
' strSubscriberLinks = strSubscriberLinks & ""
'if the user language is french then...
'Else
' strSubscriberLinks = strSubscriberLinks & ""
'End If
strSubscriberLinks = strSubscriberLinks & ""
strSubscriberLinks = strSubscriberLinks & "
"
strSubscriberLinks = strSubscriberLinks & "
"
End If
Next
'close the table containing the list of subscribers
strSubscriberLinks = strSubscriberLinks & "
" & vbCRLF
Else
If strUserLanguage = "en" Then
strSubscriberLinks = strSubscriberLinks & "The search did not return any results."
Else
strSubscriberLinks = strSubscriberLinks & "La recherche n'a retourné aucun résultat."
End If
End If
'--------------------------------------------
Else
If strUserLanguage = "en" Then
strSubscriberLinks = strSubscriberLinks & "Please enter the first few letters of either the first or last name you wish to search for." & vbCRLF
Else
strSubscriberLinks = strSubscriberLinks & "S'il vous plaît entrer les premières lettres du nom ou prénom dont vous cherchez."
End If
End If
End If
'if an error has occured report it
If err.number <> 0 Then
Call ReportError("ManageSearcheableSubscribers", err.number, err.description)
End If
intSearcheableSubscriberCount = intCounter
intSubscriberCount = intCounter
Dim strIndex, intStart, intEnd
strIndex = ""
If intIndex = 1 Then
intStart = 2
Else
intStart = 1
End If
Dim intNumPages
If (intSearcheableSubscriberCount mod 50 = 0) Then
intNumPages = intSearcheableSubscriberCount / 50
Else
intNumPages = Fix(intSearcheableSubscriberCount / 50) + 1
End If
' For intIndexCounter = 1 To intNumPages
' If (intIndexCounter = intIndex) Or (intIndexCounter = 1 And intIndex = 1) Or (CLng(intSearcheableSubscriberCount / 50) + 1 = intIndexCounter And intIndexCounter = intIndex) Then
' strIndex = strIndex & " "
' Else
' strIndex = strIndex & " "
' End If
' Next
Dim intPageCount : intPageCount = intNumPages
Dim intPageCounter, strSelected
Const CONST_strDisabled = " disabled=""disabled"""
Const CONST_strSelected = " selected=""selected"""
If intPageCount > 1 Then
If strUserLanguage = "en" Then
strIndex = strIndex & "Select a Page: "
Else
strIndex = strIndex & "Choisir une Page: "
End If
strIndex = strIndex & ""
End If
strIndex = strIndex & "
"
If intIndex < Round(intSearcheableSubscriberCount / 50) Then
'if the user language is english then...
If strUserLanguage = "en" Then
strIndex = strIndex & " " & vbCRLF
'if the user language is french then...
Else
strIndex = strIndex & " " & vbCRLF
End If
Else
'if the user language is english then...
If strUserLanguage = "en" Then
strIndex = strIndex & " " & vbCRLF
'if the user language is french then...
Else
strIndex = strIndex & " " & vbCRLF
End If
End If
strSubscriberLinks = Replace(strSubscriberLinks, "[%index%]", strIndex)
ManageSearcheableSubscribers = strSubscriberLinks
On Error Goto 0
End Function
Function GetSubscribersByPostingType(strSubscriberType, intPostingTypeId)
'On Error Resume Next
dim cmd
dim intIsLive
'if strSubscriberType variable is equal to 'live'...
If strSubscriberType = "live" Then
'set intIsLive variable to 1
intIsLive = 1
'if strSubscriberType variable is not equal to 'live' (is equal to 'test')...
Else
'set intIsLive variable to 0
intIsLive = 0
End If
set cmd = Server.CreateObject("ADODB.Command")
set cmd.ActiveConnection = conn
cmd.CommandText = "SP_GET_SUBSCRIBERS_SEARCH3"
cmd.CommandType = adCmdStoredProc
cmd.Parameters.Append cmd.CreateParameter("SUBSCRIBER_IS_LIVE", adInteger, adParamInput, , intIsLive)
cmd.Parameters.Append cmd.CreateParameter("POSTING_TYPE_ID", adInteger, adParamInput, , intPostingTypeId)
'return the posting type recordset
set GetSubscribersByPostingType = cmd.execute
'if an error has occured report it
If err.number <> 0 Then
Call ReportError("GetSubscribersByPostingType", err.number, err.description)
End If
'release cmd object from memory
set cmd = nothing
On Error Goto 0
End Function
Function GetSubscribersByGroup(strSubscriberType, intSearch_GroupId)
'On Error Resume Next
dim cmd
dim intIsLive
'if strSubscriberType variable is equal to 'live'...
If strSubscriberType = "live" Then
'set intIsLive variable to 1
intIsLive = 1
'if strSubscriberType variable is not equal to 'live' (is equal to 'test')...
Else
'set intIsLive variable to 0
intIsLive = 0
End If
' set cmd = Server.CreateObject("ADODB.Command")
' set cmd.ActiveConnection = conn
' cmd.CommandText = "SP_GET_SUBSCRIBERS_SEARCH4"
' cmd.CommandType = adCmdStoredProc
' cmd.Parameters.Append cmd.CreateParameter("SUBSCRIBER_IS_LIVE", adInteger, adParamInput, , intIsLive)
' cmd.Parameters.Append cmd.CreateParameter("POSTING_TYPE_ID", adInteger, adParamInput, , intSearch_GroupId)
' 'return the posting type recordset
' set GetSubscribersByGroup = cmd.execute
Dim objRs
Set objRs = Server.CreateObject("ADODB.recordset")
Dim strSQL
strSQL = "SELECT DISTINCT SUBSCRIBER.* " & _
"FROM GROUPS INNER JOIN " & _
"IDX_GROUP_LOOKUP ON GROUPS.GROUP_ID = IDX_GROUP_LOOKUP.GROUPLOOKUP_GROUP_ID INNER JOIN " & _
"SUBSCRIBER ON IDX_GROUP_LOOKUP.GROUPLOOKUP_SUBSCRIBER_ID = SUBSCRIBER.SUBSCRIBER_ID " & _
"WHERE (GROUPS.GROUP_ID IN (" & GetParentInList(intSearch_GroupId) & ")) AND (SUBSCRIBER.SUBSCRIBER_IS_LIVE = " & intIsLive & ") " & _
"ORDER BY SUBSCRIBER.SUBSCRIBER_LAST_NAME"
'TEST
' RESPONSE.WRITE STRsql
' response.end
objRs.Open strSQL, conn
Set GetSubscribersByGroup = objRs
Set objRs = Nothing
'if an error has occured report it
If err.number <> 0 Then
Call ReportError("GetSubscribersByGroup", err.number, err.description)
End If
'release cmd object from memory
set cmd = nothing
On Error Goto 0
End Function
Function GetParentInList(intSearch_GroupId)
'On Error Resume Next
dim cmd
set cmd = Server.CreateObject("ADODB.Command")
set cmd.ActiveConnection = conn
cmd.CommandText = "SP_GET_PARENT_GROUP_IDS"
cmd.CommandType = adCmdStoredProc
cmd.Parameters.Append cmd.CreateParameter("PARENT_IDS", adVarchar, adParamInputOutput, 8000, "")
cmd.Parameters.Append cmd.CreateParameter("SECTION_ID", adInteger, adParamInput,,intSearch_GroupId)
cmd.execute
GetParentInList = cmd.Parameters("PARENT_IDS")
set cmd = nothing ' blow away previous cmd object
If err.number <> 0 Then
Call ReportError("GetAllParentSections", err.number, err.description)
End If
On Error Goto 0
End Function
Function GetAllPostingTypeOptions_selected(byVal strLangId, intPostingTypeId)
'On Error Resume Next
dim rsOptions
dim strOptions
'--------------------------------------------
Dim intX1, arRecordset1
'get recordset
set rsOptions = GetAllPostingTypes()
strOptions = ""
'if the recordset is not empty then...
If Not rsOptions.Eof Then
'get recordset fields into array
arRecordset1 = rsOptions.GetRows(,,Array("POSTING_TYPE_USER_CAN_SUBSCRIBE", "POSTING_TYPE_ID", "POSTING_TYPE_NAME_ENG"))
End If
'close recordset
rsOptions.Close
Set rsOptions = Nothing
'if there is at least one item then...
If IsArray(arRecordset1) Then
Dim strSelectedAddOn
'for each item in the array:
For intX1 = 0 To UBound(arRecordset1, 2)
'if the current posting type can be subscribed to then...
If arRecordset1(0,intX1) = True Then
If intPostingTypeId = arRecordset1(1,intX1) Then
strSelectedAddOn = " selected=""selected"""
Else
strSelectedAddOn = ""
End If
'concatenate the current posting type to the options list
strOptions = strOptions & "" & vbCRLF
End If
Next
End If
'if an error has occured report it
If err.number <> 0 Then
Call ReportError("GetAllPostingTypeOptions_selected", err.number, err.description)
End If
'--------------------------------------------
'return the option list string
GetAllPostingTypeOptions_selected = strOptions
On Error Goto 0
End Function
'This function gets the group from the Group ID supplied
Function GetAllGroups()
On Error Resume Next
Dim objRs
Set objRs = Server.CreateObject("ADODB.recordset")
Dim strSQL
strSQL = "SELECT * FROM GROUPS ORDER BY GROUP_NAME"
'TEST
' RESPONSE.WRITE STRsql
' response.end
objRs.Open strSQL, conn
Set GetAllGroups = objRs
Set objRs = Nothing
'if an error has occured report it
If err.number <> 0 Then
Call ReportError("GetGroups", err.number, err.description)
End If
On Error Goto 0
End Function
Function GetAllGroupOptions_selected(strUserLanguage, intSearch_GroupId)
'On Error Resume Next
dim rsOptions
dim strOptions
'--------------------------------------------
Dim intX1, arRecordset1
'get recordset
set rsOptions = GetAllGroups()
strOptions = ""
'if the recordset is not empty then...
If Not rsOptions.Eof Then
'get recordset fields into array
arRecordset1 = rsOptions.GetRows(,,Array("GROUP_ID", "GROUP_ID", "GROUP_NAME"))
End If
'close recordset
rsOptions.Close
Set rsOptions = Nothing
'if there is at least one item then...
If IsArray(arRecordset1) Then
Dim strSelectedAddOn
'for each item in the array:
For intX1 = 0 To UBound(arRecordset1, 2)
'if the current posting type can be subscribed to then...
'If arRecordset1(0,intX1) = True Then
If intSearch_GroupId = arRecordset1(1,intX1) Then
strSelectedAddOn = " selected=""selected"""
Else
strSelectedAddOn = ""
End If
'concatenate the current posting type to the options list
strOptions = strOptions & "" & vbCRLF
'End If
Next
End If
'if an error has occured report it
If err.number <> 0 Then
Call ReportError("GetAllPostingTypeOptions_selected", err.number, err.description)
End If
'--------------------------------------------
'return the option list string
GetAllGroupOptions_selected = strOptions
On Error Goto 0
End Function
Dim strUserLanguage : strUserLanguage = "en"
%>
<%
If Request.Form("txtMode") = "delete" Then
'open data connection
Call OpenConn()
'BEGIN: DELETE SUBSCRIBER
'dim strMode - The strMode variable is defined in the header_inc.asp file.
dim intSubscriberId
Dim arrSubscribers : arrSubscribers = Split(Request.Form("chkRecord"), ", ")
' intSubscriberId = Trim(Request.QueryString("id"))
' strMode = Trim(Request.QueryString("mode"))
For Each intSubscriberId In arrSubscribers
'Delete all the subscriber's entries in the Group lookup table
Call Delete_LookUpSubscriber(intSubscriberId)
'delete the selected subscriber
Call DeleteSubscriber(intSubscriberId)
Next
'close data connection
Call CloseConn()
'give the user feedback with regards to the success of the delete database transaction
Session("FeedbackMode") = "delete"
Session("FeedbackError") = err.number
Session("FeedbackModule") = "subscriber"
Response.Write("")
Response.Write("")
'END: DELETE SUBSCRIBER
Else
'BEGIN: DISPLAY SUBSCRIBER INDEX
'open the data connection
Call openConn()
dim intSubsDisplayedPerPage
dim intCurrentPage
dim strSubscriberType
dim strOtherSubscriberType
dim intSubscriberCount
dim strCurrentModule
dim bolPageNumberIsValid
Dim strSearchString, intSearchType, bolSearching, intIndex
intIndex = Request.Form("txtIndex")
Dim intSearch_PostingTypeId : intSearch_PostingTypeId = CIntNumber(Request.Form("selPostingType"), 0)
Dim intSearch_GroupId : intSearch_GroupId = CIntNumber(Request.Form("selGroup"), 0)
If IsNumeric(intIndex) And intIndex <> "" Then
intIndex = CLng(intIndex)
Else
intIndex = 1
End If
If Request.Form <> "" Then
bolSearching = True
Else
bolSearching = False
intSearchType = 0
End If
strSearchString = Trim(Request.Form("txtInput"))
intSearchType = CIntNumber(Request.Form("optType"), 0)
'get subscriber type
strSubscriberType = LCase(Trim(Request.QueryString("type")))
'if strSubscriberType variable is equal to 'live' then...
If strSubscriberType = "live" Then
'change first letter of 'live' to upper case
strSubscriberType = "Live"
'set the strOtherSubscriberType variable to 'Test'
strOtherSubscriberType = "Test"
'if strSubscriberType variable is not equal to 'live' (is equal to 'test') then...
Else
'change first letter of 'test' to upper case
strSubscriberType = "Test"
'set the strOtherSubscriberType variable to 'Test'
strOtherSubscriberType = "Live"
End If
'get the number of subscribers for a given type (test or live)
intSubscriberCount = GetSubscriberCount(strSubscriberType)
Dim intSearcheableSubscriberCount
Dim strSubscribers
strSubscribers = ManageSearcheableSubscribers(intSearch_PostingTypeId, LCase(strSubscriberType), strSearchString, intSearchType, bolSearching, intIndex, strUserLanguage, intSearch_GroupId)
%>
<%
'END: DISPLAY SUBSCRIBER INDEX
End If
%>