<% 'Dimension required varaiables Dim mContactID, mEmail, mFirstName, mLastName, mPassword, mCategory, mCountry 'required fields Dim mOrganization, mAddress1, mAddress2, mCity, mState, mZip, mPhone, mFax Dim mEmailMe, mNewsletter, mGender, mBalance Dim mRegCode, mExpCode, mExpDate Dim mDateOpen, mDateUpdate, mDateClose, mClosed Dim rsAccount, SQL Sub ClearAccount() mContactID = 0 mFirstName = "" mLastName = "" mPassword = "" mEmail = "" mCategory = "" mOrganization = "" mAddress1 = "" mAddress2 = "" mCity = "" mState = "" mZip = "" mCountry = "" mPhone = "" mFax = "" mEmailMe = True mNewsletter = True mGender = 0 mRegCode = "" mExpCode = "" mExpDate = Now() mBalance = 0 mDateOpen = Now() mDateUpdate = Now() mDateClose = Now() mClosed = False End Sub ' Creates the business-logic component that actually creates a new ' user account. If everything works, the new AccountID is returned. ' All exceptions are handled. Function CreateAccount() Dim AccountID On Error Resume Next CreateAccount = 0 ' assume it fails SQL = "SELECT * FROM Contacts WHERE Email = '" & mEmail & "'" Set rsAccount = Server.CreateObject("ADODB.RecordSet") With rsAccount .ActiveConnection = DSN .CursorLocation = adUseClient .CursorType = adOpenStatic .LockType = adLockOptimistic .Open SQL If .BOF or .EOF Then 'User cannot join as Company Member If Left(mCategory,1) = "X" Then mCategory = "CA" 'User does not exist - continue .AddNew .Fields("FirstName") = mFirstName .Fields("LastName") = mLastName .Fields("Password") = mPassword .Fields("Email") = mEmail .Fields("Category") = mCategory .Fields("Country") = mCountry 'Assign Defaults to the rest .Fields("Organization") = "" .Fields("Address1") = "" .Fields("Address2") = "" .Fields("City") = "" .Fields("State") = "" .Fields("Zip") = "" .Fields("Phone") = "" .Fields("Fax") = "" .Fields("RegCode") = "" .Fields("ExpCode") = "" .Fields("ExpDate") = Date .Fields("Balance") = 0 .Fields("EmailMe") = True .Fields("Newsletter") = True .Fields("Gender") = 0 .Fields("DateUpdate") = Now .Fields("DateOpen") = Now .Fields("DateClose") = Now .Fields("Closed") = False .UpdateBatch .Requery If Err.Number = 0 Then CreateAccount = CLng(.Fields("ContactID")) End If End If .Close End With Set rsAccount = Nothing End Function Function GetAccount(SQL) ' Get the RecordSet values (if any) If SQL = "" Then SQL = "SELECT * From Contacts WHERE ContactID = " & UserID End If ClearAccount() Set rsAccount = Server.CreateObject("ADODB.RecordSet") With rsAccount .CursorLocation = adUseServer .CursorType = adOpenStatic .LockType = adLockReadOnly .Open SQL, DSN If Not rsAccount.EOF Then mContactID = 0 + CLng(.Fields("ContactID")) mCategory = CStr("" & .Fields("Category")) mFirstName = CStr("" & .Fields("FirstName")) mLastName = CStr("" & .Fields("LastName")) mPassword = CStr("" & .Fields("Password")) mEmail = CStr("" & .Fields("Email")) mOrganization = CStr("" & .Fields("Organization")) mAddress1 = CStr("" & .Fields("Address1")) mAddress2 = CStr("" & .Fields("Address2")) mCity = CStr("" & .Fields("City")) mState = CStr("" & .Fields("State")) mZip = CStr("" & .Fields("Zip")) mCountry = CStr("" & .Fields("Country")) mPhone = CStr("" & .Fields("Phone")) mFax = CStr("" & .Fields("Fax")) mRegCode = CStr("" & .Fields("RegCode")) mExpCode = CStr("" & .Fields("ExpCode")) mExpDate = CDate( .Fields("ExpDate")) mBalance = CCur( .Fields("Balance")) mEmailMe = CBool( .Fields("EmailMe")) mNewsletter = CBool( .Fields("Newsletter")) mGender = CInt( .Fields("Gender")) mDateOpen = CDate( .Fields("DateOpen")) mDateUpdate = CDate( .Fields("DateUpdate")) mDateClose = CDate( .Fields("DateClose")) mClosed = CBool( .Fields("Closed")) .Close GetAccount = mContactID End If End With Set rsAccount = Nothing End Function ' Creates the business-logic component that actually updates user account. ' If everything works, the new AccountID is returned. ' All exceptions are handled. Function UpdateAccount(SQL) 'On Error Resume Next If SQL = "" Then SQL = "SELECT * FROM Contacts WHERE ContactID = " & UserID End If UpdateAccount = 0 ' assume it fails Set rsAccount = Server.CreateObject("ADODB.RecordSet") With rsAccount .ActiveConnection = DSN .CursorLocation = adUseClient .CursorType = adOpenStatic .LockType = adLockOptimistic .Open SQL If Not .EOF Then 'Check that the user is not trying to become an Administrator If Not Left(Request.Cookies(COOKIE)("Category"), 1) = "X" Then 'Reset it back to what it was If Left(mCategory, 1) = "X" Then mCategory = Request.Cookies(COOKIE)("Category") End If If mCategory = "" Then mCategory = "CA" End If 'ContactID is an AutoNumber field .Fields("FirstName") = CStr(mFirstName) .Fields("LastName") = CStr(mLastName) .Fields("Password") = CStr(mPassword) .Fields("Email") = CStr(mEmail) .Fields("Category") = CStr(mCategory) .Fields("Organization") = CStr(mOrganization) .Fields("Address1") = CStr(mAddress1) .Fields("Address2") = CStr(mAddress2) .Fields("City") = CStr(mCity) .Fields("State") = CStr(mState) .Fields("Zip") = CStr(mZip) .Fields("Country") = CStr(mCountry) .Fields("Phone") = CStr(mPhone) .Fields("Fax") = CStr(mFax) .Fields("RegCode") = CStr(mRegCode) .Fields("ExpCode") = CStr(mExpCode) '.Fields("ExpDate") = CDate(mExpDate) .Fields("EmailMe") = CBool(mEmailMe) .Fields("Newsletter") = CBool(mNewsletter) .Fields("Gender") = CInt(mGender) '.Fields("DateOpen") = CDate(mDateOpen) .Fields("DateUpdate") = Now '.Fields("DateClose") = CDate(mDateClose) '.Fields("Closed") = CBool(mClosed) .Update If Err.Number = 0 Then UpdateAccount = .Fields("ContactID") Else 'Account was deleted in the meantime mMainPrompt = "A database error occurred" End If End With Set rsAccount = Nothing If err.number = &h80040e14 Then ' This ADO error message corresponds to the message thrown by the database ' when a unique index constraint is violated. Since trying to create ' an account with a duplicate e-mail is common, we'll handle the message ' gracefully and tell the user to choose another account. mMainPrompt = "Email Address already exists" ' Since we're handling a "normal" message, you wouldn't normally want to ' emit the error message using the global function below. We'll leave it ' in here for demonstration purposes. BuildErrorMessage() Exit Function ElseIf err.number <> 0 Then ' Emit a general error message. This could occur if the database is down or paused. mMainPrompt = "A database error occurred" Exit Function End If 'If we've gotten this far, everything went ok. Set the function to the AccountID, indicating success. UpdateAccount = UserID End Function Function DeleteAccount() 'Remove the user from the database SQL = "SELECT * From Contacts WHERE ContactID = " & CLng(UserID) Set rsAccount = Server.CreateObject("ADODB.RecordSet") With rsAccount .CursorLocation = adUseServer .CursorType = adOpenForwardOnly .LockType = adLockOptimistic .Open SQL, DSN If Not .EOF Then 'Do NOT Delete - just mark as Closed '.Delete .Fields("Closed") = True .Fields("DateClose") = Now .Update If Err.Number = 0 Then DeleteAccount = True End If .Close End With Set rsAccount = Nothing End Function Function GetEmail() 'Return the ID from Email Address GetEmail = UserID SQL = "SELECT ContactID From Contacts WHERE Email = '" & mEmail & "';" Set rsAccount = Server.CreateObject("ADODB.RecordSet") With rsAccount .CursorLocation = adUseClient .CursorType = adOpenForwardOnly .LockType = adLockReadOnly .Open SQL, DSN If (Not .BOF) AND (Not .EOF) Then GetEmail = rsAccount("ContactID") End If .Close End With Set rsAccount = Nothing End Function %>