<%
'==============================================================
' This file contains the database configuration. It also opens
' a connection object (Conn) using OpenCnx.
' The file also contains some common function.
'==============================================================
'Global scope variables:
Dim conn 'Connection object
Dim dbPassword 'Database password
'===========================================================
' Sub: OpenCnx
' Desc: 'Opens connection conn if it is not already open.
' >>> Please, modify configuration with correct values <<<
'===========================================================
Sub OpenCnx (ByRef conn)
If NOT IsObject(conn) Then
On Error Resume Next
Dim ConnStr 'Connection string
Dim dbPassword 'Database password
Set conn = Server.CreateObject("ADODB.Connection")
dbPassword = "QS2003p" ' <<<< Change any new Access database password here.
'-------------------------------------------------------
'Pick ONE of the following configurations and comment the others
'For additional tech. info see
' - http://www.able-consulting.com/ADO_Conn.htm
'-------------------------------------------------------
'1. Configuration for System DSN
'ConnStr = "DSN=DSN_Name;uid=;pwd=" & dbPassword
'2. Configuration for file DSN (DSN-Less)
'ConnStr = "DBQ=d:\inetpub\quadcomm.com\db\store.mdb;Driver={Microsoft Access Driver (*.mdb)};uid=;pwd=" & dbPassword
'3. Configuration for OLEDB drivers (more efficient)
'a) Example of OLEDB connection with OLEDB 3.51 (if you have to use this one you may want to
'consider installing a newer version of MDAC
'ConnStr = "Provider=Microsoft.Jet.OLEDB.3.51; Data Source=C:\web\quadcomm\db\store.mdb; Jet OLEDB:Database Password=" & dbPassword
'b)Example of OLEDB connection on Windows 2000 server (version 4.0)
'ConnStr = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=C:\web\quadcomm\db\store.mdb; Jet OLEDB:Database Password=" & dbPassword
ConnStr = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=C:\Web\starquestpublishing\db\store2K.mdb; Jet OLEDB:Database Password=" & dbPassword
'c)Example of OLEDB connection on Windows 2000 server (version 4.0) and MS SQL Server 7.0/2000
'ConnStr = "Provider=SQLOLEDB; Data Source=(local); Initial Catalog=QShopDB; User ID=qshop_usr; Password=" & dbPassword
'ConnStr = "Provider=SQLOLEDB; Data Source=(local); Initial Catalog=Q-Shop; User ID=sa; Password="
'-------------------------------------------------------
conn.open ConnStr 'Open connection object
'-------------------------------------------------------
'When the site is working we recommend you to comment
'Option 1 and uncomment option 2
'-------------------------------------------------------
If conn.errors.count > 0 then
Dim counter
For counter = 0 to conn.errors.count-1
If int(conn.errors(counter).number) <> 0 Then
' Option 1
response.write "Error # :" & conn.errors(counter).number & "
"
If conn.errors(counter).number = -2147467259 Then
response.write "Suggestion: Check the connection string ConnStr in conx.asp and make sure that only one option is not commented using '.
Mail error: Could not create mail object. " & " Err.Source=" & Err.Source& " Err.Number=" & Err.Number & " Err.Description=" & Err.Description & "
"
SendMail = -1
Exit Function
End If
If IsObject (MyCDO) Then
'MyCDO.SetLocaleIDs(1027) 'Use to set the code page identifier to be used for this messaging user
MyCDO.From = strFrom
MyCDO.To = strTo
If strCC <> "" Then
MyCDO.CC = strCC
End If
MyCDO.Subject = strSubject
'If there is attachment file path then attach it to mail
If strAttachPath <> "" Then
If strAttachName <> "" Then
MyCDO.AttachFile strAttachPath, strAttachName, CdoEncodingUUencode
else
MyCDO.AttachFile strAttachPath, , CdoEncodingUUencode
End If
End If
MyCDO.BodyFormat = CdoBodyFormatText ' CdoBodyFormatText | CdoBodyFormatHTML
MyCDO.MailFormat = CdoMailFormatMime ' CdoMailFormatMime | CdoMailFormatText
MyCDO.Body = strBody
'Send
MyCDO.Send
Set MyCDO = nothing
SendMail = 0
Else
SendMail = -1
End If
'Reset error handling
On Error Goto 0
End Function
'-----------------------------------------------------------
' SendMailing
' This function sends a mailing with CDONTS or calls another
' alternative function tailored to a specific component.
' Not all mail components have been included with HTML mailing
' support (only CDOSYS).
'-----------------------------------------------------------
Sub SendMailing (rsEmail, strFrom, strSubject, strBody, nMailFormat)
Dim MyCDO, strBody2
On Error Resume Next
'If shop is set to use JMail then call another sub and then exit.
If UCASE(shop_MailSystem) = "JMAIL" Then
Call SendJMailing (rsEmail, strFrom, strSubject, strBody, MailFormatText)
Exit Sub
ElseIf UCase(shop_MailSystem) = "ASPMAIL" Then
Call SendASPMailing (rsEmail, strFrom, strSubject, strBody, MailFormatText)
Exit Sub
ElseIf UCase(shop_MailSystem) = "CDOSYS" Then
Call SendCDOMailing (rsEmail, strFrom, strSubject, strBody, nMailFormat)
Exit Sub
End If
strBody2 = strBody
While NOT rsEmail.EOF
strBody2 = strBody
'Create mail object (CDONTS)
Set MyCDO = Server.CreateObject("CDONTS.NewMail")
If Err.Number <> 0 Then
Response.Write "
Mail error: Could not create mail object. " & " Err.Source=" & Err.Source& " Err.Number=" & Err.Number & " Err.Description=" & Err.Description & "
"
Exit Sub
End If
If IsObject (MyCDO) Then
'MyCDO.SetLocaleIDs(1027) 'Use to set the code page identifier to be used for this messaging user
MyCDO.From = strFrom
MyCDO.To = rsEmail("mail")
MyCDO.Subject = strSubject
Response.Write " Sending mail: " & rsEmail("mail")
'If there is attachment file path then attach it to mail
MyCDO.BodyFormat = 1 '0 = HTML, 1 = Plain Text
MyCDO.MailFormat = 0 '0: MIME, 1: Plain text.
'Replace template variables
For each cField in rsEmail.Fields
strBody2 = Replace(strBody2, "#" & cField.Name &"#", cField.Value)
Next
MyCDO.Body = strBody2
'Send
MyCDO.Send
If Err.Number <> 0 Then
Response.Write " -> Error sending mail"
End if
Set MyCDO = nothing
End If
rsEmail.MoveNext
Wend
'Reset error handling
On Error Goto 0
End Sub
'===========================================================================================
' CDOSYS functions
'===========================================================================================
Function SendCDOMail (strFrom, strTo, strCC, strSubject, strBody, strAttachPath, strAttachName)
Dim iMsg
Dim iConf
Dim Flds
On Error Resume Next
'Create message and configuration objects
set iMsg = CreateObject("CDO.Message")
set iConf = CreateObject("CDO.Configuration")
If Err.Number <> 0 Then
Response.Write "
Mail error: Could not create CDO mail object. " & " Err.Source=" & Err.Source& " Err.Number=" & Err.Number & " Err.Description=" & Err.Description & "
"
SendCDOMail = -1
Exit Function
End If
Set Flds = iConf.Fields
'If there is SMTP authentication username then add this information
If LEN(MAIL_SMTP_USERNAME) > 0 Then
With Flds
' Specify the authentication mechanism to basic (clear-text) authentication.
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = cdoBasic
' The username for authenticating to an SMTP server
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = MAIL_SMTP_USERNAME
' The password used to authenticate to an SMTP server
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = MAIL_SMTP_PASSWORD
End With
End If
' set CDOSYS configuration details
With Flds
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = cdoSendUsingPort
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = MAIL_SMTP_SERVER
.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 10
' The port on which the SMTP service specified by the smtpserver field is listening for connections (typically 25)
'.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
'Use SSL for the connection (False or True)
'.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = False
.Update
End With
' apply the settings to the message
With iMsg
Set .Configuration = iConf
.To = strTo
.From = strFrom
If strCC <> "" Then
.CC = strCC
End If
.Subject = strSubject
If strAttachPath <> "" Then
.AddAttachment strAttachPath
End If
'.HTMLBody = strHTML
.TextBody = strBody
err.Clear
'Send message
.Send
If err.Number <> 0 Then
'Error
Response.write "
Error sending message:
" & err.Description & "
"
SendCDOMail = -1
Else
'Message sent succesfully!
SendCDOMail = 0
End If
End With
' cleanup of variables
Set iMsg = Nothing
Set iConf = Nothing
Set Flds = Nothing
End Function
Sub SendCDOMailing (rsEmail, strFrom, strSubject, strBody, nMailFormat)
Dim strBody2
Dim iMsg
Dim iConf
Dim Flds
On Error Resume Next
'Create message and configuration objects
set iMsg = CreateObject("CDO.Message")
set iConf = CreateObject("CDO.Configuration")
If Err.Number <> 0 Then
Response.Write "
Mail error: Could not create CDO mail object. " & " Err.Source=" & Err.Source & " Err.Number=" & Err.Number & " Err.Description=" & Err.Description & "
"
'SendCDOMailing = -1
'Exit Sub
End If
Set Flds = iConf.Fields
'If there is SMTP authentication username then add this information
If LEN(MAIL_SMTP_USERNAME) > 0 Then
With Flds
' Specify the authentication mechanism to basic (clear-text) authentication.
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = cdoBasic
' The username for authenticating to an SMTP server
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = MAIL_SMTP_USERNAME
' The password used to authenticate to an SMTP server
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = MAIL_SMTP_PASSWORD
End With
End If
' set CDOSYS configuration details
With Flds
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = cdoSendUsingPort
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = MAIL_SMTP_SERVER
.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 10
' The port on which the SMTP service specified by the smtpserver field is listening for connections (typically 25)
'.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
'Use SSL for the connection (False or True)
'.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = False
.Update
End With
Set iMsg.Configuration = iConf
'Loop through all records:
While NOT rsEmail.EOF
'Copy template into temporaty placeholder
strBody2 = strBody
'Replace template variables
For each cField in rsEmail.Fields
strBody2 = Replace(strBody2, "#" & cField.Name &"#", cField.Value)
Next
With iMsg
.To = rsEmail("mail")
.From = shop_CompanyName & "<" & strFrom & ">"
If strCC <> "" Then
.CC = strCC
End If
.Subject = strSubject
Response.Write " Sending mail: " & rsEmail("mail")
If nMailFormat = MailFormatText Then
.TextBody = strBody2
ElseIf nMailFormat = MailFormatHtml Then
.HTMLBody = strBody2
Else
.TextBody = strBody2
End If
err.Clear
'Send message
.Send
If err.Number <> 0 Then
'Error
Response.write "
Error sending message:
" & err.Description & "
"
SendCDOMailing = -1
Else
'Message sent succesfully!
SendCDOMailing = 0
End If
End With
rsEmail.MoveNext
Wend
End Sub
'===========================================================================================
' End of CDOSYS functions
'===========================================================================================
'===========================================================================================
' JMail functions
'===========================================================================================
Function SendJMail (strFrom, strTo, strCC, strSubject, strBody, strAttachPath, strAttachName)
Dim objJMail
On Error Resume Next
' Create the JMail message Object
Set objJMail = Server.CreateObject("JMail.Message")
If Err.Number <> 0 Then
Response.Write "
Mail error: Could not create mail object. " & " Err.Source=" & Err.Source& " Err.Number=" & Err.Number & " Err.Description=" & Err.Description & "
"
Exit Function
End If
' Set logging to true to ease any potential debugging
' And set silent to true as we wish to handle our errors ourself
objJMail.Logging = True
objJMail.silent = False
If IsObject (objJMail) Then
objJMail.From = strFrom
objJMail.FromName = shop_CompanyName
'objJMail.AddRecipient "recipient@hisDomain.com", "His Name"
objJMail.AddRecipient strTo
If strCC <> "" Then
objJMail.AddRecipientCC strCC
End If
objJMail.Subject = strSubject
'If there is attachment file path then attach it to mail
If strAttachPath <> "" Then
If strAttachName <> "" Then
'objJMail.AttachFile strAttachPath, strAttachName
objJMail.AddAttachment(strAttachPath)
else
'objJMail.AttachFile strAttachPath
objJMail.AddAttachment(strAttachPath)
End If
End If
objJMail.Body = strBody
'Send message
If NOT objJMail.Send( MAIL_SMTP_SERVER ) then
'Error
Response.write "
Error sending message:
" & objJMail.log & "
"
SendJMail = -1
Else
'Message sent succesfully!
SendJMail = 0
End If
Set objJMail = nothing
Else
SendJMail = -1
End If
End Function
Sub SendJMailing (rsEmail, strFrom, strSubject, strBody)
Dim objJMail, strBody2
On Error Resume Next
strBody2 = strBody
While NOT rsEmail.EOF
strBody2 = strBody
' Create the JMail message Object
Set objJMail = Server.CreateObject("JMail.Message")
If Err.Number <> 0 Then
Response.Write "Mail error: Could not create mail object. " & "Err.Number=" & Err.Number & ", Err.Description=" & Err.Description & ", Err.Source=" & Err.Source & " "
Exit Sub
End If
If IsObject (objJMail) Then
objJMail.From = strFrom
objJMail.FromName = shop_CompanyName
objJMail.AddRecipient rsEmail("mail")
objJMail.Subject = strSubject
Response.Write " Sending mail: " & rsEmail("mail")
'Replace template variables
For each cField in rsEmail.Fields
strBody2 = Replace(strBody2, "#" & cField.Name &"#", cField.Value)
Next
objJMail.Body = strBody2
'Send
'Configure your SMTP server:
If NOT objJMail.Send(MAIL_SMTP_SERVER) then
'Error
Response.Write "Error sending mail"
Response.write "
Error sending message:
" & objJMail.log & "
"
End If
Set objJMail = nothing
End If
rsEmail.MoveNext
Wend
End Sub
'===========================================================================================
' End of JMail functions
'===========================================================================================
'===========================================================================================
' ASPMail functions (ASPMail documentation at http://www.serverobjects.com
'===========================================================================================
Function SendASPMail (strFrom, strTo, strCC, strSubject, strBody, strAttachPath, strAttachName)
Dim objASPMail
On Error Resume Next
' Create the ASPMail message Object
Set objASPMail = Server.CreateObject("SMTPsvg.Mailer")
If Err.Number <> 0 Then
Response.Write "
Mail error: Could not create mail object, check that ASPMail is installed. " & " Err.Source=" & Err.Source& " Err.Number=" & Err.Number & " Err.Description=" & Err.Description & "
"
Exit Function
End If
If IsObject (objASPMail) Then
'Configure your SMTP server:
objASPMail.RemoteHost = MAIL_SMTP_SERVER
objASPMail.FromName = shop_CompanyName
objASPMail.FromAddress = strFrom
'objASPMail.AddRecipient "His Name", "recipient@hisDomain.com"
objASPMail.AddRecipient "", strTo
If strCC <> "" Then
objASPMail.AddCC "", strCC
End If
objASPMail.Subject = strSubject
'If there is attachment file path then attach it to mail
If strAttachPath <> "" Then
If strAttachName <> "" Then
objASPMail.AddAttachment(strAttachPath)
else
objASPMail.AddAttachment(strAttachPath)
End If
End If
objASPMail.BodyText = strBody
'Send message
'Configure your SMTP server:
If NOT objASPMail.SendMail then
'Error
Response.write "
Error sending message.
" & objASPMail.Response & "
"
SendASPMail = -1
Else
'Message sent succesfully!
SendASPMail = 0
End If
Set objASPMail = nothing
Else
SendASPMail = -1
End If
'Reset error handling
On Error Goto 0
End Function
Sub SendASPMailing (rsEmail, strFrom, strSubject, strBody)
Dim objASPMail, strBody2
On Error Resume Next
strBody2 = strBody
While NOT rsEmail.EOF
strBody2 = strBody
'Create the ASPMail message Object
Set objASPMail = Server.CreateObject("SMTPsvg.Mailer")
If Err.Number <> 0 Then
Response.Write "
Mail error: Could not create mail object. " & " Err.Source=" & Err.Source& " Err.Number=" & Err.Number & " Err.Description=" & Err.Description & "
"
Exit Sub
End If
If IsObject (objASPMail) Then
'Configure your SMTP server:
objASPMail.RemoteHost = MAIL_SMTP_SERVER
'objASPMail.FromName = shop_CompanyName
objASPMail.FromAddress = strFrom
objASPMail.AddRecipient rsEmail("Name") & " " & rsEmail("Surname"), rsEmail("mail")
objASPMail.Subject = strSubject
Response.Write " Sending mail: " & rsEmail("mail")
'Replace template variables
For each cField in rsEmail.Fields
strBody2 = Replace(strBody2, "#" & cField.Name &"#", cField.Value)
Next
objASPMail.BodyText = strBody2
'Send
If NOT objASPMail.SendMail then
'Error
Response.Write " -> Error sending mail"
Response.write "
Error sending message:
" & objASPMail.Response & "
"
End If
Set objASPMail = nothing
End If
rsEmail.MoveNext
Wend
End Sub
'===========================================================================================
' End of ASPMail functions
'===========================================================================================
%>
<% Response.Buffer = True %>
<%= shop_Title %>
<%
'======================================================================================
' File: head.inc
' Description: This file produces the HTML for the definition of the top of all the
' shop pages. It also includes a call to the include file that creates
' the left hand side navigation bar leftinc.asp and until the creation of
' the cell that contains the main body of the pages.
'======================================================================================
' Initialise cat variable with the contents of Request("cat"). This holds current
' category/section
Dim strNav
If Request("cat") <> "" Then strNav = "cat=" & Request("cat") & "&path=" & Request("path")
%>
<%
Dim strSQL, errNumber, rsUsr
'If data has been posted send email
If Request("sendpwd") <> "" Then
strSQL = "SELECT * FROM Users WHERE UserID = '" & Trim(Request("UserID")) & "' OR Mail = '" & Trim(Request("UserID")) & "'"
set rsUsr = conn.Execute (strSQL)
If rsUsr.EOF AND rsUsr.BOF Then
'Not valid
Response.Write("
Sorry, we couldn't find your details in our users database. Please, check that your e-mail address is correct.
")
elseif rsUsr("Pwd") = "" OR IsNull(rsUsr("Pwd")) Then
'Password not set
Response.Write("
Sorry, this user does not have a password. Please contact us.
")
else
On Error resume Next
Dim TBdy
TBdy = "Hello," & vbCrLf & vbCrLf & "This mail has been sent following your request. Your user details are:" & vbCrLf & vbCrLf
TBdy = TBdy & CR & CR & vbTab & "E-mail : " & rsUsr("Mail") & vbCrLf
TBdy = TBdy & CR & CR & vbTab & "User ID : " & rsUsr("UserID") & " (optional login)" & vbCrLf
TBdy = TBdy & CR & CR & vbTab & "Password: " & rsUsr("Pwd") & vbCrLf & vbCrLf
TBdy = TBdy & "Thank you." & vbCrLf & vbCrLf & Application("CompanyName")
'err SendMail (strFrom, strTo, strCC, strSubject, strBody, strAttachPath, strAttachName)
errNumber = SendMail (Application("Mail"), rsUsr("mail"), null, Application("CompanyName"), TBdy, "", "")
On Error Goto 0
If errNumber1 < 0 Then %>
Sorry, there was a problem sending the message, please, contact us using the alternative e-mail address "><%= Application("Mail") %>.
Thank you.
<%
Else
Response.Write("
We have sent a message, with your password to your email address. You should receive it in the next minutes.
Thanks.
")
End If
End If 'If IfrsUsr.EOF AND rsUsr.BOF
set rsUsr = nothing
Else
'Show form with User ID pre-filled
%>
Note: We will send an email to your registered e-mail address for security reasons.
Cart
Feedback
