<% '************************************************************************* ' ASP Scripting: ' Filename: library_data_connections.asp ' Written by: Wilbert Madarang ' Date: January 4, 2003 '************************************************************************* ' Description: This function consists of a series of functions for ' connecting to the database. '************************************************************************* ' Revision History: ' 1.0 Change by WM ' 1. Added explicit local variable declaration of the variables ' (Dim strSQL, rs) across all functions. ' 2. Added function retrieveUserData( strEmail ) '************************************************************************* ' REVISION 2.0 May 15, 2003 ' modified so that all values are filtered for "''" before being saved to ' the session value... ' ' This is used to address the apostrophe bug ... '************************************************************************* %> <% '************************************** ' DATABASE_CONSTANTS '************************************** 'DATABASE_NAME="db\real\charister-dev-5-updated_AY_june11_2005.mdb" 'DATABASE_NAME="db\test\test.mdb" 'DATABASE_NAME="db\071505\113005.mdb" DATABASE_NAME="db\042006\113005.mdb" DATABASE_PATH=server.MapPath( DATABASE_NAME ) DATABASE_DRIVER="driver={Microsoft Access Driver (*.mdb)};DBQ=" APOSTROPHE_ESCAPE_CHARACTER="'" '************************************** ' VARIABLE DECLARATIONS '************************************** Dim dataConnection '************************************************************** ' FUNCTION: openDataConnection ' DESCRIPTION: ' PARAMETERS: ' RETURNS: '************************************************************** ' NOTES: Must call this to initiate data connection '************************************************************** Function openDataConnection Set dataConnection = Server.CreateObject("ADODB.Connection") dbPath = server.MapPath( DATABASE_NAME ) dataConnection.Open DATABASE_DRIVER & DATABASE_PATH If dataConnection = null Then Response.Write "Serious Error. Cannot open Data Connection!
" End If End Function '************************************************************** ' FUNCTION: closeDataConnection ' DESCRIPTION: ' PARAMETERS: ' RETURNS: '************************************************************** ' NOTES: Must call this to terminate connection '************************************************************** Function closeDataConnection If NOT (dataConnection = null) Then dataConnection.Close dataConnection = Nothing End If End Function '************************************************************** ' FUNCTION: validateLogin ' DESCRIPTION: ' PARAMETERS: ' RETURNS: '************************************************************** ' Modified May 15, 2003 ' Added local variable locPassword ' Notes: Changign strPassword using Replace will replace strPassword '************************************************************** Function validateLogin( strEmail, strPassword) Dim strSQL, rs Dim locPassword locPassword = Replace( strPassword, "'", "''''" ) Call openDataConnection() strSQL = "select * from dirUsers where userEmail='" & strEmail & "' and userPassword='" & locPassword & "'" Response.Write "strSQL is " & strSQL & "
" Set rs = dataConnection.Execute( strSQL ) Call closeDataConnection() If rs.EOF AND rs.BOF Then validateLogin = false Else validateLogin = true End If End Function '************************************************************** ' FUNCTION: validateSecretPhrase ' DESCRIPTION: ' PARAMETERS: ' RETURNS: '************************************************************** Function validateSecretPhrase( strEmail, strSecretPhrase ) Dim strSQL, rs Dim locSecretPhrase '*************************************** ' Modified by WM, May 15, 2003 ' Modified because the db is storing the escape characters from ASP ' Therefore, we need to compare using '*************************************** locSecretPhrase = Replace( strSecretPhrase, "'", "''''" ) Call openDataConnection() strSQL = "select * from dirUsers where userEmail='" & strEmail & "' and userSecretPhrase='" & locSecretPhrase & "'" 'Response.Write "strSQL is " & strSQL & "
" Set rs = dataConnection.Execute( strSQL ) Call closeDataConnection() If rs.EOF AND rs.BOF Then validateSecretPhrase = false Else validateSecretPhrase = true End If End Function '************************************************************** ' FUNCTION: retrievePassword ' DESCRIPTION: ' PARAMETERS: ' RETURNS: '************************************************************** Function retrievePassword( strEmail, strSecretPhrase ) Dim strSQL, rs Dim locSecretPhrase locSecretPhrase = Replace( strSecretPhrase, "'", "''''" ) Call openDataConnection() strSQL = "select * from dirUsers where userEmail='" & strEmail & "' and userSecretPhrase='" & locSecretPhrase & "'" Response.Write "strSQL is " & strSQL & "
" Set rs = dataConnection.Execute( strSQL ) Call closeDataConnection() If rs.EOF AND rs.BOF Then retrievePassword = "" Else retrievePassword = rs.Fields("userPassword") End If End Function '************************************************************** ' FUNCTION: emailExists ' DESCRIPTION: ' PARAMETERS: the email ' RETURNS: true if email still available '************************************************************** Function emailExists( strEmail ) Dim strSQL, rs Call openDataConnection() strTableName = "dirUsers" strSQL = "SELECT * FROM " & strTableName & " WHERE userEmail='" & strEmail & "'" Set objQuery = dataConnection.Execute(strSQL) Call closeDataConnection() If objQuery.EOF=true AND objQuery.BOF=true Then 'i.e., objQuery is empty. emailExists = false Else emailExists = true End If End Function '************************************************************** ' FUNCTION: addressExist ' DESCRIPTION: ' PARAMETERS: the Address ' RETURNS: true if address exists '************************************************************** ' NOTE: Currently not used! '************************************************************** Function addressExists( strAddress, strCity, strProvince, strPostalCode, strCountry ) Dim strSQL, rs Dim locAddress, locCity, locProvince, locCountry locAddress = Replace( strAddress, "'", "''''" ) locCity = Replace( strCity, "'", "''''" ) locProvince = Replace( strProvince, "'", "''''" ) locCountry = Replace( strCountry, "'", "''''" ) Call openDataConnection() strTableName = "dirAddress" strSQL = "SELECT * FROM " & strTableName & " WHERE strAddress='" & locAddress & "'" & _ " AND strCity='" & strCity & "' AND " & "strProvince='" & locProvince & _ "' AND strPostalCode='" & locPostalCode & "' AND strCountry='" & locCountry Set objQuery = dataConnection.Execute(strSQL) Call closeDataConnection() If objQuery.EOF=true AND objQuery.BOF=true Then doesAddressExist = false Else doesAddressExist = true End If End Function '************************************************************** ' FUNCTION: getAddressId ' DESCRIPTION: ' PARAMETERS: strAddress, strCity, strProvince, strPostalCode, strCountry ' RETURNS: addressId '************************************************************** Function getAddressId( strAddress, strCity, strProvince, strPostalCode, strCountry ) Dim strSQL, rs Dim locAddress, locCity, locProvince, locCountry locAddress = Replace( strAddress, "'", "''''" ) locCity = Replace( strCity, "'", "''''" ) locProvince = Replace( strProvince, "'", "''''" ) locCountry = Replace( strCountry, "'", "''''" ) Call openDataConnection() strTableName = "dirAddresses" strSQL = "SELECT * FROM " & strTableName & " WHERE address1 LIKE '" & locAddress & "'" & _ " AND city='" & locCity & "' AND " & "province='" & locProvince & _ "' AND postalCode='" & locPostalCode & "' AND country='" & locCountry & "'" Set objQuery = dataConnection.Execute( strSQL ) Call closeDataConnection() If objQuery.EOF=true AND objQuery.BOF=true Then getAddressId = 0 Else getAddressId = objQuery.Fields("addressId") End If End Function '************************************************************** ' FUNCTION: createNewUser ' DESCRIPTION: Creates a new User into the System ' PARAMETERS: strEmail, strFirstname, strLastname, strPassword, strSecretPhrase, strSecretPhraseHint ' RETURNS: userId is created Successfully ' 0 if creation failed '************************************************************** ' TBD: Make this rollback during failure ' Modifications: 'ay111105 Add referring code '************************************************************** Function createNewUser(strEmail, strFirstname, strLastname, strPassword, strSecretPhrase, strSecretPhraseHint, strAddress, strCity, strProvince, strPostalCode, strCountry, strReferCode ) Dim strSQL, rs, rsNewUser Dim locAddress, locPassword, locCity, locProvince, locCountry, locSecretPhrase, locSecretPhraseHint, locReferCode locAddress = Replace( strAddress, "'", "''" ) locPassword = Replace( strPassword, "'", "''" ) locCity = Replace( strCity, "'", "''" ) locProvince = Replace( strProvince, "'", "''" ) locCountry = Replace( strCountry, "'", "''" ) locSecretPhrase = Replace( strSecretPhrase, "'", "''" ) locSecretPhraseHint = Replace( strSecretPhraseHint, "'", "''" ) 'ay111105 Add referring code locReferCode = Replace( strReferCode, "'", "''" ) Call openDataConnection() Set rsNewUser = Server.CreateObject("ADODB.RecordSet") With rsNewUser .Open "dirUsers", dataConnection, adOpenKeyset, adLockOptimistic .AddNew .Fields("userEmail") = strEmail .Fields("userFirstName") = strFirstname .Fields("userLastname") = strLastname .Fields("userPassword") = locPassword .Fields("userSecretPhrase") = locSecretPhrase .Fields("userSecretPhraseHint") = locSecretPhraseHint .Fields("userAddress") = locAddress .Fields("userCity") = locCity .Fields("userProvince") = locProvince .Fields("userPostalCode") = strPostalCode .Fields("userCountry") = locCountry 'ay111105 Add referring code .Fields("userReferCode") = locReferCode .Fields("userRegistrationDate") = Date() .Update userId = .Fields("userId") End With 'Check for Errors If Err.number <> 0 Then 'dataConnection.RollBackTrans userId = 0 End If Call closeDataConnection() createNewUser = userId End Function '************************************************************************* ' FUNCTION: retrieveUserDataFromDB ' DESCRIPTION: retrieves User Data from Database and stores it in ' Session parameters ' PARAMETERS: strEmail ' RETURNS: Success or Fail '************************************************************************* ' SIDE-EFFECTS: Overwrites Existing User Session Information '************************************************************************* ' REVISION 1.0 May 15, 2003 ' modified so that all values are filtered for "''" before being saved to ' the session value... 'ay111105 Add referring code '************************************************************************* Function retrieveUserDataFromDB( strEmail ) Dim strSQL, rs Dim bSuccess 'Prepare SQL statement strSQL = "SELECT * FROM dirUsers WHERE userEmail='" & strEmail & "'" 'Execute Query Call openDataConnection Set rs = dataConnection.Execute( strSQL ) Call closeDataConnection 'Obtain Information If NOT (rs.EOF AND rs.BOF) Then 'Retrieve Values strUserId = rs.Fields( "userId" ) strEmail = rs.Fields( "userEmail" ) strFirstname = rs.Fields( "userFirstname" ) strLastname = rs.Fields( "userLastname" ) strPassword = rs.Fields( "userPassword" ) strAddress = rs.Fields( "userAddress" ) strCity = rs.Fields( "userCity" ) strProvince = rs.Fields( "userProvince" ) strPostalCode = rs.Fields( "userPostalCode" ) strCountry = rs.Fields( "userCountry" ) strSecretPhrase = rs.Fields( "userSecretPhrase" ) strSecretPhraseHint = rs.Fields( "userSecretPhraseHint" ) 'ay111105 Add referring code strReferCode = rs.Fields( "userReferCode" ) 'Adjust SQL Escape Characters to HTML Escape Character for Apostrophe strAddress = Replace( strAddress, "''", APOSTROPHE_ESCAPE_CHARACTER ) strPassword = Replace( strPassword, "''", APOSTROPHE_ESCAPE_CHARACTER ) strCity = Replace( strCity, "''", APOSTROPHE_ESCAPE_CHARACTER ) strProvince = Replace( strProvince, "''", APOSTROPHE_ESCAPE_CHARACTER ) strCountry = Replace( strCountry, "''", APOSTROPHE_ESCAPE_CHARACTER ) strSecretPhrase = Replace( strSecretPhrase, "''", APOSTROPHE_ESCAPE_CHARACTER ) strSecretPhraseHint = Replace( strSecretPhraseHint, "''", APOSTROPHE_ESCAPE_CHARACTER ) 'ay111105 Add referring code strReferCode = Replace( strReferCode, "''", APOSTROPHE_ESCAPE_CHARACTER ) 'Update Session Variables Session("MyUserId") = strUserId Session("MyEmail") = strEmail Session("MyFirstname") = strFirstname Session("MyLastname") = strLastname Session("MyPassword") = strPassword Session("MyAddress") = strAddress Session("MyCity") = strCity Session("MyProvince") = strProvince Session("MyPostalCode") = strPostalCode Session("MyCountry") = strCountry Session("MySecretPhrase") = strSecretPhrase Session("MySecretPhraseHint") = strSecretPhraseHint 'ay111105 Add referring code Session("MyReferCode") = strReferCode 'Original Code 'Session("MyUserId") = rs.Fields( "userId" ) 'Session("MyEmail") = rs.Fields( "userEmail" ) 'Session("MyFirstname") = rs.Fields( "userFirstname" ) 'Session("MyLastname") = rs.Fields( "userLastname" ) 'Session("MyPassword") = rs.Fields( "userPassword" ) 'Session("MyAddress") = rs.Fields( "userAddress" ) 'Session("MyCity") = rs.Fields( "userCity" ) 'Session("MyProvince") = rs.Fields( "userProvince" ) 'Session("MyPostalCode") = rs.Fields( "userPostalCode" ) 'Session("MyCountry") = rs.Fields( "userCountry" ) 'Session("MySecretPhrase") = rs.Fields( "userSecretPhrase" ) 'Session("MySecretPhraseHint") = rs.Fields( "userSecretPhraseHint" ) '*********** Other Session Variables ************** Session("MyConfirmPassword") = rs.Fields( "userPassword" ) Session("MyConfirmEmail") = rs.Fields( "userEmail" ) Session("MyOriginalEmail") = rs.Fields( "userEmail" ) bSuccess = True Else bSuccess = False End If retrieveUserDataFromDB = bSuccess End Function '************************************************************** ' FUNCTION: updateUserData ' DESCRIPTION: Update an Existing Record from the the System ' PARAMETERS: strUserId, strEmail, strFirstname, strLastname, strPassword, strSecretPhrase, strSecretPhraseHint ' RETURNS: true if Successful ' false is UnSuccessful '************************************************************** ' TBD: Make this rollback during failure ' Modifications: 'ay111105 Add referring code '************************************************************** Function updateUserData(strUserId, strEmail, strFirstname, strLastname, strPassword, strSecretPhrase, strSecretPhraseHint, strAddress, strCity, strProvince, strPostalCode, strCountry ) Dim strSQL, rs, rsNewUser, bSuccess strAddress = Replace( strAddress, "'", "''" ) strPassword = Replace( strPassword, "'", "''" ) strCity = Replace( strCity, "'", "''" ) strProvince = Replace( strProvince, "'", "''" ) strCountry = Replace( strCountry, "'", "''" ) strSecretPhrase = Replace( strSecretPhrase, "'", "''" ) strSecretPhraseHint = Replace( strSecretPhraseHint, "'", "''" ) 'ay111105 Add referring code strReferCode = Replace( strReferCode, "'", "''" ) bSuccess = True 'Update the Records of Existing Record Call openDataConnection() Set rsNewUser = Server.CreateObject("ADODB.RecordSet") With rsNewUser .Open "SELECT * FROM dirUsers WHERE userId=" & strUserId, dataConnection, adOpenKeyset, adLockOptimistic .Fields("userEmail") = strEmail .Fields("userFirstName") = strFirstname .Fields("userLastname") = strLastname .Fields("userPassword") = strPassword .Fields("userSecretPhrase") = strSecretPhrase .Fields("userSecretPhraseHint") = strSecretPhraseHint .Fields("userAddress") = strAddress .Fields("userCity") = strCity .Fields("userProvince") = strProvince .Fields("userPostalCode") = strPostalCode .Fields("userCountry") = strCountry 'ay111105 Add referring code .Fields("userReferCode") = strReferCode .Update End With 'Check for Errors If Err.number <> 0 Then 'dataConnection.RollBackTrans bSuccess = False End If Call closeDataConnection() updateUserData = bSuccess End Function %>