%@ Language=VBScript %>
<%
option explicit
Response.Buffer = True
%>
<%
'@BEGINVERSIONINFO
'@APPVERSION: 5.3001.0.1
'@FILENAME: db.conn.open.asp
'
'@DESCRIPTION: Opens Database Connection
'@STARTCOPYRIGHT
'The contents of this file is protected under the United States
'copyright laws as an unpublished work, and is confidential and proprietary to
'LaGarde, Incorporated. Its use or disclosure in whole or in part without the
'expressed written permission of LaGarde, Incorporated is expressly prohibited.
'
'(c) Copyright 2000 by LaGarde, Incorporated. All rights reserved.
'@ENDCOPYRIGHT
'@ENDVERSIONINFO
' Variable Declarations
Dim cnn, DSN_Name
' Object Creation
Set cnn=Server.CreateObject("ADODB.Connection")
If Session("DSN_Name") = "" Then
'***********DSN NAME*********************
' DSN_Name = "YOUR DSN NAME"
' ADDED DSN_Name below 03-27-02
DSN_Name = "larrysmithdsn"
'****************************************
Session("DSN_Name") = trim(DSN_Name)
Else
DSN_Name = Session("DSN_Name")
End If
'DSN_Name = Session("DSN_Name")
cnn.open DSN_Name
'-------------------------------------------------------------------
' Function that releases an object
'-------------------------------------------------------------------
Sub closeObj(objItem)
On Error Resume Next
objItem.Close
Set objItem=nothing
On Error GoTo 0
End Sub
%>
<%
'--------------------------------------------------------------------
' Microsoft ADO
'
' (c) 1996 Microsoft Corporation. All Rights Reserved.
'
'
'
' ADO constants include file for VBScript
'
'--------------------------------------------------------------------
'---- CursorTypeEnum Values ----
Const adOpenForwardOnly = 0
Const adOpenKeyset = 1
Const adOpenDynamic = 2
Const adOpenStatic = 3
'---- CursorOptionEnum Values ----
Const adHoldRecords = &H00000100
Const adMovePrevious = &H00000200
Const adAddNew = &H01000400
Const adDelete = &H01000800
Const adUpdate = &H01008000
Const adBookmark = &H00002000
Const adApproxPosition = &H00004000
Const adUpdateBatch = &H00010000
Const adResync = &H00020000
Const adNotify = &H00040000
'---- LockTypeEnum Values ----
Const adLockReadOnly = 1
Const adLockPessimistic = 2
Const adLockOptimistic = 3
Const adLockBatchOptimistic = 4
'---- ExecuteOptionEnum Values ----
Const adRunAsync = &H00000010
'---- ObjectStateEnum Values ----
Const adStateClosed = &H00000000
Const adStateOpen = &H00000001
Const adStateConnecting = &H00000002
Const adStateExecuting = &H00000004
'---- CursorLocationEnum Values ----
Const adUseServer = 2
Const adUseClient = 3
'---- DataTypeEnum Values ----
Const adEmpty = 0
Const adTinyInt = 16
Const adSmallInt = 2
Const adInteger = 3
Const adBigInt = 20
Const adUnsignedTinyInt = 17
Const adUnsignedSmallInt = 18
Const adUnsignedInt = 19
Const adUnsignedBigInt = 21
Const adSingle = 4
Const adDouble = 5
Const adCurrency = 6
Const adDecimal = 14
Const adNumeric = 131
Const adBoolean = 11
Const adError = 10
Const adUserDefined = 132
Const adVariant = 12
Const adIDispatch = 9
Const adIUnknown = 13
Const adGUID = 72
Const adDate = 7
Const adDBDate = 133
Const adDBTime = 134
Const adDBTimeStamp = 135
Const adBSTR = 8
Const adChar = 129
Const adVarChar = 200
Const adLongVarChar = 201
Const adWChar = 130
Const adVarWChar = 202
Const adLongVarWChar = 203
Const adBinary = 128
Const adVarBinary = 204
Const adLongVarBinary = 205
'---- FieldAttributeEnum Values ----
Const adFldMayDefer = &H00000002
Const adFldUpdatable = &H00000004
Const adFldUnknownUpdatable = &H00000008
Const adFldFixed = &H00000010
Const adFldIsNullable = &H00000020
Const adFldMayBeNull = &H00000040
Const adFldLong = &H00000080
Const adFldRowID = &H00000100
Const adFldRowVersion = &H00000200
Const adFldCacheDeferred = &H00001000
'---- EditModeEnum Values ----
Const adEditNone = &H0000
Const adEditInProgress = &H0001
Const adEditAdd = &H0002
Const adEditDelete = &H0004
'---- RecordStatusEnum Values ----
Const adRecOK = &H0000000
Const adRecNew = &H0000001
Const adRecModified = &H0000002
Const adRecDeleted = &H0000004
Const adRecUnmodified = &H0000008
Const adRecInvalid = &H0000010
Const adRecMultipleChanges = &H0000040
Const adRecPendingChanges = &H0000080
Const adRecCanceled = &H0000100
Const adRecCantRelease = &H0000400
Const adRecConcurrencyViolation = &H0000800
Const adRecIntegrityViolation = &H0001000
Const adRecMaxChangesExceeded = &H0002000
Const adRecObjectOpen = &H0004000
Const adRecOutOfMemory = &H0008000
Const adRecPermissionDenied = &H0010000
Const adRecSchemaViolation = &H0020000
Const adRecDBDeleted = &H0040000
'---- GetRowsOptionEnum Values ----
Const adGetRowsRest = -1
'---- PositionEnum Values ----
Const adPosUnknown = -1
Const adPosBOF = -2
Const adPosEOF = -3
'---- enum Values ----
Const adBookmarkCurrent = 0
Const adBookmarkFirst = 1
Const adBookmarkLast = 2
'---- MarshalOptionsEnum Values ----
Const adMarshalAll = 0
Const adMarshalModifiedOnly = 1
'---- AffectEnum Values ----
Const adAffectCurrent = 1
Const adAffectGroup = 2
Const adAffectAll = 3
'---- FilterGroupEnum Values ----
Const adFilterNone = 0
Const adFilterPendingRecords = 1
Const adFilterAffectedRecords = 2
Const adFilterFetchedRecords = 3
Const adFilterPredicate = 4
'---- SearchDirection Values ----
Const adSearchForward = 1
Const adSearchBackward = -1
'---- ConnectPromptEnum Values ----
Const adPromptAlways = 1
Const adPromptComplete = 2
Const adPromptCompleteRequired = 3
Const adPromptNever = 4
'---- ConnectModeEnum Values ----
Const adModeUnknown = 0
Const adModeRead = 1
Const adModeWrite = 2
Const adModeReadWrite = 3
Const adModeShareDenyRead = 4
Const adModeShareDenyWrite = 8
Const adModeShareExclusive = &Hc
Const adModeShareDenyNone = &H10
'---- IsolationLevelEnum Values ----
Const adXactUnspecified = &Hffffffff
Const adXactChaos = &H00000010
Const adXactReadUncommitted = &H00000100
Const adXactBrowse = &H00000100
Const adXactCursorStability = &H00001000
Const adXactReadCommitted = &H00001000
Const adXactRepeatableRead = &H00010000
Const adXactSerializable = &H00100000
Const adXactIsolated = &H00100000
'---- XactAttributeEnum Values ----
Const adXactCommitRetaining = &H00020000
Const adXactAbortRetaining = &H00040000
'---- PropertyAttributesEnum Values ----
Const adPropNotSupported = &H0000
Const adPropRequired = &H0001
Const adPropOptional = &H0002
Const adPropRead = &H0200
Const adPropWrite = &H0400
'---- ErrorValueEnum Values ----
Const adErrInvalidArgument = &Hbb9
Const adErrNoCurrentRecord = &Hbcd
Const adErrIllegalOperation = &Hc93
Const adErrInTransaction = &Hcae
Const adErrFeatureNotAvailable = &Hcb3
Const adErrItemNotFound = &Hcc1
Const adErrObjectInCollection = &Hd27
Const adErrObjectNotSet = &Hd5c
Const adErrDataConversion = &Hd5d
Const adErrObjectClosed = &He78
Const adErrObjectOpen = &He79
Const adErrProviderNotFound = &He7a
Const adErrBoundToCommand = &He7b
Const adErrInvalidParamInfo = &He7c
Const adErrInvalidConnection = &He7d
Const adErrStillExecuting = &He7f
Const adErrStillConnecting = &He81
'---- ParameterAttributesEnum Values ----
Const adParamSigned = &H0010
Const adParamNullable = &H0040
Const adParamLong = &H0080
'---- ParameterDirectionEnum Values ----
Const adParamUnknown = &H0000
Const adParamInput = &H0001
Const adParamOutput = &H0002
Const adParamInputOutput = &H0003
Const adParamReturnValue = &H0004
'---- CommandTypeEnum Values ----
Const adCmdUnknown = &H0008
Const adCmdText = &H0001
Const adCmdTable = &H0002
Const adCmdStoredProc = &H0004
'---- SchemaEnum Values ----
Const adSchemaProviderSpecific = -1
Const adSchemaAsserts = 0
Const adSchemaCatalogs = 1
Const adSchemaCharacterSets = 2
Const adSchemaCollations = 3
Const adSchemaColumns = 4
Const adSchemaCheckConstraints = 5
Const adSchemaConstraintColumnUsage = 6
Const adSchemaConstraintTableUsage = 7
Const adSchemaKeyColumnUsage = 8
Const adSchemaReferentialContraints = 9
Const adSchemaTableConstraints = 10
Const adSchemaColumnsDomainUsage = 11
Const adSchemaIndexes = 12
Const adSchemaColumnPrivileges = 13
Const adSchemaTablePrivileges = 14
Const adSchemaUsagePrivileges = 15
Const adSchemaProcedures = 16
Const adSchemaSchemata = 17
Const adSchemaSQLLanguages = 18
Const adSchemaStatistics = 19
Const adSchemaTables = 20
Const adSchemaTranslations = 21
Const adSchemaProviderTypes = 22
Const adSchemaViews = 23
Const adSchemaViewColumnUsage = 24
Const adSchemaViewTableUsage = 25
Const adSchemaProcedureParameters = 26
Const adSchemaForeignKeys = 27
Const adSchemaPrimaryKeys = 28
Const adSchemaProcedureColumns = 29
''''CDO CONST
Const cdoSendUsingMethod ="http://schemas.microsoft.com/cdo/configuration/sendusing"
Const cdoSMTPServerPort ="http://schemas.microsoft.com/cdo/configuration/smtpserverportcdoSendUsingPort"
Const cdoSMTPServer ="http://schemas.microsoft.com/cdo/configuration/smtpserver"
Const cdoSendUsingPort =2
Const cdoSMTPConnectionTimeout =5
Const cdoSMTPAuthenticate ="http://schemas.microsoft.com/cdo/configuration/smtpauthenticate"
Const cdoURLProxyServer ="http://schemas.microsoft.com/cdo/configuration/urlproxyserver"
Const cdoURLProxyBypass ="http://schemas.microsoft.com/cdo/configuration/urlproxybypass"
Const cdoURLGetLatestVersion ="http://schemas.microsoft.com/cdo/configuration/urlgetlatestversion"
Const cdoSendUserName ="http://schemas.microsoft.com/cdo/configuration/sendusername"
Const cdoSendPassword ="http://schemas.microsoft.com/cdo/configuration/sendpassword"
''''''''''''''''''''
%>
<%
'--------------------------------------------------------------------
'@BEGINVERSIONINFO
'@APPVERSION: 50.3008.0.2
'@FILENAME: incSearCHrESULTS.asp
'Access Version
'@DESCRIPTION: functions to return search results
'@STARTCOPYRIGHT
'The contents of this file is protected under the United States
'copyright laws as an unpublished work, and is confidential and proprietary to
'LaGarde, Incorporated. Its use or disclosure in whole or in part without the
'expressed written permission of LaGarde, Incorporated is expressly prohibited.
'
'(c) Copyright 2000 by LaGarde, Incorporated. All rights reserved.
'@ENDCOPYRIGHT
'@ENDVERSIONINFO
'Modified 11/20/01
'Storefront Ref#'s: 131 'JF
Function getManufacturersList(iValue)
' Variable Declarations
Dim rsManufacturersList
Dim sList
Dim intId
' Object Creation and Query
Set rsManufacturersList = Server.CreateObject("ADODB.RecordSet")
rsManufacturersList.Open "select mfgID, mfgName from sfManufacturers ORDER BY mfgName", cnn, adOpenForwardOnly, adLockOptimistic, adCmdText 'adCmdTable
sList = ""
If iValue = "" Then
Do While Not rsManufacturersList.EOF
sList = sList & ""
rsManufacturersList.MoveNext
Loop
Else
Do While Not rsManufacturersList.EOF
intId = trim(rsManufacturersList.Fields("mfgID"))
If iValue = intId Then
slist = slist & ""
Else
slist = slist & ""
End If
rsManufacturersList.MoveNext
Loop
End If
'object cleanup
rsManufacturersList.Close
Set rsManufacturersList = nothing
'return value
getManufacturersList = sList
End Function
Function getVendorList(iValue)
' Variable Declarations
Dim rsVendorList
Dim sList
Dim intId
' Object Creation and Query
Set rsVendorList = Server.CreateObject("ADODB.RecordSet")
rsVendorList.Open "select vendID,vendName from sfVendors ORDER BY vendName", cnn, adOpenForwardOnly, adLockOptimistic, adCmdText 'adCmdTable
sList = ""
If iValue = "" Then
Do While Not rsVendorList.EOF
sList = sList & ""
rsVendorList.MoveNext
Loop
Else
Do While Not rsVendorList.EOF
intId = trim(rsVendorList.Fields("vendID"))
If iValue = intId Then
sList = sList & ""
Else
sList = sList & ""
End If
rsVendorList.MoveNext
Loop
End If
'object cleanup
rsVendorList.Close
Set rsVendorList = nothing
'return value
getVendorList = sList
End Function
'--------------------------------------------------------------------
' Function : getCategoryList
' This returns the category list in HTML format for dropdown box.
'--------------------------------------------------------------------
Function getCategoryList(iValue)
' Variable Declarations
Dim rsCategoryList
Dim sList
Dim intId
' Object Creation and Query
Set rsCategoryList = Server.CreateObject("ADODB.RecordSet")
'rsCategoryList.Open "SELECT DISTINCT catID, catName FROM sfCategories INNER JOIN sfProducts ON sfCategories.catID = sfProducts.prodCategoryId ORDER BY CatName", cnn, adOpenForwardOnly, adLockOptimistic, adCmdText
rsCategoryList.Open "SELECT DISTINCT catID, catName FROM sfCategories ", cnn, adOpenForwardOnly, adLockOptimistic, adCmdText
sList = ""
If iValue = "" Then
Do While Not rsCategoryList.EOF
sList = sList & ""
rsCategoryList.MoveNext
Loop
Else
Do While Not rsCategoryList.EOF
intId = trim(rsCategoryList.Fields("catID"))
If iValue = intId Then
sList = sList & ""
Else
sList = sList & ""
End If
rsCategoryList.MoveNext
Loop
End If
' Object Cleanup
rsCategoryList.Close
Set rsCategoryList = nothing
' Return Value
getCategoryList = sList
End Function
Function getSubCategoryList(ilevel,subcatID)
'on error resume next
' Variable Declarations
Dim rsSubCategoryList
Dim sList,iLen
dim sSQl,sHierarchy
dim MainCatID
'Response.Write subcatID
if instr(subcatid, "-") > 0 then
getSubCategoryList =""
exit function
end if
if ilevel = 1 And subCatID <> "ALL" then
MainCatID = setSubcatId(subCatId,"subcatCategoryId","subcatCategoryId")
elseif ilevel > 1 And subCatID <> "ALL" then
MainCatID = setSubcatId(subCatId,"subCatId","subcatCategoryId")
end if
'subCatID = setSubcatId(subCatId,"subcatCategoryId")
if subCatID <> "ALL" then
sHierarchy = getCatHierarchy(subcatID)
iLen = len(sHierarchy)
if Ilevel = 1 then
sSQl = "SELECT Distinct subcatCategoryId, subcatID ,SubcatName,Bottom FROM sfSub_Categories Where Depth = " & iLevel & " And subcatCategoryId = " & MainCatID
else
sSQl = "SELECT Distinct subcatCategoryId, subcatID ,SubcatName,Bottom FROM sfSub_Categories Where Depth = " & iLevel & " And subcatCategoryId = " & MainCatID & _
" AND LEFT(CatHierarchy," & iLen & ") = '" & sHierarchy & "'"
end if
Set rsSubCategoryList = Server.CreateObject("ADODB.RecordSet")
rsSubCategoryList.Open sSQL , cnn, adOpenForwardOnly, adLockOptimistic, adCmdText
if rsSubCategoryList.EOF = false and rsSubCategoryList.BOF =false then
'sList = sList & ""
Do While Not rsSubCategoryList.EOF
if rsSubCategoryList.Fields("Bottom") = 1 then
sList = sList & ""
else
sList = sList & ""
end if
rsSubCategoryList.MoveNext
Loop
getSubCategoryList = sList
else
getSubCategoryList =""
end if
else
sSQl = "SELECT DISTINCT catID, catName FROM sfCategories "
'sSQl ="SELECT sfCategories.catName, sfSub_Categories.subcatName, sfSub_Categories.subcatID " _
' & "FROM sfCategories RIGHT JOIN sfSub_Categories ON sfCategories.catID = sfSub_Categories.subcatCategoryId " _
' & " Where sfSub_Categories.Depth = " & iLevel
Set rsSubCategoryList = Server.CreateObject("ADODB.RecordSet")
rsSubCategoryList.Open sSQL , cnn, adOpenForwardOnly, adLockOptimistic, adCmdText
if rsSubCategoryList.EOF = false and rsSubCategoryList.BOF =false then
Do While Not rsSubCategoryList.EOF
sList = sList & ""
rsSubCategoryList.MoveNext
Loop
getSubCategoryList = sList
else
getSubCategoryList =""
end if
end if
'Response.Write sSql
' Object Cleanup
rsSubCategoryList.Close
Set rsSubCategoryList = nothing
' Return Value
End Function
Function getProductSQLAE(searchParamType, searchParamTxt, searchParamCat, searchParamMan, searchParamVen, DateAddedStart, DateAddedEnd, PriceStart, PriceEnd, Sale,subCatID,Ilevel)
if instr(subcatid, "bottom") > 0 then
subcatid = left(subcatID,instr(subcatId,"-")-1)
end if
Dim upperLim, SQL, counter, txtArray
searchParamTxt = Replace(searchParamTxt, "*", "")
sSubcat = subCatID
if iLevel = 1 and subCatID <> "ALL" then
subCatId = setSubcatId(subCatId,"subcatCategoryId","subcatCategoryId")
end if
if iLevel = 1 then sALLSUB = "ALL"
if subCatID = "ALL" Then
'Response.Write "1 "
'SQL = " SELECT sfProducts.ProdID, sfProducts.prodName, sfProducts.prodImageSmallPath, sfProducts.prodLink, sfProducts.prodPrice, sfProducts.prodSaleIsActive, sfProducts.prodSalePrice,sfSub_Categories.CatHierarchy," _
'& "sfProducts.prodDescription, sfProducts.prodAttrNum, sfProducts.prodCategoryId, sfProducts.prodShortDescription" _
'& " FROM (sfProducts INNER JOIN sfSubCatDetail ON sfProducts.prodID = sfSubCatDetail.ProdID) INNER JOIN sfSub_Categories ON sfSubCatdetail.subcatCategoryId = sfSub_Categories.SubcatID WHERE "
SQL = "SELECT ProdID, prodName, prodImageSmallPath, prodLink, prodPrice, prodSaleIsActive, prodSalePrice, ProdID, prodDescription, prodAttrNum, prodCategoryId, prodShortDescription " _
& "FROM sfProducts WHERE "
elseif instr(subCatID,";") > 0 Then
' Response.Write "2 "
'
SQL = " SELECT sfProducts.ProdID, sfProducts.prodName, sfProducts.prodImageSmallPath, sfProducts.prodLink, sfProducts.prodPrice, sfProducts.prodSaleIsActive, sfProducts.prodSalePrice,sfSub_Categories.CatHierarchy," _
& "sfProducts.prodDescription, sfProducts.prodAttrNum, sfProducts.prodCategoryId, sfProducts.prodShortDescription" _
& " FROM (sfProducts INNER JOIN sfSubCatDetail ON sfProducts.prodID = sfSubCatDetail.ProdID) INNER JOIN sfSub_Categories ON sfSubCatdetail.subcatCategoryId = sfSub_Categories.SubcatID "
SQL = SQL & " WHERE (sfSubCatDetail.subcatCategoryId IN (Select subcatCategoryId From sfSubCatDetail Where subcatCategoryId = " & GetSubCatIDs(sSubCat) & ")) AND "
else
SQL = " SELECT sfProducts.ProdID, sfProducts.prodName, sfProducts.prodImageSmallPath, sfProducts.prodLink, sfProducts.prodPrice, sfProducts.prodSaleIsActive, sfProducts.prodSalePrice,sfSub_Categories.CatHierarchy," _
& "sfProducts.prodDescription, sfProducts.prodAttrNum, sfProducts.prodCategoryId, sfProducts.prodShortDescription" _
& " FROM (sfProducts INNER JOIN sfSubCatDetail ON sfProducts.prodID = sfSubCatDetail.ProdID) INNER JOIN sfSub_Categories ON sfSubCatdetail.subcatCategoryId = sfSub_Categories.SubcatID "
if sALLSUB <> "ALL" Then
' Response.Write "3-1 "
SQL = SQL & " WHERE (sfSubCatDetail.subcatCategoryId IN (Select subcatCategoryId From sfSubCatDetail Where subcatCategoryId = " & GetSubCatIDs(sSubCat) & ")) AND "
else
' Response.Write "3-2 "
SQL = SQL & " WHERE sfSubCatDetail.subcatCategoryId IN (Select subcatID From sfSub_Categories Where subcatCategoryId= " & sSubCat & ") AND "
end if
end if
if searchParamTxt <> "" Then
If searchParamType = "ALL" Then
' Response.Write " A
"
txtArray = split(searchParamTxt, " ")
upperLim = Ubound(txtArray)
If searchParamTxt <> "" Then
For counter=0 to (upperLim-1)
SQL = SQL & " (sfProducts.prodName LIKE '%" & txtArray(counter) & "%' OR sfProducts.prodShortDescription LIKE '%" & txtArray(counter) & "%' OR sfProducts.prodID LIKE '%" & txtArray(counter) & "%' OR sfProducts.prodDescription LIKE '%" & txtArray(counter) & "%') AND "
Next
SQL = SQL & " (sfProducts.prodName LIKE '%" & txtArray(counter) & "%' OR sfProducts.prodShortDescription LIKE '%" & txtArray(counter) & "%' OR sfProducts.prodID LIKE '%" & txtArray(counter) & "%' OR sfProducts.prodDescription LIKE '%" & txtArray(counter) & "%') AND "
End If
' Response.Write " A-1
"
Elseif searchParamType = "ANY" Then
'Response.Write " B
"
txtArray = split(searchParamTxt, " ")
upperLim = Ubound(txtArray)
SQL=SQL & "("
If searchParamTxt <> "" Then
For counter=0 to (upperLim-1)
SQL = SQL & " (sfProducts.prodName LIKE '%" & txtArray(counter) & "%' OR sfProducts.prodShortDescription LIKE '%" & txtArray(counter) & "%' OR sfProducts.prodID LIKE '%" & txtArray(counter) & "%' OR sfProducts.prodDescription LIKE '%" & txtArray(counter) & "%') OR "
Next
SQL = SQL & " (sfProducts.prodName LIKE '%" & txtArray(counter) & "%' OR sfProducts.prodShortDescription LIKE '%" & txtArray(counter) & "%' OR sfProducts.prodID LIKE '%" & txtArray(counter) & "%' OR sfProducts.prodDescription LIKE '%" & txtArray(counter) & "%')"
End If
SQL=SQL & ")"
'Response.Write " B-1
"
SQL = SQL & " And "
Elseif searchParamType = "Exact" Then
' Response.Write " C
"
if searchParamTxt <> "" Then SQL = SQL & " (sfProducts.prodName LIKE '%" & searchParamTxt & "%' OR sfProducts.prodShortDescription LIKE '%" & searchParamTxt & "%' OR sfProducts.prodID ='" & searchParamTxt & "' OR sfProducts.prodDescription LIKE '%" & searchParamTxt & "%') AND "
else
'Response.Write " D
"
SQL = SQL & " WHERE "
End If
end if
'If searchParamCat = "ALL" Then
' If searchParamTxt = "" Then
' SQL = SQL & " prodCategoryId > 0"
' Else
' SQL = SQL & " AND prodCategoryId > 0"
' End If
' Else
' If searchParamTxt = "" Then
' SQL = SQL & " prodCategoryId = " & searchParamCat
' Else
' SQL = SQL & " AND prodCategoryId = " & searchParamCat
' End If
' End If
If searchParamMan = "ALL" Then
SQL = SQL & " sfProducts.prodManufacturerId > 0"
Else
SQL = SQL & " sfProducts.prodManufacturerId = " & searchParamMan
End If
If searchParamVen = "ALL" Then
SQL = SQL & " AND sfProducts.prodVendorId > 0"
Else
SQL = SQL & " AND sfProducts.prodVendorId = " & searchParamVen
End If
If DateAddedEnd <> "" then
DateAddedEnd = dateAdd("d",1,DateAddedEnd)
end if
If DateAddedStart <> "" And DateAddedEnd <> "" Then SQL = SQL & " AND sfProducts.prodDateAdded BETWEEN #" & CDate(DateAddedStart) & "# AND #" & CDate(DateAddedEnd) & "# "
If DateAddedStart <> "" And DateAddedEnd = "" Then SQL = SQL & " AND sfProducts.prodDateAdded > #" & CDate(DateAddedStart) & "# "
If DateAddedStart = "" And DateAddedEnd <> "" Then SQL = SQL & " AND sfProducts.prodDateAdded < #" & CDate(DateAddedEnd) & "# "
If PriceStart <> "" And PriceEnd <> "" Then SQL = SQL & " AND (CDbl(sfProducts.prodPrice) BETWEEN " & CDbl(PriceStart) & " AND " & CDbl(PriceEnd) & " or (sfProducts.prodSaleIsActive=1 and CDbl(sfProducts.prodSalePrice) BETWEEN " & CDbl(PriceStart) & " AND " & CDbl(PriceEnd) & ")) "
If PriceStart <> "" And PriceEnd = "" Then SQL = SQL & " AND (CDbl(sfProducts.prodPrice) >= " & CDbl(PriceStart) & " or (sfProducts.prodSaleIsActive=1 and CDbl(sfProducts.prodSalePrice) >= " & CDbl(PriceStart) & ")) "
If PriceStart = "" And PriceEnd <> "" Then SQL = SQL & " AND (CDbl(sfProducts.prodPrice) <= " & CDbl(PriceEnd) & " or (sfProducts.prodSaleIsActive=1 and CDbl(sfProducts.prodSalePrice) <= " & CDbl(PriceEnd) & ")) "
If Sale <> "" Then SQL = SQL & " AND sfProducts.prodSaleIsActive = 1 "
SQL = SQL & " AND sfProducts.prodEnabledIsActive = 1 "
getProductSQLAE = SQL
End Function
Function getProductSQL(searchParamType, searchParamTxt, searchParamCat, searchParamMan, searchParamVen, DateAddedStart, DateAddedEnd, PriceStart, PriceEnd, Sale)
Dim upperLim, SQL, counter, txtArray
searchParamTxt = Replace(searchParamTxt, "*", "")
SQL = "SELECT ProdID, prodName, prodImageSmallPath, prodLink, prodPrice, prodSaleIsActive, prodSalePrice, catName, prodDescription, prodAttrNum, prodCategoryId, prodShortDescription " _
& "FROM sfProducts INNER JOIN sfCategories ON sfProducts.prodCategoryId = sfCategories.catID WHERE "
'create where statement
If searchParamType = "ALL" Then
txtArray = split(searchParamTxt, " ")
upperLim = Ubound(txtArray)
If searchParamTxt <> "" Then
For counter=0 to (upperLim-1)
SQL = SQL & " (prodName LIKE '%" & txtArray(counter) & "%' OR prodShortDescription LIKE '%" & txtArray(counter) & "%' OR prodID LIKE '%" & txtArray(counter) & "%' OR prodDescription LIKE '%" & txtArray(counter) & "%') AND "
Next
SQL = SQL & " (prodName LIKE '%" & txtArray(counter) & "%' OR prodShortDescription LIKE '%" & txtArray(counter) & "%' OR prodID LIKE '%" & txtArray(counter) & "%' OR prodDescription LIKE '%" & txtArray(counter) & "%') "
End If
Elseif searchParamType = "ANY" Then
txtArray = split(searchParamTxt, " ")
upperLim = Ubound(txtArray)
SQL=SQL & "("
If searchParamTxt <> "" Then
For counter=0 to (upperLim-1)
SQL = SQL & " (prodName LIKE '%" & txtArray(counter) & "%' OR prodShortDescription LIKE '%" & txtArray(counter) & "%' OR prodID LIKE '%" & txtArray(counter) & "%' OR prodDescription LIKE '%" & txtArray(counter) & "%') OR "
Next
SQL = SQL & " (prodName LIKE '%" & txtArray(counter) & "%' OR prodShortDescription LIKE '%" & txtArray(counter) & "%' OR prodID LIKE '%" & txtArray(counter) & "%' OR prodDescription LIKE '%" & txtArray(counter) & "%')"
End If
SQL=SQL & ")"
Elseif searchParamType = "Exact" Then
If searchParamTxt <> "" Then SQL = SQL & " (prodName LIKE '%" & searchParamTxt & "%' OR prodShortDescription LIKE '%" & searchParamTxt & "%' OR prodID ='" & searchParamTxt & "' OR prodDescription LIKE '%" & searchParamTxt & "%') "
End If
If searchParamCat = "ALL" Then
If searchParamTxt = "" Then
SQL = SQL & " prodCategoryId > 0"
Else
SQL = SQL & " AND prodCategoryId > 0"
End If
Else
If searchParamTxt = "" Then
SQL = SQL & " prodCategoryId = " & searchParamCat
Else
SQL = SQL & " AND prodCategoryId = " & searchParamCat
End If
End If
If searchParamMan = "ALL" Then
SQL = SQL & " AND prodManufacturerId > 0"
Else
SQL = SQL & " AND prodManufacturerId = " & searchParamMan
End If
If searchParamVen = "ALL" Then
SQL = SQL & " AND prodVendorId > 0"
Else
SQL = SQL & " AND prodVendorId = " & searchParamVen
End If
If DateAddedEnd <> "" then
DateAddedEnd = dateAdd("d",1,DateAddedEnd)
end if
If DateAddedStart <> "" And DateAddedEnd <> "" Then SQL = SQL & " AND prodDateAdded BETWEEN #" & CDate(DateAddedStart) & "# AND #" & CDate(DateAddedEnd) & "# "
If DateAddedStart <> "" And DateAddedEnd = "" Then SQL = SQL & " AND prodDateAdded > #" & CDate(DateAddedStart) & "# "
If DateAddedStart = "" And DateAddedEnd <> "" Then SQL = SQL & " AND prodDateAdded < #" & CDate(DateAddedEnd) & "# "
'djp log 201
If PriceStart <> "" And PriceEnd <> "" Then SQL = SQL & " AND (CDbl(sfProducts.prodPrice) BETWEEN " & CDbl(PriceStart) & " AND " & CDbl(PriceEnd) & " or (sfProducts.prodSaleIsActive=1 and CDbl(sfProducts.prodSalePrice) BETWEEN " & CDbl(PriceStart) & " AND " & CDbl(PriceEnd) & ")) "
If PriceStart <> "" And PriceEnd = "" Then SQL = SQL & " AND (CDbl(sfProducts.prodPrice) >= " & CDbl(PriceStart) & " or (sfProducts.prodSaleIsActive=1 and CDbl(sfProducts.prodSalePrice) >= " & CDbl(PriceStart) & ")) "
If PriceStart = "" And PriceEnd <> "" Then SQL = SQL & " AND (CDbl(sfProducts.prodPrice) <= " & CDbl(PriceEnd) & " or (sfProducts.prodSaleIsActive=1 and CDbl(sfProducts.prodSalePrice) <= " & CDbl(PriceEnd) & ")) "
If Sale <> "" Then SQL = SQL & " AND prodSaleIsActive = 1 "
SQL = SQL & " AND prodEnabledIsActive = 1 "
getProductSQL = SQL
End Function
Function getAttributeSQL(rsSearch, iPageSize, iPage)
Dim counter, rs, SQL
If Not rsSearch.EOF Then
' Clone rsSearch so it is not manipulated by the Function
Set rs = Server.CreateObject("ADODB.RecordSet")
Set rs = rsSearch.Clone
rs.AbsolutePosition = rsSearch.AbsolutePosition
SQL = "SELECT attrID, attrName, attrProdID FROM sfAttributes WHERE "
For counter = 1 to iPageSize
SQL = SQL & "attrProdId = '" & rs.Fields("prodID") & "' OR "
rs.MoveNext
Next
closeObj(rs)
SQL = Mid(SQL, 1, len(SQL)-3)
getAttributeSQL = SQL & " ORDER BY attrName"
Else
getAttributeSQL = ""
End If
End Function
Function getAttributeDetailSQL(rs)
If Not rs.EOF Then
Dim SQL
SQL = "SELECT attrdtID, attrdtAttributeId, attrdtName, attrdtPrice, attrdtType, attrdtOrder FROM sfAttributeDetail WHERE "
Do While Not rs.EOF
SQL = SQL & " attrdtAttributeId = " & rs.Fields("attrID") & " OR "
rs.MoveNext
Loop
rs.MoveFirst
SQL = Mid(SQL, 1, len(SQL)-3)
getAttributeDetailSQL = SQL & " ORDER BY attrdtOrder"
Else
getAttributeDetailSQL = ""
End If
End Function
Function getCategorySQL(txtCategory)
getCategorySQL = "SELECT catName FROM sfCategories WHERE catID = " & txtCategory
End Function
Function bottomPaging(iPage, iPageSize, iSearchRecordCount, iNumOfPages, sFromPage)
Dim txtPage, icounter, output, iStart, iEnd, sLink,iLoop
output = ""
if Application("AppName")<> "StoreFrontAE" then
txtPage = "&txtsearchParamTxt=" & Server.URLEncode(txtsearchParamTxt) & "&txtsearchParamType=" & txtsearchParamType & "&txtsearchParamCat=" _
& txtsearchParamCat & "&txtsearchParamMan=" & txtsearchParamMan & "&txtsearchParamVen=" & txtsearchParamVen _
& "&txtDateAddedStart=" & txtDateAddedStart & "&txtDateAddedEnd=" & txtDateAddedEnd _
& "&txtPriceStart=" & txtPriceStart & "&txtPriceEnd=" & txtPriceEnd & "&txtSale=" & txtSale
else
txtPage =""
For iLoop = 1 to Request.QueryString.Count
If lcase(Request.QueryString.Key(iLoop)) <> "page" then
txtPage = txtPage & "&" & Request.QueryString.Key(iLoop) & "=" & Request.QueryString.Item(iLoop)
End if
Next
txtPage = replace(txtPage," ","+")
end if
If sFromPage = "SalesPage" Then
sLink = " "1" Then
output = output & "<< " & sLink & iPage - 1 & txtPage &">Previous | "
Else
output = output & "<< Previous | "
End If
'Two cases, less than ten pages or more than ten pages total
If iNumOfPages > 10 Then 'Four cases inbeded
'First case, first ten pages
If iPage <= 10 Then
If iPage <> 10 Then
For icounter = 1 to 9
If iCounter = CInt(iPage) Then
output = output & iCounter & " | "
Else
output = output & sLink & icounter & txtPage & ">" & icounter & " | "
End If
Next
output = output & sLink & icounter & txtPage & ">" & icounter & "... | "
Else
If iNumOfPages < 20 Then
For icounter = 10 to iNumOfPages
If iCounter = CInt(iPage) Then
output = output & iCounter & " | "
Else
output = output & sLink & icounter & txtPage & ">" & icounter & " | "
End If
Next
Else
For icounter = 10 to 19
If iCounter = CInt(iPage) Then
output = output & iCounter & " | "
Else
output = output & sLink & icounter & txtPage & ">" & icounter & " | "
End If
Next
output = output & sLink & icounter & txtPage & ">" & icounter & "... | "
End If
End If
'rare case when the number of pages is divisable to records per page
ElseIf iPage <= (iNumOfPages - (iNumOfPages mod 10)) AND iPage > iNumOfPages-iPageSize AND iNumOfPages mod iPageSize = 0 Then
For icounter = iNumOfPages-9 to iNumOfPages
If iCounter = CInt(iPage) Then
output = output & iCounter & " | "
Else
output = output & sLink & icounter & txtPage & ">" & icounter & " | "
End If
Next
'Case for the inbetween areas ie 10-20 20-30...
ElseIf iPage < (iNumOfPages - (iNumOfPages mod 10)) Then
If iPage mod 10 = 0 Then
iStart = iPage
iEnd = iPage + 9
Else
iStart = (iPage - (iPage mod 10))
iEnd = iStart + 9
End If
For icounter = iStart to iEnd
If iCounter = CInt(iPage) Then
output = output & iCounter & " | "
Else
output = output & sLink & icounter & txtPage & ">" & icounter & " | "
End If
Next
output = output & sLink & icounter & txtPage & ">" & icounter & "... | "
'Case when last few pages is less then ten
Else
For icounter = (iPage - (iPage mod 10)) to iNumOfPages
If iCounter = CInt(iPage) Then
output = output & iCounter & " | "
Else
output = output & sLink & icounter & txtPage & ">" & icounter & " | "
End If
Next
End If
'If total number of pages is less than ten
Else
For icounter = 1 to iNumOfPages
If icounter = CInt(iPage) Then
output = output & iCounter & " | "
Else
output = output & sLink & icounter & txtPage & ">" & icounter & " | "
End If
Next
End If
If CInt(iNumOfPages) <> CInt(iPage) Then
output = output & sLink & iPage + 1 & txtPage &">Next >>"
Else
output = output & "Next >>"
End If
bottomPaging = output
End Function
Function GetSubCatIDs(vID)
dim rstSubCat,sSQL ,sHierarchy,iLen
dim tempID,sCriteria
Set rstSubCat = Server.CreateObject("ADODB.RecordSet")
if Instr(vId,";")> 0 then
sSql = "Select SubCatId From sfSub_Categories Where subcatCategoryId = " & Cint(left(vID,len(instr(vid,";")-1))) _
& " AND left(CatHierarchy,4)= '" & "none" & "'"
rstSubCat.Open sSql, cnn,adOpenStatic ,adLockReadOnly , adCmdText
vID = rstSubCat("SubCatID")
rstSubCat.Close
end if
sSql = "Select CatHierarchy,hasprods From sfSub_Categories Where SubcatID = " & vID
rstSubCat.Open sSql, cnn,adOpenStatic ,adLockReadOnly , adCmdText
if rstSubCat.EOF =true and rstSubCat.BOF = true then
else
if rstSubCat("hasprods") = 1 then
GetSubCatIDs =vID
else
sHierarchy = rstSubCat("CatHierarchy")
iLen = len(sHierarchy)
sSql = "Select SubCatID,CatHierarchy,hasprods From sfSub_Categories Where left(CatHierarchy," & iLen & ") = '" & sHierarchy & "' AND Hasprods = 1 AND Depth > 0"
rstSubCat.Close
rstSubCat.Open sSql, cnn,adOpenStatic ,adLockReadOnly , adCmdText
if rstSubCat.EOF =true and rstSubCat.BOF = true then
GetSubCatIDs = vID
else
tempID =""
sCriteria = " OR subcatCategoryId ="
while rstSubCat.EOF =false
tempID = tempID & rstSubCat("SubCatID") & sCriteria
rstSubCat.MoveNext
wend
tempID = left(tempID,len(tempID) - len(sCriteria))
GetSubCatIDs = tempID
end if
end if
end if
if GetSubCatIDs ="" then
GetSubCatIDs = vID
end if
End Function
Function GetFullPath(Vdata,justMain,subCatID)
Dim sSql ,X
Dim iCatId,sCriteria
Dim sFirst
Dim rst,rsCat,rsSubCat
Dim arrTemp ,bMain
If subCatID = "ALL" Then
sSql = "SELECT sfSubCatDetail.ProdID, sfSub_Categories.CatHierarchy" _
& " FROM sfSubCatDetail INNER JOIN sfSub_Categories ON sfSubCatDetail.subcatCategoryId = sfSub_Categories.subcatID" _
& " Where sfSubCatDetail.ProdID = '" & vData & "'"
Set rst = Server.CreateObject("ADODB.RecordSet")
rst.open sSql, cnn,adOpenStatic,adLockReadOnly ,1
' Response.Write ssql
If rst.eof = false then
sCriteria = rst("CatHierarchy")
else
GetFullPath = "No Category"
rst.close
set rst = nothing
exit Function
End if
rst.close
set rst = nothing
Else
sCriteria = vData
End if
bMain = false
if left(sCriteria,4)= "none" then
bMain = True
arrTemp = split(sCriteria,"-")
sCriteria = arrtemp(1)
elseif sCriteria = "" then
GetFullPath = ""
exit function
elseif instr(sCriteria,"-") = 0 then
sCriteria = sCriteria
end if
arrTemp = split(sCriteria,"-")
Set rsCat = Server.CreateObject("ADODB.RecordSet")
Set rsSubCat = Server.CreateObject("ADODB.RecordSet")
rsSubCat.Open "sfSub_Categories",cnn,adOpenStatic,adLockReadOnly ,adcmdtable
For X = 0 To UBound(arrTemp)
rsSubCat.Requery
if arrTemp(X)<> "" then
rsSubCat.Find "SubCatId = " & CInt(arrTemp(X))
GetFullPath = GetFullPath & rsSubCat("SubCatName") & "-"
end if
Next
sSql = "Select catName From sfCategories Where catId =" & rsSubCat("subcatCategoryId")
rsCat.Open sSql,cnn,adOpenStatic,adLockReadOnly ,adcmdText
if justmain = 1 then
GetFullPath = rsCat("catName")
else
On error Resume next
if bMain = True Then
GetFullPath = rsCat("catName")
else
GetFullPath = rsCat("catName") & "-" & Left(GetFullPath, Len(GetFullPath) - 1)
end if
end if
Set rsCat = Nothing
Set rsSubCat = Nothing
Exit Function
End Function
function setSubcatId(iCatId,sCriteria,returnField)
dim rst,sSql
Set rst = Server.CreateObject("ADODB.RecordSet")
' sSql = "Select subCatID,subcatCategoryId from sfSub_Categories where subcatCategoryId = " & iCatid
sSql = "Select subCatID,subcatCategoryId from sfSub_Categories where " & sCriteria & " = " & iCatid
rst.Open ssql,cnn,3,3,1
if rst.eof = true and rst.eof = true then
setSubcatId= icatId
else
setSubcatId = rst(returnField)
end if
rst.Close
set rst = nothing
end function
function getCatHierarchy(vID)
dim rst,sSql
Set rst = Server.CreateObject("ADODB.RecordSet")
sSql = "Select CatHierarchy from sfSub_Categories where subcatID = " & vID
rst.Open ssql,cnn,3,3,1
if rst.eof = true then
getCatHierarchy ="vID"
else
getCatHierarchy = rst("CatHierarchy")
end if
rst.Close
set rst = nothing
end function
%>
<%
'@BEGINVERSIONINFO
'@APPVERSION: 50.3008.0.2
'@FILENAME: incgeneral.asp
'
'@DESCRIPTION: multple functions used in the web application
'@STARTCOPYRIGHT
'The contents of this file is protected under the United States
'copyright laws and is confidential and proprietary to
'LaGarde, Incorporated. Its use or disclosure in whole or in part without the
'expressed written permission of LaGarde, Incorporated is expressly prohibited.
'
'(c) Copyright 2000,2001 by LaGarde, Incorporated. All rights reserved.
'@ENDCOPYRIGHT
'@ENDVERSIONINFO
'Modified 10/24/01
'Storefront Ref#'s: 168,163 'JF
'Modified 10/29/01
'Storefront Ref#'s: 180 'djp
'Modified 10/31/01
'Storefront Ref#'s: 194 'jf
'Modified 12/4/01
'Storefront Ref#'s: 241 djp
Dim rsAdminGen, C_STORENAME, C_HomePath, C_SecurePath,iConverion,sUserName,iEzeeHelp,sEzeeHelp,iSaveCartActive,iEmailActive,iBrandActive,sAffID,sLCID
Set rsAdminGen = Server.CreateObject("ADODB.Recordset")
rsAdminGen.Open "SELECT adminStoreName, adminDomainName, adminSSLPath, adminOandaID, adminActivateOanda,adminEzeeLogin,adminEzeeActive,adminSaveCartActive,adminEmailActive,adminSFActive,adminSFID,adminLCID FROM sfAdmin", cnn, adOpenForwardOnly, adLockReadOnly, adCmdText
C_STORENAME = trim(rsAdminGen.Fields("adminStoreName"))
C_HomePath = trim(rsAdminGen.Fields("adminDomainName"))
C_SecurePath = trim(rsAdminGen.Fields("adminSSLPath"))
iConverion = trim(rsAdminGen.Fields("adminActivateOanda"))
sUserName = trim(rsAdminGen.Fields("adminOandaID"))
sEzeeHelp = trim(rsAdminGen.Fields("adminEzeeLogin"))
iEzeeHelp = trim(rsAdminGen.Fields("adminEzeeActive"))
iSaveCartActive = trim(rsAdminGen.Fields("adminSaveCartActive"))
iEmailActive = trim(rsAdminGen.Fields("adminEmailActive"))
iBrandActive = trim(rsAdminGen.Fields("adminSFActive"))
sAffID = trim(rsAdminGen.Fields("adminSFID"))
sLCID = trim(rsAdminGen.Fields("adminLCID"))
closeObj(rsAdminGen)
If Session("LCID") <> "" Then
Session.LCID = Session("LCID")
Else
Session.LCID = sLCID
Session("LCID") = sLCID
End If
If Mid(C_HomePath, Len(C_HomePath), 1) <> "/" Then
C_HomePath = C_HomePath & "/"
End If
'Referal Varables
'dim REFERER,HTTP_REFERER,REMOTE_ADDRESS
'if trim(Request.QueryString("REFERER"))<>"" then
' REFERER = Request.QueryString("REFERER")
' Response.Cookies("sfHTTP_REFERER")("REFERER") = REFERER
' end if
' HTTP_REFERER = Request.ServerVariables("HTTP_REFERER")
' REMOTE_ADDRESS = Request.ServerVariables("REMOTE_ADDR")
'
' Response.Cookies("sfHTTP_REFERER")("HTTP_REFERER") = HTTP_REFERER
' Response.Cookies("sfHTTP_REFERER")("REMOTE_ADDRESS") = REMOTE_ADDRESS
' Response.Cookies("sfHTTP_REFERER").Expires = Date() + 1
'--------------------------------------------------------
' MakeUSDate converts all date inputs to US date format
'--------------------------------------------------------
Function MakeUSDate(InDate)
If Not IsDate(InDate) Then Exit Function
MakeUSDate = Month(InDate)&"/"&Day(InDate)&"/"&Right(Year(InDate),2)
End Function
'----------------------------------------
' getShippingSaleText
'----------------------------------------
Function getShippingSaleText(sShipping)
Dim rsShippingAdmin, sText
sText = ""
Set rsShippingAdmin = Server.CreateObject("ADODB.RecordSet")
rsShippingAdmin.Open "sfAdmin", cnn, adOpenForwardOnly, adLockReadOnly, adCmdTable
If Trim(rsShippingAdmin.Fields("adminFreeShippingIsActive")) = "1" Then
If sShipping = 0 Then
sText = "Free Shipping on orders over " & FormatCurrency(rsShippingAdmin.Fields("adminFreeShippingAmount")) & "! "
End If
End If
rsShippingAdmin.Close
Set rsShippingAdmin = nothing
getShippingSaleText = sText
End Function
'------------------------------------------------------------------
'These two functions handle Global Sales
'------------------------------------------------------------------
Function getGlobalSaleText()
Dim rsGlobalAdmin, sGlobalActive, sText
sText = ""
Set rsGlobalAdmin = Server.CreateObject("ADODB.RecordSet")
rsGlobalAdmin.open "sfAdmin", cnn, adOpenForwardOnly, adLockReadOnly, adCmdTable
sGlobalActive = Trim(rsGlobalAdmin.Fields("adminGlobalSaleIsActive"))
If sGlobalActive = "1" Then
sText = "All items discounted " & cDbl(rsGlobalAdmin.Fields("adminGlobalSaleAmt")) * 100 & "%! "
End If
rsGlobalAdmin.Close
Set rsGlobalAdmin = nothing
getGlobalSaleText = sText
End Function
function getGlobalSalePrice(subtotal)
Dim rsGlobalAdmin, sGlobalActive
Set rsGlobalAdmin = Server.CreateObject("ADODB.RecordSet")
rsGlobalAdmin.open "sfAdmin", cnn, adOpenForwardOnly, adLockReadOnly, adCmdTable
sGlobalActive = Trim(rsGlobalAdmin.Fields("adminGlobalSaleIsActive"))
If sGlobalActive = "1" Then
getGlobalSalePrice = formatNumber(cDbl(subtotal)-(cDbl(subtotal)*cDbl(rsGlobalAdmin.Fields("adminGlobalSaleAmt"))), 2)
Else
getGlobalSalePrice = subTotal
End If
rsGlobalAdmin.Close
Set rsGlobalAdmin = nothing
End Function
'---------------------------------------------------------------------
' Purpose: Deletes recordset from TmpOrders and associated child relations
'---------------------------------------------------------------------
Sub setDeleteOrder(sPrefix,iOrderDetailId)
Dim rsDelete, sLocalSQL, rsDelete2, rsDelete3,rsDelete4,sLocalSQL2,sLocalSQL3,sLocalSQL4
Select Case sPrefix
Case "odrdttmp"
sLocalSQL = "DELETE FROM sfTmpOrderDetails WHERE odrdttmpID = " & iOrderDetailId
sLocalSQL2 = "DELETE FROM sfTmpOrderAttributes WHERE odrattrtmpOrderDetailId = " & iOrderDetailId
If Application("AppName")= "StoreFrontAE" Then
'Delete records from tmporderdetails ae for this session
sLocalSQL3 = " Delete FROM sfTmpOrderDetailsAE WHERE odrdttmpAEID = " & iOrderDetailId & ""
'Move Coupon
sLocalSQL4 = "Delete FROM sfTmpOrdersAE WHERE odrtmpSessionID=" & Session("SessionID")
Set rsDelete3 = cnn.Execute(sLocalSQL3)
Set rsDelete4 = cnn.Execute(sLocalSQL4)
closeObj(rsDelete3)
closeObj(rsDelete4)
end if
Case "odrdtsvd"
sLocalSQL = "DELETE FROM sfSavedOrderDetails WHERE odrdtsvdID = " & iOrderDetailId
sLocalSQL2 = "DELETE FROM sfSavedOrderAttributes WHERE odrattrsvdOrderDetailId = " & iOrderDetailId
End Select
If vDebug = 1 Then Response.Write "
DeleteTmp SQL : " & sLocalSQL & "
SQL2: " & sLocalSQL2
Set rsDelete2 = cnn.Execute(sLocalSQL2)
Set rsDelete = cnn.Execute(sLocalSQL)
closeObj(rsDelete)
closeObj(rsDelete2)
End Sub
Function getTax(choice, sShipping, sTotalPrice, sProdID)
Dim sState, sCountry, SQL, rsTax, iTax, rsAdmin, iTaxAmt, rsProd
Set rsProd = Server.CreateObject("ADODB.Recordset")
Set rsTax = Server.CreateObject("ADODB.RecordSet")
Set rsAdmin = Server.CreateObject("ADODB.RecordSet")
SQL = "SELECT prodCountryTaxIsActive, prodStateTaxIsActive FROM sfProducts WHERE prodID = '" & sProdID & "'"
rsProd.Open SQL, cnn, adOpenForwardOnly, adLockReadOnly, adCmdText
SQL = "SELECT adminTaxShipIsActive FROM sfAdmin"
If vDebug = 1 Then Response.Write SQL & "
"
rsAdmin.Open SQL, cnn, adOpenForwardOnly, adLockReadOnly, adCmdText
Select Case choice
Case "State"
If Request("State") <> "" Then
sState = Request("State")
ElseIf sCustState <> "" Then
sState = sCustState
ElseIf Request("ShipState") <> "" Then
sState = Request("ShipState")
ElseIf Request("sShipCustState") <> "" Then
sState = sShipCustState
ElseIf sShipCustState <> "" Then
sState = sShipCustState
End if
SQL = "SELECT loclstTax FROM sfLocalesState WHERE loclstAbbreviation = '" & sState & "' AND loclstLocaleIsActive = 1 AND loclstTaxIsActive = 1"
If vDebug = 1 Then Response.Write SQL & "
"
rsTax.Open SQL, cnn, adOpenForwardOnly, adLockReadOnly, adCmdText
If Not rsTax.EOF Then
If trim(rsProd.Fields("prodStateTaxIsActive")) = "1" Then
If rsAdmin.Fields("adminTaxShipIsActive") = 1 Then
iTaxAmt = CDbl(sShipping) + CDbl(sTotalPrice)
Else
iTaxAmt = CDbl(sTotalPrice)
End If
End If
iTax = iTaxAmt * CDbl(rsTax.Fields("loclstTax"))
Else
iTax = 0
End If
Case "Country"
if Request("Country") <> "" Then
sCountry = Request("Country")
ElseIf sCustCountry <> "" Then
sCountry = sCustCountry
ElseIf Request("ShipCountry") <> "" Then
sCountry = Request("ShipCountry")
ElseIf Request("sShipCustCountry") <> "" Then
sCountry = Request("sShipCustCountry")
ElseIf sShipCustCountry <> "" Then
sCountry = sShipCustCountry
Elseif Request("Country") <> "" Then
sCountry = Request("Country")
ElseIf sCustCountry <> "" Then
sCountry = sCustCountry
End if
SQL = "SELECT loclctryTax FROM sfLocalesCountry WHERE loclctryAbbreviation = '" & sCountry & "' AND loclctryLocalIsActive = 1 AND loclctryTaxIsActive = 1"
If vDebug = 1 Then Response.Write SQL & "
"
rsTax.Open SQL, cnn, adOpenForwardOnly, adLockReadOnly, adCmdText
If Not rsTax.EOF Then
If trim(rsProd.Fields("prodCountryTaxIsActive")) = "1" Then
If rsAdmin.Fields("adminTaxShipIsActive") = 1 Then
iTaxAmt = CDbl(sShipping) + CDbl(sTotalPrice)
Else
iTaxAmt = CDbl(sTotalPrice)
End If
iTax = iTaxAmt * CDbl(rsTax.Fields("loclctryTax"))
End If
Else
iTax = 0
End If
End Select
closeObj(rsAdmin)
closeObj(rsTax)
getTax = formatNumber(iTax, 2)
End Function
'---------------------------------------------------------------------
' Collect Attribute IDs
'---------------------------------------------------------------------
Function getProdAttr(sPrefix,sOrderID,iProdAttrNum)
Dim sLocalSQL, rsAttrID, iCounter, aLocalArray
Select Case sPrefix
Case "odrattrtmp"
sLocalSQL = "SELECT odrattrtmpAttrID FROM sfTmpOrderAttributes WHERE odrattrtmpOrderDetailId = " & sOrderID
Case "odrattrsvd"
sLocalSQL = "SELECT odrattrsvdAttrID FROM sfSavedOrderAttributes WHERE odrattrsvdOrderDetailId = " & sOrderID
Case "odr"
sLocalSQL = "SELECT odrattrID FROM sfOrderAttributes WHERE odrattrOrderDetailId = " & sOrderID
End Select
Set rsAttrID = Server.CreateObject("ADODB.RecordSet")
rsAttrID.Open sLocalSQL, cnn, adOpenDynamic, adLockOptimistic, adCmdText
If vDebug = 1 Then Response.Write "
getProdAttr SQL : " & sLocalSQL ' Check if this record exists through prodID and price matches If rsAttrID.EOF or rsAttrID.BOF Then If vDebug = 1 Then Response.Write "
Empty Recordset in rsAttrID"
Else
Redim aLocalArray(iProdAttrNum)
For iCounter = 0 to iProdAttrNum - 1
aLocalArray(iCounter) = rsAttrID.Fields(sPrefix & "AttrID")
If vDebug = 1 Then Response.Write "
AttrID: " & aLocalArray(iCounter)
rsAttrID.MoveNext
Next
' End RecordSet If
End If
closeObj(rsAttrID)
getProdAttr = aLocalArray
End Function
'---------------------------------------------------------------------
' This function checks whether a product exists and retrieves an array of info
'---------------------------------------------------------------------
Function getProduct(sProdID)
Dim sLocalSQL, aLocalProdArray(3), rsSelectProd
sLocalSQL = "SELECT prodName, prodNamePlural, prodPrice, prodAttrNum,prodSaleIsActive,prodSalePrice FROM sfProducts WHERE prodEnabledIsActive=1 AND prodID = '"& sProdID & "'"
Set rsSelectProd = Server.CreateObject("ADODB.RecordSet")
rsSelectProd.Open sLocalSQL, cnn, adOpenDynamic, adLockOptimistic, adCmdText
If vDebug = 1 Then Response.Write "
getProdValues SQL : " & sLocalSQL ' Check if this record exists through prodID and price matches If rsSelectProd.EOF or rsSelectProd.BOF Then If vDebug = 1 Then Response.Write "
Empty Recordset in rsSelectProd. Product " & sProdID & " possibly not activated."
Else
aLocalProdArray(0) = rsSelectProd.Fields("prodName")
' Check if sale price is active
If rsSelectProd.Fields("prodSaleIsActive") = 1 Then
aLocalProdArray(1) = rsSelectProd.Fields("prodSalePrice")
Else
aLocalProdArray(1) = rsSelectProd.Fields("prodPrice")
End If
aLocalProdArray(2) = rsSelectProd.Fields("prodAttrNum")
' End RecordSet If
End If
closeObj(rsSelectProd)
getProduct = aLocalProdArray
End Function
'-------------------------------------------------------
' Update saved cart customers' info in sfCustomers
'-------------------------------------------------------
Sub setUpdateCustomer(sNewEmail,sFirstName,sMiddleInitial,sLastName,sCompany,sAddress1,sAddress2,sCity,sState,sZip,sCountry,sPhone,sFax,bSubscribed)
Dim sLocalSQl, rsUpdate, iOldNum
sLocalSQL = "Select custFirstName, custMiddleInitial, custLastName, custCompany, custAddr1, custAddr2, custCity, custState, custZip, custCountry, "_
& "custPhone, custFax, custTimesAccessed, custLastAccess, custEmail, custIsSubscribed FROM sfCustomers WHERE custID = " & Trim(Request.Cookies("sfCustomer")("custID"))
Set rsUpdate = SErver.CreateObject("ADODB.RecordSet")
rsUpdate.Open sLocalSQL,cnn,adOpenDynamic,adLockOptimistic,adCmdText
If Not rsUpdate.EOF Then
iOldNum = (rsUpdate.Fields("custTimesAccessed"))
If iOldNum = "" or isnull(iOldNum) Then
iOldNum = 1
Else
iOldNum = cInt(iOldNum)
End If
rsUpdate.Fields("custFirstName") = sFirstName
rsUpdate.Fields("custMiddleInitial") = sMiddleInitial
rsUpdate.Fields("custLastName") = sLastName
rsUpdate.Fields("custCompany") = sCompany
rsUpdate.Fields("custAddr1") = sAddress1
rsUpdate.Fields("custAddr2") = sAddress2
rsUpdate.Fields("custCity") = sCity
rsUpdate.Fields("custState") = sState
rsUpdate.Fields("custZip") = sZip
rsUpdate.Fields("custCountry") = sCountry
rsUpdate.Fields("custPhone") = sPhone
rsUpdate.Fields("custFax") = sFax
rsUpdate.Fields("custTimesAccessed") = iOldNum + 1
rsUpdate.Fields("custLastAccess") = Date()
If sNewEmail <> "" Then
rsUpdate.Fields("custEmail") = sNewEmail
End If
If CStr(bSubscribed) = "" Or CStr(bSubscribed) = "0" Then
rsUpdate.Fields("custissubscribed") = 0
Else
rsUpdate.Fields("custissubscribed") = 1
End If
rsUpdate.Update
End If
closeObj(rsUpdate)
End Sub
'---------------------------------------------------------------------
' This function returns one specific value associated with a single id
' Used for lookup of VendorID, ManufacturerID, CategoryID, etc
'---------------------------------------------------------------------
Function getNameWithID(sLocalTableName,sLocalFindKey,sLocalFindKeyLabel,sLocalSearchName,bStringOrNot)
Dim sLocalSQL, rsGetNameFromID, sLocalGetResult
if trim(sLocalFindKey) <> "" then
' build SQL string based on whether the key is a string or not
If (bStringOrNot = 0) Then
sLocalSQL = "SELECT " & sLocalSearchName & " FROM " & sLocalTableName & " WHERE " & sLocalFindKeyLabel & "= " & Trim(sLocalFindKey)
ElseIf (bstringOrNot = 1) Then
sLocalSQL = "SELECT " & sLocalSearchName & " FROM " & sLocalTableName & " WHERE " & sLocalFindKeyLabel & "= '" & Trim(sLocalFindKey) & "'"
Else
Response.Write("The boolean parameter is not valid. Please input either 1 for true or 0 for false")
Exit Function
End If
If vDebug = 1 Then Response.Write "
" & sLocalSQL
Set rsGetNameFromID = Server.CreateObject("ADODB.RecordSet")
rsGetNameFromID.Open sLocalSQL, cnn
If rsGetNameFromID.EOF Or rsGetNameFromID.BOF Then
'If vDebug = 1 Then Response.Write "Either the recordset doesn't exit or the field name is not typed correctly :
" & sLocalSQL
Else
sLocalGetResult = rsGetNameFromID.Fields("" &sLocalSearchName& "")
End If
closeObj(rsGetNameFromID)
getNameWithID = sLocalGetResult
else
getNameWithID = ""
end if
End Function
'---------------------------------------------------------------------
' Enters record svdOrders, returns the ID of the SvdOrder
'---------------------------------------------------------------------
Function getSavedTable(aProdAttr,sProdID,iNewQuantity,iCustID,sReferer)
Dim rsCopy, sLocalSQL, rsSvdCart, rsSvdCartAttr, iKeyID, sDateTime,sTmpAttrName, sTmpAttrID, aTmpOrderArray, bookMark
' Write to svd cart
Set rsSvdCart = Server.CreateObject("ADODB.RecordSet")
rsSvdCart.CursorLocation = adUseClient
rsSvdCart.Open "sfSavedOrderDetails Order By odrdtsvdID", cnn, adOpenDynamic, adLockOptimistic
rsSvdCart.AddNew
rsSvdCart.Fields("odrdtsvdCustID") = iCustID
rsSvdCart.Fields("odrdtsvdQuantity") = iNewQuantity
rsSvdCart.Fields("odrdtsvdProductID") = sProdID
rsSvdCart.Fields("odrdtsvdDate") = FormatDateTime(Now)
rsSvdCart.Fields("odrdtsvdSessionID") = Session("SessionID")
rsSvdCart.Fields("odrdtsvdHttpReferer") = left(sReferer,255)
rsSvdCart.Update
'bookMark = rsSvdCart.AbsolutePosition
'rsSvdCart.Requery
'rsSvdCart.AbsolutePosition = bookMark
iKeyID = rsSvdCart.Fields("odrdtsvdID")
If vDebug = 1 Then Response.Write "
SvdCart Key ID = " & iKeyID & "" ' Copy Attributes iCounter = 0 ' Collect Attribute Info from sfTmpOrderAttributes If IsArray(aProdAttr) Then Do While NOT aProdAttr(iCounter) = "" sTmpAttrID = aProdAttr(iCounter) If vDebug = 1 Then Response.Write "
sTmpAttrID = " & sTmpAttrID Set rsSvdCartAttr = Server.CreateObject("ADODB.RecordSet") rsSvdCartAttr.Open "sfSavedOrderAttributes", cnn, adOpenDynamic, adLockOptimistic rsSvdCartAttr.AddNew rsSvdCartAttr.Fields("odrattrsvdOrderDetailId") = iKeyID rsSvdCartAttr.Fields("odrattrsvdAttrID") = sTmpAttrID rsSvdCartAttr.Update iCounter = iCounter + 1 Loop ' End IsArray If End If If vDebug = 1 Then Response.Write "
Copied Record To SavedOrder" closeObj(rsCopy) closeObj(rsSvdCart) closeobj(rsSvdCartAttr) getSavedTable = iKeyId End Function '--------------------------------------------------------------------- ' Enters record TmpOrders, returns the ID of the TmpOrder '--------------------------------------------------------------------- Function getTmpTable(aProdAttr,sProdID,iNewQuantity,sReferer,iShip) Dim sLocalSQL, rsTmpCart, rsTmpCartAttr, iKeyID, sTmpAttrName, sTmpAttrID, aTmpOrderArray, bookMark ' Write to tmp cart Set rsTmpCart = Server.CreateObject("ADODB.RecordSet") rsTmpCart.CursorLocation = adUseClient rsTmpCart.Open "sfTmpOrderDetails Order By odrdttmpID", cnn, adOpenDynamic, adLockOptimistic, adCmdTable rsTmpCart.AddNew rsTmpCart.Fields("odrdttmpQuantity") = iNewQuantity rsTmpCart.Fields("odrdttmpProductID") = sProdID rsTmpCart.Fields("odrdttmpSessionID") = Session("SessionID") If sReferer <> "" and NOT isNull(sReferer) Then rsTmpCart.Fields("odrdttmpHttpReferer") = left(sReferer,255) End If rsTmpCart.Fields("odrdttmpShipping") = iShip rsTmpCart.Update 'bookMark = rsTmpCart.AbsolutePosition 'rsTmpCart.Requery 'rsTmpCart.AbsolutePosition = bookMark iKeyID = rsTmpCart.Fields("odrdttmpID") If vDebug = 1 Then Response.Write "
TmpCart Key ID = " & iKeyID & "" ' Copy Attributes iCounter = 0 ' Collect Attribute Info from sfTmpOrderAttributes If IsArray(aProdAttr) Then Do While NOT aProdAttr(iCounter) = "" sTmpAttrID = aProdAttr(iCounter) If vDebug = 1 Then Response.Write "
sTmpAttrID = " & sTmpAttrID Set rsTmpCartAttr = Server.CreateObject("ADODB.RecordSet") rsTmpCartAttr.Open "sfTmpOrderAttributes", cnn, adOpenDynamic, adLockOptimistic, adCmdTable rsTmpCartAttr.AddNew rsTmpCartAttr.Fields("odrattrtmpOrderDetailId") = iKeyID rsTmpCartAttr.Fields("odrattrtmpAttrID") = sTmpAttrID rsTmpCartAttr.Update iCounter = iCounter + 1 Loop ' End IsArray If End If If vDebug = 1 Then Response.Write "
Copied Record To TmpOrder"
closeObj(rsTmpCart)
closeobj(rsTmpCartAttr)
getTmpTable = iKeyId
End Function
'---------------------------------------------------------------------
' Purpose: Updates the Quantity field with associated prodId and CartID
'---------------------------------------------------------------------
Sub setUpdateQuantity(sPrefix,iQuantity,iTmpOrderID)
Dim rsUpdate, sLocalSQL, iOldQuantity, iNewQuantity, rsGetQuantity
Select Case sPrefix
Case "odrdttmp"
sLocalSQL = "SELECT odrdttmpQuantity FROM sfTmpOrderDetails WHERE odrdttmpID=" &iTmpOrderID & " AND odrdttmpSessionID=" & Session("SessionID")
If vDebug = 1 Then Response.Write "
setUpdateQuantity SQL : " & sLocalSQL
Case "odrdtsvd"
sLocalSQL = "SELECT odrdtsvdQuantity FROM sfSavedOrderDetails WHERE odrdtsvdID=" & iTmpOrderID & " AND odrdtsvdCustID=" & Request.Cookies("sfCustomer")("custID")
End Select
Set rsGetQuantity = Server.CreateObject("ADODB.RecordSet")
rsGetQuantity.Open sLocalSQL, cnn
If rsGetQuantity.EOF And rsGetQuantity.BOF Then Response.Redirect "abandon.asp"
' Get Old Quantity
iOldQuantity = rsGetQuantity.Fields(sPrefix & "Quantity")
rsGetQuantity.Close
iNewQuantity = cInt(iOldQuantity) + cInt(iQuantity)
' Now Update
Set rsUpdate = Server.CreateObject("ADODB.RecordSet")
rsUpdate.Open sLocalSQL, cnn, adOpenDynamic, adLockOptimistic, adCmdText
rsUpdate.Fields(sPrefix & "Quantity") = iNewQuantity
rsUpdate.Update
closeObj(rsGetQuantity)
closeObj(rsUpdate)
End Sub
'---------------------------------------------------------------------
' Purpose: Updates the Quantity field with associated prodId and CartID
'---------------------------------------------------------------------
Sub setReplaceQuantity(sPrefix,iQuantity,iTmpOrderID)
Dim rsUpdate, sLocalSQL
Select Case sPrefix
Case "odrdttmp"
sLocalSQL = "SELECT odrdttmpQuantity FROM sfTmpOrderDetails WHERE odrdttmpID=" &iTmpOrderID & " AND odrdttmpSessionID=" & Session("SessionID")
If vDebug = 1 Then Response.Write "
setUpdateQuantity SQL : " & sLocalSQL
Case "odrdtsvd"
sLocalSQL = "SELECT odrdtsvdQuantity FROM sfSavedOrderDetails WHERE odrdtsvdID=" & iTmpOrderID & " AND odrdtsvdCustID=" & Request.Cookies("sfCustomer")("custID")
If vDebug = 1 Then Response.Write "
setSvdUpdateQuantity SQL : " & sLocalSQL
End Select
' Now Update
Set rsUpdate = Server.CreateObject("ADODB.RecordSet")
rsUpdate.Open sLocalSQL, cnn, adOpenDynamic, adLockOptimistic
If rsUpdate.EOF And rsUpdate.BOF Then Response.Redirect "abandon.asp"
rsUpdate.Fields(sPrefix & "Quantity") = iQuantity
rsUpdate.Update
If rsUpdate.EOF Or rsUpdate.BOF Then
Response.Write "
Empty Recordset in rsUpdate"
Else
If vDebug = 1 Then Response.Write "
Successful update of Quantity to: " & iQuantity & "" End If closeObj(rsUpdate) End Sub '--------------------------------------------------------------------- ' Checks for existence of same product and attributes (if any) ' Returns the OrderDetail ID or -1 if record DNE '--------------------------------------------------------------------- Function getOrderID(sPrefix,sAttrPrefix,sProdID,aProdAttr,iProdAttrNum) Dim sTmpVar, bHasAttributes, iLocalResult, rsSelectProd, sTmpPrefixID, sTmpAttrName, sTmpAttr Dim sLocal, sSQL, sLocalSQL, sAttrName, bMatch, iUpperBound iLocalResult = -1 bHasAttributes = (iProdAttrNum > 0) bMatch = 0 ' SQL select Select Case sPrefix Case "odrdttmp" If bHasAttributes Then sLocalSQL = "SELECT odrdttmpID, odrattrtmpAttrID FROM sfTmpOrderAttributes INNER JOIN sfTmpOrderDetails ON sfTmpOrderAttributes.odrattrtmpOrderDetailId = sfTmpOrderDetails.odrdttmpID" _ & " WHERE odrdttmpSessionID = " & Session("SessionID") & " AND odrdttmpProductID = '" & sProdID & "'" Else sLocalSQL = "SELECT odrdttmpID FROM sfTmpOrderDetails WHERE odrdttmpSessionID = " & Session("SessionID") & " AND odrdttmpProductID = '" & sProdID & "'" End If Case "odrdtsvd" If bHasAttributes Then sLocalSQL = "SELECT odrdtsvdID, odrattrsvdAttrID FROM sfSavedOrderDetails INNER JOIN sfSavedOrderAttributes ON sfSavedOrderDetails.odrdtsvdID = sfSavedOrderAttributes.odrattrsvdOrderDetailId " _ & " WHERE odrdtsvdCustID=" & Request.Cookies("sfCustomer")("custID") & " AND odrdtsvdProductID = '" & sProdID & "'" Else sLocalSQL = "SELECT odrdtsvdID FROM sfSavedOrderDetails WHERE odrdtsvdCustID=" & Request.Cookies("sfCustomer")("custID") & " AND odrdtsvdProductID = '" & sProdID & "'" End If End Select Set rsSelectProd = Server.CreateObject("ADODB.RecordSet") rsSelectProd.Open sLocalSQL, cnn, adOpenKeyset, adLockOptimistic, adCmdText ' Check if this record exists through prodID and price matches If (rsSelectProd.BOF And rsSelectProd.EOF) Then 'No Records Matching, return -1 iLocalResult = -1 Else If bHasAttributes Then ' -- Debug Use -- Look what has been collected If vDebug = 1 Then Do While Not rsSelectProd.EOF Response.Write "
ID : " & rsSelectProd.Fields(sPrefix & "Id") & " AttrID :" & rsSelectProd.Fields(sAttrPrefix & "AttrID") rsSelectProd.MoveNext Loop End If rsSelectProd.MoveFirst iUpperBound = UBound(aProdAttr) ' Check that there are at least as many product attributes as there are rows If rsSelectProd.RecordCount < cInt(iProdAttrNum) Then getOrderID = -1 Else ' Start comparison of product attributes Do While Not rsSelectProd.EOF For iCounter = 0 to iUpperBound-1 sTmpAttr = aProdAttr(iCounter) ' If sTmpAttr is empty, the attribute specified is no longer available in the db If sTmpAttr = "" or rsSelectProd.EOF Then getOrderID = "" Exit Function Else If cStr(sTmpAttr) = cStr(rsSelectProd.Fields(sAttrPrefix & "AttrID")) Then bMatch = bMatch + 1 End If If vDebug = 1 Then Response.Write "
" & sTmpAttr & " VS " & rsSelectProd.Fields(sAttrPrefix & "AttrID")
If vDebug = 1 Then Response.Write "
bMatch = " & bMatch
If bMatch = cInt(iProdAttrNum) Then
' Return the Found Record
getOrderID = rsSelectProd.Fields(sPrefix & "ID")
Exit Function
End If
' End sTmpAttr Empty If
End If
rsSelectProd.MoveNext
Next
' Reset Match at end of Recordset
bMatch = 0
' Loop through recordset
Loop
' End iProdAttrNum if
End If
' Matched Product with No attributes
Else
getOrderID = rsSelectProd.Fields(sPrefix & "ID")
Exit Function
' End Has Attributes If
End If
' End RecordSet If
End If
closeObj(rsSelectProd)
getOrderID = -1
End Function
'---------------------------------------------------------------------
' Returns the name, price, and type associated with the attribute ID
'---------------------------------------------------------------------
Function getAttrDetails(iAttrID)
Dim sLocalSQL, rsFindAttr, aLocalAttr
sLocalSQL = "SELECT attrName, attrdtName, attrdtPrice, attrdtType FROM sfAttributeDetail INNER JOIN sfAttributes ON sfAttributes.attrID = sfAttributeDetail.attrdtAttributeId WHERE attrdtID = " & iAttrID
Set rsFindAttr = Server.CreateObject("ADODB.RecordSet")
rsFindAttr.Open sLocalSQL, cnn, adOpenDynamic, adLockOptimistic, adCmdText
If rsFindAttr.BOF Or rsFindAttr.EOF Then
If vDebug = 1 Then Response.Write "
Empty Recordset in getAttrNames"
Else
Redim aLocalAttr(4)
aLocalAttr(0) = rsFindAttr.Fields("attrdtName")
aLocalAttr(1) = rsFindAttr.Fields("attrdtPrice")
aLocalAttr(2) = rsFindAttr.Fields("attrdtType")
aLocalAttr(3) = rsFindAttr.Fields("attrName")
End If
closeObj(rsFindAttr)
getAttrDetails = aLocalAttr
End Function
'---------------------------------------------------------------------
' Returns the name, price, and type associated with the attribute ID of Old Order
'---------------------------------------------------------------------
Function getAttrDetailsRetriveOrder(iAttrID)
Dim sLocalSQL, rsFindAttr, aLocalAttr
sLocalSQL = "SELECT odrattrAttribute, odrattrName, odrattrPrice, odrattrType FROM sfOrderAttributes WHERE odrattrID = " & iAttrID
Set rsFindAttr = Server.CreateObject("ADODB.RecordSet")
rsFindAttr.Open sLocalSQL, cnn, adOpenDynamic, adLockOptimistic, adCmdText
If rsFindAttr.BOF Or rsFindAttr.EOF Then
If vDebug = 1 Then Response.Write "
Empty Recordset in getAttrNames"
Else
Redim aLocalAttr(4)
aLocalAttr(0) = rsFindAttr.Fields("odrattrAttribute")
aLocalAttr(1) = rsFindAttr.Fields("odrattrPrice")
aLocalAttr(2) = rsFindAttr.Fields("odrattrType")
aLocalAttr(3) = rsFindAttr.Fields("odrattrName")
End If
closeObj(rsFindAttr)
getAttrDetailsRetriveOrder = aLocalAttr
End Function
'---------------------------------------------------------------------
' This function calculates the subtotal for attributes
'---------------------------------------------------------------------
Function getAttrUnitPrice (dAttrTotal,sAttrPrice,iAttrType)
' Recalculate Price
If iAttrType = 1 Then
dAttrTotal = dAttrTotal + cDbl(sAttrPrice)
ElseIf iAttrType = 2 Then
dAttrTotal = dAttrTotal + cDbl(sAttrPrice)*(-1)
End If
getAttrUnitPrice = dAttrTotal
End Function
'-------------------------------------------------------------------
' Returns the recordset corresponding to a custId identifier
'-------------------------------------------------------------------
Function getRow(sTableName,sIdName,iID,cnn)
Dim sLocalSQL, rsSet
sLocalSQL = "SELECT * FROM " & sTableName & " WHERE " & sIdName & " = " & iID
' Object Creation
Set rsSet = Server.CreateObject("ADODB.RecordSet")
rsSet.Open sLocalSQL, cnn, adOpenForwardOnly, adLockOptimistic, adCmdText
Set getRow = rsSet
End Function
'-------------------------------------------------------------------
' Gets records for tables with multiple records for one customer ID
' Returns the recordset
'-------------------------------------------------------------------
Function getRowActive(sTableName,sIdName,sActiveName,iID,cnn)
Dim sLocalSQL, rsSet
sLocalSQL = "SELECT * FROM " & sTableName & " WHERE " & sIdName & " = " & iID & " AND " & sActiveName & " = 1"
' Object Creation
Set rsSet = Server.CreateObject("ADODB.RecordSet")
rsSet.Open sLocalSQL, cnn, adOpenForwardOnly, adLockOptimistic, adCmdText
Set getRowActive = rsSet
End Function
'--------------------------------------------------------------------
' Function : getCreditCardList
' This returns the credit list in HTML format for dropdown box.
'--------------------------------------------------------------------
Function getCreditCardList()
Dim rsCCList, sLocalSQL, sCCList, iCounter
sLocalSQL = "Select transID, transName From sfTransactionTypes WHERE transType = 'Credit Card' AND transIsActive = 1"
Set rsCCList = Server.CreateObject("ADODB.RecordSet")
rsCCList.Open sLocalSQL, cnn, adOpenKeyset, adLockOptimistic, adCmdText
sCCList = ""
For iCounter = 1 to rsCCList.RecordCount
sCCList = sCCList & ""
rsCCList.MoveNext
Next
getCreditCardList = sCCList
closeObj(rsCCList)
End Function
'-------------------------------------------------------
' Compares email and password, then returns the ID of the customer
' Returns -1 for failed authentication
'-------------------------------------------------------
Function customerAuth(sEmail,sPassword,sType)
Dim sLocalSQL, iCustID, rsGetID
Select Case sType
Case "strict"
sLocalSQL = "SELECT custID FROM sfCustomers WHERE custEmail = '" & sEmail & "' AND custPasswd = '" & sPassword & "' AND custID = " & Session("custID")
Case "loose"
sLocalSQL = "SELECT custID FROM sfCustomers WHERE custEmail = '" & sEmail & "' AND custPasswd = '" & sPassword & "'"
Case "loosest"
sLocalSQL = "SELECT custID FROM sfCustomers WHERE custEmail = '" & sEmail & "'"
Case else
sLocalSQL = "SELECT custID FROM sfCustomers WHERE custEmail = '" & sEmail & "'"
End Select
If sEmail = "" Or sPassword = "" Then
iCustID = -1
Else
Set rsGetID = Server.CreateObject("ADODB.RecordSet")
rsGetID.Open sLocalSQL,cnn,adOpenForwardOnly,adLockReadOnly,adCmdText
If rsGetID.BOF Or rsGetID.EOF Or sEmail = "" Or sPassword = "" Then
iCustID = -1
Else
iCustID = rsGetID.Fields("custID")
End If
End If
customerAuth = iCustID
closeobj(rsGetID)
End Function
'------------------------------------------------------------------
' Gets the InternetCash Merchant ID
'------------------------------------------------------------------
Function getICashMercID()
Dim sLocalSQL, rsICash, iID
sLocalSQL = "SELECT trnsmthdLogin FROM sfTransactionMethods WHERE trnsmthdName = 'InternetCash'"
Set rsICash = Server.CreateObject("ADODB.RecordSet")
rsICash.Open sLocalSQL, cnn, adOpenForwardOnly, adLockReadOnly, adCmdText
If rsICash.EOF or rsICash.BOF Then
Response.Write "Error: No merchant ID set for Internet Cash in table sfTransactionMethods"
Else
iID = trim(rsICash.Fields("trnsmthdLogin"))
End If
closeobj(rsICash)
getICashMercID = iID
End Function
'------------------------------------------------------------------
' Gets shipping types
'------------------------------------------------------------------
Function getShipped(sProdID)
Dim rsProdShipped, SQL
SQL = "SELECT prodShipIsActive FROM sfProducts WHERE prodID = '" & sProdID & "'"
Set rsProdShipped = Server.CreateObject("ADODB.Recordset")
rsProdShipped.Open SQL, cnn, adOpenForwardOnly, adLockReadOnly, adCmdText
getShipped = rsProdShipped(0)
closeObj(rsProdShipped)
End Function
'---------------------------------------------------------------
' To see if it is a saved cart customer
' Returns a boolean value
'---------------------------------------------------------------
Function CheckSavedCartCustomer(iCustID)
Dim sSQL, rsTmp, bTruth
sSQL = "SELECT custFirstName FROM sfCustomers WHERE custID=" & iCustID
bTruth = false
Set rsTmp = Server.CreateObject("ADODB.RecordSet")
rsTmp.Open sSQL,cnn,adOpenDynamic,adLockOptimistic,adCmdText
If NOT rsTmp.EOF Then
If trim(rsTmp.Fields("custFirstName")) = "Saved Cart Customer" Then
bTruth = true
Else
bTruth = false
End If
End If
closeobj(rsTmp)
CheckSavedCartCustomer = bTruth
End Function
'--------------------------------------------------------
' Checks if Customer exists in customer table
'--------------------------------------------------------
Function CheckCustomerExists(iCustID)
Dim sSQL, rsCust, bExists
sSQL = "SELECT custID FROM sfCustomers WHERE custID = " & iCustID
Set rsCust = Server.CreateObject("ADODB.RecordSet")
rsCust.Open sSQL, cnn, adOpenDynamic, adLockOptimistic, adCmdText
If NOT rsCust.EOF Then
If cInt(rsCust.Fields("custID")) > 0 Then
bExists = true
Else
bExists = false
End If
Else
bExists = false
End If
CheckCustomerExists = bExists
End Function
Function getCurrencyISO(slcid)
Dim rsSelect
dim sSql ,strLcid
set rsSelect = server.CreateObject ("ADODB.Recordset")
sSql = "Select slctvalLCID,slctvalCurrencyISO From sfSelectValues Where slctvalLCID = " & "'" & slcid & "'"
rsSelect.Open sSql ,cnn,adOpenForwardOnly ,adLockReadOnly,adcmdtext
getCurrencyISO = trim(rsSelect.Fields("slctvalCurrencyISO"))
'Response.Write getCurrencyISO & "what the"
rsSelect.Close
set rsSelect = nothing
End Function
Function DeleteOrder(sID)
Dim rsDelete 'As New ADODB.Recordset
Dim rsDelete1 'As New ADODB.Recordset
Dim rsDelete2 'As New ADODB.Recordset
Dim rsDelete3 'As New ADODB.Recordset
Dim vOrderId 'As Variant
Dim sSql
On Error Resume Next
Set rsDelete = Server.CreateObject("ADODB.RecordSet")
Set rsDelete1 = Server.CreateObject("ADODB.RecordSet")
Set rsDelete2 = Server.CreateObject("ADODB.RecordSet")
Set rsDelete3 = Server.CreateObject("ADODB.RecordSet")
sSql = "SELECT * FROM sfOrders" _
& " WHERE orderID = " & sID
rsDelete.Open sSql, Cnn, adOpenKeyset, adLockOptimistic, adCmdText
vOrderId = rsDelete("orderAddrId")
sSql = "SELECT * FROM sfOrderDetails WHERE odrdtOrderId = " & rsDelete.Fields("orderID")
rsDelete2.Open sSql, Cnn, adOpenKeyset, adLockOptimistic, adCmdText
' '''''rsOrderCredit
sSql = "SELECT * FrOM sfCPayments WHERE payID = " & Trim(rsDelete.Fields("orderPayId"))
rsDelete3.Open sSql, Cnn, adOpenKeyset, adLockOptimistic, adCmdText
rsDelete.Delete
'rsDelete1.Delete adAffectCurrent
rsDelete2.Delete
rsDelete3.Delete
Set rsDelete = Nothing
Set rsDelete1 = Nothing
Set rsDelete2 = Nothing
Set rsDelete3 = Nothing
End Function
Function Reset_Shipping()
Dim sSql,RstProd,rsttmpOrder
Set rstProd = Server.CreateObject("ADODB.RecordSet")
Set rsttmpOrder = Server.CreateObject("ADODB.RecordSet")
sSql = "SELECT * FROM sfTmpOrderDetails" _
& " WHERE odrdttmpSessionID = " & Session("SessionID")
rsttmpOrder.Open sSql, Cnn, adOpenKeyset, adLockOptimistic, adCmdText
While rsttmpOrder.EOF =False
sSql = "SELECT prodShipIsActive FROM sfProducts " _
& " WHERE prodID = '" & rsttmpOrder("odrdttmpProductID") & "'"
RstProd.Open sSql,cnn,adOpenStatic ,adLockReadOnly ,1
If Not isNull(RstProd("prodShipIsActive")) then
rsttmpOrder("odrdttmpShipping") = RstProd("prodShipIsActive")
Else
rsttmpOrder("odrdttmpShipping") = 0
end if
rsttmpOrder.Update
rsttmpOrder.MoveNext
Wend
On error Resume Next
rsttmpOrder.Close
rstProd.Close
Set rstProd =Nothing
Set rsttmpOrder = Nothing
End Function
%>
[an error occurred while processing this directive]
[an error occurred while processing this directive]
[an error occurred while processing this directive]
<%
'@BEGINVERSIONINFO
'@APPVERSION: 50.4013.0.3
'@FILENAME: search_results.asp
'@DESCRIPTION: Displays search results
'@STARTCOPYRIGHT
'The contents of this file is protected under the United States
'copyright laws and is confidential and proprietary to
'LaGarde, Incorporated. Its use or disclosure in whole or in part without the
'expressed written permission of LaGarde, Incorporated is expressly prohibited.
'
'(c) Copyright 2000, 2001 by LaGarde, Incorporated. All rights reserved.
'@ENDCOPYRIGHT
'@ENDVERSIONINFO
'Modified 11/20/01
'Storefront Ref#'s: 128 'JF
'Storefront Ref#'s: 219 'DP
' Constant Declarations
const varDebug = 0 'DeBug Setting
const iPageSize = 10 'Records Per Page
const iMaxRecords = 0 'Maximum amount of records returned, 0 is no maximum
Dim txtsearchParamTxt, txtsearchParamType, txtsearchParamCat, txtFromSearch, txtsearchParamMan
Dim txtCatName, txtsearchParamVen, txtImagePath, txtOutput, txtDateAddedStart
Dim txtDateAddedEnd, txtPriceStart, txtPriceEnd, txtSale, SQL, sAmount, rsCatImage
Dim iAttCounter, irsSearchAttRecordCount, iAttDetailCounter, irsSearchAttDetailRecordCount
Dim iPage, iRec, iNumOfPages, iDesignCounter, iVarPageSize, iSearchRecordCount, icounter, iDesign
Dim rsCat, rsSearch, rsSearchAtt, rsSearchAttDetail, arrAttDetail, arrProduct, arrAtt, rsManufacturer, rsVendor
dim CurrencyISO,sSubCat,sALLSUB,X,sMainCat ,iLevel,sNextLevel
'sfAE
dim bDuplicate,iDupRec
iDesign = C_DesignType 'Layout Selection
iDesignCounter = 2
iVarPageSize = iPageSize ' Records Per Page
txtFromSearch = Trim(Request.Form("txtFromSearch"))
sSubCat = Request.item("subcat")
if sSubCat = "" then
sSubCat = Request.item("txtsearchParamCat")
end if
sALLSUB = Request.item("txtsearchParamCat")
iLevel = Request.item("iLevel")
if ilevel = 2 and sALLSUB = "ALL" then
sSubCat = Request.item("subcat")
end if
' Requests the variables depending on how the page is entered
If txtFromSearch = "fromSearch" Then
txtsearchParamTxt = trim(Replace(Replace(Request.Form("txtsearchParamTxt"), "'", "''"), "*", ""))
txtsearchParamType = trim(Request.Form("txtsearchParamType"))
if Ilevel = 2 and sALLSUB = "ALL" then
txtsearchParamCat = sSubCat
Ilevel = 1
else
txtsearchParamCat = trim(Request.QueryString("txtsearchParamCat"))
end if
txtsearchParamMan = trim(Request.Form("txtsearchParamMan"))
txtsearchParamVen = trim(Request.Form("txtsearchParamVen"))
txtDateAddedStart = MakeUSDate(trim(Request.Form("txtDateAddedStart")))
txtDateAddedEnd = MakeUSDate(trim(Request.Form("txtDateAddedEnd")))
txtPriceStart = trim(Request.Form("txtPriceStart"))
txtPriceEnd = trim(Request.Form("txtPriceEnd"))
txtSale = trim(Request.Form("txtSale"))
Else
txtsearchParamTxt = trim(Replace(Replace(Request.QueryString("txtsearchParamTxt"), "'", "''"), "*", ""))
txtsearchParamType = trim(Request.QueryString("txtsearchParamType"))
if Ilevel = 2 and sALLSUB = "ALL" then
txtsearchParamCat = sSubCat
Ilevel = 1
else
txtsearchParamCat = trim(Request.QueryString("txtsearchParamCat"))
end if
txtsearchParamMan = trim(Request.QueryString("txtsearchParamMan"))
txtsearchParamVen = trim(Request.QueryString("txtsearchParamVen"))
txtDateAddedStart = MakeUSDate(trim(Request.QueryString("txtDateAddedStart")))
txtDateAddedEnd = MakeUSDate(trim(Request.QueryString("txtDateAddedEnd")))
txtPriceStart = trim(Request.QueryString("txtPriceStart"))
txtPriceEnd = trim(Request.QueryString("txtPriceEnd"))
txtSale = trim(Request.QueryString("txtSale"))
End If
CurrencyISO = getCurrencyISO(Session.LCID)
If iConverion = 1 Then Response.Write ""
Set rsSearch = Server.CreateObject("ADODB.RecordSet")
' -------------------------------------------
' RecordSet Paging Setup --------------------
' -------------------------------------------
if Application("AppName")="StoreFrontAE" then
dim iSubCat
iSubCat = sSubCat
SQL = getProductSQLAE(txtsearchParamType, txtsearchParamTxt, txtsearchParamCat, txtsearchParamMan, _
txtsearchParamVen, txtDateAddedStart, txtDateAddedEnd, txtPriceStart, txtPriceEnd, txtSale,iSubCat,iLevel)
if txtsearchParamCat <> "ALL" then
sNextLevel = getSubCategoryList(ilevel,sSubcat)
if trim(snextlevel) <> "" then
iLevel = Ilevel + 1
end if
End if
else
SQL = getProductSQL(txtsearchParamType, txtsearchParamTxt, txtsearchParamCat, txtsearchParamMan, _
txtsearchParamVen, txtDateAddedStart, txtDateAddedEnd, txtPriceStart, txtPriceEnd, txtSale)
end if
If varDebug = 1 Then Response.Write SQL & "
"
With rsSearch
.CursorLocation = adUseClient
.CacheSize = iVarPageSize
.MaxRecords = iMaxRecords
.Open SQL, cnn, adOpenForwardOnly, adLockReadOnly, adCmdText
.PageSize = iVarPageSize
End With
'Response.Write SQL
'Response.end
' Determine the page user is requesting
If Request.QueryString("PAGE") = "" Then
iPage = 1
Else
iPage = CInt(Request.QueryString("PAGE"))
' Protect against out of range pages, in case
' of a user specified page number
If iPage < 1 Then
iPage = 1
Else
If iPage > rsSearch.PageCount Then
iPage = rsSearch.PageCount
Else
iPage = CInt(Request.QueryString("PAGE"))
End If
End If
End If
'create arrays for display
'arrProduct = rsSearch.GetRows(iVarPageSize)
if rsSearch.BOF and rsSearch.EOF then
iSearchRecordCount=0
else
arrProduct = rsSearch.GetRows()
iSearchRecordCount=ubound(arrProduct,2) + 1
iNumOfPages = Int(iSearchRecordCount / iPageSize)
end if
If CInt(iNumOfPages+1) = CInt(iPage) Then iVarPageSize = iSearchRecordCount - (iNumOfPages * iPageSize)
'Response.Write "
iVarPageSize " & iVarPageSize & "
iSearchRecordCount - (iNumOfPages * iPageSize)"
'Response.Write "
" & iSearchRecordCount & "-" & "(" & iNumOfPages & " * " & iPageSize & ") = " & iSearchRecordCount - (iNumOfPages * iPageSize)
'Corrects Number of Pages if there is overflow less then records per page
If iSearchRecordCount mod iPageSize <> 0 Then iNumOfPages = iNumOfPages + 1
If rsSearch.bof=false and rsSearch.eof=true then
rsSearch.movefirst
end if
If NOT rsSearch.EOF Then rsSearch.AbsolutePage = CInt(iPage)
' Create Attribute Record Sets for product on page
SQL = getAttributeSQL(rsSearch, iVarPageSize, iPage)
If varDebug = 1 Then Response.Write SQL & "
"
Set rsSearchAtt = Server.CreateObject("ADODB.RecordSet")
If SQL <> "" Then
rsSearchAtt.Open SQL, cnn, adOpenKeyset, adLockReadOnly, adCmdText
SQL = getAttributeDetailSQL(rsSearchAtt)
If varDebug = 1 Then Response.Write SQL & "
"
If SQL <> "" Then
Set rsSearchAttDetail = Server.CreateObject("ADODB.RecordSet")
rsSearchAttDetail.Open SQL, cnn, adOpenKeyset, adLockReadOnly, adCmdText
End If
End If
If txtsearchParamCat = "ALL" Then
txtCatName = "All " & C_CategoryNameP
Else
If Not rsSearch.EOF Then
if Application("AppName")<> "StoreFrontAE" then
txtCatName = rsSearch.Fields("catName")
else
Dim arrTemp
on error resume next
if txtsearchParamCat = "ALL" then
arrTemp = GetFullPath(rsSearch.Fields("CatHierarchy"),1,iSubCat)
else
arrTemp = GetFullPath(rsSearch.Fields("CatHierarchy"),1,iSubCat)
end if
txtCatName = arrtemp
end if
Else
if Application("AppName")<> "StoreFrontAE" then
set rsCat = Server.CreateObject("ADODB.RecordSet")
SQL = getCategorySQL(txtsearchParamCat)
rsCat.Open SQL, cnn, adOpenForwardOnly, adLockReadOnly, adCmdText
txtCatName = rsCat.Fields("catName")
closeObj(rsCat)
else
on error resume next
txtCatName =GetFullPath(Request.Item("txtCatName"),1,iSubCat)
end if
End If
End If
If txtsearchParamTxt = "" Then txtsearchParamTxt = "*"
%>
|
|||||||||||||
| |||||||||||||
|
|
|||||||||||||
|