<% '******************************************************************************* '* XUD Copyright 1995-2005 XCENT - www.xcent.com * '* XUD is a trademark of XCENT * '* This notice may not be removed from this source code file * '******************************************************************************* sCMD = UCase(Trim(RequestValue("CMD"))) bPassThru = EvalBool(RequestValue("PASSTHRU")) sRegEmail = RequestValue("REGEMAIL") sReturnTo = RequestValue("ReturnTo") bDefEmailNotification = EvalBool(RequestValue("DefEmailNotification")) 'If Len(RequestValue("DefEmailNotification"))=0 Then bDefEmailNotification = True iChangesSaved = False If Len(Trim(sReturnTo)) = 0 Then If Len(Trim(gsDefLoginURL)) = 0 Then sReturnTo = "XUD.asp" Else sReturnTo = gsDefLoginURL End If End If If gbEnabled Then If gbMailingListEnable Then OpenDBConn If gbMailingListRegUsersOnly And Not bPassThru Then If IsUserLoggedIn Then sRegEmail = gsUserEmail DoPageHeader TableHead Select Case sCMD Case "UPDATE": UpdateData If bPassThru Then Response.Redirect sReturnTo Else ShowSelectForm End If Case Else ShowSelectForm End Select TableFoot DoPageFooter Else Response.Redirect "XUDLogin.asp?ReturnTo=XUDRegNotify.asp" End If Else LoadUserSettings DoPageHeader TableHead If ValidateRegEmail() Then OpenDBConn Select Case sCMD Case "UPDATE": UpdateData If bPassThru Then Response.Redirect sReturnTo Else ShowSelectForm End If Case Else ShowSelectForm End Select CloseDBConn Else 'Prompt for address PromptForEmail End If TableFoot DoPageFooter End If CloseDBConn Else DoPageHeader TableHead ShowHTMLFile "XUDHtmlTxt/XUDRegNotifyDisable.htm" TableFoot DoPageFooter End If Else Response.Redirect "XUDDisabled.asp" End If Sub UpdateData sSQL = "SELECT * FROM tblXUDNotifyList" Set rsList = Server.CreateObject("ADODB.Recordset") rsList.CursorLocation = 3 'adUseClient rsList.Open sSQL, gobjConnect, 3, 1, &H0001 'adOpenStatic, adLockReadOnly, adCmdText If Not rsList.Eof Then 'For Each x In Request.Form ' Response.Write "Parameter:" & x & " - Value:" & Request.Form(x) & "
" 'Next Do While Not rsList.Eof lNtlID = FVal(rsList("ntlID")) If Len(Trim(Request.Form("WAS" & lNtlID))) > 0 Then sState = UCase(Trim(Request.Form("WAS" & lNtlID))) If EvalBool(RequestValue("LIST" & lNtlID)) Then sState = sState & "Y" Else sState = sState & "N" End If Select Case sState Case "NN", "YY": 'Do Nothing Case "NY": 'Was not subscribed, adding sSQL = "INSERT INTO tblXUDNotify (notEmail, notName, notAdded, notIPAddr, notNtlID) " & _ " VALUES (" & _ SQLStr(sRegEmail) & ", " & _ SQLStr(sRegEmail) & ", " & _ SQLDate(Now) & ", " & _ SQLStr(Request.ServerVariables("REMOTE_ADDR")) & ", " & _ SQLVal(lNtlID) & ") " gobjConnect.BeginTrans gobjConnect.Execute sSQL gobjConnect.CommitTrans UpdateListCount lNtlID iChangesSaved = True Case "YN": 'Was Subscribed, removing sSQL = "DELETE FROM tblXUDNotify WHERE notNtlID = " & SQLVal(lNtlID) & _ " AND notEmail = " & SQLStr(sRegEmail) gobjConnect.BeginTrans gobjConnect.Execute sSQL gobjConnect.CommitTrans UpdateListCount lNtlID iChangesSaved = True Case Else 'Undefined End Select End If rsList.MoveNext Loop End If rsList.Close Set rsList = Nothing sSQL = "UPDATE tblXUDUserRegistration SET " & _ "regDefEmailNotification = " & SQLBool(bDefEmailNotification) & " " & _ "WHERE regID = " & SQLVal(glUserID) gobjConnect.Execute sSQL End Sub Sub UpdateListCount(plListID) sSQL = "SELECT Count(notEmail) as calcCount FROM tblXUDNotify WHERE notNtlID = " & SQLVal(plListID) Set rsCount = Server.CreateObject("ADODB.Recordset") rsCount.CursorLocation = 3 'adUseClient rsCount.Open sSQL, gobjConnect, 3, 1, &H0001 'adOpenStatic, adLockReadOnly, adCmdText If Not rsCount.Eof Then lListCount = FVal(rsCount("calcCount")) Else lListCount = 0 End If rsCount.Close Set rsCount = Nothing sSQL = "UPDATE tblXUDNotifyList SET ntlSubscribers = " & SQLVal(lListCount) & " WHERE ntlID = " & SQLVal(plListID) gobjConnect.Execute sSQL End Sub Sub ShowSelectForm ShowHTMLFile "XUDHtmlTxt/XUDRegNotifyShowList.htm" sSQL = "SELECT notNtlID FROM tblXUDNotify " & _ " WHERE notEmail = " & SQLStr(sRegEmail) Set rsList = Server.CreateObject("ADODB.Recordset") rsList.CursorLocation = 3 'adUseClient rsList.Open sSQL, gobjConnect, 3, 1, &H0001 'adOpenStatic, adLockReadOnly, adCmdText sMemberList = "" If Not rsList.Eof Then Do While Not rsList.Eof sMemberList = sMemberList & "[" & rsList("notNtlID") & "]" rsList.MoveNext Loop End If rsList.Close Set rsList = Nothing 'Response.Write "
" & sRegEmail & sMemberList & "
" sSQL = "SELECT * FROM tblXUDNotifyList ORDER BY ntlDescription" Set rsList = Server.CreateObject("ADODB.Recordset") rsList.CursorLocation = 3 'adUseClient rsList.Open sSQL, gobjConnect, 3, 1, &H0001 'adOpenStatic, adLockReadOnly, adCmdText If Not rsList.Eof Then Response.Write "

" Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write "" Do While Not rsList.Eof bDefSelected = EvalBool(rsList("ntlSelected")) sCheck = "[" & rsList("ntlID") & "]" If Instr(1, sMemberList, sCheck) > 0 Then bCheck = True Else bCheck = False End If Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write "" rsList.MoveNext Loop Response.Write "" If glUserID > 0 Then sSQL = "SELECT regDefEmailNotification, regDefEmailType " & _ "FROM tblXUDUserRegistration " & _ "WHERE regID = " & SQLVal(glUserID) Set rs = gobjConnect.Execute(sSQL) If not rs.Eof Then bDefEmailNotification = EvalBool(rs("regDefEmailNotification")) sDefEmailType = "" & rs("regDefEmailType") Else bDefEmailNotification = True sDefEmailType = "" End If rs.Close Set rs = Nothing Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write "" End If sSaveTxt = GLS_TextSave If bPassThru Then sSaveTxt = GLS_TextSaveContinue sCancelTxt = GLS_TextCancel If bPassThru Then sCancelTxt = GLS_TextContinueWithoutSave Response.Write "" Response.Write "

	" & gsPlainTextOpen & sRegEmail If iChangesSaved Then Response.Write GLS_RegNotifyChangesSaved End If Response.Write gsPlainTextClose & "
		" & gsPlainTextOpen & rsList("ntlDescription") If bCheck Then Response.Write GLS_RegNotifyLSSub Else Response.Write GLS_RegNotifyLSNot End If Response.Write gsPlainTextClose & "
	" & gsFormTextOpen & GLS_RegNotifyDefEmailSettings & gsFormTextClose & "
		" & gsPlainTextOpen & GLS_RegNotifyDefEmailNotification & gsPlainTextClose & "
	" Response.Write "" Response.Write "" Response.Write "" Response.Write "   " Response.Write " " Response.Write "  " Response.Write " " Response.Write "

" Else Response.Write GLS_RegNotifyNoLists End If rsList.Close Set rsList = Nothing End Sub Sub PromptForEmail Dim sShowEmail sShowEmail = gsUserEmail If Len(sRegEmail) > 0 Then sShowEmail = sRegEmail ShowHTMLFile "XUDHtmlTxt/XUDRegNotifyPromptForEmail.htm" Response.Write "

" Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write "

" & gsFormTextOpen & GLS_RegNotifyEmailPrompt & gsFormTextClose & "

" End Sub Function ValidateRegEmail ValidateRegEmail = True If Len(Trim(sRegEmail)) = 0 Then ValidateRegEmail = False Else If Instr(1, sRegEmail, ".", 1) < 1 Then ValidateRegEmail = False End If If Instr(1, sRegEmail, "@", 1) < 1 Then ValidateRegEmail = False End If End If End Function Sub TableHead Response.Write "" Response.Write "" Response.Write "" Response.Write "

" Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write " " & gsTabTextOpen & GLS_RegNotifyTitle & gsTabTextClose & "   " Response.Write "

" End Sub Sub TableFoot Response.Write "

" ShowNavBar End Sub %>