<%@ Language=VBScript %> <% Option Explicit %> <% Response.Expires = 0 %> <% On Error Resume Next %> <% Dim oPost Dim xmlDoc, uName, siteName, number Dim postText, custFile, goodCancelUrl, custSvcUrl Dim ACCOUNT, USERNAME, PASSWORD, supporturl, cancelTable Dim d, f, i, sNumber, s, ibillsub, mail Dim Xpire, todayDate, dx, auth Dim jf, fso, ts, jd, connectString Dim strSQL, odbcdate, connectUsers, rsUsers, strTime, adocommand, sqlcommand ACCOUNT = "7948" USERNAME = "a7948" PASSWORD = "xyz3679" connectString = "Driver={MySQL};DATABASE=wrpusers;SERVER=209.71.252.33;UID=4userdata;PWD=qyt6247;" cancelTable = "tblTeenCancels" goodCancelUrl = "http://hollyheartbreak.com/goodcancel.html" supportUrl = "http://hollyheartbreak.com/supportcancel.html" custsvcUrl = "http://ibillcs.com" siteName = "HollyHeartbreak.com" ' ADO constants include file for VBScript ' '-------------------------------------------------------------------- '---- CursorTypeEnum Values ---- Const adOpenForwardOnly = 0 Const adOpenKeyset = 1 Const adOpenDynamic = 2 Const adOpenStatic = 3 '---- LockTypeEnum Values ---- Const adLockReadOnly = 1 Const adLockPessimistic = 2 Const adLockOptimistic = 3 Const adLockBatchOptimistic = 4 '---- CursorLocationEnum Values ---- Const adUseServer = 2 Const adUseClient = 3 '---- CommandTypeEnum Values ---- Const adCmdUnknown = &H0008 Const adCmdText = &H0001 Const adCmdTable = &H0002 Const adCmdStoredProc = &H0004 Const adCmdFile = &H0100 Const adCmdTableDirect = &H0200 '---- ConnectModeEnum Values ---- Const adModeUnknown = 0 Const adModeRead = 1 Const adModeWrite = 2 Const adModeReadWrite = 3 Select Case UCase(Request("ACTION")) Case "CANCEL" Dim strReason, strMail uName = Request("LOGIN") If Request("LOGIN") = "" then Response.Write "

Missing Username

" Response.End End If If Request("SUB1") = "" then Response.Write "

Missing Subscription Number

" Response.End End If If Request("EMAIL") = "" OR Len(Request("EMAIL")) < 11 THEN Response.Write "

Valid E-Mail Missing

" Response.End End If If Request("reason") = "XXX" Then Response.Write "

Please Click Back and Select a Reason for Cancelation. Thanks.

" Response.End End If Set connectUsers = Server.CreateObject("ADODB.Connection") connectusers.ConnectionString = connectString connectUsers.CursorLocation = adUseServer connectUsers.Mode = adModeReadWrite connectUsers.Open strSQL = "SELECT * FROM tblActive WHERE username LIKE '" & uName & "'" Set rsUsers = Server.CreateObject("ADODB.Recordset") rsUsers.Open strSQL, connectUsers, adOpenForwardOnly, adLockOptimistic, adCmdText If rsUsers.EOF then Response.Write "USER NOT FOUND" ElseIf rsUsers("subscription").Value <> ("S:" & Request("SUB1")) then Response.Write "INVALID SUBSCRIPTION NUMBER FOR USER" Else strReason = Request("reason") Set adoCommand = Server.CreateObject("ADODB.Command") adoCommand.ActiveConnection = connectUsers adoCommand.CommandType = adCmdText strSQL = "UPDATE " & cancelTable & " SET " & strReason & " = (" & strReason strSQL = strSQL & " + 1) WHERE Record = 1" adoCommand.CommandText = strSQL adoCommand.Execute If Request("comments") <> "" THEN strSQL = "INSERT INTO tblCancelNotes (ibill_sub,notes) VALUES " strSQL = strSQL & "('" & Request("SUB1") & "','" & Request("comments") & "')" adoCommand.CommandText = strSQL adoCommand.Execute End If If Request("support") = "YES" THEN strMail = "Reason: " & Request("reason") & vbCrLf strMail = strMail & "Comments: " & vbCrLf & Request("comments") & vbCrLf & vbCrLf strMail = strMail & "Ibill sub: " & Request("SUB1") & vbCrLf strMail = strMail & "Username: " & Request("LOGIN") & vbCrLf mail = SendMail(("webmaster@" & siteName), Request("EMAIL"), "CANCEL/SUPPORT", strMail) Set adoCommand = Nothing rsUsers.Close Set rsUsers = Nothing connectUsers.Close Set connectUsers = Nothing Response.Redirect supportUrl Response.End Else s = Split(rsUsers("subscription").Value,":") ReDim Preserve s(2) sNumber = s(1) ibillSub = rsUsers("sub_acct").Value dx = IbillCancel(ibillSub, sNumber) If dx = 1 then todayDate = now Xpire = rsUsers("joindate").Value Do While CDate(Xpire) < CDate(todayDate) Xpire = (CDate(Xpire) + 30) Loop strTime = CStr(TimeValue(Xpire)) odbcDate = Year(Xpire) & "/" & Month(Xpire) & "/" & Day(Xpire) & " " & Left(strTime,Len(strTime) - 3) sqlCommand = "UPDATE tblactive SET expiration='" & odbcDate & "' WHERE username LIKE '" & uName & "'" adoCommand.CommandText = sqlCommand adoCommand.Execute Set adoCommand = Nothing rsUsers.Close Set rsUsers = Nothing connectUsers.Close Set connectUsers = Nothing Response.Write "

SUCCESS

" Response.End Else Set adoCommand = Nothing rsUsers.Close Set rsUsers = Nothing connectUsers.Close Set connectUsers = Nothing Response.Write "

Live Cancelation Failed


" Response.Write "

Please refer to Customer Service" Response.End End If End If Set adoCommand = Nothing rsUsers.Close Set rsUsers = Nothing connectUsers.Close Set connectUsers = Nothing Response.Write "

Cannot locate account


" Response.Write "

Please refer to Customer Service" Response.End End If Case "MAN_CANCEL" uName = Trim(Request("LOGIN")) If uName = "" then Response.Write "

Missing Username

" Response.End End If Set connectUsers = Server.CreateObject("ADODB.Connection") connectusers.ConnectionString = connectString connectUsers.CursorLocation = adUseServer connectUsers.Mode = adModeReadWrite connectUsers.Open strSQL = "SELECT * FROM tblActive WHERE username LIKE '" & uName & "'" Set rsUsers = Server.CreateObject("ADODB.Recordset") rsUsers.Open strSQL, connectUsers, adOpenForwardOnly, adLockOptimistic, adCmdText If rsUsers.EOF then Response.Write "SCRIPT ERROR - USER NOT FOUND" Else s = Split(rsUsers("subscription").Value,":") ReDim Preserve s(2) sNumber = s(1) ibillSub = rsUsers("sub_acct").Value dx = IbillCancel(ibillSub, sNumber) If dx = 1 then todayDate = now Xpire = rsUsers("joindate").Value Do While CDate(Xpire) < CDate(todayDate) Xpire = (CDate(Xpire) + 30) Loop strTime = CStr(TimeValue(Xpire)) odbcDate = Year(Xpire) & "/" & Month(Xpire) & "/" & Day(Xpire) & " " & Left(strTime,Len(strTime) - 3) Set adoCommand = Server.CreateObject("ADODB.Command") adoCommand.ActiveConnection = connectUsers adoCommand.CommandType = adCmdText sqlCommand = "UPDATE tblactive SET expiration='" & odbcDate & "' WHERE username LIKE '" & uName & "'" adoCommand.CommandText = sqlCommand adoCommand.Execute Set adoCommand = Nothing Response.Write "

SUCCESS

" Response.End Else Response.Write "

Live Cancelation Failed


" Response.Write "

Please refer to Customer Service" Response.End End If End If Response.Write "

Cannot locate account


" Response.Write "

Please refer to Customer Service" Response.End Case Else %>
CANCEL YOUR MEMBERSHIP TO:
<%= siteName %>

I want to cancel my account because:

Pleave provide details as to why you are canceling:

If we can resolve your issue, would you consider staying a member?


: Your Account Login Name
: Your E-mail Address
: Your IBILL Subscription Number




If you do not remember your subscription number you can look it up here


 
<% End Select '' '' Function '' EncodeText( ' Return the encoded value '' tupleName) ' tuple Name to encode '' Function EncodeText(tupleName) EncodeText = Server.URLEncode(Request(tupleName)) End function Function EncodeTxt(tupleName) EncodeTxt = Server.URLEncode(tupleName) End function Function IbillCancel(subACCT, number) ACCOUNT = ACCOUNT & subACCT ' Set xmlDoc = Server.CreateObject("MSXML2.DOMDocument.4.0") Set xmlDoc = Server.CreateObject("MSXML2.XMLHTTP") postText = "http://secure.ibill.com/cgi-win/direct/cancel.exe?Account=" & EncodeTxt(ACCOUNT) postText = postText & "&username=" & EncodeTxt(USERNAME) postText = postText & "&password=" & EncodeTxt(PASSWORD) postText = postText & "&ReqType=" & EncodeText("REQTYPE") postText = postText & "&SUB1=" & EncodeTxt(number) ' xmlDoc.async = False xmlDoc.Open "GET",posttext,"false" xmlDoc.Send ' If Not xmlDoc.Load(postText) Then ' Response.Write "Failed To Load Document.
" & xmlDoc.parseError.reason ' IbillCancel = 0 ' Else ' If xmlDoc.parsed = True Then ' Dim ElemList ' ElemList = xmlDoc.xml ' If Instr(xmldoc.Responsetext, "D>YES 0 then IbillCancel = 1 Else IbillCancel = 0 End If ' Else ' Response.Write "Error Loading Document -->" & xmlDoc.parseError.reason & "<--" ' IbillCancel = 0 ' End If ' End If Set xmlDoc = Nothing End Function Function readCustomers(fileName) Dim fso, ts, allText Set fso = Server.CreateObject("Scripting.FileSystemObject") Set ts = fso.OpenTextFile(filename) allText = ts.ReadAll ReadCustomers = allText ts.Close End Function Function SendMail(mTo, mFrom, mSubj, mBody) On Error Resume Next Dim objEmail, strBody Set objEmail = Server.CreateObject("CDONTS.NewMail") objEmail.To = mTo objEmail.From = mFrom objEmail.Subject = mSubj objEmail.Body = mBody objEmail.Send Set objEmail = nothing End Function %>